forum_conversion_.pl1 04/09/85 1616.8r w 04/08/85 1131.2 150777 /* ************************************************************** * * * Copyright, (C) Massachusetts Institute of Technology, 1984 * * * ************************************************************** */ forum_conversion_$convert: proc (P_directory, P_name, P_status); /* Version 2 Forum - convert version 1 meetings to version 2 meetings. Jay Pattin 1/8/83 Audit changes, J. Spencer Love 10/05/84 Emergency fix to handle no_write_permission on control segment 1/30/85 Jay Pattin */ declare (P_directory char (*), P_name char (*), P_status fixed bin (35)) parameter; declare acl_count fixed bin, acl_ptr ptr, cleaning_up bit (1) aligned, directory char (168), dirname_buffer char (168), dirname_len fixed bin, forum_control_entry char (32), forum_idx fixed bin, forum_name_len fixed bin, (idx, jdx) fixed bin, (inner_ring, user_ring) fixed bin (3), locked bit (1) aligned, me char (24) static options (constant) init ("forum_conversion_"), message char (256) based, (name, real_name) char (32), person_id char (22), privileged bit (1) aligned, proceedings_name char (32), project_id char (9), status fixed bin (35), status_area area based (status_area_ptr); declare 1 sb aligned like status_branch, 1 od aligned like open_data, 1 acl (acl_count) aligned based (acl_ptr), 2 access_name char (32), 2 modes bit (36) aligned, 2 xmodes bit (36) aligned, 2 code fixed bin (35); declare 1 v aligned, 2 n fixed bin, 2 vector (500) ptr unaligned; declare 1 idxs aligned, 2 n fixed bin, 2 vector (500) fixed bin (18); declare (addr, addrel, hbound, length, null, pointer, ptr, rel, rtrim, size, substr, unspec) builtin, (any_other, cleanup, no_read_permission, seg_fault_error) condition; declare (error_table_$invalid_lock_reset, error_table_$lock_wait_time_exceeded, error_table_$moderr, error_table_$noentry, error_table_$seg_busted, error_table_$segnamedup, forum_et_$chairman_only, forum_et_$invalid_trans_idx, forum_et_$not_a_forum, forum_et_$unexpected_fault) fixed bin (35) external; declare forum_data_$forum_ring fixed bin (3) external; declare forum_logger_ entry options (variable), forum_logger_$any_other entry options (variable), forum_seg_mgr_$just_create entry (char (*), char (*), ptr, ptr, fixed bin (35)), forum_seg_mgr_$lock entry (ptr), forum_seg_mgr_$terminate_all entry (ptr), forum_space_mgr_$allocate_bit_map entry (ptr, ptr, fixed bin, ptr, fixed bin (35)), forum_space_mgr_$get_attendee_slot entry (ptr, char (*), ptr, fixed bin (35)), forum_trans_mgr_$load_trans entry (ptr, char (*), fixed bin, char (*), bit (1) aligned, fixed bin, fixed bin (35)), 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_$chname_file entry (char (*), char (*), char (*), char (*), fixed bin (35)), hcs_$del_dir_tree entry (char (*), char (*), fixed bin (35)), hcs_$delentry_file entry (char (*), char (*), fixed bin (35)), hcs_$delentry_seg entry (ptr, 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_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)), hcs_$level_get entry (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_ entry (char (*), char (*), fixed bin (1), ptr, ptr, 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)), sort_items_indirect_$char entry (ptr, ptr, fixed bin (24)), user_info_$whoami entry (char (*), char (*), char (*)); %page; %include forum_structures; %page; %include v1_forum_structures; %page; %include forum_open_data; %page; %include status_structures; %page; %include access_mode_values; %page; /* forum_conversion_$convert: proc (P_directory, P_name, P_status); */ privileged = "0"b; goto COMMON; forum_conversion_$priv_convert: entry (P_directory, P_name, P_status); privileged = "1"b; COMMON: directory = P_directory; name = P_name; call hcs_$level_get (user_ring); inner_ring = get_ring_ (); acl_ptr, attendee_seg_ptr, transaction_seg_ptr, forum_control_ptr, proceedings_ptr = null (); sb.nnames = 0; cleaning_up, locked = "0"b; on any_other begin; on any_other system; call forum_logger_$any_other (0, me, "Converting ^a>^a.", directory, name); call error (forum_et_$unexpected_fault); end; on cleanup call cleanup_handler (); call hcs_$level_set (inner_ring); call user_info_$whoami (person_id, project_id, ""); forum_name_len = length (rtrim (name)) - length (".control"); if forum_name_len < 1 | forum_name_len > 20 then call error (forum_et_$not_a_forum); forum_control_entry = name; proceedings_name = substr (name, 1, forum_name_len) || ".proceedings"; call initiate_old_meeting (); if ^privileged & forum_control.chairman.person_id ^= person_id then call error (forum_et_$chairman_only); name = substr (forum_control_entry, 1, forum_name_len) || ".forum"; call forum_seg_mgr_$just_create (directory, name, attendee_seg_ptr, transaction_seg_ptr, status); if status ^= 0 then call error (status); unspec (od) = ""b; od.attendee_seg_ptr = attendee_seg_ptr; od.transaction_seg_ptr = transaction_seg_ptr; od.proceedings_ptrs (*) = null (); od.forum_name = rtrim (directory) || ">" || name; attendee_seg.first_attendee_offset, attendee_seg.last_attendee_offset = ""b; attendee_seg.attendee_count = 0; attendee_seg.chairman.person_id = forum_control.chairman.person_id; attendee_seg.chairman.project_id = forum_control.chairman.project_id; attendee_seg.flags.adjourned = forum_control.flags.adjourned; attendee_seg.flags.am_init = forum_control.flags.am_init; attendee_seg.flags.am_print_acl_msg = forum_control.flags.am_print_acl_msg; attendee_seg.flags.cm_init = forum_control.flags.cm_init; attendee_seg.flags.cm_print_acl_msg = forum_control.flags.cm_print_acl_msg; if forum_control.msg_init then attendee_seg.chairman_message = ptr (proceedings_ptr, forum_control.message_loc) -> message; else attendee_seg.chairman_message = ""; status_area_ptr = get_system_free_area_ (); call hcs_$list_acl (directory, proceedings_name, status_area_ptr, acl_ptr, null (), acl_count, status); if status ^= 0 then call error (status); jdx = 0; do idx = 1 to acl_count; if acl.access_name (idx) ^= "*.SysDaemon.*" then do; jdx = jdx + 1; if idx ^= jdx then acl.access_name (jdx) = acl.access_name (idx); if acl.modes (idx) = N_ACCESS then acl.xmodes (jdx) = N_ACCESS; else if acl.modes (idx) = R_ACCESS then acl.xmodes (jdx) = R_XACL; else acl.xmodes (jdx) = RW_XACL; acl.modes (jdx) = RW_ACCESS; end; end; call hcs_$replace_acl ((od.forum_name), ATTENDEE_SEG_NAME, acl_ptr, jdx, "1"b, status); if status ^= 0 then call error (status); if acl.access_name (acl_count) ^= "*.*.*" then do; /* Must be *.* acl term */ acl.access_name (1) = "*.*.*"; acl.xmodes (1) = N_ACCESS; call hcs_$add_acl_entries ((od.forum_name), ATTENDEE_SEG_NAME, acl_ptr, 1, status); end; acl.access_name (1) = rtrim (attendee_seg.chairman.person_id) || ".*.*"; /* make sure chairman has ACL */ acl.xmodes (1) = RWC_XACL; call hcs_$add_acl_entries ((od.forum_name), ATTENDEE_SEG_NAME, acl_ptr, 1, status); free acl; status_ptr = addr (sb); call hcs_$status_ (directory, forum_control_entry, 1, status_ptr, status_area_ptr, status); if status ^= 0 then call error (status); do idx = 1 to status_branch.nnames; real_name = status_entry_names (idx); real_name = substr (real_name, 1, length (rtrim (real_name)) - length (".control")) || ".forum"; call hcs_$chname_file (directory, name, "", real_name, status); if status ^= 0 then if status ^= error_table_$segnamedup then call error (status); end; free status_entry_names; call copy_transactions (); call sort_attendees (); call copy_attendees (1, (forum_control.no_attendees)); call forum_seg_mgr_$terminate_all (addr (od)); if forum_control_ptr ^= null () then call set_lock_$unlock (forum_control.forum_lock, (0)); call hcs_$terminate_noname (forum_control_ptr, (0)); call hcs_$terminate_noname (proceedings_ptr, (0)); /* call hcs_$delentry_seg (forum_control_ptr, (0)); call hcs_$delentry_seg (proceedings_ptr, (0)); */ call hcs_$level_set (user_ring); P_status = 0; return; PUNT: if ^cleaning_up then call cleanup_handler (); call forum_logger_ (status, me, "^a>^a", directory, name); P_status = status; return; %page; initiate_old_meeting: procedure (); declare lock_attempts fixed bin, modes fixed bin (5), rings (3) fixed bin (3); on no_read_permission call error (error_table_$moderr); on seg_fault_error call error (error_table_$seg_busted); call hcs_$initiate (directory, forum_control_entry, "", 0, 0, forum_control_ptr, status); if forum_control_ptr = null () then call error (status); call hcs_$fs_get_brackets (forum_control_ptr, modes, rings, status); if status ^= 0 then call error (status); if modes = R_ACCESS_BIN then call error (error_table_$moderr); else if modes ^= RW_ACCESS_BIN then call error (forum_et_$not_a_forum); if rings (1) ^= forum_data_$forum_ring | rings (2) ^= rings (3) then call error (forum_et_$not_a_forum); if forum_control.no_attendees < 0 | forum_control.no_attendees > hbound (forum_control.attendee, 1) then call error (forum_et_$not_a_forum); if unspec (forum_control.chairman) = ""b then call error (forum_et_$not_a_forum); call hcs_$fs_get_path_name (forum_control_ptr, dirname_buffer, dirname_len, forum_control_entry, status); if status ^= 0 then call error (status); forum_name_len = length (rtrim (forum_control_entry)) - length (".control"); if forum_name_len < 1 | forum_name_len > 20 then call error (forum_et_$not_a_forum); if substr (forum_control_entry, forum_name_len + 1) ^= ".control" then call error (forum_et_$not_a_forum); call hcs_$initiate (directory, proceedings_name, "", 0, 0, proceedings_ptr, status); if proceedings_ptr = null () then if status = error_table_$noentry | status = error_table_$moderr then call error (forum_et_$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 < R_ACCESS_BIN then call error (error_table_$moderr); if rings (1) ^= forum_data_$forum_ring | rings (2) ^= rings (3) then call error (forum_et_$not_a_forum); locked = "1"b; do lock_attempts = 1 to 10; call set_lock_$lock (forum_control.forum_lock, 2, status); if status = 0 then return; if status = error_table_$invalid_lock_reset then return; if status ^= error_table_$lock_wait_time_exceeded then call error (status); end; call error (status); end initiate_old_meeting; %page; copy_transactions: proc (); declare block_offset bit (18), pref fixed bin, trans_idx fixed bin, trans_ptr ptr, trans_len fixed bin, trans_text char (trans_len) based (trans_ptr); block_offset = ""b; do trans_idx = 1 to forum_control.no_transactions; if forum_control.transactions (trans_idx).gone then do; transaction_seg.deleted_count = transaction_seg.deleted_count + 1; transaction_block_ptr = ptr (transaction_seg_ptr, transaction_seg.current_block_offset); if trans_idx > transaction_seg.last_trans_in_block then call get_new_block (); idx = trans_idx - transaction_block.first_trans_idx + 1; transaction_block.offset (idx) = EXPUNGED; transaction_block.last_trans_idx = idx; transaction_seg.transaction_count = transaction_seg.transaction_count + 1; end; else do; trans_len = forum_control.transactions (trans_idx).length; trans_ptr = ptr (proceedings_ptr, forum_control.transactions (trans_idx).offset); pref = forum_control.transactions (trans_idx).prior_ref_index; if forum_control.transactions (pref).gone then pref = 0; call forum_trans_mgr_$load_trans (addr (od), trans_text, pref, forum_control.transactions (trans_idx).subject, (forum_control.transactions (trans_idx).unfilled), idx, status); if status ^= 0 then call error (status); if trans_idx ^= idx then call error (forum_et_$invalid_trans_idx); transaction_ptr = ptr (transaction_seg_ptr, transaction_seg.last_trans_offset); transaction.person_id = forum_control.transactions (trans_idx).person_id; transaction.project_id = forum_control.transactions (trans_idx).project_id; transaction.time = forum_control.transactions (trans_idx).time; transaction.deleted = forum_control.transactions (trans_idx).deleted; transaction.deleted_by_author = forum_control.transactions (trans_idx).deleted_by_author; if transaction.deleted then transaction_seg.deleted_count = transaction_seg.deleted_count + 1; if block_offset ^= transaction_seg.current_block_offset then do; ptr (transaction_seg_ptr, transaction_seg.current_block_offset) -> transaction_block.time = transaction.time; block_offset = transaction_seg.current_block_offset; end; end; end; return; get_new_block: proc (); declare old_block_offset bit (18); old_block_offset = rel (transaction_block_ptr); transaction_block.next_block_offset, transaction_seg.current_block_offset = transaction_seg.free_space_offset; transaction_block_ptr = ptr (transaction_seg_ptr, transaction_seg.free_space_offset); transaction_seg.free_space_offset = rel (addrel (transaction_block_ptr, size (transaction_block))); transaction_seg.last_trans_in_block = transaction_seg.last_trans_in_block + hbound (transaction_block.transactions, 1); transaction_block.first_trans_idx = trans_idx; transaction_block.prev_block_offset = old_block_offset; return; end get_new_block; end copy_transactions; %page; sort_attendees: proc (); do idx = 1 to forum_control.no_attendees; v.vector (idx) = addr (forum_control.attendee.person_id (idx)); idxs.vector (idx) = idx; end; v.n, idxs.n = forum_control.no_attendees; call sort_items_indirect_$char (addr (v), addr (idxs), 22); return; end sort_attendees; %page; copy_attendees: proc (low, high); declare (low, high, middle) fixed bin; middle = low + (high - low)/2; call copy_one_attendee ((idxs.vector (middle))); if middle < high then call copy_attendees (middle + 1, high); if middle > low then call copy_attendees (low, middle - 1); return; end copy_attendees; copy_one_attendee: proc (idx); declare (idx, jdx) fixed bin, 1 at aligned like attendee based (attendee_ptr); call forum_space_mgr_$get_attendee_slot (attendee_seg_ptr, forum_control.attendee (idx).person_id, attendee_ptr, status); if status ^= 0 then call error (status); at.project_id = forum_control.attendee (idx).project_id; at.participating = ^forum_control.attendee (idx).removed; at.deleted = forum_control.attendee (idx).deleted; at.notify = forum_control.attendee (idx).notify; at.acl_change_pending = forum_control.attendee (idx).acl_change_pending; at.message_change_pending = forum_control.attendee (idx).message_changed; at.last_time_attended = forum_control.attendee (idx).last_time_attended; call forum_space_mgr_$allocate_bit_map (addr (od), attendee_ptr, forum_control.attendee (idx).highest_trans_seen + 1, bit_map_ptr, status); if status ^= 0 then call error (status); end copy_one_attendee; %page; error: proc (P_status); declare P_status fixed bin (35); status = P_status; goto PUNT; end error; cleanup_handler: proc (); cleaning_up = "1"b; if forum_control_ptr ^= null () & locked then call set_lock_$unlock (forum_control.forum_lock, (0)); call hcs_$terminate_noname (forum_control_ptr, (0)); call hcs_$terminate_noname (proceedings_ptr, (0)); if acl_ptr ^= null () then free acl; if sb.nnames ^= 0 then free status_entry_names; if attendee_seg_ptr ^= null () then do; call hcs_$del_dir_tree (directory, name, (0)); call hcs_$delentry_file (directory, name, (0)); end; call hcs_$level_set (user_ring); end cleanup_handler; end forum_conversion_$convert;  forum_logger_.pl1 08/16/86 1414.4rew 08/16/86 1354.5 31878 /****^ ************************************************************** * * * Copyright, (C) Massachusetts Institute of Technology, 1984 * * * ************************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-07-29,Pattin), approve(86-07-29,MCR7354), audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128): CHange to send mail instead of logging. END HISTORY COMMENTS */ forum_logger_: proc options (variable); declare any_other_call bit (1) aligned, arg_ptr ptr, arg_len fixed bin (21), based_code fixed bin (35) based (arg_ptr), based_caller char (arg_len) based (arg_ptr), caller char (32), error char (100) aligned, message char (512), message_len fixed bin (21), user_ring fixed bin (3), line char (512), progname char (32); declare 1 ci aligned like condition_info; declare (addr, null, string, substr) builtin, (cleanup, any_other) condition; declare convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned), cu_$arg_list_ptr entry returns (ptr), cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)), find_condition_info_ entry (ptr, ptr, fixed bin (35)), get_group_id_ entry returns (char (32)), get_ring_ entry returns (fixed bin (3)), hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)), hcs_$level_get entry (fixed bin (3)), hcs_$level_set entry (fixed bin (3)), ioa_$rsnnl entry options (variable), ioa_$general_rs entry (ptr, fixed bin, fixed bin, char (*), fixed bin (21), bit (1) aligned, bit (1) aligned), send_mail_ entry (char(*), char(*), ptr, fixed bin(35)); declare forum_data_$log_destination char (32) external; %page; %include send_mail_info; %page; %include condition_info; %page; any_other_call = ""b; goto JOIN; forum_logger_$any_other: entry options (variable); any_other_call = "1"b; JOIN: if forum_data_$log_destination = "" then return; call hcs_$level_get (user_ring); on cleanup call hcs_$level_set (user_ring); call hcs_$level_set (get_ring_ ()); on any_other goto PUNT; /* If we get an error ourselves, lets not recurse. */ if any_other_call then do; ci.version = condition_info_version_1; call find_condition_info_ (null (), addr (ci), (0)); error = ci.condition_name; call hcs_$fs_get_path_name (ci.user_loc_ptr, (""), (0), progname, (0)); end; else do; call cu_$arg_ptr (1, arg_ptr, (0), (0)); if based_code ^= 0 then call convert_status_code_ (based_code, "", error); else error = ""; end; call cu_$arg_ptr (2, arg_ptr, arg_len, (0)); caller = based_caller; call ioa_$general_rs (cu_$arg_list_ptr (), 3, 4, message, message_len, "0"b, "0"b); message = substr (message, 1, message_len); call ioa_$rsnnl ("^a (^a): ^[^a ^;^s^]^[fault at ^p (^a). ^;^2s^]^a", line, message_len, caller, get_group_id_ (), error ^= "", error, any_other_call, ci.user_loc_ptr, progname, message); send_mail_info.version = 2; send_mail_info.sent_from = "forum_logger_"; string (send_mail_info.switches) = ""b; send_mail_info.wakeup, send_mail_info.always_add = "1"b; call send_mail_ (forum_data_$log_destination, substr (line, 1, message_len), addr (send_mail_info), (0)); PUNT: call hcs_$level_set (user_ring); return; end forum_logger_;  forum_open_mgr_.pl1 08/16/86 1414.4rew 08/16/86 1354.5 306999 /****^ ************************************************************** * * * Copyright, (C) Massachusetts Institute of Technology, 1984 * * * ************************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-07-29,Pattin), approve(86-07-29,MCR7354), audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128): Bug fixes to set_switch including TR19352, use real get_highest_seen END HISTORY COMMENTS */ /* format: style3,ifthen,ifthendo,ifthenstmt,^indnoniterdo,^inditerdo,idind30 */ forum_open_mgr_$open: proc (P_directory, P_name, P_forum_idx, P_status); /* Version 2 Forum - This module opens and closes meetings, and contains utility information-retrieving routines not associated with individual transactions. Jay Pattin 1/1/83 Modified 09/13/83 Jeffrey I. Schiller so forum_info correctly handles expunged transactions Audit changes, J. Spencer Love 10/05/84 */ declare ( P_access_name char (*), P_access_time fixed bin (71), P_area_ptr ptr, P_chairman char (*), P_directory char (*), P_event_channel fixed bin (71), P_forum_idx fixed bin, P_forum_info_ptr ptr, P_name char (*), P_open_data_ptr ptr, P_status fixed bin (35), P_switch_name char (*), P_switch_setting bit (1) aligned, P_user_list_ptr ptr, P_user_name char (*), P_xacl bit (36) aligned ) parameter; declare attendee_offset bit (18) aligned, directory char (168), egress label variable, forum_idx fixed bin, idx fixed bin, MAX_ATTENDEES fixed bin static options (constant) initial (6000), me char (16) static options (constant) init ("forum_open_mgr_"), name char (32), privileged bit (1) aligned, P_area area based (P_area_ptr), status fixed bin (35), switch fixed bin, switch_name char (32), switch_setting bit (1) aligned, system_free_area area based (get_system_free_area_ ()), uid bit (36) aligned, unseen_ptr ptr, user_ring fixed bin (3), xacl bit (36) aligned; declare static_init bit (1) aligned static init ("0"b), first_open_data_ptr ptr static init (null ()), person_id char (22) static, project_id char (9) static, process_id bit (36) aligned static, inner_ring fixed bin (3) static, lock_id bit (36) aligned static; declare 1 fmi aligned like forum_info, 1 one_acl aligned, 2 access_name char (32), 2 modes bit (36), 2 xmodes bit (36), 2 code fixed bin (35); declare expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)), forum_logger_ entry options (variable), forum_logger_$any_other entry options (variable), forum_seg_mgr_$initiate entry (char (*), char (*), bit (1) aligned, ptr, ptr, bit (36) aligned, fixed bin (35)), forum_seg_mgr_$lock entry (ptr, fixed bin (35)), forum_seg_mgr_$terminate entry (ptr, ptr), forum_seg_mgr_$terminate_all entry (ptr), forum_seg_mgr_$unlock entry (ptr), forum_space_mgr_$allocate_bit_map entry (ptr, ptr, fixed bin, ptr, fixed bin (35)), forum_space_mgr_$find_attendee entry (ptr, char (*), ptr, fixed bin (35)), forum_space_mgr_$get_attendee_slot entry (ptr, char (*), ptr, fixed bin (35)), forum_space_mgr_$get_highest_seen entry (ptr, ptr, bit (1) aligned, fixed bin, ptr, fixed bin (35)), get_lock_id_ entry returns (bit (36) aligned), get_process_id_ entry returns (bit (36) aligned), 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_$fs_get_access_modes entry (ptr, bit (36) aligned, bit (36) aligned, fixed bin (35)), hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)), hcs_$get_safety_sw_seg entry (ptr, bit (1) aligned, fixed bin (35)), hcs_$set_safety_sw_seg entry (ptr, bit (1) aligned, fixed bin (35)), hcs_$get_uid_seg entry (ptr, bit (36) aligned, fixed bin (35)), hcs_$get_user_access_modes entry (char (*), char (*), char (*), fixed bin, bit (36) aligned, bit (36) aligned, fixed bin (35)), hcs_$level_get entry (fixed bin (3)), hcs_$level_set entry (fixed bin (3)), pathname_ entry (char (*), char (*)) returns (char (168)), set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35)), user_info_$login_data entry (char (*), char (*), char (*), fixed bin, fixed bin, fixed bin, fixed bin (71), char (*)); declare ( error_table_$bad_arg, error_table_$incorrect_access, error_table_$invalidsegno, error_table_$lock_wait_time_exceeded, error_table_$locked_by_this_process, error_table_$moderr, error_table_$noalloc, error_table_$null_info_ptr, error_table_$unimplemented_version, forum_et_$anon_chairman, forum_et_$cant_stop_msg_admin, forum_et_$cant_stop_msg_site, forum_et_$chairman_only, forum_et_$forum_deleted, forum_et_$invalid_forum_idx, forum_et_$invalid_switch_name, forum_et_$meeting_adjourned, forum_et_$not_eligible, forum_et_$not_user_switch, forum_et_$switch_not_changed, forum_et_$unexpected_fault, forum_et_$you_twit ) fixed bin (35) external static; declare ( forum_data_$print_eligibility_messages, forum_data_$chairman_override ) bit (1) aligned external; declare (addr, after, before, clock, index, length, maxlength, null, ptr, rtrim, unspec) builtin, (any_other, area, cleanup, no_write_permission) condition; declare ( SAFETY_SWITCH init (1), MAX_STORAGE_SWITCH init (1), ADJ_SWITCH init (2), EMSG_SWITCH init (3), DELETED_SWITCH init (4), MAX_CM_SWITCH init (4), PART_SWITCH init (5), NOTIFY_SWITCH init (6), CMSG_SWITCH init (7), ACCESS_SWITCH init (8) ) fixed bin internal static options (constant); %page; %include forum_structures; %page; %include forum_open_data; %page; %include forum_info; %page; %include forum_user_list; %page; %include access_mode_values; %page; /* forum_open_mgr_$open: proc (P_directory, P_name, P_forum_idx, P_status); */ call initialize (OPEN_EXIT); directory = P_directory; name = P_name; on cleanup call close_meeting (); on any_other begin; revert any_other; call forum_logger_$any_other (0, me, "Opening ^a>^a.", directory, name); call error (forum_et_$unexpected_fault); end; call forum_seg_mgr_$initiate (directory, name, "1"b, attendee_seg_ptr, transaction_seg_ptr, xacl, status); if status ^= 0 then call error (status); if xacl = N_ACCESS then call error (forum_et_$not_eligible); call open_meeting (); if attendee_seg.adjourned & xacl ^= RWC_XACL then call error (forum_et_$meeting_adjourned); call forum_space_mgr_$get_attendee_slot (attendee_seg_ptr, person_id, attendee_ptr, status); if status ^= 0 then call error (status); open_data.attendee_ptr = attendee_ptr; open_data.bit_map_ptr = ptr (attendee_seg_ptr, attendee.bit_map_offset); call fill_attendee_slot (); attendee.participating = "1"b; /* only set these on opens */ attendee.deleted = "0"b; call forum_seg_mgr_$unlock (attendee_seg_ptr); P_forum_idx = open_data.forum_idx; P_status = 0; return; OPEN_EXIT: call close_meeting (); P_forum_idx = 0; P_status = status; return; %page; open_meeting: proc (); call hcs_$get_uid_seg (attendee_seg_ptr, uid, status); if status ^= 0 then call error (status); do open_data_ptr = first_open_data_ptr repeat open_data.next_open_data_ptr while (open_data_ptr ^= null ()); if open_data.forum_uid = uid then do; call forum_seg_mgr_$terminate (attendee_seg_ptr, transaction_seg_ptr); attendee_seg_ptr = open_data.attendee_seg_ptr; transaction_seg_ptr = open_data.transaction_seg_ptr; open_data.open_count = open_data.open_count + 1; return; end; end; on area call error (error_table_$noalloc); allocate open_data in (system_free_area); revert area; open_data.forum_name = rtrim (directory) || ">" || name; open_data.forum_uid = uid; open_data.attendee_seg_ptr = attendee_seg_ptr; open_data.transaction_seg_ptr = transaction_seg_ptr; open_data.proceedings_ptrs (*) = null (); open_data.attendee_ptr = null (); open_data.bit_map_ptr = null (); open_data.open_count = 1; open_data.invalid = ""b; open_data.prev_open_data_ptr = null (); open_data.next_open_data_ptr = first_open_data_ptr; if first_open_data_ptr = null () then open_data.forum_idx = -1; else do; open_data.forum_idx = first_open_data_ptr -> open_data.forum_idx - 1; first_open_data_ptr -> open_data.prev_open_data_ptr = open_data_ptr; end; first_open_data_ptr = open_data_ptr; return; end open_meeting; %page; fill_attendee_slot: proc (); if attendee.person_id ^= person_id then do; call forum_space_mgr_$find_attendee (attendee_seg_ptr, person_id, attendee_ptr, status); if status ^= 0 then call error (status); open_data.attendee_ptr = attendee_ptr; end; if attendee.bit_map_offset = ""b then do; call forum_space_mgr_$allocate_bit_map (open_data_ptr, attendee_ptr, 1, bit_map_ptr, status); if status ^= 0 then call error (status); open_data.bit_map_ptr = bit_map_ptr; end; bit_map_ptr = open_data.bit_map_ptr; if bit_map.attendee_uid ^= attendee.attendee_uid then /* In case it moved on us */ bit_map_ptr, open_data.bit_map_ptr = ptr (attendee_seg_ptr, attendee.bit_map_offset); attendee.last_time_attended = clock (); attendee.project_id = project_id; attendee.attending = "1"b; attendee.process_id = process_id; attendee.lock_id = lock_id; attendee.xacl = xacl; return; end fill_attendee_slot; %page; forum_open_mgr_$close: entry (P_forum_idx, P_status); call initialize (CLOSE_EXIT); call lookup_forum_idx ("1"b); call fill_attendee_slot (); P_forum_idx = 0; call close_meeting (); P_status = 0; return; CLOSE_EXIT: call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; return; %page; close_meeting: proc (); if open_data_ptr ^= null () then do; open_data.open_count = open_data.open_count - 1; if open_data.open_count > 0 then do; call forum_seg_mgr_$unlock (attendee_seg_ptr); return; end; if attendee_ptr ^= null () then do; attendee.attending = "0"b; attendee.event_channel = 0; end; if first_open_data_ptr = open_data_ptr then first_open_data_ptr = open_data.next_open_data_ptr; if open_data.prev_open_data_ptr ^= null () then open_data.prev_open_data_ptr -> open_data.next_open_data_ptr = open_data.next_open_data_ptr; if open_data.next_open_data_ptr ^= null () then open_data.next_open_data_ptr -> open_data.prev_open_data_ptr = open_data.prev_open_data_ptr; call forum_seg_mgr_$unlock (attendee_seg_ptr); call forum_seg_mgr_$terminate_all (open_data_ptr); free open_data; end; else call forum_seg_mgr_$terminate (attendee_seg_ptr, transaction_seg_ptr); end close_meeting; %page; forum_open_mgr_$lookup_forum_idx: entry (P_forum_idx, P_open_data_ptr, P_xacl, P_status); call initialize (LOOKUP_EXIT); call lookup_forum_idx ("0"b); call fill_attendee_slot (); P_open_data_ptr = open_data_ptr; P_xacl = xacl; P_status = 0; return; LOOKUP_EXIT: P_open_data_ptr = null (); P_xacl = ""b; P_status = status; return; lookup_forum_idx: proc (null_access_ok); declare null_access_ok bit (1) aligned; forum_idx = P_forum_idx; if forum_idx > -1 then call error (forum_et_$invalid_forum_idx); on cleanup call hcs_$level_set (user_ring); call hcs_$level_set (inner_ring); do open_data_ptr = first_open_data_ptr repeat (open_data.next_open_data_ptr) while (open_data_ptr ^= null ()); if open_data.forum_idx = forum_idx then do; call hcs_$get_uid_seg (open_data.attendee_seg_ptr, uid, status); if status ^= 0 then if status = error_table_$invalidsegno then call error (forum_et_$forum_deleted); else call error (status); if uid ^= open_data.forum_uid then call error (forum_et_$forum_deleted); attendee_seg_ptr = open_data.attendee_seg_ptr; transaction_seg_ptr = open_data.transaction_seg_ptr; attendee_ptr = open_data.attendee_ptr; call hcs_$fs_get_access_modes (attendee_seg_ptr, ""b, xacl, status); if status ^= 0 then call error (status); if xacl = N_ACCESS & ^null_access_ok then /* Somebody stole our access */ call error (forum_et_$not_eligible); call forum_seg_mgr_$lock (attendee_seg_ptr, status); if status ^= 0 then call error (status); call hcs_$level_set (user_ring); return; end; end; call error (forum_et_$invalid_forum_idx); return; end lookup_forum_idx; %page; forum_open_mgr_$get_switch: entry (P_directory, P_name, P_user_name, P_switch_name, P_switch_setting, P_status); call initialize (SET_SWITCH_EXIT); on cleanup call forum_seg_mgr_$terminate (attendee_seg_ptr, transaction_seg_ptr); directory = P_directory; name = P_name; call forum_seg_mgr_$initiate (directory, name, "1"b, attendee_seg_ptr, transaction_seg_ptr, xacl, status); if status ^= 0 then call error (status); if xacl = N_ACCESS then call error (forum_et_$not_eligible); switch_name = P_switch_name; call lookup_switch (); if switch = ADJ_SWITCH then P_switch_setting = attendee_seg.adjourned; else if switch = EMSG_SWITCH then P_switch_setting = attendee_seg.am_print_acl_msg | attendee_seg.cm_print_acl_msg; else if switch = SAFETY_SWITCH then do; call hcs_$get_safety_sw_seg (attendee_seg_ptr, P_switch_setting, status); if status ^= 0 then call error (status); end; else do; /* need attendee record */ call forum_space_mgr_$find_attendee (attendee_seg_ptr, person_id, attendee_ptr, status); if status ^= 0 then call error (status); if switch = PART_SWITCH then P_switch_setting = attendee.participating; else if switch = NOTIFY_SWITCH then P_switch_setting = attendee.notify; else if switch = CMSG_SWITCH then P_switch_setting = ^attendee.message_change_pending; else if switch = ACCESS_SWITCH then P_switch_setting = attendee.acl_change_pending; else if switch = DELETED_SWITCH then P_switch_setting = attendee.deleted; end; call forum_seg_mgr_$terminate (attendee_seg_ptr, transaction_seg_ptr); P_status = status; return; lookup_switch: proc (); if switch_name = "safety" then switch = SAFETY_SWITCH; else if switch_name = "adjourned" | switch_name = "adj" then switch = ADJ_SWITCH; else if switch_name = "meeting_eligibility_messages" | switch_name = "mtg_emsg" then switch = EMSG_SWITCH; else if switch_name = "participating" | switch_name = "part" then switch = PART_SWITCH; else if switch_name = "notify" | switch_name = "nt" then switch = NOTIFY_SWITCH; else if switch_name = "message_seen" then switch = CMSG_SWITCH; else if switch_name = "access_changed" then switch = ACCESS_SWITCH; else if switch_name = "deleted" then switch = DELETED_SWITCH; else call error (forum_et_$invalid_switch_name); end lookup_switch; %page; forum_open_mgr_$priv_set_switch: entry (P_directory, P_name, P_user_name, P_switch_name, P_switch_setting, P_status); privileged = "1"b; goto SS_COMMON; forum_open_mgr_$set_switch: entry (P_directory, P_name, P_user_name, P_switch_name, P_switch_setting, P_status); privileged = "0"b; SS_COMMON: call initialize (SET_SWITCH_EXIT); on cleanup call forum_seg_mgr_$terminate (attendee_seg_ptr, transaction_seg_ptr); directory = P_directory; name = P_name; call forum_seg_mgr_$initiate (directory, name, "1"b, attendee_seg_ptr, transaction_seg_ptr, xacl, status); if status ^= 0 then call error (status); if ^privileged & xacl = N_ACCESS then call error (forum_et_$not_eligible); call set_switch (); call forum_seg_mgr_$terminate (attendee_seg_ptr, transaction_seg_ptr); P_status = status; return; SET_SWITCH_EXIT: call forum_seg_mgr_$terminate (attendee_seg_ptr, transaction_seg_ptr); P_status = status; return; %page; forum_open_mgr_$set_switch_idx: entry (P_forum_idx, P_user_name, P_switch_name, P_switch_setting, P_status); call initialize (SET_SWITCH_IDX_EXIT); call lookup_forum_idx ("0"b); call fill_attendee_slot (); privileged = "0"b; call set_switch (); call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; return; SET_SWITCH_IDX_EXIT: call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; 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 = person_id; else if person_name ^= person_id then do; if ^privileged & xacl ^= RWC_XACL then call error (forum_et_$chairman_only); attendee_ptr = null (); end; if length (rtrim (P_switch_name)) > maxlength (switch_name) then call error (forum_et_$invalid_switch_name); else switch_name = P_switch_name; call lookup_switch (); switch_setting = P_switch_setting; if switch <= MAX_CM_SWITCH then do; if ^privileged & xacl ^= RWC_XACL then if switch <= MAX_STORAGE_SWITCH then call check_access (); else call error (forum_et_$chairman_only); if switch ^= DELETED_SWITCH & person_name ^= person_id then call error (forum_et_$not_user_switch); end; if switch = ADJ_SWITCH then call set_the_switch (attendee_seg.adjourned, switch_setting); else if switch = EMSG_SWITCH then do; if ^privileged then do; if ^switch_setting then do; if ^forum_data_$chairman_override & forum_data_$print_eligibility_messages then call error (forum_et_$cant_stop_msg_site); if attendee_seg.am_init & attendee_seg.am_print_acl_msg then call error (forum_et_$cant_stop_msg_admin); end; call set_the_switch (attendee_seg.cm_print_acl_msg, switch_setting); if ^attendee_seg.cm_init & status = forum_et_$switch_not_changed then status = 0; attendee_seg.cm_init = "1"b; end; else do; call set_the_switch (attendee_seg.am_print_acl_msg, switch_setting); if ^attendee_seg.am_init & status = forum_et_$switch_not_changed then status = 0; attendee_seg.am_init = "1"b; end; end; else if switch = SAFETY_SWITCH then do; on cleanup call hcs_$level_set (user_ring); call hcs_$level_set (inner_ring); call hcs_$set_safety_sw_seg (attendee_seg_ptr, switch_setting, status); if status ^= 0 then call error (status); call hcs_$level_set (user_ring); end; else do; if attendee_ptr = null () then do; call forum_space_mgr_$find_attendee (attendee_seg_ptr, person_name, attendee_ptr, status); if status ^= 0 then call error (status); end; if switch = PART_SWITCH then call set_the_switch (attendee.participating, switch_setting); else if switch = NOTIFY_SWITCH then call set_the_switch (attendee.notify, switch_setting); else if switch = CMSG_SWITCH then call set_the_switch (attendee.message_change_pending, ^switch_setting); else if switch = ACCESS_SWITCH then call set_the_switch (attendee.acl_change_pending, switch_setting); else if switch = DELETED_SWITCH then do; if person_id = person_name then call error (forum_et_$you_twit); /* chairman can't delete himself */ call set_the_switch (attendee.deleted, switch_setting); attendee.participating = "0"b; end; end; return; set_the_switch: proc (switch, value); declare switch bit (1) unaligned; declare value bit (1) aligned; if switch = value then status = forum_et_$switch_not_changed; else switch = value; return; end set_the_switch; check_access: proc (); declare modes bit (36) aligned; /* for set_switch, dir & name already correct, this is for _idx */ if open_data_ptr ^= null () then call expand_pathname_ ((open_data.forum_name), directory, name, status); if status ^= 0 then call error (status); call expand_pathname_ (directory, directory, name, status); if status ^= 0 then call error (status); call hcs_$get_user_access_modes (directory, name, "", -1, modes, ""b, status); if status ^= 0 then call error (status); if modes & M_ACCESS = ""b then call error (error_table_$incorrect_access); end check_access; end set_switch; %page; forum_open_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_et_$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_et_$invalid_switch_name); P_status = 0; return; SET_GLOBAL_EXIT: P_status = status; return; %page; forum_open_mgr_$set_event_channel_idx: entry (P_forum_idx, P_event_channel, P_status); call initialize (SET_EVENT_CHANNEL_IDX_EXIT); call lookup_forum_idx ("0"b); call fill_attendee_slot (); attendee.event_channel = P_event_channel; call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = 0; return; SET_EVENT_CHANNEL_IDX_EXIT: call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; return; %page; forum_open_mgr_$forum_info: entry (P_directory, P_name, P_access_name, P_access_time, P_forum_info_ptr, P_status); call initialize (FORUM_INFO_EXIT); on cleanup call forum_seg_mgr_$terminate (attendee_seg_ptr, transaction_seg_ptr); directory = P_directory; name = P_name; call forum_seg_mgr_$initiate (directory, name, "1"b, attendee_seg_ptr, transaction_seg_ptr, xacl, status); if status ^= 0 then call error (status); directory = pathname_ (directory, name); call get_forum_info (); call forum_seg_mgr_$terminate (attendee_seg_ptr, transaction_seg_ptr); forum_info = fmi; if xacl = N_ACCESS then call error (forum_et_$not_eligible); P_status = status; return; FORUM_INFO_EXIT: call forum_seg_mgr_$terminate (attendee_seg_ptr, transaction_seg_ptr); P_status = status; return; %page; forum_open_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); call lookup_forum_idx ("1"b); call fill_attendee_slot (); directory = open_data.forum_name; call get_forum_info (); call forum_seg_mgr_$unlock (attendee_seg_ptr); forum_info = fmi; P_status = 0; return; MEETING_INFO_IDX_EXIT: call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; return; %page; get_forum_info: procedure (); declare access_name char (32), access_time fixed bin (71), done bit (1) aligned, person_name char (22); 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 & forum_info.version ^= forum_info_version_2 then call error (error_table_$unimplemented_version); unspec (fmi) = ""b; fmi.version = forum_info.version; fmi.chairman.username = attendee_seg.chairman.person_id; fmi.chairman.project = attendee_seg.chairman.project_id; fmi.chairman.pad = ""; if fmi.version = forum_info_version_2 then do; fmi.attendee_count = attendee_seg.attendee_count; fmi.removal_count = 0; end; else do; fmi.attendee_count = 0; do attendee_offset = attendee_seg.first_attendee_offset repeat (attendee.next_offset) while (attendee_offset ^= ""b); fmi.attendee_count = fmi.attendee_count + 1; if fmi.attendee_count > MAX_ATTENDEES then do; fmi.attendee_count = attendee_seg.attendee_count; call hcs_$fs_get_path_name (attendee_seg_ptr, directory, (0), (""), (0)); call forum_logger_ (0, me, "Looping attendee list in ^a", directory); go to COUNT_CONTINUE; end; attendee_ptr = ptr (attendee_seg_ptr, attendee_offset); if ^attendee.participating then fmi.removal_count = fmi.removal_count + 1; end; if fmi.attendee_count ^= attendee_seg.attendee_count then do; call hcs_$fs_get_path_name (attendee_seg_ptr, directory, (0), (""), (0)); call forum_logger_ (0, me, "Attendee count in ^a claimed to be ^d, was ^d.", directory, attendee_seg.attendee_count, fmi.attendee_count); end; end; COUNT_CONTINUE: call hcs_$get_uid_seg (attendee_seg_ptr, fmi.forum_uid, status); if status ^= 0 then call error (status); if access_name = "" then person_name = person_id; else do; person_name = before (access_name, "."); if length (rtrim (person_name)) > 1 & substr (person_name, 1, 1) = "*" then access_name = "anonymous." || after (access_name, "."); call hcs_$get_user_access_modes (directory, ATTENDEE_SEG_NAME, access_name, -1, ""b, xacl, status); if status ^= 0 then call error (status); end; fmi.eligible = (xacl ^= N_ACCESS); call forum_space_mgr_$find_attendee (attendee_seg_ptr, person_name, attendee_ptr, (0)); if attendee_ptr = null () then return; fmi.removed = ^attendee.participating; fmi.last_time_attended = attendee.last_time_attended; call forum_space_mgr_$get_highest_seen (attendee_ptr, transaction_seg_ptr, "1"b, fmi.last_seen_trans_idx, unseen_ptr, status); if status ^= 0 then call error (status); if ^fmi.removed then do; fmi.notify = attendee.notify; fmi.attending = attendee.attending; end; fmi.adjourned = attendee_seg.adjourned; if xacl = N_ACCESS then return; fmi.read_only = (xacl = R_XACL); transaction_ptr = ptr (transaction_seg_ptr, transaction_seg.last_trans_offset); done = "0"b; do while (^done); if transaction.time <= access_time | transaction.prev_offset = ""b then done = "1"b; else transaction_ptr = ptr (transaction_seg_ptr, transaction.prev_offset); end; fmi.transaction_count = transaction.trans_idx; fmi.deletion_count = transaction_seg.deleted_count; if fmi.last_seen_trans_idx <= fmi.transaction_count then transaction_ptr = unseen_ptr; else if transaction.next_offset = ""b then transaction_ptr = null (); else transaction_ptr = ptr (transaction_seg_ptr, transaction.next_offset); do while (transaction_ptr ^= null ()); if transaction.person_id ^= person_name & ^transaction.deleted then fmi.changes_count = fmi.changes_count + 1; if transaction.next_offset = ""b then transaction_ptr = null (); else transaction_ptr = ptr (transaction_seg_ptr, transaction.next_offset); end; idx = transaction_seg.transaction_count; if idx < 1 then return; transaction_ptr = ptr (transaction_seg_ptr, transaction_seg.last_trans_offset); do while (transaction.deleted | transaction.time > access_time); if transaction.prev_offset = ""b then return; else transaction_ptr = ptr (transaction_seg_ptr, transaction.prev_offset); end; fmi.last_time_changed = transaction.time; status = 0; return; end get_forum_info; %page; forum_open_mgr_$list_users: entry (P_directory, P_name, P_area_ptr, P_user_list_ptr, P_status); call initialize (LIST_USERS_EXIT); on cleanup call forum_seg_mgr_$terminate (attendee_seg_ptr, transaction_seg_ptr); directory = P_directory; name = P_name; call forum_seg_mgr_$initiate (directory, name, "1"b, attendee_seg_ptr, transaction_seg_ptr, xacl, status); if status ^= 0 then call error (status); if xacl = N_ACCESS then call error (forum_et_$not_eligible); call get_user_list (); call forum_seg_mgr_$terminate (attendee_seg_ptr, transaction_seg_ptr); P_status = 0; return; LIST_USERS_EXIT: call forum_seg_mgr_$terminate (attendee_seg_ptr, transaction_seg_ptr); P_status = status; return; %page; forum_open_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 ("0"b); call fill_attendee_slot (); call get_user_list (); call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = 0; return; LIST_USERS_IDX_EXIT: call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; return; %page; get_user_list: procedure; declare jdx fixed bin; user_list_no_attendees = attendee_seg.attendee_count; allocate user_list in (P_area); user_list.version = user_list_version_2; user_list.chairman.person_id = attendee_seg.chairman.person_id; user_list.chairman.project_id = attendee_seg.chairman.project_id; user_list.transaction_count = transaction_seg.transaction_count; jdx = 0; do attendee_ptr = ptr (attendee_seg_ptr, attendee_seg.first_attendee_offset) repeat attendee_ptr while (attendee_ptr ^= null ()); if ^attendee.deleted | xacl = RWC_XACL | attendee.person_id = person_id then do; jdx = jdx + 1; if jdx > user_list_no_attendees then call error (forum_et_$unexpected_fault); if attendee.attending then do; /* check if he's really there */ call set_lock_$lock ((attendee.lock_id), 0, status); if status ^= error_table_$lock_wait_time_exceeded & status ^= error_table_$locked_by_this_process then do; attendee.attending = "0"b; attendee.lock_id = "0"b; end; end; user_list.attendees (jdx).person_id = attendee.person_id; user_list.attendees (jdx).project_id = attendee.project_id; user_list.attendees (jdx).attending = attendee.attending; user_list.attendees (jdx).notify = attendee.notify; user_list.attendees (jdx).removed = ^attendee.participating; user_list.attendees (jdx).deleted = attendee.deleted; user_list.attendees (jdx).read_only = (attendee.xacl = R_XACL); user_list.attendees (jdx).last_time_attended = attendee.last_time_attended; call forum_space_mgr_$get_highest_seen (attendee_ptr, transaction_seg_ptr, "0"b, user_list.attendees (jdx).highest_trans_seen, (null ()), status); if status ^= 0 then call error (status); end; if attendee.next_offset = ""b then attendee_ptr = null (); else attendee_ptr = ptr (attendee_seg_ptr, attendee.next_offset); end; user_list.no_attendees = jdx; P_user_list_ptr = user_list_ptr; return; end get_user_list; %page; forum_open_mgr_$change_chairman_idx: entry (P_forum_idx, P_chairman, P_status); call initialize (CHANGE_CHAIRMAN_IDX_EXIT); call lookup_forum_idx ("0"b); directory = open_data.forum_name; privileged = "0"b; call change_the_chairman (); call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = 0; return; CHANGE_CHAIRMAN_IDX_EXIT: call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; return; %page; forum_open_mgr_$priv_change_chairman: entry (P_directory, P_name, P_chairman, P_status); privileged = "1"b; goto CC_COMMON; forum_open_mgr_$change_chairman: entry (P_directory, P_name, P_chairman, P_status); privileged = "0"b; CC_COMMON: call initialize (CHANGE_CHAIRMAN_EXIT); directory = P_directory; name = P_name; call forum_seg_mgr_$initiate (directory, name, "1"b, attendee_seg_ptr, transaction_seg_ptr, xacl, status); if status ^= 0 then call error (status); if ^privileged & xacl = N_ACCESS then call error (forum_et_$not_eligible); directory = rtrim (directory) || ">" || name; call change_the_chairman (); call forum_seg_mgr_$terminate (attendee_seg_ptr, transaction_seg_ptr); P_status = 0; return; CHANGE_CHAIRMAN_EXIT: call forum_seg_mgr_$terminate (attendee_seg_ptr, transaction_seg_ptr); P_status = status; return; %page; change_the_chairman: procedure (); declare chairman_name char (32), chairman_personid char (22), chairman_projectid char (10); if ^privileged & xacl ^= RWC_XACL then call error (forum_et_$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, ".")); if substr (chairman_personid, 1, 1) = "*" then call error (forum_et_$anon_chairman); call forum_space_mgr_$find_attendee (attendee_seg_ptr, chairman_personid, attendee_ptr, status); if status ^= 0 then call error (status); one_acl.access_name = rtrim (chairman_name) || ".*"; one_acl.modes = RW_ACCESS; one_acl.xmodes = RWC_XACL; on cleanup call hcs_$level_set (user_ring); call hcs_$level_set (inner_ring); call hcs_$add_acl_entries (directory, ATTENDEE_SEG_NAME, addr (one_acl), 1, status); if status ^= 0 then call error (status); call hcs_$level_set (user_ring); attendee_seg.chairman.person_id = chairman_personid; attendee_seg.chairman.project_id = chairman_projectid; return; end change_the_chairman; %page; initialize: proc (P_egress); declare P_egress label variable, anon fixed bin; egress = P_egress; attendee_seg_ptr, transaction_seg_ptr, open_data_ptr = null (); attendee_ptr, bit_map_ptr = null (); if ^static_init then do; inner_ring = get_ring_ (); process_id = get_process_id_ (); lock_id = get_lock_id_ (); call user_info_$login_data (person_id, project_id, (""), anon, 0, 0, 0, ("")); if anon = 1 then person_id = "*" || person_id; static_init = "1"b; end; call hcs_$level_get (user_ring); return; end initialize; error: proc (P_status); declare P_status fixed bin (35); status = P_status; goto egress; end error; end forum_open_mgr_$open;  forum_salvager_.pl1 09/09/86 0903.6rew 09/09/86 0901.4 219312 /****^ ************************************************************** * * * Copyright, (C) Massachusetts Institute of Technology, 1983 * * * ************************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-07-29,Pattin), approve(86-07-29,MCR7354), audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128): Fixed to set seen switches when expunging transactions. Copy chairman message across. Detect more bugs in seen maps. Make sure all proceedings segments are initiated. 2) change(86-09-07,Pattin), approve(86-09-07,MCR7354), audit(86-09-07,Margolin), install(86-09-09,MR12.0-1151): Correct copy_back to use length of new attendee segment instead of length of old attendee segment when copying from temp seg and truncating attendee segment. END HISTORY COMMENTS */ forum_salvager_: proc (P_attendee_seg_ptr, P_transaction_seg_ptr); /* Version 2 forum - Salvage a meeting and/or expunge deleted transactions and attendees Jay Pattin 1/19/83 Added entry to copy a meeting 3/18/83 Jay Pattin */ /* Modified 09/12/83 by Jeffrey I. Schiller. Bugfixes */ /* Modified 11/20/83 by Jeffrey I. Schiller. Allow expunge and salvage of a forum with multiple proceedings segments. Also fixes for large transactions. Deletion of left over proceedings components after expunge. */ /* Modified 03/09/84 by Jeffrey I. Schiller. arrange for forum_$copy to expunge deleted transactions and participants if the person doing the copy is not the chairman. (Security problem). */ /* Audit changes, J. Spencer Love 10/05/84 */ declare (P_attendees_deleted fixed bin, P_attendee_seg_ptr ptr, P_copy_options_ptr ptr, P_forum_idx fixed bin, P_status fixed bin (35), P_switches_word bit (36) aligned, P_transactions_deleted fixed bin, P_transaction_seg_ptr ptr) parameter; declare attendee_count fixed bin, attendee_seg_damaged bit (1) aligned, created bit (1) aligned, deleted_attendees fixed bin, deleted_count fixed bin, deleted_transactions fixed bin, directory char (168), egress label variable, expunged_map bit (transaction_seg.transaction_count) based (expunged_map_ptr), expunged_map_ptr ptr, idx fixed bin, inner_ring fixed bin (3), last_attendee_ptr ptr, me char (16) static options (constant) init ("forum_salvager_"), name char (32), new_aseg_ptr ptr, new_dir char (168), new_name char (32), new_tseg_ptr ptr, salvage_entry bit (1) aligned, status fixed bin (35), system_area area based (get_system_free_area_ ()), temp_map bit (temp_map_len) based (temp_map_ptr), temp_map_len fixed bin, temp_map_ptr ptr, user_ring fixed bin (3), xacl bit (36) aligned; declare 1 switches aligned, 2 transactions bit (1) unaligned, 2 users bit (1) unaligned; declare 1 auto_area_info aligned like area_info, 1 od aligned like open_data, /* for new copy */ 1 sod aligned like open_data, /* for original when salvaging or copying */ 1 new_aseg aligned like attendee_seg based (new_aseg_ptr), 1 new_tseg aligned like transaction_seg based (new_tseg_ptr); declare USERID_CHARS char (100) static options (constant) init (" !""#$%&'()*+,-./0123456789:;<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~"); declare (addr, addrel, divide, fixed, hbound, index, null, ptr, rel, reverse, size, string, substr, unspec, verify) builtin, (any_other, cleanup) condition; declare (error_table_$incorrect_access, error_table_$unsupported_operation, forum_et_$chairman_only, forum_et_$invalid_trans_idx, forum_et_$trans_reaped, forum_et_$unexpected_fault, sys_info$max_seg_size) fixed bin (35) external; declare define_area_ entry (ptr, fixed bin (35)), forum_logger_ entry options (variable), forum_logger_$any_other entry options (variable), forum_open_mgr_$lookup_forum_idx entry (fixed bin, ptr, bit (36) aligned, fixed bin (35)), forum_seg_mgr_$initiate entry (char (*), char (*), bit (1) aligned, ptr, ptr, bit (36) aligned, fixed bin (35)), forum_seg_mgr_$initiate_seg entry (ptr, fixed bin, fixed bin (35)), forum_seg_mgr_$just_create entry (char (*), char (*), ptr, ptr, fixed bin (35)), forum_seg_mgr_$terminate entry (ptr, ptr), forum_seg_mgr_$terminate_all entry (ptr), forum_seg_mgr_$unlock entry (ptr), forum_space_mgr_$allocate_bit_map entry (ptr, ptr, fixed bin, ptr, fixed bin (35)), forum_space_mgr_$find_transaction entry (ptr, fixed bin, ptr, fixed bin (35)), forum_space_mgr_$get_attendee_slot entry (ptr, char (*), ptr, fixed bin (35)), forum_trans_mgr_$load_trans entry (ptr, char (*), fixed bin, char (*), bit (1) aligned, fixed bin, fixed bin (35)), get_lock_id_ entry returns (bit (36) aligned), get_ring_ entry returns (fixed bin (3)), get_system_free_area_ entry returns (ptr), get_temp_segment_ entry (char (*), ptr, fixed bin (35)), hcs_$delentry_file entry (char (*), char (*), fixed bin (35)), hcs_$delentry_seg entry (ptr, fixed bin(35)), hcs_$del_dir_tree entry (char (*), char (*), fixed bin (35)), hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)), hcs_$level_get entry (fixed bin (3)), hcs_$level_set entry (fixed bin (3)), hcs_$status_long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)), hcs_$truncate_seg entry (ptr, fixed bin (19), fixed bin (35)), pathname_ entry (char (*), char (*)) returns (char (168)), release_temp_segment_ entry (char (*), ptr, fixed bin (35)), release_temp_segments_ entry (char (*), (*) ptr, fixed bin (35)), sort_items_indirect_$char entry (ptr, ptr, fixed bin (24)); %page; %include forum_structures; %page; %include forum_open_data; %page; %include area_info; %page; %include status_structures; %page; %include copy_options; %page; %include copy_flags; %page; /* forum_salvager_: proc (P_attendee_seg_ptr, P_transaction_seg_ptr); */ egress = PUNT; salvage_entry = "1"b; expunged_map_ptr, temp_map_ptr, new_aseg_ptr, new_tseg_ptr = null (); od.proceedings_ptrs (*) = null (); string (switches) = ""b; attendee_seg_ptr = P_attendee_seg_ptr; transaction_seg_ptr = P_transaction_seg_ptr; call hcs_$level_get (user_ring); call hcs_$fs_get_path_name (attendee_seg_ptr, directory, idx, "", (0)); sod.attendee_seg_ptr = attendee_seg_ptr; sod.transaction_seg_ptr = transaction_seg_ptr; sod.proceedings_ptrs (*) = null (); sod.forum_name = directory; open_data_ptr = addr (sod); call forum_logger_ (0, me, "Salvaging ^a.", substr (directory, 1, idx)); goto COMMON; forum_salvager_$expunge: entry (P_forum_idx, P_switches_word, P_attendees_deleted, P_transactions_deleted, P_status); egress = PUNT; salvage_entry = "0"b; attendee_seg_ptr, transaction_seg_ptr = null (); expunged_map_ptr, temp_map_ptr, new_aseg_ptr, new_tseg_ptr = null (); od.proceedings_ptrs (*) = null (); call hcs_$level_get (user_ring); string (switches) = P_switches_word; call forum_open_mgr_$lookup_forum_idx (P_forum_idx, open_data_ptr, xacl, status); if status ^= 0 then call error (status); attendee_ptr = open_data.attendee_ptr; attendee_seg_ptr = open_data.attendee_seg_ptr; transaction_seg_ptr = open_data.transaction_seg_ptr; if xacl ^= RWC_XACL then call error (forum_et_$chairman_only); COMMON: inner_ring = get_ring_ (); on any_other call any_other_handler (); on cleanup call clean_up_salvage (); call hcs_$level_set (inner_ring); call initialize_copy (); call copy_all (); new_tseg.deleted_count = deleted_count; call copy_back (); attendee_seg.salvaging = "0"b; if ^salvage_entry then do; call forum_seg_mgr_$unlock (attendee_seg_ptr); P_attendees_deleted = deleted_attendees; P_transactions_deleted = deleted_transactions; end; call hcs_$level_set (user_ring); P_status = 0; return; PUNT: P_status = status; call release_temp_segments_ (me, od.proceedings_ptrs (*), (0)); call release_temp_segment_ (me, new_aseg_ptr, (0)); call release_temp_segment_ (me, new_tseg_ptr, (0)); if ^salvage_entry then call forum_seg_mgr_$unlock (attendee_seg_ptr); call hcs_$level_set (user_ring); return; clean_up_salvage: procedure (); if temp_map_ptr ^= null () then free temp_map; if expunged_map_ptr ^= null () then free expunged_map; call release_temp_segments_ (me, od.proceedings_ptrs (*), (0)); call release_temp_segment_ (me, new_aseg_ptr, (0)); call release_temp_segment_ (me, new_tseg_ptr, (0)); call hcs_$level_set (user_ring); return; end clean_up_salvage; %page; forum_seg_mgr_$copy: entry (P_copy_options_ptr, P_status); created = "0"b; attendee_seg_ptr, transaction_seg_ptr = null (); temp_map_ptr, expunged_map_ptr = null (); copy_options_ptr = P_copy_options_ptr; copy_options.target_err_switch = "0"b; egress = COPY_PUNT; inner_ring = get_ring_ (); call hcs_$level_get (user_ring); on any_other call any_other_handler (); on cleanup call clean_up_copy (); call hcs_$level_set (inner_ring); directory = copy_options.source_dir; name = copy_options.source_name; new_dir = copy_options.target_dir; new_name = copy_options.target_name; call forum_seg_mgr_$initiate (directory, name, "1"b, attendee_seg_ptr, transaction_seg_ptr, xacl, status); if status ^= 0 then call error (status); if xacl = ""b then call error (error_table_$incorrect_access); string (switches) = ""b; /* Initially decide to copy everything. */ if xacl ^= RWC_XACL then do; /* But if we are not a chairman, then only copy non-deleted stuff */ switches.transactions = "1"b; switches.users = "1"b; end; if copy_options.update | copy_options.extend then call error (error_table_$unsupported_operation); copy_options.target_err_switch = "1"b; call forum_seg_mgr_$just_create (new_dir, new_name, new_aseg_ptr, new_tseg_ptr, status); if status ^= 0 then call error (status); created = "1"b; unspec (sod) = ""b; sod.attendee_seg_ptr = attendee_seg_ptr; sod.transaction_seg_ptr = transaction_seg_ptr; sod.proceedings_ptrs (*) = null (); sod.forum_name = pathname_ (directory, name); open_data_ptr = addr (sod); unspec (od) = ""b; od.attendee_seg_ptr = new_aseg_ptr; od.transaction_seg_ptr = new_tseg_ptr; od.proceedings_ptrs (*) = null (); od.forum_name = pathname_ (new_dir, new_name); new_aseg.flags = attendee_seg.flags; new_aseg.flags.salvaging = "0"b; /* just in case */ new_aseg.chairman_message = attendee_seg.chairman_message; new_aseg.chairman = attendee_seg.chairman; /* just create set it to this user */ call copy_all (); call forum_seg_mgr_$terminate_all (open_data_ptr); call forum_seg_mgr_$terminate_all (addr (od)); call hcs_$level_set (user_ring); P_status = 0; return; COPY_PUNT: call clean_up_copy (); P_status = status; return; clean_up_copy: procedure (); if temp_map_ptr ^= null () then free temp_map; if expunged_map_ptr ^= null () then free expunged_map; if created then do; call hcs_$del_dir_tree (new_dir, new_name, (0)); call hcs_$delentry_file (new_dir, new_name, (0)); end; call forum_seg_mgr_$terminate (attendee_seg_ptr, transaction_seg_ptr); call hcs_$level_set (user_ring); return; end clean_up_copy; %page; initialize_copy: proc (); call get_temp_segment_ (me, new_aseg_ptr, status); if status ^= 0 then call error (status); call get_temp_segment_ (me, new_tseg_ptr, status); if status ^= 0 then call error (status); od.forum_name = open_data.forum_name; od.attendee_seg_ptr = new_aseg_ptr; od.transaction_seg_ptr = new_tseg_ptr; new_aseg.version = ATTENDEE_SEG_VERSION_1; new_aseg.lock = get_lock_id_ (); new_aseg.flags = attendee_seg.flags; new_aseg.salvaging = "1"b; new_aseg.chairman = attendee_seg.chairman; new_aseg.chairman_message = attendee_seg.chairman_message; unspec (auto_area_info) = ""b; auto_area_info.version = area_info_version_1; auto_area_info.system = "1"b; auto_area_info.zero_on_free = "1"b; auto_area_info.zero_on_alloc = "1"b; auto_area_info.size = sys_info$max_seg_size - size (attendee_seg_header); auto_area_info.areap = addr (new_aseg.attendee_area); auto_area_info.owner = "forum"; call define_area_ (addr (auto_area_info), status); if status ^= 0 then call error (status); transaction_block_ptr = addr (new_tseg.first_free_word); new_tseg.version = TRANS_SEG_VERSION_1; new_tseg.first_block_offset, new_tseg.current_block_offset = rel (transaction_block_ptr); new_tseg.last_trans_in_block = hbound (transaction_block.transactions, 1); new_tseg.current_segno = 1; new_tseg.free_space_offset = rel (addrel (transaction_block_ptr, size (transaction_block))); transaction_block.first_trans_idx, transaction_block.last_trans_idx = 1; return; end initialize_copy; %page; copy_all: proc (); temp_map_len = transaction_seg.transaction_count; allocate temp_map in (system_area); allocate expunged_map in (system_area); expunged_map = ""b; call check_attendee_count (); if attendee_seg_damaged then attendee_count = 5000; /* should be enough */ call copy_transactions (); call copy_attendees (); free temp_map; return; end copy_all; %page; check_attendee_count: proc (); attendee_ptr = ptr (attendee_seg_ptr, attendee_seg.first_attendee_offset); attendee_count, deleted_attendees = 0; attendee_seg_damaged = "0"b; do while (attendee_ptr ^= null ()); if check_for_damage () then do; attendee_seg_damaged = "1"b; last_attendee_ptr -> attendee.next_offset = ""b; return; end; attendee_count = attendee_count + 1; if switches.users & attendee.deleted then deleted_attendees = deleted_attendees + 1; last_attendee_ptr = attendee_ptr; if attendee.next_offset = ""b then attendee_ptr = null (); else attendee_ptr = ptr (attendee_seg_ptr, attendee.next_offset); end; if attendee_count ^= attendee_seg.attendee_count then attendee_seg_damaged = "1"b; return; check_for_damage: proc () returns (bit (1) aligned); if attendee.version ^= ATTENDEE_VERSION_1 then return ("1"b); if attendee.attendee_uid < 0 | attendee.attendee_uid > attendee_seg.attendee_count then return ("1"b); if verify (attendee.person_id, USERID_CHARS) ^= 0 then return ("1"b); if verify (attendee.project_id, USERID_CHARS) ^= 0 then return ("1"b); return ("0"b); end check_for_damage; end check_attendee_count; %page; copy_attendees: proc (); declare 1 v aligned, 2 n fixed bin, 2 vector (attendee_count) ptr unaligned; declare 1 idxs aligned, 2 n fixed bin, 2 vector (attendee_count) fixed bin (18); idx = 0; attendee_ptr = ptr (attendee_seg_ptr, attendee_seg.first_attendee_offset); do while (attendee_ptr ^= null ()); if ^switches.users | ^attendee.deleted then do; idx = idx + 1; v.vector (idx) = addr (attendee.person_id); idxs.vector (idx) = idx; end; if attendee.next_offset = ""b then attendee_ptr = null (); else attendee_ptr = ptr (attendee_seg_ptr, attendee.next_offset); end; if attendee_seg_damaged then call find_attendees (); v.n, idxs.n = idx; call sort_items_indirect_$char (addr (v), addr (idxs), 22); call copy_the_attendees (1, idx); return; find_attendees: proc (); /* WALK THROUGH SEG LOOKING FOR ATTENDEE_VERSION_1 */ call forum_logger_ (0, me, "Attendee seg damaged ^a.", open_data.forum_name); /* call error (forum_et_$unexpected_fault); */ end find_attendees; %page; copy_the_attendees: proc (low, high); declare (low, high, idx, jdx, middle) fixed bin, 1 at aligned like attendee based (new_attendee_ptr), new_attendee_ptr ptr; declare kdx fixed bin; middle = low + divide (high - low, 2, 17, 0); attendee_ptr = addrel (v.vector (idxs.vector (middle)), -2); call forum_space_mgr_$get_attendee_slot (new_aseg_ptr, (attendee.person_id), new_attendee_ptr, status); if status ^= 0 then call error (status); at.project_id = attendee.project_id; at.participating = attendee.participating; at.deleted = "0"b; at.notify = attendee.notify; at.acl_change_pending = attendee.acl_change_pending; at.message_change_pending = attendee.message_change_pending; at.last_time_attended = attendee.last_time_attended; at.xacl = attendee.xacl; bit_map_ptr = ptr (attendee_seg_ptr, attendee.bit_map_offset); if bit_map.attendee_uid ^= attendee.attendee_uid then do; idx = new_tseg.transaction_count; jdx = 1; temp_map = ""b; end; else do; temp_map = bit_map.map | substr (expunged_map, attendee.bit_map_first_trans); idx = index (bit_map.map, "0"b); if idx = 0 then idx = bit_map.length; jdx = attendee.bit_map_first_trans; idx = idx + jdx - 1; end; call forum_space_mgr_$allocate_bit_map (addr (od), new_attendee_ptr, idx, bit_map_ptr, status); if status ^= 0 then call error (status); idx = at.bit_map_first_trans - jdx + 1; if idx <= temp_map_len then bit_map.map = substr (temp_map, idx); kdx = index (reverse (bit_map.map), "1"b); if kdx = 0 then kdx = -1; else kdx = bit_map.length - kdx; kdx = kdx + at.bit_map_first_trans; if kdx > transaction_seg.transaction_count then do; idx = transaction_seg.transaction_count - at.bit_map_first_trans + 1; if idx > 0 then substr (bit_map.map, idx) = ""b; else do; at.bit_map_first_trans = transaction_seg.transaction_count + 1; bit_map.map = ""b; end; end; if middle < high then call copy_the_attendees (middle + 1, high); if middle > low then call copy_the_attendees (low, middle - 1); return; end copy_the_attendees; end copy_attendees; %page; copy_transactions: proc (); declare block_offset bit (18), pref_offset bit (18), pref_ptr ptr, new_trans_ptr ptr, 1 new_trans like transaction based (new_trans_ptr), pref fixed bin, subject char (subject_len) based (subject_ptr), subject_len fixed bin, subject_ptr ptr, trans_idx fixed bin, trans_ptr ptr, trans_len fixed bin (21), trans_text char (trans_len) based (trans_ptr); deleted_transactions, deleted_count = 0; block_offset = ""b; do trans_idx = 1 to transaction_seg.transaction_count; call forum_space_mgr_$find_transaction (transaction_seg_ptr, trans_idx, transaction_ptr, status); if status ^= 0 & status ^= forum_et_$trans_reaped then if status = forum_et_$unexpected_fault then status = forum_et_$trans_reaped; /* damaged */ else call error (status); if status = forum_et_$trans_reaped then call expunge (); else if switches.transactions & transaction.deleted then call expunge (); else do; trans_len = transaction.text_length; subject_len = transaction.subject_length; if open_data.proceedings_ptrs (transaction.segno) = null () then do; call forum_seg_mgr_$initiate_seg (open_data_ptr, transaction.segno, status); if status ^= 0 then call error (status); end; trans_ptr = ptr (open_data.proceedings_ptrs (transaction.segno), transaction.text_offset); subject_ptr = ptr (open_data.proceedings_ptrs (transaction.segno), transaction.subject_offset); pref = 0; pref_offset = transaction.pref_offset; do while (pref_offset ^= ""b); pref_ptr = ptr (transaction_seg_ptr, pref_offset); if ^pref_ptr -> transaction.deleted then do; pref = pref_ptr -> transaction.trans_idx; goto have_pref; end; pref_offset = pref_ptr -> transaction.pref_offset; end; have_pref: call forum_trans_mgr_$load_trans (addr (od), trans_text, pref, subject, (transaction.unfilled), idx, status); if status ^= 0 then call error (status); if trans_idx ^= idx then call error (forum_et_$invalid_trans_idx); new_trans_ptr = ptr (new_tseg_ptr, new_tseg.last_trans_offset); new_trans.person_id = transaction.person_id; new_trans.project_id = transaction.project_id; new_trans.time = transaction.time; new_trans.deleted = transaction.deleted; new_trans.deleted_by_author = transaction.deleted_by_author; if new_trans.deleted then deleted_count = deleted_count + 1; if block_offset ^= new_tseg.current_block_offset then do; ptr (new_tseg_ptr, new_tseg.current_block_offset) -> transaction_block.time = new_trans.time; block_offset = new_tseg.current_block_offset; end; end; end; return; expunge: proc (); if status = 0 then deleted_transactions = deleted_transactions + 1; deleted_count = deleted_count + 1; transaction_block_ptr = ptr (new_tseg_ptr, new_tseg.current_block_offset); if trans_idx > new_tseg.last_trans_in_block then call get_new_block (); idx = trans_idx - transaction_block.first_trans_idx + 1; transaction_block.offset (idx) = EXPUNGED; transaction_block.last_trans_idx = idx; new_tseg.transaction_count = new_tseg.transaction_count + 1; substr (expunged_map, trans_idx, 1) = "1"b; return; end expunge; get_new_block: proc (); declare old_block_offset bit (18); old_block_offset = rel (transaction_block_ptr); new_tseg.current_block_offset, transaction_block.next_block_offset = new_tseg.free_space_offset; transaction_block_ptr = ptr (new_tseg_ptr, new_tseg.free_space_offset); new_tseg.free_space_offset = rel (addrel (transaction_block_ptr, size (transaction_block))); new_tseg.last_trans_in_block = new_tseg.last_trans_in_block + hbound (transaction_block.transactions, 1); transaction_block.first_trans_idx = trans_idx; transaction_block.prev_block_offset = old_block_offset; return; end get_new_block; end copy_transactions; %page; copy_back: proc (); declare 1 sb aligned like status_branch, attendee_seg_len fixed bin (21), directory char (168), dir_len fixed bin, entry_name char (32), segment char (seg_len) based, seg_len fixed bin (21); call hcs_$fs_get_path_name (new_aseg_ptr, directory, dir_len, entry_name, status); if status ^= 0 then call error (status); call hcs_$status_long (directory, entry_name, 0, addr (sb), null (), status); if status ^= 0 then call error (status); attendee_seg_len = 4096 * sb.current_length; /* Make sure all of the proceedings segments in the old meeting have been initiated. If all of the transactions in one segment are being expunged, the segment may not be initiated and we will fault on it here */ do idx = 1 to transaction_seg.current_segno; if open_data.proceedings_ptrs (idx) = null () then do; call forum_seg_mgr_$initiate_seg (open_data_ptr, idx, status); if status ^= 0 then call error (status); end; end; do idx = 1 to new_tseg.current_segno; if idx ^= new_tseg.current_segno then seg_len = 4 * sys_info$max_seg_size; else seg_len = 4 * fixed (new_tseg.next_trans_offset, 19); open_data.proceedings_ptrs (idx) -> segment = od.proceedings_ptrs (idx) -> segment; end; do idx = new_tseg.current_segno + 1 to transaction_seg.current_segno; call hcs_$delentry_seg (open_data.proceedings_ptrs (idx), (0)); open_data.proceedings_ptrs (idx) = null (); end; seg_len = attendee_seg_len; attendee_seg_ptr -> segment = new_aseg_ptr -> segment; seg_len = 4 * fixed (new_tseg.free_space_offset, 19); transaction_seg_ptr -> segment = new_tseg_ptr -> segment; call hcs_$truncate_seg (open_data.proceedings_ptrs (new_tseg.current_segno), fixed (new_tseg.next_trans_offset, 19), (0)); call hcs_$truncate_seg (attendee_seg_ptr, divide (attendee_seg_len, 4, 19, 0), (0)); call hcs_$truncate_seg (transaction_seg_ptr, fixed (new_tseg.free_space_offset, 19), (0)); do idx = 1 to new_tseg.current_segno; call release_temp_segment_ (me, od.proceedings_ptrs (idx), (0)); end; call release_temp_segment_ (me, new_aseg_ptr, (0)); call release_temp_segment_ (me, new_tseg_ptr, (0)); end copy_back; %page; any_other_handler: proc (); on any_other system; if open_data_ptr ^= null () then directory = open_data.forum_name; else directory = ""; call forum_logger_$any_other (0, me, directory); status = forum_et_$unexpected_fault; goto egress; end any_other_handler; error: proc (P_status); declare P_status fixed bin (35); status = P_status; goto egress; end error; end forum_salvager_;  forum_seg_mgr_.pl1 08/16/86 1414.4rew 08/16/86 1354.3 286425 /****^ ************************************************************** * * * Copyright, (C) Massachusetts Institute of Technology, 1984 * * * ************************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-07-29,Pattin), approve(86-07-29,MCR7354), audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128): Don't allow removal of *.* ACL with replace entrypoint. Require only 'm' permission on containing dir to change acl. END HISTORY COMMENTS */ forum_seg_mgr_$create_forum: proc (P_directory, P_name, P_status); /* Version 2 Forum -- This module contains routines to create, delete, initiate, and terminate segments of meetings. 12/31/82 Jay Pattin */ /* Modified 03/09/84 by Jeffrey I. Schiller so a chairman without sma access to the containing dir of a forum can set access on the forum. Although he still cannot set "c" access unless he does have "sma" Modified 6/24/84 Jay Pattin to remove above code, which didn't work and replace it with code that allows anyone with "c" access to give "c" access. */ /* Audit changes, J. Spencer Love 10/05/84 */ declare (P_acl_count fixed bin, P_acl_ptr ptr, P_area_ptr ptr, P_attendee_seg_ptr ptr, P_directory char (*), P_forum_idx fixed bin, P_lock_switch bit (1) aligned, P_name char (*), P_new_name char (*), P_no_sysdaemon bit (1), P_old_name char (*), P_open_data_ptr ptr, P_real_dir char (*), P_real_name char (*), P_return_ptr ptr, P_seg_index fixed bin, P_status fixed bin (35), P_transaction_seg_ptr ptr, P_uid bit (36) aligned, P_xacl bit (36) aligned) parameter; declare acl_count fixed bin, acl_ptr ptr, area_ptr ptr, based_area area based (area_ptr), create_only bit (1) aligned, created bit (1) aligned, directory char (168), dirname_buffer char (168), dirname_len fixed bin, dirname char (dirname_len) based (addr (dirname_buffer)), egress label variable, forum_dir char (168), forum_idx fixed bin, mode fixed bin (5), name char (32), new_name char (32), old_name char (32), p ptr, real_dir char (168), real_name char (32), rings (3) fixed bin (3), safety_switch bit (1), seg_index fixed bin, status fixed bin (35), uid bit (36) aligned, xacl bit (36) aligned; declare static_init bit (1) aligned static init ("0"b), my_authorization bit (72) aligned static, full_authorization bit (72) aligned, user_ring fixed bin (3) static, inner_ring fixed bin (3) static, person_id char (22) static, project_id char (9) static, MAX_ATTENDEES fixed bin static options (constant) initial (6000), me char (16) static options (constant) init ("forum_seg_mgr_"); declare 1 aim_bits aligned like aim_template based (addr (full_authorization)); declare 1 auto_area_info aligned like area_info; declare 1 acl_term aligned based, 2 access_name char (32), 2 modes bit (36), 2 xmodes bit (36), 2 code fixed bin (35); declare 1 one_acl like acl_term, 1 two_acls (2) like acl_term, 1 acl (acl_count) like acl_term based (acl_ptr), 1 delete_acl (acl_count) based (acl_ptr), 2 access_name char (32), 2 code fixed bin (35); declare check_star_name_$entry entry (char (*), fixed bin (35)), define_area_ entry (ptr, fixed bin (35)), expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)), forum_logger_$any_other entry options (variable), forum_open_mgr_$lookup_forum_idx entry (fixed bin, ptr, bit (36) aligned, fixed bin (35)), get_authorization_ entry returns (bit (72) aligned), get_group_id_ entry returns (char (32)), get_lock_id_ entry returns (bit (36) aligned), 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_$append_branchx entry (char (*), char (*), fixed bin (5), (3) fixed bin (3), char (*), fixed bin (1), fixed bin (1), fixed bin (24), fixed bin (35)), hcs_$chname_file entry (char (*), char (*), char (*), char (*), fixed bin (35)), hcs_$del_dir_tree entry (char (*), char (*), fixed bin (35)), hcs_$delentry_file entry (char (*), char (*), fixed bin (35)), hcs_$delete_acl_entries entry (char (*), char (*), ptr, fixed bin, fixed bin (35)), hcs_$fs_get_access_modes entry (ptr, bit (36) aligned, bit (36) aligned, 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_safety_sw_seg entry (ptr, bit (1), fixed bin (35)), hcs_$get_uid_seg entry (ptr, bit (36) aligned, fixed bin (35)), hcs_$get_user_effmode entry (char (*), char (*), char (*), fixed bin, 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 (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_$replace_dir_acl entry (char (*), char (*), ptr, fixed bin, bit (1), fixed bin (35)), hcs_$set_ring_brackets entry (char(*), char(*), (3)fixed bin(3), 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)), pathname_ entry (char (*), char (*)) returns (char (168)), 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 (*)); declare (error_table_$ai_restricted, error_table_$bad_acl_mode, error_table_$dirlong, error_table_$incorrect_access, error_table_$invalid_lock_reset, error_table_$lock_wait_time_exceeded, error_table_$namedup, error_table_$noentry, error_table_$nostars, error_table_$notadir, error_table_$safety_sw_on, error_table_$seg_busted, forum_et_$anon_chairman, forum_et_$blank_forum_name, forum_et_$invalid_seg_idx, forum_et_$long_forum_name, forum_et_$meeting_bloat, forum_et_$need_star_acl, forum_et_$no_suffix, forum_et_$no_such_forum, forum_et_$not_a_forum, forum_et_$unexpected_fault, sys_info$max_seg_size) fixed bin (35) external static; declare forum_data_$forum_ring fixed bin (3) external; declare (addr, addrel, char, hbound, length, ltrim, null, ptr, rel, rtrim, size, substr, unspec) builtin, (any_other, cleanup, seg_fault_error) condition; %page; %include forum_structures; %page; %include forum_open_data; %page; %include access_mode_values; %page; %include aim_template; %page; %include area_info; %page; /* forum_seg_mgr_$create_forum: entry (P_directory, P_name, P_status); */ create_only = "0"b; goto CREATE_COMMON; forum_seg_mgr_$just_create: /* entry for convert to call */ entry (P_directory, P_name, P_attendee_seg_ptr, P_transaction_seg_ptr, P_status); create_only = "1"b; CREATE_COMMON: call initialize (CREATE_EXIT); created = "0"b; call copy_pathname_args (); call check_star_name_$entry (name, status); if status ^= 0 then if status = 1 | status = 2 then call error (error_table_$nostars); else call error (status); if substr (person_id, 1, 1) = "*" then call error (forum_et_$anon_chairman); on any_other call any_other_handler (); on cleanup begin; if created then begin; call hcs_$del_dir_tree (directory, name, (0)); call hcs_$delentry_file (directory, name, (0)); end; call hcs_$level_set (user_ring); end; call hcs_$level_set (inner_ring); call hcs_$status_minf (directory, name, 0, (0), (0), status); if status = 0 then call error (error_table_$namedup); else if status ^= error_table_$noentry then call error (status); call check_access (); rings (1) = forum_data_$forum_ring; rings (2) = 7; call hcs_$append_branchx (directory, name, SMA_ACCESS_BIN, rings, get_group_id_ (), 1, 0, 0, status); if status ^= 0 then call error (status); created = "1"b; one_acl.access_name = "*.*.*"; one_acl.modes = SMA_ACCESS; one_acl.xmodes = ""b; call hcs_$replace_dir_acl (directory, name, addr (one_acl), 1, "1"b, status); if status ^= 0 then call error (status); forum_dir = rtrim (directory) || ">" || name; /* change to inside the meeting */ /* and create first three segs */ rings (1), rings (2), rings (3) = forum_data_$forum_ring; call hcs_$append_branch (forum_dir, ATTENDEE_SEG_NAME, RW_ACCESS_BIN, status); if status ^= 0 then call error (status); call hcs_$set_ring_brackets (forum_dir, ATTENDEE_SEG_NAME, rings, status); if status ^= 0 then call error (status); call hcs_$append_branch (forum_dir, TRANSACTION_SEG_NAME, RW_ACCESS_BIN, status); if status ^= 0 then call error (status); call hcs_$set_ring_brackets (forum_dir, TRANSACTION_SEG_NAME, rings, status); if status ^= 0 then call error (status); real_name = rtrim (PROCEEDINGS_SEG_NAME) || "1"; call hcs_$append_branch (forum_dir, real_name, RW_ACCESS_BIN, status); if status ^= 0 then call error (status); call hcs_$set_ring_brackets (forum_dir, real_name, rings, status); two_acls.access_name (1) = "*.*.*"; two_acls.modes (1) = RW_ACCESS; two_acls.xmodes (1) = N_ACCESS; two_acls.access_name (2) = rtrim (person_id) || ".*.*"; two_acls.modes (2) = RW_ACCESS; two_acls.xmodes (2) = RWC_XACL; /* only set xacl on Attendee seg */ call hcs_$replace_acl (forum_dir, ATTENDEE_SEG_NAME, addr (two_acls), 2, "1"b, status); if status ^= 0 then call error (status); call hcs_$replace_acl (forum_dir, TRANSACTION_SEG_NAME, addr (two_acls), 1, "1"b, status); if status ^= 0 then call error (status); call hcs_$replace_acl (forum_dir, real_name, addr (two_acls), 1, "1"b, status); if status ^= 0 then call error (status); call hcs_$initiate (forum_dir, ATTENDEE_SEG_NAME, "", 0, 0, attendee_seg_ptr, status); if attendee_seg_ptr = null () then call error (status); call hcs_$initiate (forum_dir, TRANSACTION_SEG_NAME, "", 0, 0, transaction_seg_ptr, status); if transaction_seg_ptr = null () then call error (status); attendee_seg.lock = get_lock_id_ (); attendee_seg.version = ATTENDEE_SEG_VERSION_1; attendee_seg.attendee_count = 0; attendee_seg.chairman.person_id = person_id; attendee_seg.chairman.project_id = project_id; attendee_seg.chairman_message = ""; unspec (auto_area_info) = ""b; auto_area_info.version = area_info_version_1; auto_area_info.system = "1"b; auto_area_info.zero_on_free = "1"b; auto_area_info.zero_on_alloc = "1"b; auto_area_info.size = sys_info$max_seg_size - size (attendee_seg_header); auto_area_info.areap = addr (attendee_seg.attendee_area); auto_area_info.owner = "forum"; call define_area_ (addr (auto_area_info), status); if status ^= 0 then call error (status); if ^create_only then do; area_ptr = addr (attendee_seg.attendee_area); allocate attendee in (based_area); alloc_bit_map_length = 504; allocate bit_map in (based_area); attendee_seg.attendee_count = 1; attendee_seg.first_attendee_offset, attendee_seg.last_attendee_offset = rel (attendee_ptr); attendee.version = ATTENDEE_VERSION_1; attendee.attendee_uid = 1; attendee.person_id = person_id; attendee.project_id = project_id; attendee.bit_map_first_trans = 1; attendee.bit_map_offset = rel (bit_map_ptr); attendee.bit_map_length = bit_map.length; bit_map.attendee_uid = 1; end; transaction_block_ptr = addr (transaction_seg.first_free_word); transaction_seg.version = TRANS_SEG_VERSION_1; transaction_seg.first_block_offset, transaction_seg.current_block_offset = rel (transaction_block_ptr); transaction_seg.last_trans_in_block = hbound (transaction_block.transactions, 1); transaction_seg.current_segno = 1; transaction_seg.free_space_offset = rel (addrel (transaction_block_ptr, size (transaction_block))); transaction_block.first_trans_idx = 1; transaction_block.last_trans_idx = 1; if create_only then do; P_attendee_seg_ptr = attendee_seg_ptr; P_transaction_seg_ptr = transaction_seg_ptr; end; else do; call set_lock_$unlock (attendee_seg.lock, (0)); call hcs_$terminate_noname (attendee_seg_ptr, (0)); call hcs_$terminate_noname (transaction_seg_ptr, (0)); call hcs_$level_set (user_ring); end; P_status = 0; return; CREATE_EXIT: if created then do; call hcs_$del_dir_tree (directory, name, (0)); call hcs_$delentry_file (directory, name, (0)); end; call hcs_$level_set (user_ring); P_status = status; return; %page; forum_seg_mgr_$delete_forum: entry (P_directory, P_name, P_status); call initialize (DELETE_EXIT); call copy_pathname_args (); call initiate_meeting ("0"b); call lock_meeting (); call check_access (); on cleanup call hcs_$level_set (user_ring); call hcs_$level_set (inner_ring); call hcs_$get_safety_sw_seg (attendee_seg_ptr, safety_switch, (0)); if safety_switch then call error (error_table_$safety_sw_on); call hcs_$del_dir_tree (directory, name, status); if status ^= 0 then call error (status); call hcs_$delentry_file (directory, name, status); if status ^= 0 then call error (status); call hcs_$level_set (user_ring); P_status = 0; return; DELETE_EXIT: call unlock_meeting (); if attendee_seg_ptr ^= null () then call terminate_meeting (); call hcs_$level_set (user_ring); P_status = status; return; check_access: proc (); call expand_pathname_ (directory, real_dir, real_name, status); if status ^= 0 then call error (status); call hcs_$get_user_effmode (real_dir, real_name, "", (user_ring), mode, status); if status ^= 0 then call error (status); if mode < SM_ACCESS_BIN then call error (error_table_$incorrect_access); return; end check_access; %page; forum_seg_mgr_$chname_forum: entry (P_directory, P_name, P_old_name, P_new_name, P_status); call initialize (CHNAME_EXIT); call copy_pathname_args (); on any_other call any_other_handler (); call initiate_meeting ("0"b); call chname (); CHNAME_EXIT: call terminate_meeting (); P_status = status; return; forum_seg_mgr_$chname_forum_idx: entry (P_forum_idx, P_old_name, P_new_name, P_status); call initialize (CHNAME_IDX_EXIT); on any_other call any_other_handler (); forum_idx = P_forum_idx; call forum_open_mgr_$lookup_forum_idx (forum_idx, open_data_ptr, xacl, status); if status ^= 0 then call error (status); attendee_seg_ptr = open_data.attendee_seg_ptr; call expand_pathname_ ((open_data.forum_name), directory, name, status); if status ^= 0 then call error (status); call chname (); call hcs_$fs_get_path_name (attendee_seg_ptr, directory, (0), (""), status); if status ^= 0 then call error (status); open_data.forum_name = directory; CHNAME_IDX_EXIT: call unlock_meeting (); P_status = status; return; %page; chname: proc; if length (rtrim (P_old_name)) > 32 | length (rtrim (P_new_name)) > 32 then call error (forum_et_$long_forum_name); old_name = P_old_name; if old_name ^= "" then call validate_name (old_name); new_name = P_new_name; if new_name ^= "" then do; call validate_name (new_name); call check_star_name_$entry (new_name, status); if status ^= 0 then if status = 1 | status = 2 then call error (error_table_$nostars); else call error (status); end; on cleanup call hcs_$level_set (user_ring); call hcs_$level_set (inner_ring); call hcs_$chname_file (directory, name, old_name, new_name, status); if status ^= 0 then call error (status); call hcs_$level_set (user_ring); return; end chname; %page; copy_pathname_args: proc; if length (rtrim (P_directory)) > 168 then call error (error_table_$dirlong); else directory = P_directory; if length (rtrim (P_name)) > 32 then call error (forum_et_$long_forum_name); else name = P_name; call validate_name (name); return; end copy_pathname_args; validate_name: proc (name); declare name char (32), name_len fixed bin; if name = "" then call error (forum_et_$blank_forum_name); name_len = length (rtrim (name)) - length (".forum"); if name_len < 1 then call error (forum_et_$no_suffix); if substr (name, name_len + 1) ^= ".forum" then call error (forum_et_$no_suffix); return; end validate_name; %page; forum_seg_mgr_$create_segment: /* caller should have it locked */ entry (P_open_data_ptr, P_status); call initialize (CREATE_SEG_EXIT); open_data_ptr = P_open_data_ptr; transaction_seg_ptr = open_data.transaction_seg_ptr; directory = open_data.forum_name; seg_index = transaction_seg.current_segno + 1; if seg_index > hbound (open_data.proceedings_ptrs, 1) then call error (forum_et_$meeting_bloat); name = rtrim (PROCEEDINGS_SEG_NAME) || ltrim (char (seg_index)); on cleanup call hcs_$level_set (user_ring); call hcs_$level_set (inner_ring); call hcs_$append_branch (directory, name, RW_ACCESS_BIN, status); if status ^= 0 then call error (status); rings (1), rings (2), rings (3) = forum_data_$forum_ring; call hcs_$set_ring_brackets (directory, name, rings, status); if status ^= 0 then call error (status); one_acl.access_name = "*.*.*"; one_acl.modes = RW_ACCESS; one_acl.xmodes =""b; call hcs_$replace_acl (directory, name, addr (one_acl), 1, "1"b, status); if status ^= 0 then call error (status); transaction_seg.current_segno = seg_index; transaction_seg.next_trans_offset = ""b; CREATE_SEG_EXIT: call hcs_$level_set (user_ring); P_status = status; return; %page; forum_seg_mgr_$set_forum_acl: entry (P_directory, P_name, P_acl_ptr, P_acl_count, P_status); call initialize (SET_ACL_EXIT); call copy_pathname_args (); acl_ptr = P_acl_ptr; acl_count = P_acl_count; call initiate_meeting ("0"b); if xacl ^= RWC_XACL then call check_access (); directory = pathname_ (directory, name); call check_acl (); on cleanup call hcs_$level_set (user_ring); call hcs_$level_set (inner_ring); call hcs_$add_acl_entries (directory, ATTENDEE_SEG_NAME, acl_ptr, acl_count, status); if status ^= 0 then call error (status); call update_acl_change (); SET_ACL_EXIT: call terminate_meeting (); call hcs_$level_set (user_ring); P_status = status; return; %page; forum_seg_mgr_$replace_forum_acl: entry (P_directory, P_name, P_acl_ptr, P_acl_count, P_no_sysdaemon, P_status); call initialize (REPLACE_ACL_EXIT); acl_ptr = P_acl_ptr; acl_count = P_acl_count; call copy_pathname_args (); call initiate_meeting ("0"b); if xacl ^= RWC_XACL then call check_access (); directory = pathname_ (directory, name); call check_acl (); do seg_index = 1 to acl_count; if acl.access_name (seg_index) = "*.*.*" then goto HAVE_STAR_ACL; end; call error (forum_et_$need_star_acl); HAVE_STAR_ACL: /* check for at least one c acl */ on cleanup call hcs_$level_set (user_ring); call hcs_$level_set (inner_ring); call hcs_$replace_acl (directory, ATTENDEE_SEG_NAME, P_acl_ptr, P_acl_count, P_no_sysdaemon, status); if status ^= 0 then call error (status); call update_acl_change (); REPLACE_ACL_EXIT: call terminate_meeting (); call hcs_$level_set (user_ring); P_status = status; return; %page; check_acl: proc (); declare idx fixed bin; do idx = 1 to acl_count; if acl.modes (idx) ^= RW_ACCESS | (acl.xmodes (idx) ^= N_ACCESS & acl.xmodes (idx) ^= R_XACL & acl.xmodes (idx) ^= RW_XACL & acl.xmodes (idx) ^= RWC_XACL) then call error (error_table_$bad_acl_mode); end; return; end check_acl; update_acl_change: proc (); declare attendee_count fixed bin, attendee_offset bit (18) aligned; attendee_count = 0; do attendee_offset = attendee_seg.first_attendee_offset repeat (attendee.next_offset) while (attendee_offset ^= ""b); attendee_count = attendee_count + 1; if attendee_count > MAX_ATTENDEES then call error (forum_et_$unexpected_fault); attendee_ptr = ptr (attendee_seg_ptr, attendee_offset); if attendee.person_id ^= person_id then attendee.acl_change_pending = "1"b; end; return; end update_acl_change; %page; forum_seg_mgr_$delete_forum_acl: entry (P_directory, P_name, P_acl_ptr, P_acl_count, P_status); call initialize (DELETE_ACL_EXIT); call copy_pathname_args (); acl_ptr = P_acl_ptr; acl_count = P_acl_count; call initiate_meeting ("0"b); if xacl ^= RWC_XACL then call check_access (); directory = rtrim (directory) || ">" || name; do seg_index = 1 to acl_count; if delete_acl.access_name (seg_index) = "*.*.*" then call error (forum_et_$need_star_acl); end; on cleanup call hcs_$level_set (user_ring); call hcs_$level_set (inner_ring); call hcs_$delete_acl_entries (directory, ATTENDEE_SEG_NAME, acl_ptr, acl_count, status); if status ^= 0 then call error (status); call update_acl_change (); DELETE_ACL_EXIT: call terminate_meeting (); call hcs_$level_set (user_ring); P_status = status; return; %page; forum_seg_mgr_$list_forum_acl: entry (P_directory, P_name, P_area_ptr, P_return_ptr, P_acl_ptr, P_acl_count, P_status); call initialize (LIST_ACL_EXIT); call copy_pathname_args (); directory = rtrim (directory) || ">" || name; on cleanup call hcs_$level_set (user_ring); call hcs_$level_set (inner_ring); call hcs_$list_acl (directory, ATTENDEE_SEG_NAME, P_area_ptr, P_return_ptr, P_acl_ptr, P_acl_count, status); if status ^= 0 then call error (status); call hcs_$level_set (user_ring); P_status = 0; return; LIST_ACL_EXIT: call hcs_$level_set (user_ring); P_acl_ptr = null (); P_acl_count = 0; P_status = status; return; %page; forum_seg_mgr_$get_forum_path: entry (P_directory, P_name, P_real_dir, P_real_name, P_status); call initialize (GET_PATH_EXIT); on cleanup call terminate_meeting (); call copy_pathname_args (); call initiate_meeting ("0"b); /* verify that it's real */ P_real_dir = directory; P_real_name = name; call terminate_meeting (); P_status = 0; return; GET_PATH_EXIT: call terminate_meeting (); P_real_dir, P_real_name = ""; P_status = status; return; forum_seg_mgr_$get_forum_path_idx: entry (P_forum_idx, P_real_dir, P_real_name, P_status); call initialize (GET_PATH_EXIT); forum_idx = P_forum_idx; call forum_open_mgr_$lookup_forum_idx (forum_idx, open_data_ptr, xacl, status); if status ^= 0 then call error (status); attendee_seg_ptr = open_data.attendee_seg_ptr; call unlock_meeting (); call expand_pathname_ ((open_data.forum_name), real_dir, real_name, status); P_real_dir = real_dir; P_real_name = real_name; P_status = 0; return; %page; forum_seg_mgr_$get_uid_file: entry (P_directory, P_name, P_uid, P_status); call initialize (GET_UID_EXIT); on cleanup call terminate_meeting (); call copy_pathname_args (); call initiate_meeting ("0"b); /* verify that it's real */ call hcs_$get_uid_seg (attendee_seg_ptr, uid, status); if status ^= 0 then call error (status); call terminate_meeting (); P_uid = uid; P_status = 0; return; GET_UID_EXIT: call terminate_meeting (); P_uid = ""b; P_status = status; return; %page; forum_seg_mgr_$initiate: entry (P_directory, P_name, P_lock_switch, P_attendee_seg_ptr, P_transaction_seg_ptr, P_xacl, P_status); call initialize (INITIATE_EXIT); call copy_pathname_args (); call initiate_meeting ("1"b); if P_lock_switch then call lock_meeting (); P_directory = directory; /* copy back real name */ P_name = name; P_attendee_seg_ptr = attendee_seg_ptr; P_transaction_seg_ptr = transaction_seg_ptr; P_xacl = xacl; P_status = 0; return; INITIATE_EXIT: call unlock_meeting (); call terminate_meeting (); P_attendee_seg_ptr = null (); P_transaction_seg_ptr = null (); P_status = status; return; %page; initiate_meeting: proc (initiate_trans); declare initiate_trans bit (1) aligned, access_class bit (72) aligned; on any_other call any_other_handler (); on seg_fault_error call error (error_table_$seg_busted); on cleanup begin; call terminate_meeting (); call hcs_$level_set (user_ring); end; call hcs_$level_set (inner_ring); call hcs_$get_access_class (directory, name, access_class, status); if status ^= 0 then if status = error_table_$noentry then call error (forum_et_$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; forum_dir = rtrim (directory) || ">" || name; call hcs_$initiate (forum_dir, ATTENDEE_SEG_NAME, "", 0, 0, attendee_seg_ptr, status); if attendee_seg_ptr = null () then if status = error_table_$noentry | status = error_table_$notadir then call error (forum_et_$not_a_forum); else call error (status); call hcs_$fs_get_brackets (attendee_seg_ptr, mode, rings, status); if status ^= 0 then call error (status); if mode ^= RW_ACCESS_BIN then call error (forum_et_$not_a_forum); if (rings (1) ^= forum_data_$forum_ring) | (rings (2) ^= rings (3)) then call error (forum_et_$not_a_forum); if attendee_seg.version ^= ATTENDEE_SEG_VERSION_1 then call error (forum_et_$not_a_forum); call hcs_$fs_get_path_name (attendee_seg_ptr, dirname_buffer, dirname_len, (""), status); if status ^= 0 then call error (status); call expand_pathname_ (dirname, directory, name, status); if status ^= 0 then call error (status); call validate_name (name); call hcs_$fs_get_access_modes (attendee_seg_ptr, ""b, xacl, status); if status ^= 0 then call error (status); if initiate_trans then do; call hcs_$initiate (dirname, TRANSACTION_SEG_NAME, "", 0, 0, transaction_seg_ptr, status); if transaction_seg_ptr = null () then if status = error_table_$noentry then call error (forum_et_$not_a_forum); else call error (status); call hcs_$fs_get_brackets (transaction_seg_ptr, mode, rings, status); if status ^= 0 then call error (status); if mode ^= RW_ACCESS_BIN then call error (forum_et_$not_a_forum); if rings (1) ^= forum_data_$forum_ring | rings (2) ^= rings (3) then call error (forum_et_$not_a_forum); end; call hcs_$level_set (user_ring); return; end initiate_meeting; %page; forum_seg_mgr_$lock: entry (P_attendee_seg_ptr, P_status); call initialize (LOCK_EXIT); attendee_seg_ptr = P_attendee_seg_ptr; call lock_meeting (); P_status = 0; return; LOCK_EXIT: P_status = status; return; lock_meeting: proc (); declare count fixed bin, not_locked bit (1) aligned; on any_other call any_other_handler (); 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 (attendee_seg.lock, 2, status); 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; end lock_meeting; %page; forum_seg_mgr_$initiate_seg: entry (P_open_data_ptr, P_seg_index, P_status); call initialize (INITIATE_SEG_EXIT); open_data_ptr = P_open_data_ptr; seg_index = P_seg_index; if seg_index < 1 | seg_index > open_data.transaction_seg_ptr -> transaction_seg.current_segno then call error (forum_et_$invalid_seg_idx); if open_data.proceedings_ptrs (seg_index) ^= null () then return; name = rtrim (PROCEEDINGS_SEG_NAME) || ltrim (char (seg_index)); on cleanup call hcs_$level_set (user_ring); call hcs_$level_set (inner_ring); call hcs_$initiate ((open_data.forum_name), name, "", 0, 0, p, status); if p = null () then if status = error_table_$noentry then call error (forum_et_$invalid_seg_idx); else call error (status); open_data.proceedings_ptrs (seg_index) = p; call hcs_$level_set (user_ring); P_status = 0; return; INITIATE_SEG_EXIT: call hcs_$level_set (user_ring); P_status = status; return; %page; forum_seg_mgr_$terminate: entry (P_attendee_seg_ptr, P_transaction_seg_ptr); call initialize (TERMINATE_EXIT); on cleanup call hcs_$level_set (user_ring); call hcs_$level_set (inner_ring); attendee_seg_ptr = P_attendee_seg_ptr; transaction_seg_ptr = P_transaction_seg_ptr; call unlock_meeting (); call terminate_meeting (); P_attendee_seg_ptr = null (); P_transaction_seg_ptr = null (); call hcs_$level_set (user_ring); return; forum_seg_mgr_$terminate_all: entry (P_open_data_ptr); call initialize (TERMINATE_EXIT); on cleanup call hcs_$level_set (user_ring); call hcs_$level_set (inner_ring); open_data_ptr = P_open_data_ptr; if open_data_ptr = null () then return; if open_data.open_count = 0 then do seg_index = 1 to hbound (open_data.proceedings_ptrs, 1); p = open_data.proceedings_ptrs (seg_index); open_data.proceedings_ptrs (seg_index) = null (); call hcs_$terminate_noname (p, (0)); end; attendee_seg_ptr = open_data.attendee_seg_ptr; transaction_seg_ptr = open_data.transaction_seg_ptr; if open_data.open_count = 0 then do; open_data.attendee_seg_ptr = null (); open_data.transaction_seg_ptr = null (); open_data.invalid = "1"b; end; call unlock_meeting (); if open_data.open_count = 0 then call terminate_meeting (); TERMINATE_EXIT: call hcs_$level_set (user_ring); return; %page; terminate_meeting: proc (); dcl old_ring fixed bin (3); call hcs_$level_get (old_ring); on cleanup call hcs_$level_set (old_ring); call hcs_$level_set (inner_ring); p = attendee_seg_ptr; attendee_seg_ptr = null (); call hcs_$terminate_noname (p, (0)); p = transaction_seg_ptr; transaction_seg_ptr = null (); call hcs_$terminate_noname (p, (0)); call hcs_$level_set (old_ring); return; end terminate_meeting; %page; forum_seg_mgr_$unlock: entry (P_attendee_seg_ptr); call initialize (UNLOCK_EXIT); attendee_seg_ptr = P_attendee_seg_ptr; call unlock_meeting (); UNLOCK_EXIT: return; unlock_meeting: proc (); if attendee_seg_ptr = null () then return; on any_other goto PUNT_UNLOCK; call set_lock_$unlock (attendee_seg.lock, (0)); PUNT_UNLOCK: return; end unlock_meeting; %page; initialize: procedure (P_egress); declare P_egress label variable, anon fixed bin; egress = P_egress; if ^static_init then do; call user_info_$login_data (person_id, project_id, (""), anon, 0, 0, 0, ("")); if anon = 1 then person_id = "*" || person_id; my_authorization = get_authorization_ (); inner_ring = get_ring_ (); static_init = "1"b; end; call hcs_$level_get (user_ring); attendee_seg_ptr, transaction_seg_ptr, open_data_ptr = null (); return; end initialize; any_other_handler: proc (); on any_other system; call forum_logger_$any_other (0, me, "^a>^a.", directory, name); status = forum_et_$unexpected_fault; goto egress; end any_other_handler; error: procedure (error_code); declare error_code fixed bin (35); status = error_code; goto egress; /* lets PUNT */ end error; end forum_seg_mgr_$create_forum;  forum_space_mgr_.pl1 10/20/92 1124.7r w 10/20/92 1120.7 179109 /****^ ************************************************************** * * * Copyright, (C) BULL HN Information Systems Inc., 1992 * * * * Copyright, (C) Massachusetts Institute of Technology, 1984 * * * ************************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-07-29,Pattin), approve(86-07-29,MCR7354), audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128): Added $next and $previous, changed to use find_bit_ for effeciency in searching seen maps. Moved get_highest_seen from trans_mgr and rewrote it to be faster. Fixed bug in block chaining (see find_block). 2) change(92-09-10,Zimmerman), approve(92-09-10,MCR8258), audit(92-09-22,WAAnderson), install(92-09-28,MR12.5-1020): Problem with current being set to deleted txn., or being set to -1. 3) change(92-10-02,Zimmerman), approve(92-10-02,PBF8258), audit(92-10-09,WAAnderson), install(92-10-20,MR12.5-1030): Post bug fix: correct error which caused ckm to incorrectly report seen txns. as new. END HISTORY COMMENTS */ /* format: style3,ifthen,ifthendo,ifthenstmt,^indnoniterdo,^inditerdo,idind30 */ forum_space_mgr_$find_attendee: proc (P_attendee_seg_ptr, P_attendee_name, P_attendee_ptr, P_status); /* Version 2 Forum - This module contains procedures to find and allocate attendee slots, transaction slots, and bit maps. Jay Pattin 1/1/83 Modified 09/12/83 by Jeffrey I. Schiller. Bugfix to get_transaction_slot Audit changes, J. Spencer Love 10/05/84 */ declare (P_attendee_name char (*), P_attendee_ptr ptr, P_attendee_seg_ptr ptr, P_bit_map_ptr ptr, P_check_new bit (1) aligned, P_first fixed bin, P_next_idx fixed bin, P_open_data_ptr ptr, P_prev_idx fixed bin, P_status fixed bin (35), P_transaction_ptr ptr, P_transaction_seg_ptr ptr, P_trans_idx fixed bin) parameter; declare attendee_name char (22), attendee_offset bit (18), based_area_ptr ptr, based_area area based (based_area_ptr), based_bs bit (bit_map.length) based, egress label variable, first fixed bin, highest fixed bin, idx fixed bin, last_trans_ptr ptr, loop_counter fixed bin, MAX_ATTENDEES fixed bin static options (constant) initial (6000), me char (16) static options (constant) init ("forum_space_mgr_"), result fixed bin, old_attendee_ptr ptr, old_bit_map_ptr ptr, original_high fixed bin, p ptr, path char (168), seen_all bit (1) aligned, status fixed bin (35), trans_offset bit (18), trans_idx fixed bin; declare (addr, addrel, clock, copy, hbound, index, max, null, ptr, rel, size, substr) builtin, area condition; declare END_OF_SEG bit (18) aligned static options (constant) init ("776000"b3); declare (forum_et_$invalid_trans_idx, forum_et_$meeting_bloat, forum_et_$no_such_user, forum_et_$no_transactions, forum_et_$roster_full, forum_et_$trans_reaped, forum_et_$unexpected_fault) fixed bin (35) external static; declare forum_logger_ entry options (variable), hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)), find_bit_$last_on entry (bit (*)) returns (fixed bin (24)); declare out_of_bounds condition; %page; %include forum_structures; %page; %include forum_open_data; %page; /* forum_space_mgr_$find_attendee: proc (P_attendee_seg_ptr, P_attendee_name, P_attendee_ptr, P_status); */ attendee_name = P_attendee_name; attendee_seg_ptr = P_attendee_seg_ptr; egress = GET_ATTENDEE_EXIT; result = lookup_attendee (); if result ^= 0 then do; P_status = forum_et_$no_such_user; P_attendee_ptr = null (); end; else do; P_attendee_ptr = attendee_ptr; P_status = 0; end; return; %page; forum_space_mgr_$get_attendee_slot: /* allocate a new attendee_slot */ entry (P_attendee_seg_ptr, P_attendee_name, P_attendee_ptr, P_status); egress = GET_ATTENDEE_EXIT; attendee_name = P_attendee_name; attendee_seg_ptr = P_attendee_seg_ptr; if attendee_seg.first_attendee_offset = ""b then attendee_ptr = null (); else do; result = lookup_attendee (); if result = 0 then do; P_attendee_ptr = attendee_ptr; P_status = 0; return; end; end; old_attendee_ptr = attendee_ptr; based_area_ptr = addr (attendee_seg.attendee_area); on area call error (forum_et_$roster_full); allocate attendee in (based_area); revert area; attendee_offset = rel (attendee_ptr); attendee.version = ATTENDEE_VERSION_1; attendee.attendee_uid = attendee_seg.attendee_count + 1; attendee.person_id = attendee_name; if attendee_seg.chairman_message ^= "" then attendee.flags.message_change_pending = "1"b; if old_attendee_ptr = null () then attendee_seg.first_attendee_offset = attendee_offset; else do; if result = 1 then old_attendee_ptr -> attendee.left_son_offset = attendee_offset; else old_attendee_ptr -> attendee.right_son_offset = attendee_offset; old_attendee_ptr = ptr (attendee_seg_ptr, attendee_seg.last_attendee_offset); old_attendee_ptr -> attendee.next_offset = attendee_offset; end; attendee_seg.last_attendee_offset = attendee_offset; attendee_seg.attendee_count = attendee_seg.attendee_count + 1; P_attendee_ptr = attendee_ptr; P_status = 0; return; GET_ATTENDEE_EXIT: P_status = status; P_attendee_ptr = null (); return; %page; lookup_attendee: proc () returns (fixed bin); /* 0 - found, 1 - left, 2 - right */ declare attendee_count fixed bin; attendee_count = 0; attendee_ptr = ptr (attendee_seg_ptr, attendee_seg.first_attendee_offset); do attendee_ptr = attendee_ptr repeat p; attendee_count = attendee_count + 1; if attendee.version ^= ATTENDEE_VERSION_1 | attendee_count > MAX_ATTENDEES then do; call hcs_$fs_get_path_name (attendee_seg_ptr, path, idx, "", (0)); call forum_logger_ (0, me, "Bad attendee thread at ^p in ^a.", attendee_ptr, substr (path, 1, idx)); call error (forum_et_$unexpected_fault); end; if attendee.person_id = attendee_name then return (0); if attendee_name > attendee.person_id then do; if attendee.right_son_offset = ""b then return (2); p = ptr (attendee_seg_ptr, attendee.right_son_offset); end; else do; if attendee.left_son_offset = ""b then return (1); p = ptr (attendee_seg_ptr, attendee.left_son_offset); end; end; end lookup_attendee; %page; forum_space_mgr_$find_transaction: entry (P_transaction_seg_ptr, P_trans_idx, P_transaction_ptr, P_status); egress = FIND_TRANS_EXIT; trans_idx = P_trans_idx; transaction_seg_ptr = P_transaction_seg_ptr; call find_block (); if transaction_block.offset (idx) = EXPUNGED then call error (forum_et_$trans_reaped); transaction_ptr = ptr (transaction_seg_ptr, transaction_block.offset (idx)); on out_of_bounds goto hit_out_of_bounds; if transaction.version ^= TRANSACTION_VERSION_1 | transaction.trans_idx ^= trans_idx then do; hit_out_of_bounds: revert out_of_bounds; call hcs_$fs_get_path_name (transaction_seg_ptr, path, idx, "", (0)); call forum_logger_ (0, me, "Bad transaction thread at ^p (^d) in ^a.", transaction_ptr, trans_idx, substr (path, 1, idx)); call error (forum_et_$unexpected_fault); end; revert out_of_bounds; P_transaction_ptr = transaction_ptr; P_status = 0; return; FIND_TRANS_EXIT: P_transaction_ptr = null (); P_status = status; return; find_block: procedure (); /* last_block_ptr used to correct bug in pre 2.13 forum */ declare last_block_ptr pointer; if trans_idx < 1 | trans_idx > transaction_seg.transaction_count then call error (forum_et_$invalid_trans_idx); loop_counter = 0; transaction_block_ptr = ptr (transaction_seg_ptr, transaction_seg.current_block_offset); if transaction_block.next_block_offset ^= ""b then do; do while (transaction_block_ptr ^= null ()); last_block_ptr = transaction_block_ptr; if transaction_block.prev_block_offset = ""b then transaction_block_ptr = null (); else do; transaction_block_ptr = ptr (transaction_seg_ptr, transaction_block.prev_block_offset); transaction_block.next_block_offset = rel (last_block_ptr); end; end; transaction_block_ptr = ptr (transaction_seg_ptr, transaction_seg.current_block_offset); transaction_block.next_block_offset = ""b; end; do while (trans_idx < transaction_block.first_trans_idx); loop_counter = loop_counter + 1; if loop_counter > 100 /* infinity */ then call error (forum_et_$unexpected_fault); transaction_block_ptr = ptr (transaction_seg_ptr, transaction_block.prev_block_offset); end; idx = trans_idx - transaction_block.first_trans_idx + 1; end find_block; %page; forum_space_mgr_$find_next_transaction: entry (P_transaction_seg_ptr, P_trans_idx, P_next_idx, P_status); egress = NEXT_TRANS_EXIT; transaction_seg_ptr = P_transaction_seg_ptr; trans_idx = P_trans_idx; call find_block (); do while (transaction_block_ptr ^= null ()); do loop_counter = idx + 1 to transaction_block.last_trans_idx; if transaction_block.offset (loop_counter) ^= EXPUNGED then do; P_next_idx = transaction_block.first_trans_idx + loop_counter - 1; P_status = 0; return; end; end; idx = 0; if transaction_block.next_block_offset ^= ""b then transaction_block_ptr = ptr (transaction_seg_ptr, transaction_block.next_block_offset); else transaction_block_ptr = null (); end; status = forum_et_$no_transactions; NEXT_TRANS_EXIT: P_next_idx = 0; P_status = status; return; %page; forum_space_mgr_$find_prev_transaction: entry (P_transaction_seg_ptr, P_trans_idx, P_prev_idx, P_status); egress = PREV_TRANS_EXIT; transaction_seg_ptr = P_transaction_seg_ptr; trans_idx = P_trans_idx; call find_block (); do while (transaction_block_ptr ^= null ()); do loop_counter = idx - 1 by -1 to 1; if transaction_block.offset (loop_counter) ^= EXPUNGED then do; P_prev_idx = transaction_block.first_trans_idx + loop_counter - 1; P_status = 0; return; end; end; if transaction_block.prev_block_offset ^= ""b then do; transaction_block_ptr = ptr (transaction_seg_ptr, transaction_block.prev_block_offset); idx = transaction_block.last_trans_idx + 1; end; else transaction_block_ptr = null (); end; status = forum_et_$no_transactions; PREV_TRANS_EXIT: P_prev_idx = 0; P_status = status; return; %page; forum_space_mgr_$get_transaction_slot: entry (P_transaction_seg_ptr, P_transaction_ptr, P_status); egress = FIND_TRANS_EXIT; transaction_seg_ptr = P_transaction_seg_ptr; transaction_block_ptr = ptr (transaction_seg_ptr, transaction_seg.current_block_offset); if transaction_seg.last_trans_offset = ""b then last_trans_ptr = null (); else last_trans_ptr = ptr (transaction_seg_ptr, transaction_seg.last_trans_offset); trans_idx = transaction_seg.transaction_count + 1; if transaction_seg.first_trans_offset = ""b then do; transaction_seg.first_trans_offset = transaction_seg.free_space_offset; transaction_block.time = clock (); end; if trans_idx > transaction_seg.last_trans_in_block then call get_new_block (); transaction_ptr = ptr (transaction_seg_ptr, transaction_seg.free_space_offset); trans_offset = rel (addrel (transaction_ptr, size (transaction))); if trans_offset >= END_OF_SEG then call error (forum_et_$meeting_bloat); idx = trans_idx - transaction_block.first_trans_idx + 1; transaction_seg.last_trans_offset, transaction_block.offset (idx) = transaction_seg.free_space_offset; transaction_seg.free_space_offset = trans_offset; transaction.version = TRANSACTION_VERSION_1; if last_trans_ptr = null () then transaction.prev_offset = ""b; else transaction.prev_offset = rel (last_trans_ptr); transaction.trans_idx = trans_idx; if last_trans_ptr ^= null () then last_trans_ptr -> transaction.next_offset = rel (transaction_ptr); transaction_seg.transaction_count = trans_idx; transaction_block.last_trans_idx = idx; P_transaction_ptr = transaction_ptr; P_status = 0; return; get_new_block: proc (); declare old_block_offset bit (18); old_block_offset = rel (transaction_block_ptr); transaction_block.next_block_offset, transaction_seg.current_block_offset = transaction_seg.free_space_offset; transaction_block_ptr = ptr (transaction_seg_ptr, transaction_seg.free_space_offset); trans_offset = rel (addrel (transaction_block_ptr, size (transaction_block))); if trans_offset >= END_OF_SEG then call error (forum_et_$meeting_bloat); transaction_seg.free_space_offset = trans_offset; transaction_seg.last_trans_in_block = transaction_seg.last_trans_in_block + hbound (transaction_block.transactions, 1); transaction_block.first_trans_idx = trans_idx; transaction_block.prev_block_offset = old_block_offset; transaction_block.time = clock (); return; end get_new_block; %page; forum_space_mgr_$allocate_bit_map: entry (P_open_data_ptr, P_attendee_ptr, P_first, P_bit_map_ptr, P_status); egress = BIT_MAP_EXIT; open_data_ptr = P_open_data_ptr; attendee_ptr = P_attendee_ptr; attendee_seg_ptr = open_data.attendee_seg_ptr; transaction_seg_ptr = open_data.transaction_seg_ptr; if transaction_seg.first_trans_offset = ""b then first = transaction_seg.transaction_count; else first = max (P_first, ptr (transaction_seg_ptr, transaction_seg.first_trans_offset) -> transaction.trans_idx); if attendee.bit_map_offset = ""b then old_bit_map_ptr = null (); else old_bit_map_ptr = ptr (attendee_seg_ptr, attendee.bit_map_offset); based_area_ptr = addr (attendee_seg.attendee_area); alloc_bit_map_length = max (504, transaction_seg.transaction_count + 100 - first); on area call error (forum_et_$roster_full); allocate bit_map in (based_area); revert area; bit_map.attendee_uid = attendee.attendee_uid; if old_bit_map_ptr ^= null () then do; if first < attendee.bit_map_first_trans then do; idx = attendee.bit_map_first_trans - first; substr (bit_map.map, 1, idx) = copy ("1"b, idx); substr (bit_map.map, idx + 1) = old_bit_map_ptr -> bit_map.map; end; else if first = attendee.bit_map_first_trans then bit_map.map = old_bit_map_ptr -> bit_map.map; else do; idx = first - attendee.bit_map_first_trans + 1; bit_map.map = substr (old_bit_map_ptr -> bit_map.map, idx, attendee.bit_map_length - idx + 1); end; free old_bit_map_ptr -> bit_map; end; else if ^attendee_seg.salvaging then call mark_expunged (); attendee.bit_map_first_trans = first; attendee.bit_map_offset = rel (bit_map_ptr); attendee.bit_map_length = bit_map.length; P_bit_map_ptr = bit_map_ptr; P_status = 0; return; BIT_MAP_EXIT: P_status = status; P_bit_map_ptr = null (); if bit_map_ptr ^= null () then free bit_map; return; mark_expunged: procedure (); declare idx fixed bin, status fixed bin (35); call forum_space_mgr_$find_transaction (transaction_seg_ptr, first, transaction_ptr, status); if status ^= 0 then return; do while ("1"b); idx = transaction.trans_idx; if transaction.next_offset = ""b then return; transaction_ptr = ptr (transaction_seg_ptr, transaction.next_offset); if transaction.trans_idx ^= idx + 1 then substr (bit_map.map, idx - first + 2, transaction.trans_idx - idx - 1) = copy ("1"b, transaction.trans_idx - idx - 1); end; end mark_expunged; %page; forum_space_mgr_$get_highest_seen: entry (P_attendee_ptr, P_transaction_seg_ptr, P_check_new, P_trans_idx, P_transaction_ptr, P_status); dcl seen_last bit (1); attendee_ptr = P_attendee_ptr; transaction_seg_ptr = P_transaction_seg_ptr; egress = GET_HIGHEST_EXIT; seen_last = "0"b; if attendee.bit_map_offset = ""b then do; P_trans_idx = 0; P_transaction_ptr = ptr (transaction_seg_ptr, transaction_seg.first_trans_offset); P_status = 0; return; end; bit_map_ptr = ptr (attendee_ptr, attendee.bit_map_offset); seen_all = "0"b; /* NOTE: use based_bit to avoid having to call the alloc_bs operator. Because bit_map.map is declared to be aligned, it owuld otherwise have to be copied. */ highest = find_bit_$last_on (addr (bit_map.map) -> based_bs) - 1; idx = highest + attendee.bit_map_first_trans; original_high = 0; if idx = transaction_seg.transaction_count then if index (substr (bit_map.map, 1, transaction_seg.transaction_count - attendee.bit_map_first_trans + 1), "0"b) = 0 then seen_all = "1"b; else seen_last = "1"b; else if idx > transaction_seg.transaction_count then do; call hcs_$fs_get_path_name (attendee_ptr, path, original_high, "", (0)); call forum_logger_ (0, me, "Bit map too high. highest = ^d, first = ^d, count = ^d in ^a.", idx, attendee.bit_map_first_trans, transaction_seg.transaction_count, substr (path, 1, original_high)); idx = transaction_seg.transaction_count; transaction_ptr = ptr (transaction_seg_ptr, transaction_seg.last_trans_offset); goto EXIT_LOOP; end; do while (idx > 0); /* Find highest seen not by us */ call forum_space_mgr_$find_transaction (transaction_seg_ptr, idx, transaction_ptr, status); if status = 0 then do; /* skip transactions entered by us. */ if seen_all | ^P_check_new | ((transaction.person_id ^= attendee.person_id) & ^transaction.deleted) then goto EXIT_LOOP; if original_high = 0 then original_high = idx; /* highest unexpunged we've seen */ idx = idx - 1; end; else if status = forum_et_$trans_reaped then do; call forum_space_mgr_$find_prev_transaction (transaction_seg_ptr, idx, idx, status); if status ^= 0 then if status ^= forum_et_$no_transactions then call error (status); if idx < attendee.bit_map_first_trans then highest = -1; else highest = idx - attendee.bit_map_first_trans + 1; end; else call error (status); if highest > 0 then do; highest = find_bit_$last_on (substr (bit_map.map, 1, highest)) - 1; idx = attendee.bit_map_first_trans + highest; end; end; /* Now scan forward until we come to a transaction that isn't ours */ EXIT_LOOP: if idx = 0 then do; if original_high = 0 then do; /* No transactions seen */ P_trans_idx = 0; if transaction_seg.first_trans_offset = ""b then P_transaction_ptr = null (); else P_transaction_ptr = ptr (transaction_seg_ptr, transaction_seg.first_trans_offset); end; else do; P_trans_idx = 0; /* All were deleted or ours */ call forum_space_mgr_$find_transaction (transaction_seg_ptr, original_high, transaction_ptr, status); if status ^= 0 then call error (status); if transaction.next_offset = ""b then P_transaction_ptr = null (); else P_transaction_ptr = ptr (transaction_seg_ptr, transaction.next_offset); end; end; else if (P_check_new & ^seen_last) then do; do while (transaction.next_offset ^= ""b); transaction_ptr = ptr (transaction_seg_ptr, transaction.next_offset); if (transaction.person_id ^= attendee.person_id & ^transaction.deleted) then goto FOUND_UNSEEN; end; transaction_ptr = null (); FOUND_UNSEEN: P_trans_idx = idx; P_transaction_ptr = transaction_ptr; end; else do; P_trans_idx = idx; P_transaction_ptr = null (); end; P_status = 0; return; GET_HIGHEST_EXIT: P_status = status; P_trans_idx = 0; P_transaction_ptr = null (); return; %page; error: proc (P_status); declare P_status fixed bin (35); status = P_status; goto egress; end error; end forum_space_mgr_$find_attendee;  forum_trans_mgr_.pl1 10/19/92 1521.3r w 10/19/92 1453.3 382077 /****^ ************************************************************** * * * Copyright, (C) BULL HN Information Systems Inc., 1992 * * * * Copyright, (C) Massachusetts Institute of Technology, 1984 * * * ************************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-07-29,Pattin), approve(86-07-29,MCR7356), audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128): Added $rechain entry point. 2) change(86-07-30,Pattin), approve(86-07-30,MCR7354), audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128): Added (next previous)_transaction entries. Improved handling of RQO during salvage/copy and transaction entering. Fixed some looping bugs in trans_time_info. Fixed trans_time_info error return. Other performance improvements in forum_limits and trans_ref_info. 3) change(92-10-07,Vu), approve(92-10-07,MCR8273), audit(92-10-08,Zimmerman), install(92-10-19,MR12.5-1027): Forum will go into an infinite loop for any date_time string which falls between transaction blocks. END HISTORY COMMENTS */ /* SECURITY/AUDITING NOTE: The enter_trans and rechain entrypoints reference the string arguments (P_input_string and P_subject) twice. Since neither of these strings are used in any security or integrity checking, this should not be considered a violation of the standard that states that gates should only reference their arguments twice. */ /* format: style3,ifthen,ifthendo,ifthenstmt,^indnoniterdo,^inditerdo,idind30 */ forum_trans_mgr_$enter_trans: procedure (P_forum_idx, P_input_string, P_pref, P_subject, P_filled_sw, P_trans_idx, P_status); /* Version 2 Forum - This module deals with entering and reading transactions, and managing information relating to transactions. Jay Pattin 1/2/83 8/19/83 Jay Pattin new notifications Modified 11/20/83 by Jeffrey I. Schiller to allow expunging of forums with multiple proceedings segments (prior behavior was an FPE). Also bugfixes to support large (upto one segment) transactions. Modified 12/22/83 by Jeffrey I. Schiller to fix bug in forum_limits as applied to expunged transactions. Audit changes, J. Spencer Love 10/05/84 */ declare ( P_attendee_offset bit (18), P_bit_map bit (*), P_deleted_sw bit (1) aligned, P_directory char (*), P_filled_sw bit (1) aligned, P_first_trans_idx fixed bin, P_flags_word bit (36) aligned, P_forum_idx fixed bin, (P_high_time, P_low_time) fixed bin (71), (P_high_trans, P_low_trans) fixed bin, P_input_string char (*), P_last_trans_idx fixed bin, P_last_seen_trans_idx fixed bin, P_name char (*), P_new_trans_count fixed bin, (P_next, P_previous) fixed bin, P_open_data_ptr ptr, P_area_ptr ptr, P_trans_ptr ptr, (P_pref, P_nref) fixed bin, P_status fixed bin (35), P_subject char (*), P_trans_idx fixed bin, P_type fixed bin, P_uid bit (36) aligned, P_user_name char (*), P_value_sw bit (1) aligned ) parameter; declare chairman bit (1) aligned, directory char (168), done bit (1) aligned, forum_idx fixed bin, input_len fixed bin (21), (high_time, low_time) fixed bin (71), (high_trans, low_trans) fixed bin, idx fixed bin, loading bit (1) aligned, message char (256), name char (32), new_trans_count fixed bin, next_trans_ptr ptr, next_word fixed bin (35), (nref, pref) fixed bin, privileged bit (1) aligned, status fixed bin (35), subject_len fixed bin (21), subject_offset bit (18) aligned, text_offset bit (18) aligned, trans_idx fixed bin, trans_ptr ptr, type fixed bin, user_name char (32), value_sw bit (1) aligned, xacl bit (36) aligned, (any_other, area, record_quota_overflow, seg_fault_error, cleanup) condition, (addr, binary, bit, clock, copy, divide, index, length, null, ptr, rel, rtrim, string, substr) builtin; declare person_id char (22) static, project_id char (9) static, static_init bit (1) aligned static init ("0"b); declare 1 forum_message aligned, 2 forum_uid bit (36), 2 attendee_offset bit (18); declare ipc_message fixed bin (71) based (addr (forum_message)); declare forum_logger_ entry options (variable), forum_logger_$any_other entry options (variable), forum_notify_gate_$lookup entry (char (*), bit (1) aligned, fixed bin (35)), forum_open_mgr_$lookup_forum_idx entry (fixed bin, ptr, bit (36) aligned, fixed bin (35)), forum_seg_mgr_$create_segment entry (ptr, fixed bin (35)), forum_seg_mgr_$initiate entry (char (*), char (*), bit (1) aligned, ptr, ptr, bit (36) aligned, fixed bin (35)), forum_seg_mgr_$initiate_seg entry (ptr, fixed bin, fixed bin (35)), forum_seg_mgr_$terminate entry (ptr, ptr), forum_seg_mgr_$unlock entry (ptr), forum_space_mgr_$allocate_bit_map entry (ptr, ptr, fixed bin, ptr, fixed bin (35)), forum_space_mgr_$find_attendee entry (ptr, char (*), ptr, fixed bin (35)), forum_space_mgr_$find_next_transaction entry (ptr, fixed bin, fixed bin, fixed bin(35)), forum_space_mgr_$find_prev_transaction entry (ptr, fixed bin, fixed bin, fixed bin(35)), forum_space_mgr_$find_transaction entry (ptr, fixed bin, ptr, fixed bin (35)), forum_space_mgr_$get_transaction_slot entry (ptr, ptr, fixed bin (35)), forum_space_mgr_$get_highest_seen entry (ptr, ptr, bit (1) aligned, fixed bin, ptr, fixed bin (35)), get_temp_segment_ entry (char (*), ptr, fixed bin (35)), hcs_$force_write entry (ptr, bit (36), 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)), sys_info$max_seg_size fixed bin(35) ext static, user_info_$login_data entry (char (*), char (*), char (*), fixed bin, fixed bin, fixed bin, fixed bin (71), char (*)); declare ( error_table_$noalloc, error_table_$rqover, error_table_$seg_busted, forum_et_$cant_notify, forum_et_$no_message, forum_et_$not_eligible, forum_et_$meeting_bloat, forum_et_$message_too_long, forum_et_$incorrect_uid, forum_et_$read_only, forum_et_$rqo, forum_et_$rqo_load, forum_et_$trans_deleted, forum_et_$chairman_only, forum_et_$invalid_att_idx, forum_et_$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 (P_area_ptr), proceeding_string char (alloc_text_length) based (trans_ptr), subject char (subject_len) based, text char (input_len) based; %page; %include forum_structures; %page; %include forum_open_data; %page; %include forum_flags; %page; %include forum_user_trans; %page; %include send_mail_info; %page; /* forum_trans_mgr_$enter_trans: procedure (P_forum_idx, P_input_string, P_pref, P_subject, P_filled_sw, P_trans_idx, P_status); */ loading = "0"b; goto ENTER_COMMON; forum_trans_mgr_$load_trans: entry (P_open_data_ptr, P_input_string, P_pref, P_subject, P_filled_sw, P_trans_idx, P_status); loading = "1"b; ENTER_COMMON: call initialize (ENTER_PUNT); on cleanup call forum_seg_mgr_$unlock (attendee_seg_ptr); on seg_fault_error call error (error_table_$seg_busted); on any_other call any_other_handler (); if ^loading then do; forum_idx = P_forum_idx; call forum_open_mgr_$lookup_forum_idx (forum_idx, open_data_ptr, xacl, status); if status ^= 0 then call error (status); end; else open_data_ptr = P_open_data_ptr; transaction_seg_ptr = open_data.transaction_seg_ptr; attendee_seg_ptr = open_data.attendee_seg_ptr; if ^loading then do; if xacl = R_XACL then call error (forum_et_$read_only); attendee_ptr = open_data.attendee_ptr; bit_map_ptr = open_data.bit_map_ptr; end; pref = P_pref; if pref ^= 0 then do; call forum_space_mgr_$find_transaction (transaction_seg_ptr, pref, trans_ptr, status); if status ^= 0 then if loading then pref = 0; else call error (status); end; idx = transaction_seg.current_segno; if open_data.proceedings_ptrs (idx) = null () then do; if ^attendee_seg.salvaging then call forum_seg_mgr_$initiate_seg (open_data_ptr, idx, status); else call get_temp_segment_ ("forum_salvager_", open_data.proceedings_ptrs (idx), status); if status ^= 0 then call error (status); end; next_word = binary (transaction_seg.next_trans_offset, 35); input_len = length (rtrim (P_input_string)); subject_len = length (rtrim (P_subject)); if (next_word + divide (subject_len + input_len + 3, 4, 35) + 2) > sys_info$max_seg_size then do; call get_new_seg (); next_word = 0; end; next_trans_ptr = ptr (open_data.proceedings_ptrs (idx), next_word); on record_quota_overflow begin; if loading then call error (forum_et_$rqo_load); else call error (forum_et_$rqo); end; next_trans_ptr -> subject = P_subject; subject_offset = rel (next_trans_ptr); next_word = next_word + divide (subject_len + 3, 4, 35); next_trans_ptr = ptr (next_trans_ptr, next_word); next_trans_ptr -> text = P_input_string; text_offset = rel (next_trans_ptr); next_word = next_word + divide (input_len + 3, 4, 35); transaction_seg.next_trans_offset = bit (binary (next_word, 18), 18); call forum_space_mgr_$get_transaction_slot (transaction_seg_ptr, transaction_ptr, status); if status ^= 0 then call error (status); transaction.segno = idx; transaction.subject_offset = subject_offset; transaction.subject_length = subject_len; transaction.text_offset = text_offset; transaction.text_length = input_len; if ^loading then do; call hcs_$force_write (open_data.proceedings_ptrs (idx), (""b), (0)); transaction.person_id = person_id; transaction.project_id = project_id; transaction.time = clock (); end; transaction.nref_offset = ""b; string (transaction.flags) = ""b; transaction.unfilled = P_filled_sw; if pref ^= 0 then do; /* link this transaction into reply chain if apropriate */ done = "0"b; do while (^done); if trans_ptr -> transaction.nref_offset = ""b then done = "1"b; else trans_ptr = ptr (transaction_seg_ptr, trans_ptr -> transaction.nref_offset); end; trans_ptr -> transaction.nref_offset = rel (transaction_ptr); transaction.pref_offset = rel (trans_ptr); end; if ^loading then call set_seen_switch (transaction.trans_idx, "1"b); P_trans_idx = transaction.trans_idx; revert seg_fault_error; revert record_quota_overflow; on any_other begin; on any_other system; call forum_logger_$any_other (0, "forum_trans_mgr_ (notify)", open_data.forum_name); call error (forum_et_$cant_notify); end; status = 0; if ^loading then do; forum_message.forum_uid = open_data.forum_uid; /* for validation purposes */ forum_message.attendee_offset = rel (attendee_ptr); call ioa_$rsnnl ("A new transaction has just been added to the ^a meeting.", message, (0), open_data.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; attendee_ptr = ptr (attendee_seg_ptr, attendee_seg.first_attendee_offset); do while (attendee_ptr ^= null ()); if attendee.person_id = person_id then goto NEXT; if attendee.attending & attendee.participating then call hcs_$wakeup (attendee.process_id, attendee.event_channel, ipc_message, (0)); else if attendee.notify & attendee.participating then do; call forum_notify_gate_$lookup ((attendee.person_id), done, status); if done & status = 0 then call send_mail_ (rtrim (attendee.person_id) || "." || rtrim (attendee.project_id), rtrim (message), addr (send_mail_info), (0)); end; NEXT: if attendee.next_offset = ""b then attendee_ptr = null (); else attendee_ptr = ptr (attendee_seg_ptr, attendee.next_offset); end; status = 0; call forum_seg_mgr_$unlock (attendee_seg_ptr); end; P_status = status; return; ENTER_PUNT: if ^loading then call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; return; %page; get_new_seg: proc (); if attendee_seg.salvaging then do; idx, transaction_seg.current_segno = transaction_seg.current_segno + 1; transaction_seg.next_trans_offset = ""b; call get_temp_segment_ ("forum_salvager_", open_data.proceedings_ptrs (idx), status); if status ^= 0 then call error (status); end; else do; call forum_seg_mgr_$create_segment (open_data_ptr, status); if status ^= 0 then call error (status); idx = transaction_seg.current_segno; call forum_seg_mgr_$initiate_seg (open_data_ptr, idx, status); if status ^= 0 then call error (status); end; next_trans_ptr = open_data.proceedings_ptrs (idx); return; end get_new_seg; %page; forum_trans_mgr_$rechain: entry (P_forum_idx, P_trans_idx, P_pref, P_subject, P_status); call initialize (CHAIN_PUNT); on cleanup call forum_seg_mgr_$unlock (attendee_seg_ptr); on any_other call any_other_handler (); forum_idx = P_forum_idx; trans_idx = P_trans_idx; pref = P_pref; call forum_open_mgr_$lookup_forum_idx (forum_idx, open_data_ptr, xacl, status); if status ^= 0 then call error (status); attendee_seg_ptr = open_data.attendee_seg_ptr; transaction_seg_ptr = open_data.transaction_seg_ptr; if xacl ^= RWC_XACL then call error (forum_et_$chairman_only); call forum_space_mgr_$find_transaction (transaction_seg_ptr, trans_idx, transaction_ptr, status); if status ^= 0 then call error (status); call change_subject (P_subject); if pref ^= 0 then do; call forum_space_mgr_$find_transaction (transaction_seg_ptr, pref, trans_ptr, status); if status ^= 0 then call error (status); if pref > trans_idx then do; done = "0"b; do while (^done); if trans_ptr -> transaction.pref_offset = ""b then done = "1"b; else if trans_ptr -> transaction.trans_idx <= trans_idx then done = "1"b; else trans_ptr = ptr (trans_ptr, trans_ptr -> transaction.pref_offset); end; if trans_ptr -> transaction.trans_idx > trans_idx then do; /* first in chain */ call remove_from_chain (); transaction.pref_offset = ""b; transaction.nref_offset = rel (trans_ptr); trans_ptr -> transaction.pref_offset = rel (transaction_ptr); goto CHAIN_PUNT; /* done */ end; end; done = "0"b; do while (^done); if trans_ptr -> transaction.nref_offset = ""b then done = "1"b; else if ptr (trans_ptr, trans_ptr -> transaction.nref_offset) -> transaction.trans_idx >= trans_idx then done = "1"b; else trans_ptr = ptr (trans_ptr, trans_ptr -> transaction.nref_offset); end; if trans_ptr = transaction_ptr then goto CHAIN_PUNT; /* already chained */ end; call remove_from_chain (); if pref ^= 0 then do; /* If this had a reply, unthread it */ transaction.nref_offset = trans_ptr -> transaction.nref_offset; /* and thread in new one */ if transaction.nref_offset ^= ""b then ptr (transaction_ptr, transaction.nref_offset) -> transaction.pref_offset = rel (transaction_ptr); transaction.pref_offset = rel (trans_ptr); trans_ptr -> transaction.nref_offset = rel (transaction_ptr); end; else do; transaction.pref_offset = ""b; /* Not in reply to anything anymore */ transaction.nref_offset = ""b; end; status = 0; CHAIN_PUNT: call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; return; %page; remove_from_chain: procedure (); if transaction.pref_offset ^= ""b then /* remove from original chain */ ptr (transaction_ptr, transaction.pref_offset) -> transaction.nref_offset = transaction.nref_offset; if transaction.nref_offset ^= ""b then ptr (transaction_ptr, transaction.nref_offset) -> transaction.pref_offset = transaction.pref_offset; end remove_from_chain; change_subject: procedure (new_subject); declare new_subject char (*) parameter; subject_len = length (rtrim (new_subject)); if subject_len = 0 then return; /* easy case. it's short enough to just overwrite the old one */ if subject_len <= transaction.subject_length then do; idx = transaction.segno; if open_data.proceedings_ptrs (idx) = null () then call forum_seg_mgr_$initiate_seg (open_data_ptr, idx, status); if status ^= 0 then call error (status); ptr (open_data.proceedings_ptrs (idx), transaction.subject_offset) -> subject = new_subject; transaction.subject_length = subject_len; return; end; if transaction.segno ^= transaction_seg.current_segno then call error (forum_et_$meeting_bloat); /* If it won't fit in the new segment, shoudl we copy the transaction ?? */ next_word = binary (transaction_seg.next_trans_offset, 35); if next_word + divide (subject_len + 3, 4, 35) + 2 > sys_info$max_seg_size then call error (forum_et_$meeting_bloat); /* lose, lose */ next_trans_ptr = ptr (open_data.proceedings_ptrs (transaction_seg.current_segno), next_word); on record_quota_overflow call error (forum_et_$rqo); next_trans_ptr -> subject = new_subject; revert record_quota_overflow; transaction.subject_offset = rel (next_trans_ptr); transaction.subject_length = subject_len; next_word = next_word + divide (subject_len + 3, 4, 35); transaction_seg.next_trans_offset = bit (binary (next_word, 18), 18); return; end change_subject; %page; forum_trans_mgr_$read_trans: entry (P_forum_idx, P_trans_idx, P_area_ptr, P_trans_ptr, P_status); call initialize (READ_PUNT); on cleanup call forum_seg_mgr_$unlock (attendee_seg_ptr); on seg_fault_error call error (error_table_$seg_busted); on any_other call any_other_handler (); forum_idx = P_forum_idx; trans_idx = P_trans_idx; call forum_open_mgr_$lookup_forum_idx (forum_idx, open_data_ptr, xacl, status); if status ^= 0 then call error (status); transaction_seg_ptr = open_data.transaction_seg_ptr; attendee_seg_ptr = open_data.attendee_seg_ptr; call forum_space_mgr_$find_transaction (transaction_seg_ptr, trans_idx, transaction_ptr, status); if status ^= 0 then call error (status); if transaction.deleted then if xacl ^= RWC_XACL & person_id ^= transaction.person_id then call error (forum_et_$trans_deleted); idx = transaction.segno; if open_data.proceedings_ptrs (idx) = null () then do; call forum_seg_mgr_$initiate_seg (open_data_ptr, idx, status); if status ^= 0 then call error (status); end; subject_len, alloc_subject_length = transaction.subject_length; alloc_text_length = transaction.text_length; on area call error (error_table_$noalloc); on record_quota_overflow call error (error_table_$rqover); allocate forum_user_trans in (output_area) set (forum_user_trans_ptr); revert area; revert record_quota_overflow; forum_user_trans.type = user_trans_type; forum_user_trans.person_id = transaction.person_id; forum_user_trans.project_id = transaction.project_id; forum_user_trans.trans_no = trans_idx; forum_user_trans.time = transaction.time; forum_user_trans.prev_trans_ptr, forum_user_trans.next_trans_ptr = null (); /* these are used by user ring status */ forum_user_trans.unfilled = transaction.unfilled; trans_ptr = ptr (open_data.proceedings_ptrs (idx), transaction.subject_offset); forum_user_trans.subject = trans_ptr -> subject; trans_ptr = ptr (trans_ptr, transaction.text_offset); forum_user_trans.text = proceeding_string; if transaction.deleted then P_status = forum_et_$trans_deleted; else P_status = 0; P_trans_ptr = forum_user_trans_ptr; call forum_seg_mgr_$unlock (attendee_seg_ptr); return; READ_PUNT: call forum_seg_mgr_$unlock (attendee_seg_ptr); P_trans_ptr = null (); P_status = status; return; %page; forum_trans_mgr_$set_message: entry (P_forum_idx, P_input_string, P_status); call initialize (SET_MESSAGE_EXIT); on cleanup call forum_seg_mgr_$unlock (attendee_seg_ptr); on any_other call any_other_handler (); forum_idx = P_forum_idx; if length (rtrim (P_input_string)) > 256 then call error (forum_et_$message_too_long); call forum_open_mgr_$lookup_forum_idx (forum_idx, open_data_ptr, xacl, status); if status ^= 0 then call error (status); attendee_seg_ptr = open_data.attendee_seg_ptr; if xacl ^= RWC_XACL then call error (forum_et_$chairman_only); attendee_seg.chairman_message = P_input_string; attendee_ptr = ptr (attendee_seg_ptr, attendee_seg.first_attendee_offset); do while (attendee_ptr ^= null ()); attendee.message_change_pending = "1"b; if attendee.next_offset = ""b then attendee_ptr = null (); else attendee_ptr = ptr (attendee_seg_ptr, attendee.next_offset); end; status = 0; SET_MESSAGE_EXIT: call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; return; %page; forum_trans_mgr_$get_message: entry (P_forum_idx, P_input_string, P_status); call initialize (GET_MESSAGE_EXIT); on cleanup call forum_seg_mgr_$unlock (attendee_seg_ptr); on any_other call any_other_handler (); forum_idx = P_forum_idx; call forum_open_mgr_$lookup_forum_idx (forum_idx, open_data_ptr, xacl, status); if status ^= 0 then call error (status); attendee_seg_ptr = open_data.attendee_seg_ptr; if attendee_seg.chairman_message = "" then call error (forum_et_$no_message); P_input_string = attendee_seg.chairman_message; GET_MESSAGE_EXIT: call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; if status ^= 0 then P_input_string = ""; return; %page; forum_trans_mgr_$trans_time_info: entry (P_forum_idx, P_low_time, P_high_time, P_low_trans, P_high_trans, P_status); call initialize (TRANS_TIME_PUNT); on any_other call any_other_handler (); on cleanup call forum_seg_mgr_$unlock (attendee_seg_ptr); forum_idx = P_forum_idx; call forum_open_mgr_$lookup_forum_idx (forum_idx, open_data_ptr, xacl, status); if status ^= 0 then call error (status); attendee_seg_ptr = open_data.attendee_seg_ptr; transaction_seg_ptr = open_data.transaction_seg_ptr; low_time = P_low_time; high_time = P_high_time; low_trans = 1; high_trans = transaction_seg.transaction_count; transaction_block_ptr = ptr (transaction_seg_ptr, transaction_seg.first_block_offset); transaction_ptr = ptr (transaction_seg_ptr, transaction_seg.last_trans_offset); if transaction_seg.last_trans_offset = ""b then do; /* see TR 19266 */ high_trans = 0; low_trans = 0; end; else if high_time ^= 0 & high_time < transaction_block.time then high_trans = 0; else if low_time > transaction.time then low_trans = high_trans; else do; if low_time > transaction_block.time then low_trans = find (low_time, "1"b); if high_time ^= 0 & high_time < transaction.time then high_trans = find (high_time, "0"b); end; P_high_trans = high_trans; P_low_trans = low_trans; call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = 0; return; TRANS_TIME_PUNT: call forum_seg_mgr_$unlock (attendee_seg_ptr); P_high_trans = 0; P_low_trans = 0; P_status = status; return; %page; find: proc (t, low_end) returns (fixed bin); declare t fixed bin (71), low_end bit (1) aligned, trans_ptr ptr, 1 trans like transaction based (trans_ptr), (idx, low, high, h, l) fixed bin; done = "0"b; transaction_block_ptr = ptr (transaction_seg_ptr, transaction_seg.current_block_offset); do while (^done); if t < transaction_block.time then transaction_block_ptr = ptr (transaction_seg_ptr, transaction_block.prev_block_offset); else done = "1"b; end; low = 1; high = transaction_block.last_trans_idx; do idx = divide (high + low, 2, 17, 0) repeat idx; if transaction_block.offset (idx) = EXPUNGED then do; do h = idx to high while (transaction_block.offset (h) = EXPUNGED); end; do l = idx to low by -1 while (transaction_block.offset (l) = EXPUNGED); end; if h > high then do; /* all expunged */ if l = 0 then if low_end then return (ptr (transaction_seg_ptr, transaction_seg.first_trans_offset) -> transaction.trans_idx); else return (0); else high = l; end; else if t < ptr (transaction_seg_ptr, transaction_block.offset (h)) -> trans.time then high = l; else low = h; if idx > high then idx = high; else if idx < low then idx = low; end; else do; trans_ptr = ptr (transaction_seg_ptr, transaction_block.offset (idx)); if trans.time < t then do; if ptr (transaction_seg_ptr, trans.next_offset) -> trans.time > t then return (idx + transaction_block.first_trans_idx - 1); else do; low = idx + 1; idx = divide (high + low, 2, 17, 0); end; end; else if ptr (transaction_seg_ptr, trans.prev_offset) -> trans.time <= t then return (idx + transaction_block.first_trans_idx - 2); else do; high = idx - 1; idx = divide (high + low, 2, 17, 0); end; end; end; end find; %page; forum_trans_mgr_$trans_ref_info: entry (P_forum_idx, P_trans_idx, P_type, P_pref, P_nref, P_deleted_sw, P_status); call initialize (TRANS_REF_PUNT); on any_other call any_other_handler (); on cleanup call forum_seg_mgr_$unlock (attendee_seg_ptr); forum_idx = P_forum_idx; call forum_open_mgr_$lookup_forum_idx (forum_idx, open_data_ptr, xacl, status); if status ^= 0 then call error (status); attendee_seg_ptr = open_data.attendee_seg_ptr; transaction_seg_ptr = open_data.transaction_seg_ptr; trans_idx = P_trans_idx; type = P_type; call forum_space_mgr_$find_transaction (transaction_seg_ptr, trans_idx, transaction_ptr, status); if status ^= 0 then call error (status); chairman = (person_id = attendee_seg.chairman.person_id); P_deleted_sw = transaction.deleted; pref, nref = 0; done = "0"b; trans_ptr = transaction_ptr; do while (^done); if trans_ptr -> transaction.pref_offset = ""b then done = "1"b; else do; trans_ptr = ptr (transaction_seg_ptr, trans_ptr -> transaction.pref_offset); done = check (); if done then pref = trans_ptr -> transaction.trans_idx; end; end; done = "0"b; trans_ptr = transaction_ptr; do while (^done); if trans_ptr -> transaction.nref_offset = ""b then done = "1"b; else do; trans_ptr = ptr (transaction_seg_ptr, trans_ptr -> transaction.nref_offset); done = check (); if done then nref = trans_ptr -> transaction.trans_idx; end; end; P_pref = pref; P_nref = nref; TRANS_REF_PUNT: call forum_seg_mgr_$unlock (attendee_seg_ptr); if status ^= 0 then do; P_pref, P_nref = 0; P_deleted_sw = "0"b; end; P_status = status; return; %page; forum_trans_mgr_$set_delete_sw: entry (P_forum_idx, P_trans_idx, P_value_sw, P_status); call initialize (SET_DELETE_EXIT); on any_other call any_other_handler (); on cleanup call forum_seg_mgr_$unlock (attendee_seg_ptr); forum_idx = P_forum_idx; trans_idx = P_trans_idx; value_sw = P_value_sw; call forum_open_mgr_$lookup_forum_idx (forum_idx, open_data_ptr, xacl, status); if status ^= 0 then call error (status); attendee_seg_ptr = open_data.attendee_seg_ptr; transaction_seg_ptr = open_data.transaction_seg_ptr; call forum_space_mgr_$find_transaction (transaction_seg_ptr, trans_idx, transaction_ptr, status); if status ^= 0 then call error (status); if person_id = transaction.person_id then privileged = "0"b; else if xacl = RWC_XACL then privileged = "1"b; else call error (forum_et_$chairman_only); if ^value_sw & ^privileged & ^transaction.deleted_by_author then call error (forum_et_$chairman_only); transaction.deleted_by_author = value_sw & ^privileged & (^transaction.deleted | value_sw); if transaction.deleted & value_sw then goto SET_DELETE_EXIT; if ^transaction.deleted & ^value_sw then goto SET_DELETE_EXIT; transaction.deleted = value_sw; if value_sw then transaction_seg.deleted_count = transaction_seg.deleted_count + 1; else transaction_seg.deleted_count = transaction_seg.deleted_count - 1; SET_DELETE_EXIT: call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; return; %page; forum_trans_mgr_$set_seen_switch: entry (P_forum_idx, P_user_name, P_trans_idx, P_value_sw, P_status); call initialize (SET_SEEN_EXIT); on cleanup call forum_seg_mgr_$unlock (attendee_seg_ptr); forum_idx = P_forum_idx; user_name = P_user_name; trans_idx = P_trans_idx; value_sw = P_value_sw; call forum_open_mgr_$lookup_forum_idx (forum_idx, open_data_ptr, xacl, status); if status ^= 0 then call error (status); attendee_seg_ptr = open_data.attendee_seg_ptr; transaction_seg_ptr = open_data.transaction_seg_ptr; if user_name = "" | user_name = person_id then attendee_ptr = open_data.attendee_ptr; else do; if xacl ^= RWC_XACL then call error (forum_et_$chairman_only); call forum_space_mgr_$find_attendee (attendee_seg_ptr, user_name, attendee_ptr, status); if status ^= 0 then call error (status); end; call forum_space_mgr_$find_transaction (transaction_seg_ptr, trans_idx, transaction_ptr, status); if status ^= 0 then call error (status); call set_seen_switch (trans_idx, value_sw); SET_SEEN_EXIT: call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; return; set_seen_switch: proc (trans_idx, value); declare trans_idx fixed bin, value bit (1) aligned; idx = trans_idx - attendee.bit_map_first_trans + 1; bit_map_ptr = ptr (attendee_seg_ptr, attendee.bit_map_offset); if idx < 1 then do; if value then return; call forum_space_mgr_$allocate_bit_map (open_data_ptr, attendee_ptr, trans_idx, bit_map_ptr, status); if status ^= 0 then call error (status); end; else if idx > bit_map.length then do; if ^value then return; idx = index (bit_map.map, "0"b); if idx = 0 then idx = bit_map.length; idx = idx + attendee.bit_map_first_trans - 1; call forum_space_mgr_$allocate_bit_map (open_data_ptr, attendee_ptr, idx, bit_map_ptr, status); if status ^= 0 then call error (status); end; idx = trans_idx - attendee.bit_map_first_trans + 1; open_data.bit_map_ptr = bit_map_ptr; substr (bit_map.map, idx, 1) = value; return; end set_seen_switch; %page; forum_trans_mgr_$get_transaction_map: entry (P_directory, P_name, P_user_name, P_bit_map, P_status); call initialize (GET_MAP_EXIT); on cleanup call forum_seg_mgr_$terminate (attendee_seg_ptr, transaction_seg_ptr); directory = P_directory; name = P_name; call forum_seg_mgr_$initiate (directory, name, "1"b, attendee_seg_ptr, transaction_seg_ptr, xacl, status); if status ^= 0 then call error (status); if xacl = ""b then call error (forum_et_$not_eligible); call get_seen_map (); call forum_seg_mgr_$terminate (attendee_seg_ptr, transaction_seg_ptr); P_status = 0; return; GET_MAP_EXIT: call forum_seg_mgr_$terminate (attendee_seg_ptr, transaction_seg_ptr); P_bit_map = ""b; P_status = status; return; forum_trans_mgr_$get_transaction_map_idx: entry (P_forum_idx, P_user_name, P_bit_map, P_status); call initialize (GET_MAP_IDX_EXIT); on cleanup call forum_seg_mgr_$unlock (attendee_seg_ptr); forum_idx = P_forum_idx; call forum_open_mgr_$lookup_forum_idx (forum_idx, open_data_ptr, xacl, status); if status ^= 0 then call error (status); attendee_seg_ptr = open_data.attendee_seg_ptr; transaction_seg_ptr = open_data.transaction_seg_ptr; call get_seen_map (); call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = 0; return; GET_MAP_IDX_EXIT: call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; P_bit_map = ""b; return; %page; get_seen_map: proc (); declare seen_map bit (transaction_seg.transaction_count); user_name = P_user_name; if open_data_ptr ^= null () & (user_name = "" | user_name = person_id) then attendee_ptr = open_data.attendee_ptr; else do; call forum_space_mgr_$find_attendee (attendee_seg_ptr, user_name, attendee_ptr, status); if status ^= 0 then call error (status); end; if attendee.bit_map_offset = ""b then seen_map = ""b; else do; bit_map_ptr = ptr (attendee_seg_ptr, attendee.bit_map_offset); idx = attendee.bit_map_first_trans - 1; if idx = 0 then seen_map = bit_map.map; else do; substr (seen_map, 1, idx) = copy ("1"b, idx); substr (seen_map, idx + 1) = bit_map.map; end; end; P_bit_map = seen_map; end get_seen_map; %page; forum_trans_mgr_$forum_limits: entry (P_forum_idx, P_type, P_last_seen_trans_idx, P_first_trans_idx, P_last_trans_idx, P_new_trans_count, P_flags_word, P_status); call initialize (FORUM_LIMITS_PUNT); on cleanup call forum_seg_mgr_$unlock (attendee_seg_ptr); forum_idx = P_forum_idx; type = P_type; call forum_open_mgr_$lookup_forum_idx (forum_idx, open_data_ptr, xacl, status); if status ^= 0 then call error (status); attendee_seg_ptr = open_data.attendee_seg_ptr; transaction_seg_ptr = open_data.transaction_seg_ptr; attendee_ptr = open_data.attendee_ptr; chairman = (xacl = RWC_XACL); forum_flags_word = ""b; forum_flags.chairman = chairman; forum_flags.adjourned = attendee_seg.adjourned; forum_flags.read_only = (xacl = R_XACL); forum_flags.print_cm_message = attendee.message_change_pending; forum_flags.acl_has_changed = attendee.acl_change_pending; /* The following statement is dedicated to IS-14 and HBD */ forum_flags.print_acl_message = attendee_seg.cm_print_acl_msg | (attendee_seg.am_init & attendee_seg.am_print_acl_msg) | (forum_data_$print_eligibility_messages & ^(attendee_seg.am_init & ^attendee_seg.am_print_acl_msg) & ^(forum_data_$chairman_override & attendee_seg.cm_init & ^attendee_seg.cm_print_acl_msg)); P_flags_word = forum_flags_word; if transaction_seg.first_trans_offset = ""b then do; P_first_trans_idx, P_last_trans_idx, P_last_seen_trans_idx, P_new_trans_count = 0; goto FORUM_LIMITS_PUNT; end; done = "0"b; trans_ptr = ptr (transaction_seg_ptr, transaction_seg.first_trans_offset); do idx = 1 to transaction_seg.transaction_count while (^done); done = check (); if trans_ptr -> transaction.next_offset = ""b then done = "1"b; else if ^done then trans_ptr = ptr (transaction_seg_ptr, trans_ptr -> transaction.next_offset); end; if ^done then call looping (); /* Check to make sure we actually found a transaction that meets the select type */ if trans_ptr -> transaction.next_offset = ""b then do; done = check (); if ^done then do; P_first_trans_idx, P_last_trans_idx, P_last_seen_trans_idx, P_new_trans_count = 0; goto FORUM_LIMITS_PUNT; end; end; P_first_trans_idx = trans_ptr -> transaction.trans_idx; done = "0"b; trans_ptr = ptr (transaction_seg_ptr, transaction_seg.last_trans_offset); do idx = 1 to transaction_seg.transaction_count while (^done); done = check (); if trans_ptr -> transaction.prev_offset = ""b then done = "1"b; else if ^done then trans_ptr = ptr (transaction_seg_ptr, trans_ptr -> transaction.prev_offset); end; if ^done then call looping (); P_last_trans_idx = trans_ptr -> transaction.trans_idx; call forum_space_mgr_$get_highest_seen (attendee_ptr, transaction_seg_ptr, "1"b, high_trans, transaction_ptr, status); if status ^= 0 then call error (status); P_last_seen_trans_idx = high_trans; new_trans_count = 0; done = (transaction_ptr = null ()); do idx = 1 to transaction_seg.transaction_count while (^done); if transaction.person_id ^= person_id & ^transaction.deleted then new_trans_count = new_trans_count + 1; if transaction.next_offset = ""b then done = "1"b; else transaction_ptr = ptr (transaction_seg_ptr, transaction.next_offset); end; if ^done then call looping (); P_new_trans_count = new_trans_count; FORUM_LIMITS_PUNT: call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; return; %page; check: proc () returns (bit (1) aligned); if type = ONLY_UNDELETED & trans_ptr -> transaction.deleted then return ("0"b); else if type = ONLY_DELETED & ^trans_ptr -> transaction.deleted then return ("0"b); else if trans_ptr -> transaction.deleted & ^chairman & trans_ptr -> transaction.person_id ^= person_id then return ("0"b); else return ("1"b); end check; looping: proc; call forum_logger_ (0, "forum_trans_mgr_", "Loop detected in ^a, trans_ptr = ^p.", open_data.forum_name, trans_ptr); call error (forum_et_$unexpected_fault); end looping; %page; forum_trans_mgr_$check_user: entry (P_forum_idx, P_user_name, P_trans_idx, P_status); call initialize (CHECK_USER_EXIT); on any_other call any_other_handler (); on cleanup call forum_seg_mgr_$unlock (attendee_seg_ptr); forum_idx = P_forum_idx; call forum_open_mgr_$lookup_forum_idx (forum_idx, open_data_ptr, xacl, status); if status ^= 0 then call error (status); attendee_seg_ptr = open_data.attendee_seg_ptr; transaction_seg_ptr = open_data.transaction_seg_ptr; user_name = P_user_name; P_trans_idx = 0; done = "0"b; transaction_ptr = ptr (transaction_seg_ptr, transaction_seg.last_trans_offset); do while (^done); if transaction.person_id = user_name then done = "1"b; else if transaction.prev_offset = ""b then done = "1"b; else transaction_ptr = ptr (transaction_seg_ptr, transaction.prev_offset); end; if transaction.person_id = user_name then P_trans_idx = transaction.trans_idx; CHECK_USER_EXIT: call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; return; %page; forum_trans_mgr_$convert_attendee_idx: entry (P_forum_idx, P_attendee_offset, P_user_name, P_status); call initialize (CONV_ATT_EXIT); P_user_name = ""; on cleanup call forum_seg_mgr_$unlock (attendee_seg_ptr); on any_other call any_other_handler (); forum_idx = P_forum_idx; call forum_open_mgr_$lookup_forum_idx (forum_idx, open_data_ptr, xacl, status); if status ^= 0 then call error (status); attendee_seg_ptr = open_data.attendee_seg_ptr; attendee_ptr = ptr (attendee_seg_ptr, P_attendee_offset); if attendee.version ^= ATTENDEE_VERSION_1 then call error (forum_et_$invalid_att_idx); P_user_name = rtrim (attendee.person_id) || "." || attendee.project_id; CONV_ATT_EXIT: call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; return; %page; forum_trans_mgr_$validate_uid: entry (P_forum_idx, P_uid, P_status); call initialize (VALIDATE_UID_EXIT); on cleanup call forum_seg_mgr_$unlock (attendee_seg_ptr); on any_other call any_other_handler (); forum_idx = P_forum_idx; call forum_open_mgr_$lookup_forum_idx (forum_idx, open_data_ptr, xacl, status); if status ^= 0 then call error (status); attendee_seg_ptr = open_data.attendee_seg_ptr; if open_data.forum_uid ^= P_uid then call error (forum_et_$incorrect_uid); VALIDATE_UID_EXIT: call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; return; %page; forum_trans_mgr_$next_transaction: entry (P_forum_idx, P_trans_idx, P_next, P_status); call initialize (NEXT_PUNT); on any_other call any_other_handler; on cleanup call forum_seg_mgr_$unlock (attendee_seg_ptr); forum_idx = P_forum_idx; trans_idx = P_trans_idx; call forum_open_mgr_$lookup_forum_idx (forum_idx, open_data_ptr, xacl, status); if status ^= 0 then call error (status); attendee_seg_ptr = open_data.attendee_seg_ptr; call forum_space_mgr_$find_next_transaction (open_data.transaction_seg_ptr, trans_idx, high_trans, status); if status ^= 0 then call error (status); P_next = high_trans; status = 0; NEXT_PUNT: if status ^= 0 then P_next = 0; call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; return; %page; forum_trans_mgr_$previous_transaction: entry (P_forum_idx, P_trans_idx, P_previous, P_status); call initialize (PREV_PUNT); on any_other call any_other_handler; on cleanup call forum_seg_mgr_$unlock (attendee_seg_ptr); forum_idx = P_forum_idx; trans_idx = P_trans_idx; call forum_open_mgr_$lookup_forum_idx (forum_idx, open_data_ptr, xacl, status); if status ^= 0 then call error (status); attendee_seg_ptr = open_data.attendee_seg_ptr; call forum_space_mgr_$find_prev_transaction (open_data.transaction_seg_ptr, trans_idx, low_trans, status); if status ^= 0 then call error (status); P_previous = low_trans; status = 0; PREV_PUNT: if status ^= 0 then P_previous = 0; call forum_seg_mgr_$unlock (attendee_seg_ptr); P_status = status; return; %page; initialize: procedure (P_egress); declare P_egress label variable, anon fixed bin; egress = P_egress; if ^static_init then do; call user_info_$login_data (person_id, project_id, (""), anon, 0, 0, 0, ("")); if anon = 1 then person_id = "*" || person_id; static_init = "1"b; end; attendee_seg_ptr, transaction_seg_ptr, open_data_ptr = null (); status = 0; return; end initialize; any_other_handler: proc (); on any_other system; if open_data_ptr ^= null () then directory = open_data.forum_name; else directory = ""; call forum_logger_$any_other (0, "forum_trans_mgr_", directory); status = forum_et_$unexpected_fault; goto egress; end any_other_handler; error: procedure (P_status); declare P_status fixed bin (35); status = P_status; goto egress; end error; end forum_trans_mgr_$enter_trans;  v2forum_mgr_tv_.alm 08/16/86 1414.4rew 08/16/86 1354.6 45711 " *************************************************************** " * * " * Copyright (c) 1982 by Massachusetts Institute of Technology * " * * " *************************************************************** " HISTORY COMMENTS: " 1) change(86-07-29,Pattin), approve(86-07-29,MCR7354), " audit(86-08-03,Margolin), install(86-08-16,MR12.0-1128): " Added $next_transaction and $previous_transaction entries. " 2) change(86-07-29,Pattin), approve(86-07-29,MCR7356), " audit(86-08-03,Margolin), install(86-08-16,MR12.0-1128): " Added $rechain entry. " END HISTORY COMMENTS " " Transfer vector for bound_forum_mgr_ " Designed to avoid problems with installations. " " Jay Pattin 5/9/82 " " Modified to choose between version 1 and version 2 2/28/83 Jay Pattin name v2forum_mgr_tv_ temp temp1 " tv target_seg,entry_name{,target_entry_name} macro tv segdef &2 &2: getlp &=&3.,.&[ tra &1$&2 &; tra &1$&3 &] &end " idx_tv v2_target_seg,v2_target_entry,v1_allowed{,real_target_name{,real_v1_target_name} " " This is simple, version 2 uses negative indexes, version 1 uses positive. macro idx_tv entry &2 &2: tsx3 VERSION_BY_INDEX " version 2 returns 0,x3 - version 1 1,x3 &=&4.,.&[ tra &1$&2 " go to version 2 entry &; tra &1$&4 &] &=&3,no&[ tra V1_NOT_ALLOWED " is version 1 allowed &] &=&5.,.&[ tra forum_mgr_tv_$&2 " go to version 1 entry &; tra forum_mgr_tv_$&5 &] &end VERSION_BY_INDEX: epp1 pr0|2,* " first arg is forum_idx szn pr1|0 " is it positive ? tpl 1,x3 " yes, then version 1 tra 0,x3 " else version 2 V1_NOT_ALLOWED: lda pr0|0 " arg_count * 2 in au ldq forum_et_$old_format stq pr0|0,au* short_return " " name_tv v2_target_seg,v2_target_entry,v1_allowed{,real_target_name} " macro name_tv entry &2 &2: tsx3 VERSION_BY_NAME " returns tra 0,x3 if version 2 - 1,x3 if version 1 &=&4.,.&[ tra &1$&2 " go to version 2 entry &; tra &1$&4 &] &=&3,no&[ tra V1_NOT_ALLOWED " is version 1 allowed &; tra forum_mgr_tv_$&2 " go to version 1 entry &] &end CONTROL: aci /control/ VERSION_BY_NAME: ldx1 pr0|0 " 2 * arg_count to x1 lxl0 pr0|0 " call_type to x0 canx0 10,du " is there an environment_ptr ? tze 2,ic adx1 2,du " skip over it if yes ldq pr0|4,x1* " load descriptor of second arg (length in ql) epp1 pr0|4,* " pointer to forum name in pr1 scmr (pr,rl),(du) " look backwards for a period desc9a pr1|0,ql " forum name oct 056000000000 " period arg pr6|temp1 ttn 0,x3 " no period, goto version 2 sbq pr6|temp1 " position of last period a9bd pr1|0,ql " add in offset of period, pr1 now points to character after . lxl1 pr6|temp1 " remaining length of forum name. cmpc (pr,rl),(),fill(040) " look for 'control' desc9a pr1|0,x1 desc9a CONTROL,7 tze 1,x3 " if we win, it's version 1 tra 0,x3 " if not control, it's version 2 " name_tv forum_open_mgr_,open_forum,yes,open idx_tv forum_open_mgr_,close_forum,yes,close name_tv forum_seg_mgr_,list_forum_acl,no name_tv forum_seg_mgr_,set_forum_acl,no name_tv forum_seg_mgr_,replace_forum_acl,no name_tv forum_seg_mgr_,delete_forum_acl,no name_tv forum_open_mgr_,get_switch,no name_tv forum_seg_mgr_,get_uid_file,yes name_tv forum_open_mgr_,set_switch,yes idx_tv forum_open_mgr_,set_switch_idx,yes idx_tv forum_open_mgr_,set_event_channel_idx,yes idx_tv forum_trans_mgr_,convert_attendee_idx,yes idx_tv forum_trans_mgr_,validate_uid,yes idx_tv forum_trans_mgr_,get_message,yes idx_tv forum_trans_mgr_,enter_trans,yes idx_tv forum_trans_mgr_,read_trans,yes idx_tv forum_trans_mgr_,rechain,no idx_tv forum_trans_mgr_,set_delete_sw,yes idx_tv forum_trans_mgr_,forum_limits,yes,,real_forum_limits name_tv forum_open_mgr_,list_users,yes idx_tv forum_open_mgr_,list_users_idx,yes idx_tv forum_trans_mgr_,trans_ref_info,yes,,real_trans_ref_info idx_tv forum_trans_mgr_,trans_time_info,yes idx_tv forum_trans_mgr_,next_transaction,no idx_tv forum_trans_mgr_,previous_transaction,no idx_tv forum_trans_mgr_,check_user,yes idx_tv forum_trans_mgr_,set_seen_switch,no idx_tv forum_trans_mgr_,get_transaction_map,no idx_tv forum_trans_mgr_,get_transaction_map_idx,no name_tv forum_open_mgr_,forum_info,yes idx_tv forum_open_mgr_,forum_info_idx,yes name_tv forum_seg_mgr_,get_forum_path,yes idx_tv forum_seg_mgr_,get_forum_path_idx,yes name_tv forum_seg_mgr_,create_forum,yes name_tv forum_seg_mgr_,chname_forum,yes tv forum_conversion_,convert tv forum_salvager_,copy idx_tv forum_seg_mgr_,chname_forum_idx,yes name_tv forum_seg_mgr_,delete_forum,yes idx_tv forum_trans_mgr_,set_message,yes name_tv forum_open_mgr_,change_chairman,yes idx_tv forum_open_mgr_,change_chairman_idx,yes idx_tv forum_salvager_,expunge,no name_tv forum_open_mgr_,priv_change_chairman,yes tv forum_conversion_,priv_convert name_tv forum_open_mgr_,priv_set_switch,yes tv forum_open_mgr_,set_global_switch end 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