/* *************************************************************** * * * Copyright (c) 1982 by Massachusetts Institute of Technology * * * *************************************************************** */ /****^ HISTORY COMMENTS: 1) change(89-02-27,TLNguyen), approve(89-02-27,MCR8049), audit(89-02-28,Parisek), install(89-03-15,MR12.3-1025): a. replaced create_branch_version_1 with create_branch_version_2. b. removed an automatic variable named hash since there are no references to this variable. END HISTORY COMMENTS */ forum_notifications_$accept: procedure (P_status); /* Jay Pattin 03/26/82 */ /* Reworked for move into ring 1 - Jay Pattin 11/6/82 */ /* Gutted and redone Jeffrey I. Schiller 09/21/83 */ /* Fixed write-down bug found during security audit - J. Spencer Love 10/05/84 */ declare P_status fixed bin (35) parameter, P_result bit (1) aligned parameter, P_user_name char (*) parameter; declare notify_seg_ptr ptr static init (null ()), me char (22) static init (""), my_authorization bit (72) aligned static init (""b), my_lock_id bit (36) aligned static init (""b); declare notify_seg_entry char (32) static options (constant) init ("Notifications Database"), sentinel bit (36) aligned static options (constant) init ("123456765432"b3); declare exit label variable, (inner_ring, user_ring) fixed bin (3), max_auth bit (72) aligned, (notify_idx, chain, slot) fixed bin, p ptr, status fixed bin (35), system_high bit (72) aligned, user_name char (22); declare forum_data_$central_directory char (168) external; declare (error_table_$lock_wait_time_exceeded, error_table_$invalid_lock_reset, error_table_$locked_by_this_process, error_table_$noentry, error_table_$no_w_permission, forum_error_table_$need_system_high, forum_error_table_$no_notify_seg, forum_error_table_$notify_seg_bad, forum_error_table_$unexpected_fault) fixed bin (35) external; declare (addr, hbound, length, null, rtrim, unspec) builtin, (any_other, cleanup, no_write_permission) condition; declare 1 notify_seg aligned based (notify_seg_ptr), 2 sentinel bit (36) aligned, 2 lock bit (36) aligned, 2 first_free fixed bin, /* free list head */ 2 highest_used fixed bin, /* highest index actually in use */ 2 first_slot (200) fixed bin, /* hash table */ 2 user (0 refer (notify_seg.highest_used)), 3 name char (22), 3 lock_id bit (36) aligned, 3 authorization bit (72) aligned, 3 next_slot fixed bin; declare 1 cbi aligned like create_branch_info; declare convert_authorization_$from_string entry (bit (72) aligned, char (*), fixed bin (35)), get_authorization_ entry (bit (72) aligned), get_max_authorization_ entry returns (bit (72) aligned), get_lock_id_ entry (bit(36) aligned), get_ring_ entry returns (fixed bin (3)), hash_index_ entry (ptr, fixed bin, fixed bin, fixed bin) returns (fixed bin), hcs_$create_branch_ entry (char(*), char(*), ptr, fixed bin(35)), hcs_$delentry_file entry (char(*), char(*), fixed bin(35)), hcs_$initiate entry (char(*), char(*), char(*), fixed bin(1), fixed bin(2), ptr, fixed bin(35)), hcs_$level_get entry returns (fixed bin (3)), hcs_$level_set entry (fixed bin (3)), hcs_$terminate_noname entry (ptr, fixed bin(35)), set_lock_$lock entry (bit(36) aligned, fixed bin, fixed bin(35)), set_lock_$unlock entry (bit(36) aligned, fixed bin(35)), user_info_$whoami entry (char(*), char(*), char(*)); %page; %include create_branch_info; %page; /* forum_notifications_$accept: procedure (P_status); */ user_ring = hcs_$level_get (); on cleanup call unlock_db (); call initialize (ACCEPT_EXIT); call lock_db (); notify_idx = lookup (me, chain); if notify_idx = 0 then do; slot = allocate_slot (); call thread_in (chain, slot); end; call unlock_db (); P_status = 0; return; ACCEPT_EXIT: REFUSE_EXIT: P_status = status; call unlock_db (); return; forum_notifications_$accept_test: entry (P_user_name, P_status); user_name = P_user_name; user_ring = hcs_$level_get (); on cleanup call unlock_db (); call initialize (ACCEPT_EXIT); call lock_db (); notify_idx = lookup (user_name, chain); if notify_idx = 0 then do; slot = allocate_slot (); notify_seg.user (slot).name = user_name; call thread_in (chain, slot); end; call unlock_db (); P_status = 0; return; %page; forum_notifications_$refuse: entry (P_status); user_ring = hcs_$level_get (); on cleanup call unlock_db (); call initialize (REFUSE_EXIT); call lock_db (); notify_idx = lookup (me, chain); if notify_idx > 0 then do; call thread_out (chain, notify_idx); call free_slot (notify_idx); end; call unlock_db (); P_status = 0; return; %page; forum_notifications_$lookup: entry (P_user_name, P_result, P_status); user_ring = hcs_$level_get (); on cleanup call unlock_db (); call initialize (LOOKUP_EXIT); call lock_db (); user_name = P_user_name; notify_idx = lookup (user_name, chain); if notify_idx = 0 then P_result = "0"b; else P_result = "1"b; call unlock_db (); P_status = 0; return; LOOKUP_EXIT: P_status = status; P_result = "0"b; call unlock_db (); return; %page; forum_notifications_$init: entry (P_status); exit = INIT_EXIT; inner_ring = get_ring_ (); user_ring = hcs_$level_get (); on cleanup begin; call hcs_$delentry_file (forum_data_$central_directory, notify_seg_entry, (0)); call hcs_$level_set (user_ring); end; on any_other call error (forum_error_table_$unexpected_fault); call convert_authorization_$from_string (system_high, "system_high", status); if status ^= 0 then call error (status); max_auth = get_max_authorization_ (); if max_auth ^= system_high then call error (forum_error_table_$need_system_high); call hcs_$level_set (inner_ring); call hcs_$delentry_file (forum_data_$central_directory, notify_seg_entry, status); if status ^= 0 & status ^= error_table_$noentry then call error (status); unspec (cbi) = ""b; cbi.version = create_branch_version_2; cbi.priv_upgrade_sw = "1"b; cbi.mode = "101"b; /* RW */ cbi.rings (*) = inner_ring; cbi.userid = "*.*.*"; cbi.access_class = max_auth; call hcs_$create_branch_ (forum_data_$central_directory, notify_seg_entry, addr (cbi), status); if status ^= 0 then call error (status); call hcs_$initiate (forum_data_$central_directory, notify_seg_entry, "", 0, 0, notify_seg_ptr, status); if notify_seg_ptr = null () then call error (status); notify_seg.first_free, notify_seg.highest_used = 0; notify_seg.sentinel = sentinel; p = notify_seg_ptr; notify_seg_ptr = null (); call hcs_$terminate_noname (p, (0)); call hcs_$level_set (user_ring); P_status = 0; return; INIT_EXIT: call hcs_$delentry_file (forum_data_$central_directory, notify_seg_entry, (0)); call hcs_$level_set (user_ring); P_status = status; return; %page; lock_db: procedure; on no_write_permission call error (error_table_$no_w_permission); call set_lock_$lock (notify_seg.lock, 5, status); if status ^= 0 & status ^= error_table_$invalid_lock_reset then call error (status); return; end lock_db; unlock_db: procedure; on no_write_permission begin; goto PUNT; end; if notify_seg_ptr ^= null () then call set_lock_$unlock (notify_seg.lock, (0)); PUNT: call hcs_$level_set (user_ring); return; end unlock_db; %page; lookup: proc (user_name, hash) returns (fixed bin); dcl user_name char (*); dcl hash fixed bin; dcl last_slot fixed bin; dcl slot fixed bin; hash = hash_index_ (addr (user_name), length (rtrim (user_name)), 0, hbound (notify_seg.first_slot, 1)) + 1; lookup_retry: last_slot = 0; do slot = notify_seg.first_slot (hash) repeat notify_seg.user (slot).next_slot while (slot ^= 0); NEXT: call set_lock_$lock (notify_seg.user.lock_id (slot), 0, status); if status ^= error_table_$lock_wait_time_exceeded & status ^= error_table_$locked_by_this_process then do; call thread_out (chain, slot); call free_slot (slot); goto lookup_retry; end; else if notify_seg.user (slot).name = user_name then do; if notify_seg.user (slot).authorization = my_authorization then return (slot); end; else last_slot = slot; end; return (0); end lookup; %page; allocate_slot: procedure () returns (fixed bin); dcl slot fixed bin; if notify_seg.first_free = 0 then call gc (); slot = notify_seg.first_free; notify_seg.first_free = notify_seg.user (slot).next_slot; notify_seg.user (slot).name = me; notify_seg.user (slot).lock_id = my_lock_id; notify_seg.user (slot).authorization = my_authorization; notify_seg.user (slot).next_slot = 0; return (slot); end allocate_slot; %page; free_slot: proc (slot); dcl slot fixed bin; notify_seg.user (slot).name = ""; notify_seg.user (slot).lock_id = ""b; notify_seg.user (slot).authorization = ""b; notify_seg.user (slot).next_slot = notify_seg.first_free; notify_seg.first_free = slot; return; end free_slot; %page; thread_in: proc (chain, inslot); dcl (chain, inslot) fixed bin; dcl slot fixed bin; dcl last_slot fixed bin; last_slot = 0; do slot = notify_seg.first_slot (chain) repeat notify_seg.user (slot).next_slot while (slot ^= 0); last_slot = slot; end; if last_slot = 0 then notify_seg.first_slot (chain) = inslot; else notify_seg.user (last_slot).next_slot = inslot; return; end thread_in; %page; thread_out: proc (chain, outslot); dcl chain fixed bin; dcl outslot fixed bin; dcl last_slot fixed bin; dcl slot fixed bin; last_slot = 0; do slot = notify_seg.first_slot (chain) repeat notify_seg.user (slot).next_slot while (slot ^= 0); if slot = outslot then do; if last_slot = 0 then notify_seg.first_slot (chain) = notify_seg.user (slot).next_slot; else notify_seg.user (last_slot).next_slot = notify_seg.user (slot).next_slot; notify_seg.user (slot).next_slot = 0; return; end; last_slot = slot; end; return; end thread_out; %page; gc: proc (); dcl (idx, slot) fixed bin; dcl freed bit (1) aligned; freed = "0"b; do idx = 1 to hbound (notify_seg.first_slot, 1); retry_gc_idx: do slot = notify_seg.first_slot (idx) repeat notify_seg.user (slot).next_slot while (slot > 0); call set_lock_$lock (notify_seg.user.lock_id (slot), 0, status); if status ^= error_table_$lock_wait_time_exceeded & status ^= error_table_$locked_by_this_process then do; call thread_out (idx, slot); call free_slot (slot); freed = "1"b; goto retry_gc_idx; end; end; end; if ^freed then do; notify_seg.highest_used = notify_seg.highest_used + 1; notify_seg.first_free = notify_seg.highest_used; end; return; end gc; %page; initialize: procedure (P_exit); declare P_exit label variable; exit = P_exit; inner_ring = get_ring_ (); call hcs_$level_set (inner_ring); if notify_seg_ptr = null () then do; call hcs_$initiate (forum_data_$central_directory, notify_seg_entry, "", 0, 0, notify_seg_ptr, (0)); if notify_seg_ptr = null () then call error (forum_error_table_$no_notify_seg); if notify_seg.sentinel ^= sentinel then do; call hcs_$terminate_noname (notify_seg_ptr, (0)); notify_seg_ptr = null (); call error (forum_error_table_$notify_seg_bad); end; call user_info_$whoami (me, "", ""); call get_lock_id_ (my_lock_id); call get_authorization_ (my_authorization); end; return; end initialize; error: procedure (P_status); declare P_status fixed bin (35); status = P_status; goto exit; end error; end forum_notifications_$accept; */ ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull and Bull HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato. Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by Bull HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved */