forum_mgr_tv_.alm 10/30/84 1244.0r 10/30/84 0958.5 18414 " *************************************************************** " * * " * Copyright (c) 1982 by Massachusetts Institute of Technology * " * * " *************************************************************** " " Transfer vector for bound_v1_forum_mgr_ " Designed to avoid problems with installations. " " Jay Pattin 5/9/82 name forum_mgr_tv_.alm macro tv segdef &2 &2: getlp &=&3.,.&[ tra &1$&2 &; tra &1$&3 &] &end tv v1_forum_mgr_,open_forum tv v1_forum_mgr_,close_forum tv v1_forum_seg_mgr_,list_forum_acl tv v1_forum_mgr_,set_switch tv v1_forum_mgr_,set_switch_idx tv v1_forum_mgr_,set_event_channel tv v1_forum_mgr_,set_event_channel_idx tv v1_forum_trans_mgr_,convert_attendee_idx tv v1_forum_trans_mgr_,validate_uid tv v1_forum_trans_mgr_,get_message tv v1_forum_trans_mgr_,enter_trans tv v1_forum_trans_mgr_,read_trans tv v1_forum_trans_mgr_,set_delete_sw tv v1_forum_trans_mgr_,forum_limits tv v1_forum_trans_mgr_,real_forum_limits tv v1_forum_mgr_,list_users tv v1_forum_mgr_,list_users_idx tv v1_forum_trans_mgr_,trans_ref_info tv v1_forum_trans_mgr_,real_trans_ref_info tv v1_forum_trans_mgr_,trans_time_info tv v1_forum_trans_mgr_,check_user tv v1_forum_mgr_,set_last_seen_idx tv v1_forum_mgr_,forum_info tv v1_forum_mgr_,forum_info_idx tv v1_forum_seg_mgr_,get_forum_path tv v1_forum_seg_mgr_,get_forum_path_idx tv v1_forum_seg_mgr_,get_uid_file tv v1_forum_seg_mgr_,create_forum tv v1_forum_seg_mgr_,chname_forum tv v1_forum_seg_mgr_,chname_forum_idx tv v1_forum_seg_mgr_,delete_forum tv v1_forum_seg_mgr_,set_forum_acl tv v1_forum_trans_mgr_,set_message tv v1_forum_mgr_,change_chairman tv v1_forum_mgr_,change_chairman_idx tv v1_forum_gc_,expunge tv v1_forum_mgr_,priv_change_chairman tv v1_forum_seg_mgr_,priv_delete_forum tv v1_forum_seg_mgr_,priv_set_forum_acl tv v1_forum_mgr_,priv_set_switch tv v1_forum_mgr_,set_global_switch end  v1_forum_gc_.pl1 10/30/84 1244.0r 10/30/84 0958.5 92223 /* *************************************************************** * * * Copyright (c) 1982 by Massachusetts Institute of Technology * * * *************************************************************** */ v1_forum_gc_$expunge: proc (P_forum_idx, P_switches_word, P_participants_deleted, P_trans_deleted, P_participants_damaged, P_trans_damaged, P_status); /* Garbage collector for forum meetings 6/23/82 Jay Pattin */ declare (P_forum_idx, P_participants_deleted, P_trans_deleted, P_participants_damaged, P_trans_damaged) fixed bin parameter, P_switches_word bit (36) aligned, P_status fixed bin (35) parameter; declare attendee_count fixed bin, current_loc fixed bin (19), deleted_count fixed bin, forum_idx fixed bin, idx fixed bin, inner_ring fixed bin (3), new_control_ptr ptr, new_proc_len fixed bin (19), new_proc_ptr ptr, new_trans_ptr ptr, project char (9), trans_deleted fixed bin, users_deleted fixed bin, users_damaged fixed bin, trans_damaged fixed bin, old_trans_ptr ptr, seg_len fixed bin (21), seg (seg_len) fixed bin based, status fixed bin (35), trans_len fixed bin (21), trans char (trans_len) based, user_name char (22), user_ring fixed bin (3); declare 1 new_control aligned like forum_control based (new_control_ptr), 1 damaged_transaction aligned like one_transaction; declare 1 switches based (addr (P_switches_word)), 2 transactions bit (1) unaligned, 2 users bit (1) unaligned; declare (any_other, cleanup, out_of_bounds) condition, (addr, clock, collate, currentsize, min, null, ptr, string, substr, unspec, verify) builtin; declare me char (12) static options (constant) init ("v1_forum_gc_"); declare (error_table_$out_of_bounds, forum_error_table_$chairman_only, forum_error_table_$unexpected_fault) fixed bin (35) external; declare v1_forum_mgr_$get_ptrs entry (fixed bin, ptr, ptr, fixed bin, bit (1) aligned, fixed bin (35)), v1_forum_mgr_$unlock entry (ptr), get_lock_id_ entry returns (bit (36) aligned), get_ring_ entry returns (fixed bin (3)), get_temp_segment_ entry (char (*), ptr, fixed bin (35)), hcs_$level_get entry returns (fixed bin (3)), hcs_$level_set entry (fixed bin (3)), hcs_$truncate_seg entry (ptr, fixed bin (19), fixed bin (35)), release_temp_segment_ entry (char (*), ptr, fixed bin (35)), user_info_$whoami entry (char(*), char(*), char(*)); %page; %include v1_forum_structures; %page; forum_idx = P_forum_idx; trans_deleted, users_deleted, trans_damaged, users_damaged = 0; attendee_count, deleted_count, current_loc, new_proc_len = 0; status = 0; forum_control_ptr, new_proc_ptr, new_control_ptr = null (); inner_ring = get_ring_ (); user_ring = hcs_$level_get (); on any_other call error (forum_error_table_$unexpected_fault); on out_of_bounds call error (error_table_$out_of_bounds); on cleanup begin; call v1_forum_mgr_$unlock (forum_control_ptr); call release_temp_segment_ (me, new_control_ptr, (0)); call release_temp_segment_ (me, new_proc_ptr, (0)); call hcs_$level_set (user_ring); end; call v1_forum_mgr_$get_ptrs (forum_idx, forum_control_ptr, proceedings_ptr, (0), ("0"b), status); if status ^= 0 then call error (status); call user_info_$whoami (user_name, project, ""); if forum_control.chairman.person_id ^= user_name then call error (forum_error_table_$chairman_only); call hcs_$level_set (inner_ring); call get_temp_segment_ (me, new_control_ptr, status); if status ^= 0 then call error (status); call get_temp_segment_ (me, new_proc_ptr, status); if status ^= 0 then call error (status); /* First build the control header */ new_control.forum_lock = get_lock_id_ (); /* just to be safe */ new_control.no_deleted, new_control.no_attendees, new_control.next_trans_loc = 0; /* yet to be determined */ new_control.flags = forum_control.flags; string (new_control.flags.mbz0) = ""b; string (new_control.flags.mbz1) = ""b; new_control.no_transactions = forum_control.no_transactions; /* this won't change */ new_control.mbz2 = ""b; new_control.chairman = forum_control.chairman; if forum_control.msg_init then do; /* put cmsg at front of proceedings */ new_control.message_loc = 0; new_proc_len = 64; trans_len = 256; old_trans_ptr = ptr (proceedings_ptr, forum_control.message_loc); new_proc_ptr -> trans = old_trans_ptr -> trans; end; %page; /* now let's gc the participants */ do idx = 1 to forum_control.no_attendees; if damaged_user (idx) then users_damaged = users_damaged + 1; else if ^switches.users | ^forum_control.attendee (idx).deleted then do; attendee_count = attendee_count + 1; unspec (new_control.attendee (attendee_count)) = unspec (forum_control.attendee (idx)); new_control.attendee (attendee_count).unused_flags = "0"b; if forum_control.attendee (idx).highest_trans_seen < 0 then new_control.attendee (attendee_count).highest_trans_seen = forum_control.no_transactions; else new_control.attendee (attendee_count).highest_trans_seen = min (forum_control.attendee (idx).highest_trans_seen, forum_control.no_transactions); end; else users_deleted = users_deleted + 1; end; new_control.no_attendees = attendee_count; /* and now the proceedings */ unspec (damaged_transaction) = ""b; damaged_transaction.gone, damaged_transaction.deleted = "1"b; do idx = 1 to forum_control.no_transactions; if unspec (forum_control.transactions (idx)) = unspec (damaged_transaction) then unspec (new_control.transactions (idx)) = unspec (damaged_transaction); else if damaged (idx) then do; trans_damaged = trans_damaged + 1; unspec (new_control.transactions (idx)) = ""b; new_control.transactions (idx).gone, new_control.transactions (idx).deleted = "1"b; end; else do; unspec (new_control.transactions (idx)) = unspec (forum_control.transactions (idx)); if switches.transactions & forum_control.transactions (idx).deleted then do; deleted_count = deleted_count + 1; if ^forum_control.transactions (idx).gone then do; trans_deleted = trans_deleted + 1; if forum_control.transactions (idx).prior_ref_index > 0 then new_control.transactions (forum_control.transactions (idx).prior_ref_index).next_ref_index = forum_control.transactions (idx).next_ref_index; if forum_control.transactions (idx).next_ref_index > 0 then forum_control.transactions (forum_control.transactions (idx).next_ref_index).prior_ref_index = forum_control.transactions (idx).prior_ref_index; end; new_control.transactions (idx).gone = "1"b; new_control.transactions (idx).offset, new_control.transactions (idx).length = 0; end; else do; new_control.transactions (idx).offset = new_proc_len; trans_len = forum_control.transactions (idx).length; new_trans_ptr = ptr (new_proc_ptr, new_proc_len); current_loc = forum_control.transactions (idx).offset; old_trans_ptr = ptr (proceedings_ptr, current_loc); new_trans_ptr -> trans = old_trans_ptr -> trans; new_proc_len = new_proc_len + (trans_len + 3)/4; end; end; end; new_control.no_deleted = deleted_count; new_control.next_trans_loc = new_proc_len; /* COPY THE MEETING BACK HERE */ seg_len = currentsize (new_control); forum_control_ptr -> seg = new_control_ptr -> seg; seg_len = new_proc_len; proceedings_ptr -> seg = new_proc_ptr -> seg; %page; /* Now truncate proceedings segment and clean up */ call hcs_$truncate_seg (proceedings_ptr, new_proc_len, status); if status ^= 0 then call error (status); call v1_forum_mgr_$unlock (forum_control_ptr); call release_temp_segment_ (me, new_proc_ptr, status); if status ^= 0 then call error (status); call release_temp_segment_ (me, new_control_ptr, status); if status ^= 0 then call error (status); call hcs_$level_set (user_ring); P_participants_deleted = users_deleted; P_trans_deleted = trans_deleted; P_participants_damaged = users_damaged; P_trans_damaged = trans_damaged; P_status = 0; return; PUNT: P_status = status; call hcs_$level_set (user_ring); P_participants_deleted, P_trans_deleted, P_participants_damaged, P_trans_damaged = 0; return; %page; damaged_user: proc (idx) returns (bit (1) aligned); declare idx fixed bin; if verify (forum_control.attendee (idx).project_id, substr (collate (), 9)) ^= 0 then return ("1"b); if verify (forum_control.attendee (idx).project_id, substr (collate (), 9)) ^= 0 then return ("1"b); if forum_control.attendee (idx).project_id = "" | forum_control.attendee (idx).person_id = "" then return ("1"b); return ("0"b); end damaged_user; /* Check to see if a transaction looks like a transaction */ damaged: proc (idx) returns (bit (1) aligned); declare idx fixed bin; if verify (forum_control.transactions (idx).person_id, substr (collate (), 9)) ^= 0 then return ("1"b); if verify (forum_control.transactions (idx).project_id, substr (collate (), 9)) ^= 0 then return ("1"b); if forum_control.transactions (idx).prior_ref_index < 0 | forum_control.transactions (idx).prior_ref_index >= idx then return ("1"b); if (forum_control.transactions (idx).next_ref_index <= idx & forum_control.transactions (idx).next_ref_index > 0) | forum_control.transactions (idx).next_ref_index > forum_control.no_transactions then return ("1"b); if forum_control.transactions (idx).offset >= 1044480 then return ("1"b); if forum_control.transactions (idx).offset < current_loc & ^(forum_control.transactions (idx).offset = 0 & forum_control.transactions (idx).gone) then return ("1"b); if forum_control.transactions (idx).length >= 1044480 then return ("1"b); if forum_control.transactions (idx).time > clock () then return ("1"b); return ("0"b); end damaged; error: proc (P_status); declare P_status fixed bin (35); call v1_forum_mgr_$unlock (forum_control_ptr); status = P_status; goto PUNT; end error; end v1_forum_gc_$expunge;  v1_forum_mgr_.pl1 08/16/86 1418.7r w 08/16/86 1354.8 546804 /* *************************************************************** * * * Copyright (c) 1982 by Massachusetts Institute of Technology * * * *************************************************************** */ /* This module is part of the forum inner ring side. It maintains the correspondence between forum pathnames (from the user ring), forum indexes (for the user ring) and pointers to the forum segments which are used only in the inner ring. It also implements locking the forums. Original Coding 14 June 1981 by J. Spencer Love Modified 01/12/82 Jay Pattin to add get_forum_path and change_chairman Modified 01/16/82 Jay Pattin to add list_users (was in trans_mgr_) renamed v1_forum_mgr_ with associated editing 01/21/82 Jay Pattin Modified 02/16/82 Jay Pattin added listening and set_event_channel Modified 03/29/82 Jay Pattin added priv_change_chairman Modified 05/05/82 Jay Pattin added read only support Modified 05/21/82 Jay Pattin added eligibility hacking Modified 06/23/82 Jay Pattin garbage collection Modified 06/23/82 Jay Pattin check for anonymous users Modified 9/25/82 Jay Pattin add adjourned switch, AIM support */ %page; /* THIS IS DOCUMENTATION FOR THE INTERNAL INNER RING INTERFACES They are to be called by other ring 3 procedures only. The caller needn't change the validation level, since all necessary validation level changes for initiating and terminating forum segments and determining access are performed by these entrypoints. Name: v1_forum_mgr_$get_ptrs Most inner ring forum interfaces should use a forum index to identify the forum. The correspondence between these identifiers and useful pointers is mapped by this entrypoint. Pass the index by reference; no need to copy, and get back the information you need to do your work. The forum is also locked by this entrypoint. To unlock the forum, call v1_forum_mgr_$unlock. You should have a cleanup handler to do this in case of random lossage, and also check all exit points in your program, because it is very important that the forum never be left locked when control is returned to the user ring. You should also never return pointers to the forum to the user ring, or other information like other processes' event channels or process_ids. Please also DO NOT TERMINATE THE POINTERS RETURNED BY THIS INTERFACE. Name: v1_forum_mgr_$unlock The following entrypoint is for cleaning up after v1_forum_mgr_$get_ptrs. The following sequence or an equivalent should be used in all code that accepts forum indexes as input: forum_control_ptr = null (); on cleanup call v1_forum_mgr_$unlock (forum_control_ptr); call v1_forum_mgr_$get_ptrs (P_forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, status); if status ^= 0 then do; P_status = status; return; end; It accepts a null pointer. It traps faults. There is no error code because nothing can go wrong that doesn't kill your process, and that would be due to random damage in the environment, not this module. Name: v1_forum_mgr_$initiate There is also an interface for dealing with forums that are not already open. It optionally locks the forum. Otherwise it performs essentially all the checks that forum_$open provides. However, it can return with a zero code and proceedings pointer = null. In this case, the user has sufficient access to find out the name of the chairman and the names of the participants. Absolutely no information whatsoever should be returned about the transactions. Entrypoints that return no or partial information in this case should return forum_error_table_$not_eligible after calling v1_forum_mgr_$terminate. This interface is intended to be called with a user ring validation level. It can be called at the forum ring validation level, but the caller probably shouldn't have its privileges enabled. It is also intended that you pass the character string arguments from the user ring by reference without copying so that truncation can be detected. Name: v1_forum_mgr_$terminate The following is for cleaning up after v1_forum_mgr_$initiate. It unlocks the forum if it is locked. It traps faults. It eats null pointers. It hacks its own validation level. In nulls its arguments. There is no error code because nothing can go wrong that doesn't kill your process, and that is an act of God and the initializer, not this module. */ %page; v1_forum_mgr_$open_forum: procedure (P_forum_dir, P_forum_entry, P_forum_idx, P_status); declare P_forum_dir char (*) parameter, P_forum_entry char (*) parameter, P_forum_idx fixed bin parameter, P_lock_switch bit (1) aligned parameter, P_forum_control_ptr ptr parameter, P_proceedings_ptr ptr parameter, P_attendee_idx fixed bin parameter, P_user_name char (*) parameter, P_switch_name char (*) parameter, P_switch_setting bit (1) aligned parameter, P_event_channel fixed bin (71) parameter, P_access_name char (*) parameter, P_access_time fixed bin (71) parameter, P_forum_info_ptr ptr parameter, P_area_ptr ptr parameter, P_user_list_ptr ptr parameter, P_last_seen_trans_idx fixed bin parameter, P_force_switch bit (1) aligned parameter, P_chairman char (*) parameter, P_write_allowed bit (1) aligned parameter, P_status fixed bin (35) parameter; declare (addr, after, before, clock, hbound, index, length, max, maxlength, min, null, rtrim, substr, unspec) builtin; declare (any_other, area, cleanup, no_read_permission, no_write_permission, seg_fault_error) condition; declare attendee_idx fixed bin, /* The users slot in the array forum_control.attendee */ caller_validation fixed bin (3), /* The validation level to exit with. Set by initialize. */ dirname_buffer char (168), /* The REAL directory containing the forum */ dirname_len fixed bin, /* The length returned by hcs_$fs_get_path_name */ egress label variable, /* BAIL OUT AT 30,000 FEET. Set by initialize. */ force_switch bit (1) aligned, /* To max or not to max, for set_last_seen_trans_idx */ last_seen_trans_idx fixed bin, /* copy of P_last_seen_trans_idx */ forum_control_entry char (32), /* The REAL entryname of the control segment. */ forum_name_len fixed bin, /* The length of the forum name without a suffix */ forum_data_ptr ptr, /* If this ptr is nonnull the forum is open */ forum_dir char (168), /* The copied directory input parameter */ no_w_access bit (1) aligned, privileged bit (1) aligned, switch_name char (32), switch_setting bit (1) aligned, write_allowed bit (1) aligned, status fixed bin (35); /* What went wrong */ declare 1 segment_acl aligned, 2 access_name char (32), 2 modes bit (36), 2 xmodes bit (36), 2 status fixed bin (35); declare 1 delete_acl aligned, 2 access_name char (32), 2 status fixed bin (35); /* The following is used by get_forum_info to accumulate data. Automatic storage is safe and secure. */ declare 1 fmi aligned like forum_info; /* The following is used by find_forum_data and maintained by open_forum and close_forum to find openings. */ declare first_forum_data_ptr ptr static initial (null ()); /* The following are global static constants set by initialize the first time we are called. */ declare static_initialized bit (1) aligned static initial ("0"b), anon_switch bit (1) aligned static initial ("0"b), my_authorization bit (72) aligned static initial ("0"b), full_authorization bit (72) aligned static initial ("0"b), my_process_id bit (36) aligned static initial (""b), my_lock_id bit (36) aligned static initial (""b), my_validation fixed bin (3) static initial (5), project char (9) static initial (""), user_name char (22) static initial (""); declare directory char (dirname_len) based (addr (dirname_buffer)), system_area area based (get_system_free_area_ ()), P_area area based (P_area_ptr); declare 1 aim_bits aligned like aim_template based (addr (full_authorization)); declare 1 forum_data aligned based (forum_data_ptr), 2 next_ptr ptr, /* Thread. Used for searching. */ 2 prev_ptr ptr, /* Thread. Used for unthreading. */ 2 name char (24) unaligned,/* For debugging only. Unsuffixed forum name. */ 2 forum_control_ptr ptr, /* The control segment */ 2 proceedings_ptr ptr, /* The proceedings segment */ 2 forum_control_uid bit (36), /* The UID of the control segment. For comparison. */ 2 forum_idx fixed bin, /* The index of this opening. For lookup. */ 2 attendee_idx fixed bin, /* The slot in the attendee array. For efficiency */ 2 opening_count fixed bin; /* Don't initiate more than once. See UID. */ declare (forum_error_table_$cant_stop_msg_admin, forum_error_table_$cant_stop_msg_site, forum_error_table_$chairman_only, forum_error_table_$invalid_forum_idx, forum_error_table_$invalid_switch_name, forum_error_table_$invalid_trans_idx, forum_error_table_$long_forum_name, forum_error_table_$forum_deleted, forum_error_table_$meeting_adjourned, forum_error_table_$no_control_suffix, forum_error_table_$no_such_forum, forum_error_table_$no_such_user, forum_error_table_$not_a_forum, forum_error_table_$not_eligible, forum_error_table_$roster_full, forum_error_table_$switch_not_changed, forum_error_table_$unexpected_fault, forum_error_table_$you_twit, error_table_$ai_restricted, error_table_$bad_arg, error_table_$dirlong, error_table_$invalid_lock_reset, error_table_$lock_wait_time_exceeded, error_table_$locked_by_this_process, error_table_$moderr, error_table_$noalloc, error_table_$noentry, error_table_$null_info_ptr, error_table_$seg_busted, error_table_$unimplemented_version ) fixed bin (35) external; declare (forum_data_$print_eligibility_messages, forum_data_$chairman_override) bit (1) aligned external; declare get_authorization_ entry returns (bit (72) aligned), get_group_id_$tag_star entry returns (char (32)), get_lock_id_ entry (bit(36) aligned), get_process_id_ entry returns (bit (36)), get_ring_ entry returns (fixed bin (3)), get_system_free_area_ entry returns (ptr), hcs_$add_acl_entries entry (char (*), char (*), ptr, fixed bin, fixed bin (35)), hcs_$delete_acl_entries entry (char(*), char(*), ptr, fixed bin, fixed bin(35)), hcs_$fs_get_brackets entry (ptr, fixed bin (5), (3) fixed bin (3), fixed bin (35)), hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)), hcs_$get_access_class entry (char(*), char(*), bit (72) aligned, fixed bin (35)), hcs_$get_authorization entry (bit (72) aligned, bit (72) aligned), hcs_$get_uid_seg entry (ptr, bit (36) aligned, fixed bin (35)), hcs_$get_user_effmode entry (char (*), char (*), char (*), fixed bin (3), fixed bin (5), 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)), read_write_allowed_ entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned), set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35)), set_lock_$unlock entry (bit (36) aligned, fixed bin (35)), user_info_$login_data entry (char (*), char (*), char (*), fixed bin, fixed bin, fixed bin, fixed bin (71), char (*)); %page; %include v1_forum_structures; %page; %include forum_info; %page; %include forum_user_list; %page; %include aim_template; %page; %include access_mode_values; %page; /* This is the primary user ring interface to forum. To enter a forum and read or enter transactions, the forum must first be opened. This sets the attending flag and returns an integer to identify the opening. */ /* v1_forum_mgr_$open: procedure (P_forum_dir, P_forum_entry, P_forum_idx, P_status); */ call initialize (OPEN_EXIT); /* Set up for "error" procedure and cleanup handler. */ call copy_pathname_args (); /* P_forum_dir and P_forum_entry */ on cleanup call close_forum (); /* If (heaven forbid) we should crawl out, die gracefully. */ call initiate_forum ("1"b); /* Set forum_control_ptr and proceedings_ptr. */ if no_w_access then call error (forum_error_table_$not_eligible); call lock_forum (); /* Lock out anyone else during update. */ call open_forum (); /* Find or allocate forum_data. */ if forum_control.flags.adjourned then if anon_switch | user_name ^= forum_control.chairman.person_id then call error (forum_error_table_$meeting_adjourned); call fill_attendee_slot (); /* Update control segment. */ forum_control.attendee (attendee_idx).public_wakeup_chan = 0; forum_control.attendee (attendee_idx).write_allowed = write_allowed; call unlock_forum (); /* Finished updating, unlock. */ P_forum_idx = forum_data.forum_idx; /* Tell user how to access this forum in the future. */ P_status = 0; /* If we got this far there was no error. */ return; OPEN_EXIT: call close_forum (); /* Clean up the mess, we didn't make it. */ P_forum_idx = 0; /* Lowest valid forum index is 1, so this won't be back. */ P_status = status; /* Tell user what went wrong. */ return; %page; /* This performs the actual forum opening. It requires that the forum be initiated and locked. It sets forum_data_ptr. If the forum was not previously opened, it changes first_forum_data_ptr; otherwise it sets attendee_idx. It detects duplicate openings by comparing UIDs to avoid reused segment number bugs. */ open_forum: procedure (); declare forum_control_uid bit (36) aligned; on cleanup forum_data_ptr = null (); call hcs_$get_uid_seg (forum_control_ptr, forum_control_uid, status); if status ^= 0 then call error (status); do forum_data_ptr = first_forum_data_ptr repeat (forum_data.next_ptr) while (forum_data_ptr ^= null ()); if forum_data.forum_control_uid = forum_control_uid then do; call terminate_forum (); /* Initiated too many times. Once is sufficient. */ forum_data.opening_count = forum_data.opening_count + 1; forum_control_ptr = forum_data.forum_control_ptr; proceedings_ptr = forum_data.proceedings_ptr; attendee_idx = forum_data.attendee_idx; return; end; end; /* If we are here, forum was not previously opened, so we must allocate and fill in a forum_data block */ call allocate_forum_data (); forum_data.name = substr (forum_control_entry, 1, forum_name_len); forum_data.forum_control_ptr = forum_control_ptr; forum_data.proceedings_ptr = proceedings_ptr; forum_data.forum_control_uid = forum_control_uid; forum_data.opening_count = 1; forum_data.prev_ptr = null (); /* Thread the forum_data block into the list so we can */ forum_data.next_ptr = first_forum_data_ptr; /* find it later. Bidirectional threads to unthread later */ if forum_data.next_ptr = null () then forum_data.forum_idx = 1; /* Meeting index must have no duplications. */ else do; forum_data.forum_idx = forum_data.next_ptr -> forum_data.forum_idx + 1; forum_data.next_ptr -> forum_data.prev_ptr = forum_data_ptr; end; first_forum_data_ptr = forum_data_ptr; /* Threads are OK, so now make him official */ return; end open_forum; %page; /* We must set our validation level to 3 before allocating forum_data because forum_data is allocated in the inner ring's system free area. If this area is extended by this allocation, a bug in get_next_area_component_ creates the new component with brackets of validation level rather than copying the ring brackets from the first component of the area. This is in its own procedure to satisfy my warped sense of esthetics. */ allocate_forum_data: procedure (); on any_other call error (forum_error_table_$unexpected_fault); on area call error (error_table_$noalloc); /* Deal with inability to allocate gracefully. */ on cleanup call hcs_$level_set (caller_validation); call hcs_$level_set (my_validation); allocate forum_data in (system_area); call hcs_$level_set (caller_validation); return; end allocate_forum_data; %page; /* This undoes the work of v1_forum_mgr_$close. It zeros its first argument so you won't close the forum more times than you open it. */ v1_forum_mgr_$close_forum: entry (P_forum_idx, P_status); call initialize (CLOSE_EXIT); /* Set up for "error" procedure and cleanup handler. */ call lookup_forum_idx (); /* Find forum_data node from P_forum_idx. */ on cleanup call unlock_forum (); /* Now I lay me down to crunch, if I should fault... */ call lock_forum (); /* Don't let anyone else see the forum while we frob it. */ call check_attendee_idx (); /* Just in case forum was garbage collected. */ P_forum_idx = 0; /* Make sure caller doesn't close this one twice. */ call close_forum (); /* Clean up forum opening, unlock, terminate */ P_status = 0; /* If we got this far then there is no error. */ return; CLOSE_EXIT: call unlock_forum (); /* Clean up the mess, we didn't make it. */ P_status = status; /* Tell then use what went wrong. */ return; %page; /* This procedure closes a forum. It assumes that the forum is initiated (forum_control_ptr ^= null ()), that the forum is open (forum_data_ptr ^= null ()), that the forum is locked, and that attendee_idx is valid. However, it is also used as a cleanup handler for open relation, so it hedges each assumption with a check. */ close_forum: procedure (); if forum_data_ptr ^= null () then do; forum_data.opening_count = forum_data.opening_count - 1; if forum_data.opening_count > 0 then do; call unlock_forum (); return; end; /* If we get here, we are really closing a forum, so unthread the forum_data node and free it. We check that first_forum_data_ptr = forum_data_ptr instead of prev_ptr = null as last ditch protection against inconsistency. */ if first_forum_data_ptr = forum_data_ptr then first_forum_data_ptr = forum_data.next_ptr; if forum_data.prev_ptr ^= null () then forum_data.prev_ptr -> forum_data.next_ptr = forum_data.next_ptr; if forum_data.next_ptr ^= null () then forum_data.next_ptr -> forum_data.prev_ptr = forum_data.prev_ptr; free forum_data; end; /* See if we actually own an attendee slot. If we do, then clear it out. But if we don't have forum_control_ptr valid, or attendee_idx is zero, or some other process claims to own the slot, then we leave it alone. We are protected from trying to modify the forum if it is not locked because attendee_idx is zero until after the forum has been locked, and unlock_forum zeros it again before unlocking. */ if forum_control_ptr ^= null () & attendee_idx > 0 then if forum_control.attendee (attendee_idx).process_id = my_process_id then do; forum_control.attendee (attendee_idx).project_id = project; forum_control.attendee (attendee_idx).last_time_attended = clock (); forum_control.attendee (attendee_idx).public_wakeup_chan = 0; forum_control.attendee (attendee_idx).attending = "0"b; end; call unlock_forum (); call terminate_forum (); return; end close_forum; %page; /* This is an internal ring 3 interface. A ring three entrypoint which accepts a forum index should call here to translate the forum index into pointers to the two segments and get the index of the current user's slot on the attendee array, which is a speed optimization. If you get back a nonzero code, PUNT. Return the code to the user ring. Otherwise, you have the forum LOCKED, and you must call v1_forum_mgr_$unlock before returning to the user ring. It is perfectly OK to call this entrypoint with a null pointer or an unlocked database, so put it in your cleanup handler. DO NOT TERMINATE THESE POINTERS! */ v1_forum_mgr_$get_ptrs: entry (P_forum_idx, P_forum_control_ptr, P_proceedings_ptr, P_attendee_idx, P_write_allowed, P_status); call initialize (GET_PTRS_EXIT); /* Set up for "error" procedure and cleanup handler. */ call lookup_forum_idx (); /* Find forum_data node from P_forum_idx. */ on cleanup call unlock_forum (); /* In case of crawlout, for whatever reason... */ call lock_forum (); /* We want the whole thing to ourselves for a while. */ call fill_attendee_slot (); /* Make sure that last_time_attended is updated. */ P_forum_control_ptr = forum_control_ptr; P_proceedings_ptr = proceedings_ptr; P_attendee_idx = attendee_idx; /* Tell caller this for efficiency. */ P_write_allowed = forum_control.attendee (attendee_idx).write_allowed; P_status = 0; return; GET_PTRS_EXIT: call unlock_forum (); /* Clean up the mess, we didn't make it. */ P_forum_control_ptr = null (); P_proceedings_ptr = null (); P_attendee_idx = 0; /* This means that the slot number is unknown. */ P_status = status; /* Tell the caller what went wrong. */ return; %page; /* The procedure looks up a forum index of the sort that passes for a forum pointer in the user ring. Rather than have an array and hence a maximum number of forums that can easily be concurrently open, a linked list is employed. It is expected that rarely will more than two forums be open in the same process, so search time should normally not be significant. If the search is successful, we set forum_data_ptr, forum_control_ptr, proceedings_ptr and attendee_idx. Otherwise, we set the error code and bail out. */ lookup_forum_idx: procedure (); declare forum_control_uid bit (36) aligned, forum_idx fixed bin; on cleanup forum_data_ptr = null (); /* This ptr may be used be our callers' cleanup handlers. */ forum_idx = P_forum_idx; /* Copy the parameter in case it uses tally modifiers. */ if forum_idx < 1 then call error (forum_error_table_$invalid_forum_idx); /* So try to find the right forum_data node. If we return out of the loop, forum_data_ptr will be correctly set. */ do forum_data_ptr = first_forum_data_ptr repeat (forum_data.next_ptr) while (forum_data_ptr ^= null ()); if forum_data.forum_idx = forum_idx then do; call hcs_$get_uid_seg (forum_data.forum_control_ptr, forum_control_uid, status); if status ^= 0 then call error (status); if forum_data.forum_control_uid ^= forum_control_uid then call error (forum_error_table_$forum_deleted); forum_control_ptr = forum_data.forum_control_ptr; proceedings_ptr = forum_data.proceedings_ptr; attendee_idx = forum_data.attendee_idx; return; end; end; /* If we get here. forum_data_ptr is null, so we don't have the cleanup handler null it and save microseconds. */ revert cleanup; call error (forum_error_table_$invalid_forum_idx); end lookup_forum_idx; %page; /* The contract of this procedure is to try very hard to lock the forum. We assume that forum_control_ptr is valid. Since it makes the first reference to the control segment for some pathways, and the first write to the segment for others, it has lots of handlers. Once the forum is locked, the ACL cannot be changed by the forum primitives, nor the forum be deleted, so these handlers are not needed throughout the rest of the forum inner ring. */ lock_forum: procedure (); declare count fixed bin, not_locked bit (1) aligned; on any_other call error (forum_error_table_$unexpected_fault); on no_read_permission call error (error_table_$moderr); on no_write_permission call error (error_table_$moderr); on seg_fault_error call error (error_table_$seg_busted); not_locked = "1"b; do count = 1 to 10 while (not_locked); call set_lock_$lock (forum_control.forum_lock, 2, status); if status = 0 then not_locked = "0"b; else if status ^= error_table_$lock_wait_time_exceeded then not_locked = "0"b; end; if status ^= 0 then if status ^= error_table_$invalid_lock_reset then call error (status); return; /* This implicitly reverts the handlers */ end lock_forum; %page; /* This routine keeps the attendee slot for the current user up to date in the control segment. Of particular interest is the last_time_attended field. Meeting_control_ptr is assumed valid. No variables are set. */ fill_attendee_slot: procedure (); call check_attendee_idx (); /* Check this in case forum was garbage collected. */ /* The clock value is put in forum_control.last_time_attended every time we reference the forum. */ forum_control.attendee (attendee_idx).last_time_attended = clock (); /* Since we're changing the page anyway, we might as well always write out this info which must be written out when the forum is opened and which might be smashed if two processes for the same user both have the same forum open. */ forum_control.attendee (attendee_idx).project_id = project; forum_control.attendee (attendee_idx).attending = "1"b; forum_control.attendee (attendee_idx).removed = "0"b; forum_control.attendee (attendee_idx).process_id = my_process_id; forum_control.attendee (attendee_idx).lock_id = my_lock_id; return; end fill_attendee_slot; %page; /* This procedure makes sure that the saved attendee_idx is still valid. When opening, attendee_idx = 0, which means there is no saved index. If it isn't, make it so, adding a new participant if necessary. */ check_attendee_idx: procedure (); declare idx fixed bin; /* If attendee_idx is nonzero, we must think the forum is locked and open. See if the user's slot has moved, which could happen if the forum is garbage collected. If it hasn't moved, then we can just return, saving lots of work. */ if forum_data_ptr ^= null & attendee_idx > 0 then if forum_control.attendee (attendee_idx).person_id = user_name then return; /* See if there is a slot for the person. If there is, we will set attendee_idx. */ attendee_idx = 0; do idx = 1 to forum_control.no_attendees while (attendee_idx = 0); if forum_control.attendee (idx).person_id = user_name then attendee_idx = idx; end; /* If attendee_idx is still not set, then the person isn't currently participating. Allocate her a slot. */ if attendee_idx = 0 then do; attendee_idx = forum_control.no_attendees + 1; if attendee_idx > hbound (forum_control.attendee, 1) then call error (forum_error_table_$roster_full); forum_control.no_attendees = attendee_idx; forum_control.attendee (attendee_idx).person_id = user_name; forum_control.attendee (attendee_idx).project_id = ""; forum_control.attendee (attendee_idx).message_changed = "1"b; /* Well, sort of */ end; /* If the forum is open, then update this information in the forum_data node. */ if forum_data_ptr ^= null () then forum_data.attendee_idx = attendee_idx; forum_control.attendee (attendee_idx).deleted = "0"b; return; end check_attendee_idx; lookup_attendee: procedure (person_name); declare person_name char (*), idx fixed bin; attendee_idx = 0; do idx = 1 to forum_control.no_attendees while (attendee_idx = 0); if forum_control.attendee (idx).person_id = person_name then attendee_idx = idx; end; if attendee_idx = 0 then call error (forum_error_table_$no_such_user); return; end lookup_attendee; %page; /* This is an internal ring 3 interface. Call it to clean up after calling v1_forum_mgr_$get_ptrs. It accepts a null input argument so don't hesitate to put it in your cleanup handlers. */ v1_forum_mgr_$unlock: entry (P_forum_control_ptr); forum_control_ptr = P_forum_control_ptr; /* Copy parameter for internal procedure. */ if ^static_initialized then return; /* If this isn't set, we have no business here. */ call unlock_forum (); /* ZAP. We don't care about this forum anymore anyway. */ return; /* This procedure cleans up after lock_forum. It goes in cleanup handlers so it has its own handlers. */ unlock_forum: procedure (); attendee_idx = 0; /* This being nonzero implies that the forum is locked. */ if forum_control_ptr = null () then return; /* If we don't even have this, we can't be locked. */ on any_other go to PUNT_UNLOCK; /* If anything goes wrong, we can't unlock, so give up. */ call set_lock_$unlock (forum_control.forum_lock, (0)); PUNT_UNLOCK: return; end unlock_forum; %page; /* This is an internal ring 3 interface. It should be called by anyone wishing to initiate a forum forum given a dirname and entryname from the user ring. Pass the dirname and entryname by reference that came from the calling ring so their lengths can be checked. If a nonzero code is returned, pass it back to the caller. If proceedings_ptr is null, you have only "r" access to the ".control" segment and should not return any information to the user ring about transactions. Otherwise, you have "rw" access to both segment. You should call v1_forum_mgr_$terminate to terminate the pointers. It doesn't mind getting null pointers so put it in your cleanup handler. If you don't take kindly to a null proceedings_ptr, terminate and then return the code forum_error_table_$not_eligible. It locks the forum if asked nicely. */ v1_forum_mgr_$initiate: entry (P_forum_dir, P_forum_entry, P_lock_switch, P_forum_control_ptr, P_proceedings_ptr, P_status); call initialize (INITIATE_EXIT); /* set up for "error" procedure and cleanup handler */ call copy_pathname_args (); /* P_forum_dir and P_forum_entry */ on cleanup call close_forum (); /* Just unlock and terminate. forum_data_ptr is null. */ call initiate_forum ("1"b); /* This is what we are here for. */ if P_lock_switch then call lock_forum (); /* If user asked for this, give it to him. */ P_forum_control_ptr = forum_control_ptr; P_proceedings_ptr = proceedings_ptr; P_status = 0; /* If we got this far there is no error. */ return; INITIATE_EXIT: call close_forum (); /* Just unlock and terminate. forum_data_ptr is null. */ P_forum_control_ptr = null (); P_proceedings_ptr = null (); P_status = status; /* Tell user what went wrong. */ return; %page; /* See that the split pathname passed to us is plausible. Ring zero will pass on the directory name later, so all we have to do is make sure it isn't truncated. The entryname must end in the ".control" suffix. The rest of the checking we leave until later. No global variables are referenced. */ copy_pathname_args: procedure (); declare forum_name_len fixed bin; if length (rtrim (P_forum_dir)) > maxlength (forum_dir) then call error (error_table_$dirlong); else forum_dir = P_forum_dir; if length (rtrim (P_forum_entry)) > maxlength (forum_control_entry) then call error (forum_error_table_$long_forum_name); else forum_control_entry = P_forum_entry; forum_name_len = length (rtrim (forum_control_entry)) - length (".control"); if forum_name_len < 1 then call error (forum_error_table_$no_control_suffix); if substr (forum_control_entry, forum_name_len + 1) ^= ".control" then call error (forum_error_table_$no_control_suffix); return; end copy_pathname_args; %page; /* This routine is the arbiter of acceptable forum format. Since the pathname passed in could be a link, paranoia is indicated. The name on the link needn't be on the forum, but the name on the forum must be on both forum segments. If we only have "r" on the control segment, we don't bother to check the proceedings. */ initiate_forum: procedure (initiate_proceedings); declare initiate_proceedings bit (1) aligned, access_class bit (72) aligned, modes fixed bin (5), proceedings_entry char (32), rings (3) fixed bin (3); /* Handle unexpected errors. We don't have the forum locked, so anything can happen. */ on any_other call error (forum_error_table_$unexpected_fault); on cleanup call terminate_forum (); on no_read_permission call error (error_table_$moderr); on seg_fault_error call error (error_table_$seg_busted); /* We have to initiate at the inner ring validation level, since the segments aren't accessible from the outer ring. */ call hcs_$level_set (my_validation); call hcs_$get_access_class (forum_dir, forum_control_entry, access_class, status); if status ^= 0 then if status = error_table_$noentry then call error (forum_error_table_$no_such_forum); else call error (status); if ^read_write_allowed_ (my_authorization, access_class) then do; call hcs_$get_authorization (full_authorization, (""b)); if ^aim_bits.privileges.ipc | ^aim_bits.privileges.seg | ^aim_bits.privileges.dir then call error (error_table_$ai_restricted); end; call hcs_$initiate (forum_dir, forum_control_entry, "", 0, 0, forum_control_ptr, status); if forum_control_ptr = null () then call error (status); /* Verify the access mode and ring brackets, which must be correct on a valid forum. "r" access is OK. */ call hcs_$fs_get_brackets (forum_control_ptr, modes, rings, status); if status ^= 0 then call error (status); if modes = RW_ACCESS_BIN then no_w_access = "0"b; else if modes = R_ACCESS_BIN then no_w_access = "1"b; else call error (forum_error_table_$not_a_forum); if (rings (1) ^= my_validation) | (rings (2) ^= rings (3)) then call error (forum_error_table_$not_a_forum); /* Now, refer to the segment. Faults may be taken here. The attendee count must be plausible. */ if forum_control.no_attendees < 0 | forum_control.no_attendees > hbound (forum_control.attendee, 1) then call error (forum_error_table_$not_a_forum); /* The attendee count can be zero. So check something that can't be, to eliminate uninitialized segments. */ if unspec (forum_control.chairman) = ""b then call error (forum_error_table_$not_a_forum); /* We don't trust the pathname the user gave us. It might be a link. Get one we can trust. */ call hcs_$fs_get_path_name (forum_control_ptr, dirname_buffer, dirname_len, forum_control_entry, status); if status ^= 0 then call error (status); /* If the primary name of the segment doesn't have the suffix, this can't be a forum. */ forum_name_len = length (rtrim (forum_control_entry)) - length (".control"); if forum_name_len < 1 | forum_name_len > 20 then call error (forum_error_table_$not_a_forum); if substr (forum_control_entry, forum_name_len + 1) ^= ".control" then call error (forum_error_table_$not_a_forum); /* Leave forum_name_len set for open_forum. If we have "rw" access on the ".control" segment, then we also initiate the ".proceedings" segment. */ if modes = RW_ACCESS_BIN & initiate_proceedings then do; proceedings_entry = substr (forum_control_entry, 1, forum_name_len) || ".proceedings"; call hcs_$initiate (directory, proceedings_entry, "", 0, 0, proceedings_ptr, status); if proceedings_ptr = null () then if status = error_table_$noentry | status = error_table_$moderr then call error (forum_error_table_$not_a_forum); else call error (status); call hcs_$fs_get_brackets (proceedings_ptr, modes, rings, status); if status ^= 0 then call error (status); if modes ^= RW_ACCESS_BIN & modes ^= R_ACCESS_BIN then call error (forum_error_table_$not_a_forum); write_allowed = (modes = RW_ACCESS_BIN); if (rings (1) ^= my_validation) | (rings (2) ^= rings (3)) then call error (forum_error_table_$not_a_forum); end; call hcs_$level_set (caller_validation); /* Close barn door behind. */ return; end initiate_forum; %page; /* This is an internal ring 3 interface to clean up after v1_forum_mgr_$initiate. It nulls its arguments if they aren't already, so put it in your cleanup handlers. */ v1_forum_mgr_$terminate: entry (P_forum_control_ptr, P_proceedings_ptr); forum_control_ptr = P_forum_control_ptr; /* Copy parameters for internal procedures. */ proceedings_ptr = P_proceedings_ptr; if ^static_initialized then return; /* The static variable "my_validation" must be set. */ caller_validation = hcs_$level_get (); /* We will need this to revert after terminating. */ P_forum_control_ptr = null (); /* Make sure caller does not terminate these twice. */ P_proceedings_ptr = null (); call unlock_forum (); /* In case we locked it before, unlock it now. */ call terminate_forum (); /* This is what we are here for, so do it. */ return; /* This procedure cleans up after initiate forum. It must affect the ring 3 address space. It is robust. */ terminate_forum: procedure (); declare p ptr; on cleanup call hcs_$level_set (caller_validation); call hcs_$level_set (my_validation); /* Here we go..... */ on any_other go to PUNT_TERMINATE; /* Handle any unexpected faults. */ p = proceedings_ptr; /* Make SURE pointers aren't terminated twice. */ proceedings_ptr = null (); if p ^= null () then call hcs_$terminate_noname (p, (0)); p = forum_control_ptr; /* Make SURE pointers aren't terminated twice. */ forum_control_ptr = null (); if p ^= null () then call hcs_$terminate_noname (p, (0)); PUNT_TERMINATE: call hcs_$level_set (caller_validation); return; end terminate_forum; %page; /* This interface allows the attending switch to be turned off, and the notify and removed switches to be frobbed, by either the chairman or the user on his own entry. */ v1_forum_mgr_$priv_set_switch: entry (P_forum_dir, P_forum_entry, P_user_name, P_switch_name, P_switch_setting, P_status); privileged = "1"b; goto SS_COMMON; v1_forum_mgr_$set_switch: entry (P_forum_dir, P_forum_entry, P_user_name, P_switch_name, P_switch_setting, P_status); privileged = "0"b; SS_COMMON: call initialize (SET_SWITCH_EXIT); /* set up for "error" procedure and cleanup handler */ call copy_pathname_args (); /* P_forum_dir and P_forum_entry */ on cleanup call terminate_forum (); call initiate_forum ("1"b); /* Get pointers to forum */ if ^privileged & no_w_access then call error (forum_error_table_$not_eligible); call set_switch (); /* Do the work */ call terminate_forum (); /* Clean up shop and go home */ P_status = status; /* If we got this far there was no error */ return; SET_SWITCH_EXIT: call terminate_forum (); /* Clean up the mess, we couldn't do it. */ P_status = status; /* Tell the use what went wrong. */ return; %page; /* This consolidates the interface to turn the various per-user flags on and off */ v1_forum_mgr_$set_switch_idx: entry (P_forum_idx, P_user_name, P_switch_name, P_switch_setting, P_status); privileged = "0"b; call initialize (SET_SWITCH_IDX_EXIT); /* set up for "error" procedure and cleanup handler */ call lookup_forum_idx (); /* Find forum_data node from P_forum_idx */ call set_switch (); /* Do the work. */ P_status = status; /* If we get this far there was no error. */ return; SET_SWITCH_IDX_EXIT: P_status = status; /* Tell the user what went wrong. */ return; %page; /* Do all the work of setting a switch. We have to copy and check all the arguments from the user ring, and decide whether to permit the operation. Only the chairman can mess with other people's switches. */ set_switch: procedure (); declare person_name char (20); if length (rtrim (P_user_name)) > maxlength (person_name) then call error (error_table_$bad_arg); else person_name = P_user_name; if person_name = "" then person_name = user_name; else if person_name ^= user_name then if anon_switch | user_name ^= forum_control.chairman.person_id then call error (forum_error_table_$chairman_only); else forum_data_ptr = null (); if length (rtrim (P_switch_name)) > maxlength (switch_name) then call error (forum_error_table_$invalid_switch_name); else switch_name = P_switch_name; switch_setting = P_switch_setting; on cleanup begin; call unlock_forum (); call hcs_$level_set (caller_validation); end; if privileged & no_w_access then do; call hcs_$level_set (my_validation); call force_access (); end; call lock_forum (); call lookup_attendee (person_name); if switch_name = "participating" | switch_name = "part" then call set_the_switch (forum_control.attendee (attendee_idx).removed, ^switch_setting); else if switch_name = "notify" | switch_name = "nt" then call set_the_switch (forum_control.attendee (attendee_idx).notify, switch_setting); else if switch_name = "message_seen" then call set_the_switch (forum_control.attendee (attendee_idx).message_changed, ^switch_setting); else if switch_name = "access_changed" then call set_the_switch (forum_control.attendee (attendee_idx).acl_change_pending, switch_setting); /* rest of switches may only be changed by the chairman */ else if switch_name = "deleted" then do; if ^privileged & (anon_switch | user_name ^= forum_control.chairman.person_id) then call error (forum_error_table_$chairman_only); if user_name = person_name then call error (forum_error_table_$you_twit); /* chairman can't delete himself */ call set_the_switch (forum_control.attendee (attendee_idx).deleted, switch_setting); end; else if switch_name = "adjourned" | switch_name = "adj" then do; if ^privileged & (anon_switch | user_name ^= forum_control.chairman.person_id) then call error (forum_error_table_$chairman_only); call set_the_switch (forum_control.flags.adjourned, switch_setting); end; else if switch_name = "meeting_eligibility_messages" | switch_name = "mtg_emsg" then do; if ^privileged then do; if anon_switch | user_name ^= forum_control.chairman.person_id then call error (forum_error_table_$chairman_only); if ^switch_setting then do; if ^forum_data_$chairman_override & forum_data_$print_eligibility_messages then call error (forum_error_table_$cant_stop_msg_site); if forum_control.am_init & forum_control.am_print_acl_msg then call error (forum_error_table_$cant_stop_msg_admin); end; call set_the_switch (forum_control.cm_print_acl_msg, switch_setting); if ^forum_control.cm_init & status = forum_error_table_$switch_not_changed then status = 0; forum_control.cm_init = "1"b; end; else do; call set_the_switch (forum_control.am_print_acl_msg, switch_setting); if ^forum_control.am_init & status = forum_error_table_$switch_not_changed then status = 0; forum_control.am_init = "1"b; end; end; else call error (forum_error_table_$invalid_switch_name); call unlock_forum (); if privileged & no_w_access then do; call delete_access (); call hcs_$level_set (caller_validation); end; return; set_the_switch: proc (switch, value); declare switch bit (1) unaligned; declare value bit (1) aligned; if switch = value then status = forum_error_table_$switch_not_changed; else switch = value; return; end set_the_switch; end set_switch; %page; v1_forum_mgr_$set_global_switch: entry (P_switch_name, P_switch_setting, P_status); call initialize (SET_GLOBAL_EXIT); if length (rtrim (P_switch_name)) > maxlength (switch_name) then call error (forum_error_table_$invalid_switch_name); else switch_name = P_switch_name; switch_setting = P_switch_setting; on no_write_permission call error (error_table_$moderr); if switch_name = "print_eligibility_messages" | switch_name = "pemsg" then forum_data_$print_eligibility_messages = switch_setting; else if switch_name = "chairman_set_eligibility_msg" | switch_name = "cm_set_emsg" then forum_data_$chairman_override = switch_setting; else call error (forum_error_table_$invalid_switch_name); P_status = 0; return; SET_GLOBAL_EXIT: P_status = status; return; %page; /* If you want to be told when a new transaction arrives in a forum you are attending, you gotta tell the guy where to send the wakeup. */ v1_forum_mgr_$set_event_channel: entry (P_forum_dir, P_forum_entry, P_event_channel, P_status); call initialize (SET_EVENT_CHANNEL_EXIT); call copy_pathname_args (); on cleanup begin; call unlock_forum (); call terminate_forum (); end; call initiate_forum ("0"b); if no_w_access then call error (forum_error_table_$not_eligible); call lookup_attendee (user_name); call lock_forum (); forum_control.attendee (attendee_idx).public_wakeup_chan = P_event_channel; forum_control.attendee (attendee_idx).process_id = my_process_id; call unlock_forum (); call terminate_forum (); P_status = 0; return; SET_EVENT_CHANNEL_EXIT: call unlock_forum (); call terminate_forum (); P_status = status; return; %page; v1_forum_mgr_$set_event_channel_idx: entry (P_forum_idx, P_event_channel, P_status); call initialize (SET_EVENT_CHANNEL_IDX_EXIT); /* set up for "error" procedure and cleanup handler */ call lookup_forum_idx (); /* Find forum_data node from P_forum_idx */ on cleanup call unlock_forum (); call lock_forum (); forum_control.attendee (attendee_idx).public_wakeup_chan = P_event_channel; forum_control.attendee (attendee_idx).process_id = my_process_id; call unlock_forum (); P_status = 0; return; SET_EVENT_CHANNEL_IDX_EXIT: call unlock_forum (); P_status = status; return; %page; /* Note: This interface does not lock the forum so occasional rare lossages can occur. It can return the code forum_error_table_$not_eligible to indicate that the caller or specified access name lacks access to open the forum. Partial info is returned in this case. */ v1_forum_mgr_$forum_info: entry (P_forum_dir, P_forum_entry, P_access_name, P_access_time, P_forum_info_ptr, P_status); call initialize (FORUM_INFO_EXIT); /* set up for "error" procedure and cleanup handler */ call copy_pathname_args (); /* P_forum_dir and P_forum_entry */ on cleanup call terminate_forum (); on no_read_permission call error (error_table_$moderr); call initiate_forum ("0"b); call get_forum_info (no_w_access); if no_w_access then status = forum_error_table_$not_eligible; else status = 0; call terminate_forum (); forum_info = fmi; P_status = status; return; FORUM_INFO_EXIT: call terminate_forum (); P_status = status; return; %page; /* This interface locks the database, since it must be openable to use it. We assume that response time is not as critical for the "current" forum (after all, you went to the trouble of opening it) as it is for the dirname, entryname entrypoint which is used by the forum_list command. */ v1_forum_mgr_$forum_info_idx: entry (P_forum_idx, P_access_name, P_access_time, P_forum_info_ptr, P_status); call initialize (MEETING_INFO_IDX_EXIT); /* set up for "error" procedure and cleanup handler */ call lookup_forum_idx (); /* Find forum_data node from P_forum_idx */ on cleanup call unlock_forum (); call lock_forum (); call fill_attendee_slot (); call get_forum_info ("0"b); call unlock_forum (); forum_info = fmi; P_status = 0; return; MEETING_INFO_IDX_EXIT: call unlock_forum (); P_status = status; return; %page; get_forum_info: procedure (no_w_access); declare no_w_access bit (1) aligned, access_name char (32), access_time fixed bin (71), idx fixed bin, person_name char (20); if length (rtrim (P_access_name)) > maxlength (access_name) then call error (error_table_$bad_arg); else access_name = P_access_name; access_time = P_access_time; forum_info_ptr = P_forum_info_ptr; if forum_info_ptr = null () then call error (error_table_$null_info_ptr); if forum_info.version ^= forum_info_version_1 then call error (error_table_$unimplemented_version); unspec (fmi) = ""b; fmi.version = forum_info_version_1; fmi.chairman.username = forum_control.chairman.person_id; fmi.chairman.project = forum_control.chairman.project_id; fmi.chairman.pad = ""; fmi.attendee_count = forum_control.no_attendees; do idx = 1 to forum_control.no_attendees; if forum_control.attendee (idx).removed then fmi.removal_count = fmi.removal_count + 1; end; if forum_data_ptr ^= null () then fmi.forum_uid = forum_data.forum_control_uid; else do; call hcs_$get_uid_seg (forum_control_ptr, fmi.forum_uid, status); if status ^= 0 then call error (status); end; if access_name = "" then do; person_name = user_name; fmi.eligible = ^no_w_access; end; else do; person_name = before (access_name, "."); call check_eligible (access_name); attendee_idx = 0; end; if person_name = "*" then attendee_idx = 0; else do idx = 1 to forum_control.no_attendees while (attendee_idx = 0); if forum_control.attendee (idx).person_id = person_name then attendee_idx = idx; end; if attendee_idx = 0 then return; if ^no_w_access then forum_control.attendee (attendee_idx).lock_id = my_lock_id; fmi.removed = forum_control.attendee (attendee_idx).removed | forum_control.attendee (attendee_idx).deleted; fmi.last_time_attended = forum_control.attendee (attendee_idx).last_time_attended; fmi.last_seen_trans_idx = get_highest_seen (forum_control.attendee (attendee_idx).highest_trans_seen, user_name); if ^fmi.removed then do; fmi.notify = forum_control.attendee (attendee_idx).notify; fmi.attending = forum_control.attendee (attendee_idx).attending; end; fmi.adjourned = forum_control.flags.adjourned; if no_w_access then return; fmi.read_only = ^forum_control.attendee (attendee_idx).write_allowed; do idx = forum_control.no_transactions by -1 to 1 while (forum_control.transactions (idx).time > access_time); end; fmi.transaction_count = idx; fmi.deletion_count = forum_control.no_deleted; if person_name ^= "*" & person_name ^= "" then do idx = min (fmi.transaction_count, forum_control.attendee (attendee_idx).highest_trans_seen) + 1 to forum_control.no_transactions; if forum_control.transactions (idx).person_id ^= person_name & ^forum_control.transactions (idx).deleted then fmi.changes_count = fmi.changes_count + 1; end; idx = forum_control.no_transactions; if idx < 1 then return; do while (forum_control.transactions (idx).deleted | forum_control.transactions (idx).time > access_time); idx = idx - 1; if idx < 1 then return; end; fmi.last_time_changed = forum_control.transactions (idx).time; return; end get_forum_info; %page; /* This procedure checks if a person other than the caller is eligible to participate in a forum. Since we require as a condition for a valid forum that the proceedings must have "rw" access if the control segment does, and we have already verified that the rings are correct on the control segment, we will punt checking to see that access_name has "rw" on both segments. In fact, we may not even know that the second segment exists. We make no attempt to use a saved pathname since we have a perfectly good pointer and we are paranoid about renamings and the like. We initiated it before it was locked, and only after locking can we be sure that the name or ACL won't change. */ check_eligible: procedure (access_name); declare access_name char (32), entryname char (32), modes fixed bin (5); on cleanup call hcs_$level_set (caller_validation); call hcs_$level_set (my_validation); call hcs_$fs_get_path_name (forum_control_ptr, dirname_buffer, dirname_len, entryname, status); if status ^= 0 then call error (status); call hcs_$get_user_effmode (directory, entryname, access_name, my_validation, modes, status); if status ^= 0 then call error (status); if modes = RW_ACCESS_BIN then fmi.eligible = "1"b; call hcs_$level_set (caller_validation); return; end check_eligible; %page; v1_forum_mgr_$set_last_seen_idx: entry (P_forum_idx, P_last_seen_trans_idx, P_force_switch, P_status); call initialize (SET_LAST_SEEN_IDX_EXIT); call lookup_forum_idx (); last_seen_trans_idx = P_last_seen_trans_idx; force_switch = P_force_switch; on cleanup call unlock_forum (); call lock_forum (); if last_seen_trans_idx < 0 | last_seen_trans_idx > forum_control.no_transactions then call error (forum_error_table_$invalid_trans_idx); call fill_attendee_slot (); if ^force_switch then last_seen_trans_idx = max (last_seen_trans_idx, forum_control.attendee (attendee_idx).highest_trans_seen); forum_control.attendee (attendee_idx).highest_trans_seen = last_seen_trans_idx; call unlock_forum (); P_status = 0; return; SET_LAST_SEEN_IDX_EXIT: call unlock_forum (); P_status = status; return; %page; v1_forum_mgr_$list_users: entry (P_forum_dir, P_forum_entry, P_area_ptr, P_user_list_ptr, P_status); call initialize (LIST_USERS_EXIT); call copy_pathname_args (); on cleanup call terminate_forum (); call initiate_forum ("0"b); if no_w_access then call error (forum_error_table_$not_eligible); call get_user_list (); call terminate_forum (); P_status = 0; return; LIST_USERS_EXIT: call terminate_forum (); P_status = status; return; %page; v1_forum_mgr_$list_users_idx: entry (P_forum_idx, P_area_ptr, P_user_list_ptr, P_status); call initialize (LIST_USERS_IDX_EXIT); call lookup_forum_idx (); on cleanup call unlock_forum (); call lock_forum (); call fill_attendee_slot (); call get_user_list (); call unlock_forum (); P_status = 0; return; LIST_USERS_IDX_EXIT: call unlock_forum (); P_status = status; return; %page; get_user_list: procedure; declare (idx, jdx) fixed bin; user_list_no_attendees = forum_control.no_attendees; allocate user_list in (P_area); unspec (user_list) = ""b; user_list.version = user_list_version_2; user_list.chairman.person_id = forum_control.chairman.person_id; user_list.chairman.project_id = forum_control.chairman.project_id; user_list.transaction_count = forum_control.no_transactions; jdx = 0; do idx = 1 to forum_control.no_attendees; if ^forum_control.attendee (idx).deleted then do; jdx = jdx + 1; if forum_control.attendee (idx).attending then do; /* check if he's really there */ call set_lock_$lock ((forum_control.attendee (idx).lock_id), 0, status); if status ^= error_table_$lock_wait_time_exceeded & status ^= error_table_$locked_by_this_process then do; forum_control.attendee (idx).attending = "0"b; forum_control.attendee (idx).lock_id = "0"b; end; end; user_list.attendees (jdx).person_id = forum_control.attendee (idx).person_id; user_list.attendees (jdx).project_id = forum_control.attendee (idx).project_id; user_list.attendees (jdx).attending = forum_control.attendee (idx).attending; user_list.attendees (jdx).notify = forum_control.attendee (idx).notify; user_list.attendees (jdx).removed = forum_control.attendee (idx).removed; user_list.attendees (jdx).read_only = ^forum_control.attendee (idx).write_allowed; user_list.attendees (jdx).last_time_attended = forum_control.attendee (idx).last_time_attended; user_list.attendees (jdx).highest_trans_seen = get_highest_seen (forum_control.attendee (idx).highest_trans_seen, forum_control.attendee (idx).person_id); end; end; user_list.no_attendees = jdx; P_user_list_ptr = user_list_ptr; return; end get_user_list; get_highest_seen: procedure (start, person) returns (fixed bin); declare start fixed bin, person char (22), highest fixed bin, done bit (1) aligned; done = "0"b; highest = start; do while ((highest + 1) <= forum_control.no_transactions & ^done); if (forum_control.transactions (highest + 1).deleted | forum_control.transactions (highest + 1).person_id = person) then highest = highest + 1; else done = "1"b; end; done = "0"b; do while (^done & highest ^= 0); if forum_control.transactions (highest).deleted then highest = highest - 1; else done = "1"b; end; return (highest); end get_highest_seen; %page; v1_forum_mgr_$change_chairman_idx: entry (P_forum_idx, P_chairman, P_status); call initialize (CHANGE_CHAIRMAN_IDX_EXIT); call lookup_forum_idx (); on cleanup call unlock_forum (); call lock_forum (); privileged = "0"b; call change_the_chairman (); call unlock_forum (); P_status = 0; return; CHANGE_CHAIRMAN_IDX_EXIT: call unlock_forum (); P_status = status; return; %page; v1_forum_mgr_$priv_change_chairman: entry (P_forum_dir, P_forum_entry, P_chairman, P_status); privileged = "1"b; goto CC_COMMON; v1_forum_mgr_$change_chairman: entry (P_forum_dir, P_forum_entry, P_chairman, P_status); privileged = "0"b; CC_COMMON: call initialize (CHANGE_CHAIRMAN_EXIT); call copy_pathname_args (); on cleanup call terminate_forum (); call initiate_forum ("0"b); call change_the_chairman (); call terminate_forum (); P_status = 0; return; CHANGE_CHAIRMAN_EXIT: call terminate_forum (); P_status = status; return; %page; change_the_chairman: procedure (); declare chairman_name char (32), chairman_personid char (22), chairman_projectid char (10), entryname char (32); if ^privileged then if anon_switch | user_name ^= forum_control.chairman.person_id then call error (forum_error_table_$chairman_only); if length (rtrim (P_chairman)) > maxlength (chairman_name) then call error (error_table_$bad_arg); else chairman_name = P_chairman; if index (chairman_name, ".") = 0 | index (chairman_name, ".") > maxlength (chairman_personid) + 1 then call error (error_table_$bad_arg); chairman_personid = before (chairman_name, "."); chairman_projectid = rtrim (after (chairman_name, ".")); call lookup_attendee (chairman_personid); on cleanup call hcs_$level_set (caller_validation); call hcs_$level_set (my_validation); if privileged & no_w_access then call force_access (); call hcs_$fs_get_path_name (forum_control_ptr, dirname_buffer, dirname_len, entryname, status); if status ^= 0 then call error (status); segment_acl.access_name = chairman_personid || ".*.*"; segment_acl.modes = RW_ACCESS; segment_acl.xmodes = "0"b; segment_acl.status = 0; call hcs_$add_acl_entries (directory, entryname, addr (segment_acl), 1, status); if status ^= 0 then call error (status); entryname = substr (entryname, 1, length (rtrim (entryname)) - length ("control")) || "proceedings"; call hcs_$add_acl_entries (directory, entryname, addr (segment_acl), 1, status); if status ^= 0 then call error (status); forum_control.chairman.person_id = chairman_personid; forum_control.chairman.project_id = chairman_projectid; if privileged & no_w_access then call delete_access (); call hcs_$level_set (caller_validation); return; end change_the_chairman; %page; /* Most entrypoints call this procedure to set up for error handling. The caller's validation level is obtained, static "constants" are initialized, the emergency bailout at 30,000 feet label that the "error" procedure transfers to is set, and all automatic variables used in cleanup handlers are initialized. */ initialize: procedure (P_egress); declare P_egress label variable, anon fixed bin; egress = P_egress; caller_validation = hcs_$level_get (); if ^static_initialized then do; my_authorization = get_authorization_ (); my_validation = get_ring_ (); my_process_id = get_process_id_ (); call get_lock_id_ (my_lock_id); call user_info_$login_data (user_name, project, (""), anon, 0, 0, 0, ("")); if anon = 1 then do; anon_switch = "1"b; user_name = "*" || user_name; end; static_initialized = "1"b; end; forum_control_ptr = null (); proceedings_ptr = null (); forum_data_ptr = null (); attendee_idx = 0; return; end initialize; /* This is where we bail out at 30,000 feet by passing in an error code and knowing that this procedure never returns. The label variable "egress" is set in "initialize". */ error: procedure (P_status); declare P_status fixed bin (35) parameter; status = P_status; go to egress; end error; force_access: procedure (); segment_acl.access_name = get_group_id_$tag_star (); segment_acl.modes = RW_ACCESS; segment_acl.xmodes = ""b; call hcs_$add_acl_entries (directory, forum_control_entry, addr (segment_acl), 1, status); if status ^= 0 then call error (status); return; end force_access; delete_access: procedure (); delete_acl.access_name = get_group_id_$tag_star (); call hcs_$delete_acl_entries (directory, forum_control_entry, addr (delete_acl), 1, (0)); end delete_access; end v1_forum_mgr_$open_forum;  v1_forum_seg_mgr_.pl1 04/10/85 0855.3r w 04/08/85 1131.7 167733 /* *************************************************************** * * * Copyright (c) 1982 by Massachusetts Institute of Technology * * * *************************************************************** */ v1_forum_seg_mgr_$create_forum: procedure (P_dir_name, P_forum_name, P_code); /* 11/14/82 Jay Pattin split off from v1_forum_trans_mgr_, changed (add delete)_name to chname */ /* 8/12/83 Jay Pattin added get_uid_file */ declare (P_access_name char (*), P_acl_ptr ptr, P_acl_count fixed bin, P_code fixed bin (35), P_dir_name char (*), P_forum_idx fixed bin, P_forum_name char (*), P_new_name char (*), P_old_name char (*), P_output_area ptr, P_real_dir char (*), P_real_name char (*), P_uid bit (36) aligned, P_userp bit (1) aligned, P_setp bit (1) aligned, P_writep bit (1) aligned) parameter; declare access_name char (32), acl_count fixed bin, acl_ptr ptr, anon_sw bit (1) aligned, attendee_idx fixed bin, code fixed bin (35), created bit (1) aligned, dir_name char (168), dirname_len fixed bin, directory char (dirname_len) based (addr (dir_name)), egress label variable, forum_name char (32), forum_name_len fixed bin, idx fixed bin, inner_ring fixed bin (3), new_name char (32), old_name char (32), old_name_len fixed bin, person_id char (22), privileged bit (1) aligned, proc_name char (32), project_id char (9), real_dir char (168), real_name char (32), user_ring fixed bin (3); declare 1 acl_term aligned based, 2 access_name char (32), 2 modes bit (36), 2 xmodes bit (36), 2 status_code fixed bin (35); declare 1 one_acl like acl_term; declare 1 two_acls (2) aligned like acl_term; declare check_star_name_$entry entry (char (*), fixed bin (35)), v1_forum_mgr_$get_ptrs entry (fixed bin, ptr, ptr, fixed bin, bit (1) aligned, fixed bin (35)), v1_forum_mgr_$initiate entry (char (*), char (*), bit (1) aligned, ptr, ptr, fixed bin (35)), v1_forum_mgr_$terminate entry (ptr, ptr), v1_forum_mgr_$unlock entry (ptr), get_group_id_ entry returns (char (32)), get_ring_ entry returns (fixed bin (3)), hcs_$add_acl_entries entry (char (*), char (*), ptr, fixed bin, fixed bin (35)), hcs_$append_branch entry (char (*), char (*), fixed bin (5), fixed bin (35)), hcs_$chname_seg entry (ptr, char (*), char (*), fixed bin (35)), hcs_$delentry_file entry (char (*), char (*), fixed bin (35)), hcs_$delentry_seg entry (ptr, fixed bin (35)), hcs_$delete_acl_entries entry (char(*), char(*), ptr, fixed bin, fixed bin(35)), hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)), hcs_$get_link_target entry (char (*), char (*), char (*), char (*), fixed bin (35)), hcs_$get_uid_seg entry (ptr, bit (36) aligned, 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_$list_acl entry (char(*), char(*), ptr, ptr, ptr, fixed bin, fixed bin(35)), hcs_$replace_acl entry (char (*), char (*), ptr, fixed bin, bit (1), fixed bin (35)), hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)), 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_$login_data entry (char (*), char (*), char (*), fixed bin, fixed bin, fixed bin, fixed bin (71), char (*)); declare (error_table_$badstar, error_table_$namedup, error_table_$noentry, forum_error_table_$anon_chairman, forum_error_table_$blank_forum_name, forum_error_table_$chairman_only, forum_error_table_$long_forum_name, forum_error_table_$no_control_suffix, forum_error_table_$not_a_forum, forum_error_table_$unexpected_fault, forum_error_table_$you_twit) fixed bin (35) external static; declare (addr, clock, length, null, rtrim, string, substr, unspec) builtin; declare (any_other, cleanup) condition; %page; %include v1_forum_structures; %page; %include access_mode_values; %page; call initialize (CREATE_FORUM_EXIT); forum_name = P_forum_name; /* copy into inner ring */ dir_name = P_dir_name; created = "0"b; on cleanup call hcs_$level_set (user_ring); call hcs_$level_set (inner_ring); call validate_name (forum_name); proc_name = substr (forum_name, 1, forum_name_len) || ".proceedings"; call check_star_name_$entry (forum_name, code); if code ^= 0 then call error (error_table_$badstar); if anon_sw then call error (forum_error_table_$anon_chairman); call hcs_$status_minf (dir_name, forum_name, 0, (0), (0), code); if code = 0 then call error (error_table_$namedup); else if code ^= error_table_$noentry then call error (code); call hcs_$status_minf (dir_name, proc_name, 0, (0), (0), code); if code = 0 then call error (error_table_$namedup); else if code ^= error_table_$noentry then call error (code); created = "1"b; call hcs_$append_branch (dir_name, forum_name, RW_ACCESS_BIN, code); if code ^= 0 then call error (code); call hcs_$append_branch (dir_name, proc_name, RW_ACCESS_BIN, code); if code ^= 0 then call error (code); two_acls (1).access_name = person_id || ".*.*"; two_acls (1).modes = RW_ACCESS; two_acls (1).xmodes = "0"b; two_acls (2).access_name = "*.*.*"; /* Give the world r Access to the forum_control segment */ two_acls (2).modes = R_ACCESS; two_acls (2).xmodes = "0"b; call hcs_$replace_acl (dir_name, forum_name, addr (two_acls), 2, "0"b, code); if code ^= 0 then call error (code); two_acls (2).access_name = "*.*.*"; /* Give the world null Access to the proceedings segment */ two_acls (2).modes = N_ACCESS; two_acls (2).xmodes = "0"b; call hcs_$replace_acl (dir_name, proc_name, addr (two_acls), 2, "0"b, code); if code ^= 0 then call error (code); call hcs_$initiate (dir_name, forum_name, "", 0, 0, forum_control_ptr, code); if code ^= 0 then call error (code); call set_lock_$lock (forum_control.forum_lock, 3, code); if code ^= 0 then call error (code); forum_control.next_trans_loc = 0; /* initialize some stuff */ string (forum_control.flags) = ""b; forum_control.no_transactions = 0; forum_control.no_attendees = 1; forum_control.no_deleted = 0; forum_control.chairman.person_id = person_id; /* we are the chairman */ forum_control.chairman.project_id = project_id; unspec (forum_control.attendee (1)) = ""b; forum_control.attendee (1).person_id = person_id; forum_control.attendee (1).project_id = project_id; forum_control.attendee (1).last_time_attended = clock (); call set_lock_$unlock (forum_control.forum_lock, (0)); call hcs_$terminate_noname (forum_control_ptr, code); if code ^= 0 then call error (code); call hcs_$level_set (user_ring); P_code = 0; return; CREATE_FORUM_EXIT: if created then do; call hcs_$delentry_file (dir_name, forum_name, (0)); call hcs_$delentry_file (dir_name, proc_name, (0)); end; P_code = code; call hcs_$level_set (user_ring); return; %page; v1_forum_seg_mgr_$chname_forum: entry (P_dir_name, P_forum_name, P_old_name, P_new_name, P_code); call initialize (CHNAME_EXIT); on cleanup begin; call v1_forum_mgr_$terminate (forum_control_ptr, proceedings_ptr); call hcs_$level_set (user_ring); end; on any_other call error (forum_error_table_$unexpected_fault); call hcs_$level_set (inner_ring); call v1_forum_mgr_$initiate (P_dir_name, P_forum_name, "0"b, forum_control_ptr, proceedings_ptr, code); if code ^= 0 then call error (code); call chname (); CHNAME_EXIT: call v1_forum_mgr_$terminate (forum_control_ptr, proceedings_ptr); call hcs_$level_set (user_ring); P_code = code; return; v1_forum_seg_mgr_$chname_forum_idx: entry (P_forum_idx, P_old_name, P_new_name, P_code); call initialize (CHNAME_IDX_EXIT); on cleanup begin; call v1_forum_mgr_$unlock (forum_control_ptr); call hcs_$level_set (user_ring); end; on any_other call error (forum_error_table_$unexpected_fault); call hcs_$level_set (inner_ring); call v1_forum_mgr_$get_ptrs (P_forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, ("0"b), code); if code ^= 0 then call error (code); call chname (); CHNAME_IDX_EXIT: call v1_forum_mgr_$unlock (forum_control_ptr); call hcs_$level_set (user_ring); P_code = code; return; %page; chname: proc (); if anon_sw | forum_control.chairman.person_id ^= person_id then call error (forum_error_table_$chairman_only); old_name = P_old_name; if old_name ^= "" then do; call validate_name (old_name); old_name_len = forum_name_len; end; new_name = P_new_name; if new_name ^= "" then do; call validate_name (new_name); call check_star_name_$entry (new_name, code); if code ^= 0 then call error (error_table_$badstar); end; call hcs_$chname_seg (forum_control_ptr, old_name, new_name, code); if code ^= 0 then call error (code); if old_name ^= "" then old_name = substr (old_name, 1, old_name_len) || ".proceedings"; if new_name ^= "" then new_name = substr (new_name, 1, forum_name_len) || ".proceedings"; call hcs_$chname_seg (proceedings_ptr, old_name, new_name, code); if code ^= 0 then call error (code); return; end chname; %page; v1_forum_seg_mgr_$priv_delete_forum: entry (P_dir_name, P_forum_name, P_code); privileged = "1"b; goto DELETE_COMMON; v1_forum_seg_mgr_$delete_forum: entry (P_dir_name, P_forum_name, P_code); privileged = "0"b; DELETE_COMMON: call initialize (DELETE_FORUM_EXIT); on any_other call error (forum_error_table_$unexpected_fault); on cleanup call hcs_$level_set (user_ring); call hcs_$level_set (inner_ring); call force_acl (); /* This will fail if no 'm' permission on dir */ call v1_forum_mgr_$initiate (P_dir_name, P_forum_name, "1"b, forum_control_ptr, proceedings_ptr, code); if code ^= 0 then call error (code); /* Get pointers to forums */ unspec (forum_control.chairman) = ""b; /* From here on this is no longer a valid forum... if we blow out from here down, a System maintainer will have to flush the thing */ call hcs_$delentry_seg (forum_control_ptr, code); call hcs_$delentry_seg (proceedings_ptr, code); DELETE_FORUM_EXIT: call hcs_$level_set (user_ring); P_code = code; return; %page; v1_forum_seg_mgr_$priv_set_forum_acl: entry (P_dir_name, P_forum_name, P_access_name, P_userp, P_setp, P_writep, P_code); privileged = "1"b; call initialize (SET_FORUM_ACL_EXIT); on any_other call error (forum_error_table_$unexpected_fault); call force_acl (); on cleanup begin; call v1_forum_mgr_$terminate (forum_control_ptr, proceedings_ptr); call hcs_$level_set (user_ring); end; call hcs_$level_set (inner_ring); call v1_forum_mgr_$initiate (P_dir_name, P_forum_name, "1"b, forum_control_ptr, proceedings_ptr, code); if code ^= 0 then call error (code); access_name = P_access_name; /* So he can remove own acl */ if P_userp & access_name = person_id then call v1_forum_mgr_$unlock (forum_control_ptr); goto SET_ACL_COMMON; v1_forum_seg_mgr_$set_forum_acl: entry (P_forum_idx, P_access_name, P_userp, P_setp, P_writep, P_code); privileged = "0"b; call initialize (SET_FORUM_ACL_EXIT); on cleanup begin; call v1_forum_mgr_$unlock (forum_control_ptr); call hcs_$level_set (user_ring); end; on any_other call error (forum_error_table_$unexpected_fault); call hcs_$level_set (inner_ring); call v1_forum_mgr_$get_ptrs (P_forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, ("0"b), code); if code ^= 0 then call error (code); if anon_sw | forum_control.chairman.person_id ^= person_id then call error (forum_error_table_$chairman_only); access_name = P_access_name; if ((^P_setp & P_userp) | (P_setp & ^P_writep)) & access_name = person_id then call error (forum_error_table_$you_twit); SET_ACL_COMMON: if P_userp then one_acl.access_name = rtrim (access_name) || ".*.*"; else one_acl.access_name = "*." || rtrim (access_name) || ".*"; if P_setp then one_acl.modes = RW_ACCESS; else one_acl.modes = R_ACCESS; one_acl.xmodes = "0"b; call hcs_$fs_get_path_name (forum_control_ptr, dir_name, (0), forum_name, code); if code ^= 0 then call error (code); forum_name_len = length (rtrim (forum_name)) - length (".control"); call hcs_$add_acl_entries (dir_name, forum_name, addr (one_acl), 1, code); if code ^= 0 then call error (code); if P_setp & ^P_writep then one_acl.modes = R_ACCESS; else if ^P_setp then one_acl.modes = N_ACCESS; /* When removing people, leave them r access to forum_control segment but null access to proceedings segment */ call hcs_$add_acl_entries (dir_name, substr (forum_name, 1, forum_name_len) || ".proceedings", addr (one_acl), 1, code); if code ^= 0 then call error (code); do idx = 1 to forum_control.no_attendees; forum_control.attendee (idx).acl_change_pending = "1"b; end; if ^privileged then forum_control.attendee (attendee_idx).acl_change_pending = "0"b; SET_FORUM_ACL_EXIT: if privileged then do; call delete_forced_acl (); call v1_forum_mgr_$terminate (forum_control_ptr, proceedings_ptr); end; else call v1_forum_mgr_$unlock (forum_control_ptr); call hcs_$level_set (user_ring); P_code = code; return; %page; validate_name: proc (name); declare name char (32); if name = "" then call error (forum_error_table_$blank_forum_name); forum_name_len = length (rtrim (name)) - length (".control"); if forum_name_len < 1 then call error (forum_error_table_$no_control_suffix); else if forum_name_len > 20 then call error (forum_error_table_$long_forum_name); if substr (name, forum_name_len + 1) ^= ".control" then call error (forum_error_table_$no_control_suffix); return; end validate_name; force_acl: procedure (); one_acl.access_name = get_group_id_ (); one_acl.modes = RW_ACCESS; one_acl.xmodes = ""b; call hcs_$add_acl_entries (P_dir_name, P_forum_name, addr (one_acl), 1, code); if code ^= 0 then if code = error_table_$noentry then call error (forum_error_table_$not_a_forum); else call error (code); forum_name_len = length (rtrim (P_forum_name)) - length (".control"); call hcs_$add_acl_entries (P_dir_name, substr (P_forum_name, 1, forum_name_len) || ".proceedings", addr (one_acl), 1, code); if code ^= 0 then if code = error_table_$noentry then call error (forum_error_table_$not_a_forum); else call error (code); return; end force_acl; delete_forced_acl: procedure (); declare 1 delete_acls aligned, 2 access_name char (32), 2 status fixed bin (35); delete_acls.access_name = get_group_id_ (); call hcs_$delete_acl_entries (P_dir_name, P_forum_name, addr (delete_acls), 1, (0)); forum_name_len = length (rtrim (P_forum_name)) - length (".control"); call hcs_$delete_acl_entries (P_dir_name, substr (P_forum_name, 1, forum_name_len) || ".proceedings", addr (delete_acls), 1, (0)); return; end delete_forced_acl; %page; v1_forum_seg_mgr_$list_forum_acl: entry (P_dir_name, P_forum_name, P_output_area, P_acl_ptr, P_acl_count, P_code); call initialize (LIST_ACL_EXIT); dir_name = P_dir_name; forum_name = P_forum_name; call validate_name (forum_name); forum_name = substr (forum_name, 1, forum_name_len) || ".proceedings"; on cleanup call hcs_$level_set (user_ring); call hcs_$level_set (inner_ring); call hcs_$list_acl (dir_name, forum_name, P_output_area, acl_ptr, null (), acl_count, code); if code ^= 0 then call error (code); call hcs_$level_set (user_ring); P_acl_ptr = acl_ptr; P_acl_count = acl_count; P_code = 0; return; LIST_ACL_EXIT: call hcs_$level_set (user_ring); P_acl_ptr = null (); P_acl_count = 0; P_code = code; return; %page; v1_forum_seg_mgr_$get_forum_path: entry (P_dir_name, P_forum_name, P_real_dir, P_real_name, P_code); call initialize (GET_MEETING_PATH_EXIT); dir_name = P_dir_name; forum_name = P_forum_name; call validate_name (forum_name); on cleanup call hcs_$level_set (user_ring); call hcs_$level_set (inner_ring); call hcs_$get_link_target (dir_name, forum_name, real_dir, real_name, code); if code ^= 0 then call error (code); call validate_name (real_name); /* make sure target is validly named */ call hcs_$level_set (user_ring); P_real_dir = real_dir; P_real_name = real_name; P_code = 0; return; GET_MEETING_PATH_EXIT: call hcs_$level_set (user_ring); P_real_dir = ""; P_real_name = ""; P_code = code; return; %page; v1_forum_seg_mgr_$get_forum_path_idx: entry (P_forum_idx, P_real_dir, P_real_name, P_code); call initialize (GET_MEETING_PATH_EXIT); on cleanup call v1_forum_mgr_$unlock (forum_control_ptr); call v1_forum_mgr_$get_ptrs (P_forum_idx, forum_control_ptr, proceedings_ptr, (0), ("0"b), code); if code ^= 0 then call error (code); call hcs_$fs_get_path_name (forum_control_ptr, dir_name, dirname_len, real_name, code); if code ^= 0 then call error (code); call v1_forum_mgr_$unlock (forum_control_ptr); P_real_dir = directory; P_real_name = real_name; P_code = 0; return; %page; v1_forum_seg_mgr_$get_uid_file: entry (P_dir_name, P_forum_name, P_uid, P_code); call initialize (UID_EXIT); on cleanup begin; call v1_forum_mgr_$terminate (forum_control_ptr, proceedings_ptr); call hcs_$level_set (user_ring); end; on any_other call error (forum_error_table_$unexpected_fault); call hcs_$level_set (inner_ring); call v1_forum_mgr_$initiate (P_dir_name, P_forum_name, "0"b, forum_control_ptr, proceedings_ptr, code); if code ^= 0 then call error (code); call hcs_$get_uid_seg (forum_control_ptr, P_uid, code); if code ^= 0 then call error (code); UID_EXIT: call v1_forum_mgr_$terminate (forum_control_ptr, proceedings_ptr); call hcs_$level_set (user_ring); P_code = code; return; %page; initialize: procedure (P_egress); declare P_egress label variable, anon fixed bin; egress = P_egress; inner_ring = get_ring_ (); user_ring = hcs_$level_get (); call user_info_$login_data (person_id, project_id, (""), anon, 0, 0, 0, ("")); anon_sw = (anon = 1); forum_control_ptr, proceedings_ptr = null (); /* no forum initialized yet, this call */ code = 0; /* no errors yet either */ return; end initialize; error: procedure (error_code); declare error_code fixed bin (35); code = error_code; goto egress; /* lets PUNT */ end error; end v1_forum_seg_mgr_$create_forum;  v1_forum_trans_mgr_.pl1 10/30/84 1244.0r 10/30/84 0958.6 228510 /* *************************************************************** * * * Copyright (c) 1982 by Massachusetts Institute of Technology * * * *************************************************************** */ /* * v1_forum_trans_mgr_ Manager of forum transactions. We call v1_forum_mgr_ to initiate or otherwise deal with forums as a whole */ /* Original code By Mike Auerbach and Jeff Schiller 1/82 Jay Pattin Many changes for forum and general reorganization 2/16/82 Jay Pattin added list_acl 3/29/82 Jay Pattin added privileged entries 4/16/82 Jay Pattin added force_acl to make privileged entries work correctly 5/05/82 Jay Pattin added support for read only participants 8/20/82 Jay Pattin to check entry names and anonymous users 10/9/82 Jay Pattin added trans_time_info, user deletion of own transactions 11/14/82 Jay Pattin split off forum_space_mgr_. 8/5/83 Jay Pattin new notifications */ v1_forum_trans_mgr_$enter_trans: procedure (a_forum_idx, a_input_string, a_previous_trans, a_subject, a_filled_sw, a_trans_no, a_code); declare (a_attendee_idx fixed bin, a_code fixed bin (35), /* returned status code */ a_deleted_sw bit (1) aligned, a_filled_sw bit (1) aligned, a_first_trans_idx fixed bin, a_flags_word bit (36) aligned, a_forum_idx fixed bin, /* index in forum data of this forum */ (a_high_time, a_low_time) fixed bin (71), (a_high_trans, a_low_trans) fixed bin, a_input_string char (*), a_last_trans_idx fixed bin, a_last_seen_trans_idx fixed bin, a_new_trans_count fixed bin, a_output_area ptr, /* pointer to area to allocate text in */ a_output_ptr ptr, /* pointer to transaction structure (output) */ (a_pref, a_nref) fixed bin, a_previous_trans fixed bin, /* transaction to chain this one from, 0 if none */ a_subject char (*), a_trans_no fixed bin, a_type fixed bin, a_uid bit (36) aligned, a_user_name char (*), a_value_sw bit (1) aligned) parameter; declare anon_sw bit (1) aligned, attendee_idx fixed bin, /* index into attendee part of forum */ chairman bit (1) aligned, code fixed bin (35), dir_name char (168), done bit (1) aligned, forum_idx fixed bin, forum_name char (32), input_len fixed bin, (high_time, low_time) fixed bin (71), (high_trans, low_trans) fixed bin, i fixed bin, message char (256), new_trans_count fixed bin, next_trans_ptr ptr, /* pointer to next transaction in proceedings segment */ person_id char (22), (nref, pref) fixed bin, project_id char (9), transx fixed bin, trans_no fixed bin, trans_ptr ptr, /* pointer to transaction in proceedings segment */ type fixed bin, uid bit (36) aligned, user_name char (32), value_sw bit (1) aligned, (write_allowed, privileged) bit (1) aligned, (any_other, area, out_of_bounds, record_quota_overflow, seg_fault_error, cleanup) condition, (addr, clock, rtrim, length, null, ptr, substr) builtin; declare v1_forum_mgr_$get_ptrs entry (fixed bin, ptr, ptr, fixed bin, bit (1) aligned, fixed bin (35)), v1_forum_mgr_$unlock entry (ptr), forum_notify_gate_$lookup entry (char (*), bit (1) aligned, fixed bin (35)), hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)), hcs_$force_write entry (ptr, bit (36), fixed bin (35)), hcs_$get_uid_seg entry (ptr, bit (36) aligned, fixed bin (35)), hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)), ioa_$rsnnl entry options (variable), send_mail_ entry (char (*), char (*), ptr, fixed bin (35)), user_info_$login_data entry (char (*), char (*), char (*), fixed bin, fixed bin, fixed bin, fixed bin (71), char (*)); declare (error_table_$noalloc, error_table_$seg_busted) fixed bin (35) external; declare (forum_error_table_$cant_notify, forum_error_table_$no_message, forum_error_table_$message_too_long, forum_error_table_$incorrect_uid, forum_error_table_$meeting_bloat, forum_error_table_$invalid_trans_idx, forum_error_table_$read_only, forum_error_table_$rqo, forum_error_table_$trans_deleted, forum_error_table_$chairman_only, forum_error_table_$trans_reaped, forum_error_table_$invalid_att_idx, forum_error_table_$unexpected_fault) fixed bin (35) external; declare (forum_data_$print_eligibility_messages, forum_data_$chairman_override) bit (1) aligned external; declare egress label variable, output_area area based (a_output_area), proceeding_string char (alloc_text_length) based (trans_ptr), transaction char (input_len) based; %page; %include v1_forum_structures; %page; %include forum_flags; %page; %include forum_user_trans; %page; %include send_mail_info; %page; /* v1_forum_trans_mgr_$enter_trans: entry (a_forum_idx, a_input_string, a_previous_trans, a_subject, a_filled_sw, a_trans_no, a_code); */ forum_idx = a_forum_idx; /* copy for safety against user ring */ call initialize (ENTER_PUNT); on cleanup call v1_forum_mgr_$unlock (forum_control_ptr); on seg_fault_error call error (error_table_$seg_busted); on any_other call error (forum_error_table_$unexpected_fault); call v1_forum_mgr_$get_ptrs (forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, write_allowed, code); if code ^= 0 then call error (code); if ^write_allowed then call error (forum_error_table_$read_only); next_trans_ptr = ptr (proceedings_ptr, forum_control.next_trans_loc); on out_of_bounds call error (forum_error_table_$meeting_bloat); on record_quota_overflow call error (forum_error_table_$rqo); input_len = length (a_input_string); next_trans_ptr -> transaction = a_input_string; revert out_of_bounds; call hcs_$force_write (proceedings_ptr, (""b), (0)); transx = forum_control.no_transactions + 1; forum_control.transactions (transx).offset = forum_control.next_trans_loc; forum_control.transactions (transx).length = input_len; forum_control.transactions (transx).person_id = forum_control.attendee (attendee_idx).person_id; forum_control.transactions (transx).project_id = forum_control.attendee (attendee_idx).project_id; forum_control.transactions (transx).time = clock (); forum_control.transactions (transx).subject = a_subject; forum_control.transactions (transx).prior_ref_index, forum_control.transactions (transx).next_ref_index = 0; forum_control.transactions (transx).unfilled = a_filled_sw; forum_control.transactions (transx).deleted, forum_control.transactions (transx).gone = "0"b; pref = a_previous_trans; /* copy into lower ring */ if pref ^= 0 then /* link this transaction into reply chain if apropriate */ do; do while (forum_control.transactions (pref).next_ref_index ^= 0); pref = forum_control.transactions (pref).next_ref_index; end; forum_control.transactions (pref).next_ref_index = transx; forum_control.transactions (transx).prior_ref_index = pref; end; forum_control.next_trans_loc = forum_control.next_trans_loc + (input_len + 3) / 4; a_trans_no, forum_control.no_transactions = transx; /* atomic commit point */ revert seg_fault_error; revert record_quota_overflow; on any_other call error (forum_error_table_$cant_notify); call hcs_$get_uid_seg (forum_control_ptr, uid, code); if code ^= 0 then call error (code); msg_ptr = addr (forum_message); forum_message.forum_uid = uid; /* for validation purposes */ forum_message.index = attendee_idx; call hcs_$fs_get_path_name (forum_control_ptr, dir_name, (0), forum_name, code); if code ^= 0 then call error (code); forum_name = substr (forum_name, 1, length (rtrim (forum_name)) - length (".control")); call ioa_$rsnnl ("A new transaction has just been added to the ^a>^a meeting.", message, (0), dir_name, forum_name); send_mail_info.version = 2; send_mail_info.sent_from = "forum"; string (send_mail_info.switches) = ""b; send_mail_info.wakeup, send_mail_info.always_add = "1"b; do transx = 1 to forum_control.no_attendees; if transx = attendee_idx then goto NEXT; if forum_control.attendee (transx).attending & ^forum_control.attendee (transx).removed then call hcs_$wakeup (forum_control.attendee (transx).process_id, forum_control.attendee (transx).public_wakeup_chan, ipc_message, (0)); else if forum_control.attendee (transx).notify & ^forum_control.attendee (transx).removed then do; call forum_notify_gate_$lookup (forum_control.attendee (transx).person_id, done, code); if done & code = 0 then call send_mail_ (rtrim (forum_control.attendee (transx).person_id) || "." || rtrim (forum_control.attendee (transx).project_id), rtrim (message), addr (send_mail_info), (0)); end; NEXT: end; code = 0; ENTER_PUNT: call v1_forum_mgr_$unlock (forum_control_ptr); a_code = code; return; %page; v1_forum_trans_mgr_$read_trans: entry (a_forum_idx, a_trans_no, a_output_area, a_output_ptr, a_code); trans_no = a_trans_no; /* copy trans_no to inner ring */ call initialize (READ_PUNT); on cleanup call v1_forum_mgr_$unlock (forum_control_ptr); on seg_fault_error call error (error_table_$seg_busted); on any_other call error (forum_error_table_$unexpected_fault); call v1_forum_mgr_$get_ptrs (a_forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, (""b), code); if code ^= 0 then call error (code); if trans_no < 1 | trans_no > forum_control.no_transactions then call error (forum_error_table_$invalid_trans_idx); if forum_control.transactions (trans_no).deleted then if person_id ^= forum_control.chairman.person_id & person_id ^= forum_control.transactions (trans_no).person_id then call error (forum_error_table_$trans_deleted); else if forum_control.transactions (trans_no).gone then call error (forum_error_table_$trans_reaped); alloc_subject_length = length (forum_control.transactions (trans_no).subject); alloc_text_length = forum_control.transactions (trans_no).length; on area call error (error_table_$noalloc); allocate forum_user_trans in (output_area) set (forum_user_trans_ptr); /* allocate structure in desired area */ revert area; trans_ptr = ptr (proceedings_ptr, forum_control.transactions (trans_no).offset); forum_user_trans.type = user_trans_type; forum_user_trans.person_id = forum_control.transactions (trans_no).person_id; forum_user_trans.project_id = forum_control.transactions (trans_no).project_id; forum_user_trans.trans_no = trans_no; forum_user_trans.time = forum_control.transactions (trans_no).time; forum_user_trans.prev_trans_ptr, forum_user_trans.next_trans_ptr = null (); /* these are used by user ring code */ forum_user_trans.subject = forum_control.transactions (trans_no).subject; forum_user_trans.text = proceeding_string; forum_user_trans.unfilled = forum_control.transactions (trans_no).unfilled; if forum_control.transactions (trans_no).deleted then a_code = forum_error_table_$trans_deleted; else a_code = 0; a_output_ptr = forum_user_trans_ptr; call v1_forum_mgr_$unlock (forum_control_ptr); return; READ_PUNT: call v1_forum_mgr_$unlock (forum_control_ptr); a_output_ptr = null (); a_code = code; return; %page; v1_forum_trans_mgr_$set_message: entry (a_forum_idx, a_input_string, a_code); forum_idx = a_forum_idx; call initialize (SET_MESSAGE_EXIT); on cleanup call v1_forum_mgr_$unlock (forum_control_ptr); on any_other call error (forum_error_table_$unexpected_fault); if length (a_input_string) > 256 then call error (forum_error_table_$message_too_long); call v1_forum_mgr_$get_ptrs (forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, ("0"b), code); if code ^= 0 then call error (code); if anon_sw | forum_control.chairman.person_id ^= person_id then call error (forum_error_table_$chairman_only); input_len = 256; if ^forum_control.flags.msg_init then do; next_trans_ptr = ptr (proceedings_ptr, forum_control.next_trans_loc); forum_control.message_loc = forum_control.next_trans_loc; forum_control.next_trans_loc = forum_control.next_trans_loc + 64; forum_control.flags.msg_init = "1"b; next_trans_ptr -> transaction = ""; end; next_trans_ptr = ptr (proceedings_ptr, forum_control.message_loc); on out_of_bounds call error (forum_error_table_$meeting_bloat); next_trans_ptr -> transaction = a_input_string; revert out_of_bounds; do attendee_idx = 1 to forum_control.no_attendees; forum_control.attendee (attendee_idx).message_changed = "1"b; end; code = 0; SET_MESSAGE_EXIT: call v1_forum_mgr_$unlock (forum_control_ptr); a_code = code; return; %page; v1_forum_trans_mgr_$get_message: entry (a_forum_idx, a_input_string, a_code); forum_idx = a_forum_idx; call initialize (GET_MESSAGE_EXIT); on cleanup call v1_forum_mgr_$unlock (forum_control_ptr); on any_other call error (forum_error_table_$unexpected_fault); call v1_forum_mgr_$get_ptrs (forum_idx, forum_control_ptr, proceedings_ptr, (0), ("0"b), code); if code ^= 0 then call error (code); if ^forum_control.flags.msg_init then call error (forum_error_table_$no_message); trans_ptr = ptr (proceedings_ptr, forum_control.message_loc); input_len = 256; a_input_string = trans_ptr -> transaction; GET_MESSAGE_EXIT: call v1_forum_mgr_$unlock (forum_control_ptr); a_code = code; if code ^= 0 then a_input_string = ""; return; %page; v1_forum_trans_mgr_$trans_time_info: entry (a_forum_idx, a_low_time, a_high_time, a_low_trans, a_high_trans, a_code); call initialize (TRANS_REF_PUNT); on any_other call error (forum_error_table_$unexpected_fault); on cleanup call v1_forum_mgr_$unlock (forum_control_ptr); call v1_forum_mgr_$get_ptrs (a_forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, ("0"b), code); if code ^= 0 then call error (code); low_time = a_low_time; high_time = a_high_time; low_trans = 1; high_trans = forum_control.no_transactions; if high_time ^= 0 & high_time < forum_control.transactions (1).time then high_trans = 0; else if low_time > forum_control.transactions (high_trans).time then low_trans = high_trans; else do; if low_time > forum_control.transactions (1).time then low_trans = find (low_time, 1, (high_trans)); if high_time ^= 0 & high_time < forum_control.transactions (high_trans).time then high_trans = find (high_time, (low_trans), (high_trans)) + 1; end; a_high_trans = high_trans; a_low_trans = low_trans; call v1_forum_mgr_$unlock (forum_control_ptr); a_code = 0; return; find: proc (t, low, high) returns (fixed bin); declare t fixed bin (71), (idx, low, high, h, l) fixed bin; do idx = (high + low) / 2 repeat idx; if forum_control.transactions (idx).time = 0 then do; /* The garbage collector has been here */ do h = idx to high while (forum_control.transactions (h).time = 0); end; do l = idx to low by -1 while (forum_control.transactions (l).time = 0); end; if t < forum_control.transactions (h).time then high = l; else low = h; end; else if forum_control.transactions (idx).time < t then do; if forum_control.transactions (idx + 1).time > t then return (idx); else do; low = idx; idx = idx + (high - idx) / 2; end; end; else if forum_control.transactions (idx - 1).time < t then return (idx - 1); else do; high = idx; idx = idx - (idx - low) / 2; end; end; end find; %page; v1_forum_trans_mgr_$real_trans_ref_info: entry (a_forum_idx, a_trans_no, a_type, a_pref, a_nref, a_deleted_sw, a_code); type = a_type; goto TRANS_REF_COMMON; v1_forum_trans_mgr_$trans_ref_info: entry (a_forum_idx, a_trans_no, a_pref, a_nref, a_deleted_sw, a_code); type = ONLY_UNDELETED; TRANS_REF_COMMON: call initialize (TRANS_REF_PUNT); on any_other call error (forum_error_table_$unexpected_fault); on cleanup call v1_forum_mgr_$unlock (forum_control_ptr); call v1_forum_mgr_$get_ptrs (a_forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, ("0"b), code); if code ^= 0 then call error (code); trans_no = a_trans_no; /* copy this argument into the inner ring */ if trans_no < 1 | trans_no > forum_control.no_transactions then call error (forum_error_table_$invalid_trans_idx); if forum_control.transactions (trans_no).gone then call error (forum_error_table_$trans_reaped); chairman = (person_id = forum_control.chairman.person_id); pref, nref = -1; /* so loops work */ done = "0"b; do i = trans_no repeat pref while (^done & pref ^= 0); pref = forum_control.transactions (i).prior_ref_index; call check (pref); end; done = "0"b; do i = trans_no repeat nref while (^done & nref ^= 0); nref = forum_control.transactions (i).next_ref_index; call check (nref); end; a_pref = pref; a_nref = nref; a_deleted_sw = forum_control.transactions (trans_no).deleted; TRANS_REF_PUNT: call v1_forum_mgr_$unlock (forum_control_ptr); if code ^= 0 then do; a_pref, a_nref = 0; a_deleted_sw = "0"b; end; a_code = code; return; %page; v1_forum_trans_mgr_$set_delete_sw: entry (a_forum_idx, a_trans_no, a_value_sw, a_code); call initialize (SET_DELETE_EXIT); on any_other call error (forum_error_table_$unexpected_fault); on cleanup call v1_forum_mgr_$unlock (forum_control_ptr); value_sw = a_value_sw; /* copy into inner ring */ call v1_forum_mgr_$get_ptrs (a_forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, ("0"b), code); if code ^= 0 then call error (code); trans_no = a_trans_no; /* copy this to inner ring */ if trans_no < 1 | trans_no > forum_control.no_transactions then call error (forum_error_table_$invalid_trans_idx); if forum_control.transactions (trans_no).gone & ^value_sw then call error (forum_error_table_$trans_reaped); /* transaction has been reaped by garbage collection */ if person_id = forum_control.transactions (trans_no).person_id then privileged = "0"b; /* so chair can retrieve own */ else if ^anon_sw & person_id = forum_control.chairman.person_id then privileged = "1"b; else call error (forum_error_table_$chairman_only); if ^value_sw & ^privileged & ^forum_control.transactions (trans_no).deleted_by_author then call error (forum_error_table_$chairman_only); forum_control.transactions (trans_no).deleted_by_author = value_sw & ^privileged & (^forum_control.transactions (trans_no).deleted | value_sw); if forum_control.transactions (trans_no).deleted & value_sw then goto SET_DELETE_EXIT; if ^forum_control.transactions (trans_no).deleted & ^value_sw then goto SET_DELETE_EXIT; forum_control.transactions (trans_no).deleted = value_sw; /* well one way or the other... */ if value_sw then forum_control.no_deleted = forum_control.no_deleted + 1; else forum_control.no_deleted = forum_control.no_deleted - 1; SET_DELETE_EXIT: call v1_forum_mgr_$unlock (forum_control_ptr); a_code = code; return; %page; v1_forum_trans_mgr_$forum_limits: entry (a_forum_idx, a_last_seen_trans_idx, a_first_trans_idx, a_last_trans_idx, a_new_trans_count, a_flags_word, a_code); type = ONLY_UNDELETED; goto LIMITS_COMMON; v1_forum_trans_mgr_$real_forum_limits: entry (a_forum_idx, a_type, a_last_seen_trans_idx, a_first_trans_idx, a_last_trans_idx, a_new_trans_count, a_flags_word, a_code); type = a_type; LIMITS_COMMON: call initialize (FORUM_LIMITS_PUNT); on cleanup call v1_forum_mgr_$unlock (forum_control_ptr); call v1_forum_mgr_$get_ptrs (a_forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, ("0"b), code); if code ^= 0 then call error (code); chairman = (^anon_sw & forum_control.chairman.person_id = person_id); forum_flags_word = ""b; forum_flags.chairman = chairman; forum_flags.adjourned = forum_control.flags.adjourned; forum_flags.read_only = ^forum_control.attendee (attendee_idx).write_allowed; forum_flags.print_cm_message = forum_control.attendee (attendee_idx).message_changed; forum_flags.acl_has_changed = forum_control.attendee (attendee_idx).acl_change_pending; /* The following statement is dedicated to IS-14 and HBD */ forum_flags.print_acl_message = forum_control.cm_print_acl_msg | (forum_control.am_init & forum_control.am_print_acl_msg) | (forum_data_$print_eligibility_messages & ^(forum_control.am_init & ^forum_control.am_print_acl_msg) & ^(forum_data_$chairman_override & forum_control.cm_init & ^forum_control.cm_print_acl_msg)); a_flags_word = forum_flags_word; if forum_control.attendee (attendee_idx).highest_trans_seen < 0 | forum_control.attendee (attendee_idx).highest_trans_seen > forum_control.no_transactions then forum_control.attendee (attendee_idx).highest_trans_seen, a_last_seen_trans_idx = 0; else a_last_seen_trans_idx = get_highest_seen ((forum_control.attendee (attendee_idx).highest_trans_seen)); done = "0"b; do i = 1 repeat i + 1 while (^done & i <= forum_control.no_transactions); call check (i); end; if ^done then a_first_trans_idx = 0; else a_first_trans_idx = i - 1; done = "0"b; do i = forum_control.no_transactions repeat i - 1 while (^done & i ^= 0); call check (i); end; a_last_trans_idx = i + 1; new_trans_count = 0; do i = a_last_seen_trans_idx + 1 to forum_control.no_transactions; if forum_control.transactions (i).person_id ^= person_id & ^forum_control.transactions (i).deleted then new_trans_count = new_trans_count + 1; end; a_new_trans_count = new_trans_count; FORUM_LIMITS_PUNT: call v1_forum_mgr_$unlock (forum_control_ptr); a_code = code; return; %page; check: proc (idx); declare idx fixed bin, del bit (1) aligned; if forum_control.transactions (idx).gone then return; del = forum_control.transactions (idx).deleted; if type = ONLY_UNDELETED & del then return; else if type = ONLY_DELETED & ^del then return; else if del & ^chairman & forum_control.transactions (idx).person_id ^= person_id then return; else done = "1"b; return; end check; get_highest_seen: procedure (start) returns (fixed bin); declare start fixed bin; done = "0"b; do while ((start + 1) <= forum_control.no_transactions & ^done); if forum_control.transactions (start + 1).person_id = person_id then start = start + 1; else done = "1"b; end; done = "0"b; do start = start repeat start - 1 while (^done & start ^= 0); call check (start); end; return (start + 1); end get_highest_seen; %page; v1_forum_trans_mgr_$check_user: entry (a_forum_idx, a_user_name, a_trans_no, a_code); call initialize (CHECK_USER_EXIT); on any_other call error (forum_error_table_$unexpected_fault); on cleanup call v1_forum_mgr_$unlock (forum_control_ptr); call v1_forum_mgr_$get_ptrs (a_forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, ("0"b), code); if code ^= 0 then call error (code); user_name = a_user_name; /* copy into lower ring */ a_trans_no = 0; /* to start with, none seen for this user */ do i = forum_control.no_transactions by -1 to 1; if forum_control.transactions (i).person_id = user_name then a_trans_no = i; end; CHECK_USER_EXIT: call v1_forum_mgr_$unlock (forum_control_ptr); a_code = code; return; %page; v1_forum_trans_mgr_$convert_attendee_idx: entry (a_forum_idx, a_attendee_idx, a_user_name, a_code); call initialize (CONV_ATT_EXIT); on cleanup call v1_forum_mgr_$unlock (forum_control_ptr); on any_other call error (forum_error_table_$unexpected_fault); call v1_forum_mgr_$get_ptrs (a_forum_idx, forum_control_ptr, proceedings_ptr, (0), ("0"b), code); if code ^= 0 then call error (code); attendee_idx = a_attendee_idx; if attendee_idx < 1 | attendee_idx > forum_control.no_attendees then call error (forum_error_table_$invalid_att_idx); user_name = rtrim (forum_control.attendee (attendee_idx).person_id) || "." || rtrim (forum_control.attendee (attendee_idx).project_id); a_user_name = user_name; /* copy to user ring storage */ CONV_ATT_EXIT: call v1_forum_mgr_$unlock (forum_control_ptr); a_code = code; return; %page; v1_forum_trans_mgr_$validate_uid: entry (a_forum_idx, a_uid, a_code); call initialize (VALIDATE_UID_EXIT); on cleanup call v1_forum_mgr_$unlock (forum_control_ptr); on any_other call error (forum_error_table_$unexpected_fault); call v1_forum_mgr_$get_ptrs (a_forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, ("0"b), code); if code ^= 0 then call error (code); call hcs_$get_uid_seg (forum_control_ptr, uid, code); if code ^= 0 then call error (code); if uid ^= a_uid then call error (forum_error_table_$incorrect_uid); VALIDATE_UID_EXIT: call v1_forum_mgr_$unlock (forum_control_ptr); a_code = code; return; %page; initialize: procedure (P_egress); declare P_egress label variable, anon fixed bin; egress = P_egress; call user_info_$login_data (person_id, project_id, (""), anon, 0, 0, 0, ("")); anon_sw = (anon = 1); if anon_sw then person_id = "*" || person_id; forum_control_ptr, proceedings_ptr = null (); /* no forum initialized yet, this call */ code = 0; /* no errors yet either */ return; end initialize; error: procedure (error_code); declare error_code fixed bin (35); code = error_code; goto egress; /* let's PUNT */ end error; end v1_forum_trans_mgr_$enter_trans; bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- 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