



		    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
