



		    forum_mgr_tv_.alm               10/30/84  1244.0r   10/30/84  0958.5       18414



"  ***************************************************************
"  *                                                             *
"  * Copyright (c) 1982 by Massachusetts Institute of Technology *
"  *                                                             *
"  ***************************************************************
"
"	Transfer vector for bound_v1_forum_mgr_
"	Designed to avoid problems with installations.
"
"	Jay Pattin 5/9/82


	name	forum_mgr_tv_.alm

	macro	tv

	segdef	&2

&2:	getlp
&=&3.,.&[	tra	&1$&2
&;	tra	&1$&3
&]

	&end

	tv	v1_forum_mgr_,open_forum
	tv	v1_forum_mgr_,close_forum

	tv	v1_forum_seg_mgr_,list_forum_acl

	tv	v1_forum_mgr_,set_switch
	tv	v1_forum_mgr_,set_switch_idx

	tv	v1_forum_mgr_,set_event_channel
	tv	v1_forum_mgr_,set_event_channel_idx
	tv	v1_forum_trans_mgr_,convert_attendee_idx
	tv	v1_forum_trans_mgr_,validate_uid

	tv	v1_forum_trans_mgr_,get_message
	tv	v1_forum_trans_mgr_,enter_trans
	tv	v1_forum_trans_mgr_,read_trans

	tv	v1_forum_trans_mgr_,set_delete_sw

	tv	v1_forum_trans_mgr_,forum_limits
	tv	v1_forum_trans_mgr_,real_forum_limits
	tv	v1_forum_mgr_,list_users
	tv	v1_forum_mgr_,list_users_idx

	tv	v1_forum_trans_mgr_,trans_ref_info
	tv	v1_forum_trans_mgr_,real_trans_ref_info
	tv	v1_forum_trans_mgr_,trans_time_info
	tv	v1_forum_trans_mgr_,check_user
	tv	v1_forum_mgr_,set_last_seen_idx

	tv	v1_forum_mgr_,forum_info
	tv	v1_forum_mgr_,forum_info_idx
	tv	v1_forum_seg_mgr_,get_forum_path
	tv	v1_forum_seg_mgr_,get_forum_path_idx
	tv	v1_forum_seg_mgr_,get_uid_file

	tv	v1_forum_seg_mgr_,create_forum
	tv	v1_forum_seg_mgr_,chname_forum
	tv	v1_forum_seg_mgr_,chname_forum_idx
	tv	v1_forum_seg_mgr_,delete_forum
	tv	v1_forum_seg_mgr_,set_forum_acl
	tv	v1_forum_trans_mgr_,set_message

	tv	v1_forum_mgr_,change_chairman
	tv	v1_forum_mgr_,change_chairman_idx

	tv	v1_forum_gc_,expunge

	tv	v1_forum_mgr_,priv_change_chairman
	tv	v1_forum_seg_mgr_,priv_delete_forum
	tv	v1_forum_seg_mgr_,priv_set_forum_acl
	tv	v1_forum_mgr_,priv_set_switch
	tv	v1_forum_mgr_,set_global_switch

	end




		    v1_forum_gc_.pl1                10/30/84  1244.0r   10/30/84  0958.5       92223



/* ***************************************************************
   *                                                             *
   * Copyright (c) 1982 by Massachusetts Institute of Technology *
   *                                                             *
   *************************************************************** */


v1_forum_gc_$expunge:
     proc  (P_forum_idx, P_switches_word, P_participants_deleted, P_trans_deleted, P_participants_damaged, 
	P_trans_damaged, P_status);

/* Garbage collector for forum meetings
   6/23/82 Jay Pattin */

declare	(P_forum_idx, P_participants_deleted, P_trans_deleted, P_participants_damaged, P_trans_damaged)
				fixed bin parameter,
	P_switches_word		bit (36) aligned,
	P_status			fixed bin (35) parameter;

declare	attendee_count		fixed bin,
	current_loc		fixed bin (19),
	deleted_count		fixed bin,
	forum_idx			fixed bin,
	idx			fixed bin,
	inner_ring		fixed bin (3),
	new_control_ptr		ptr,
	new_proc_len		fixed bin (19),
	new_proc_ptr		ptr,
	new_trans_ptr		ptr,
	project			char (9),
	trans_deleted		fixed bin,
	users_deleted		fixed bin,
	users_damaged		fixed bin,
	trans_damaged		fixed bin,
	old_trans_ptr		ptr,
	seg_len			fixed bin (21),
	seg			(seg_len) fixed bin based,
	status			fixed bin (35),
	trans_len			fixed bin (21),
	trans			char (trans_len) based,
	user_name			char (22),
	user_ring			fixed bin (3);

declare	1 new_control		aligned like forum_control based (new_control_ptr),
	1 damaged_transaction	aligned like one_transaction;

declare	1 switches		based (addr (P_switches_word)),
	2 transactions		bit (1) unaligned,
	2 users			bit (1) unaligned;

declare	(any_other, cleanup, out_of_bounds)
				condition,
	(addr, clock, collate, currentsize, min, null, ptr, string, substr, unspec, verify)
				builtin;

declare	me			char (12) static options (constant) init ("v1_forum_gc_");

declare	(error_table_$out_of_bounds,
	forum_error_table_$chairman_only,
	forum_error_table_$unexpected_fault)
				fixed bin (35) external;

declare	v1_forum_mgr_$get_ptrs		entry (fixed bin, ptr, ptr, fixed bin, bit (1) aligned, fixed bin (35)),
	v1_forum_mgr_$unlock		entry (ptr),
	get_lock_id_		entry returns (bit (36) aligned),
	get_ring_			entry returns (fixed bin (3)),
	get_temp_segment_		entry (char (*), ptr, fixed bin (35)),
	hcs_$level_get		entry returns (fixed bin (3)),
	hcs_$level_set		entry (fixed bin (3)),
	hcs_$truncate_seg		entry (ptr, fixed bin (19), fixed bin (35)),
	release_temp_segment_	entry (char (*), ptr, fixed bin (35)),
	user_info_$whoami		entry (char(*), char(*), char(*));
%page;
%include v1_forum_structures;
%page;
	forum_idx = P_forum_idx;
	trans_deleted, users_deleted, trans_damaged, users_damaged = 0;
	attendee_count, deleted_count, current_loc, new_proc_len = 0;
	status = 0;
	forum_control_ptr, new_proc_ptr, new_control_ptr = null ();
	inner_ring = get_ring_ ();
	user_ring = hcs_$level_get ();
	
	on any_other call error (forum_error_table_$unexpected_fault);
	on out_of_bounds call error (error_table_$out_of_bounds);
	on cleanup begin;
	     call v1_forum_mgr_$unlock (forum_control_ptr);
	     call release_temp_segment_ (me, new_control_ptr, (0));
	     call release_temp_segment_ (me, new_proc_ptr, (0));
	     call hcs_$level_set (user_ring);
	end;

	call v1_forum_mgr_$get_ptrs (forum_idx, forum_control_ptr, proceedings_ptr, (0), ("0"b), status);
	if status ^= 0 then call error (status);

	call user_info_$whoami (user_name, project, "");
	if forum_control.chairman.person_id ^= user_name then call error (forum_error_table_$chairman_only);

	call hcs_$level_set (inner_ring);

	call get_temp_segment_ (me, new_control_ptr, status);
	if status ^= 0 then call error (status);

	call get_temp_segment_ (me, new_proc_ptr, status);
	if status ^= 0 then call error (status);

	/* First build the control header */

	new_control.forum_lock = get_lock_id_ ();	/* just to be safe */
	new_control.no_deleted, new_control.no_attendees, new_control.next_trans_loc = 0;    /* yet to be determined */
	new_control.flags = forum_control.flags;
	string (new_control.flags.mbz0) = ""b;
	string (new_control.flags.mbz1) = ""b;
	new_control.no_transactions = forum_control.no_transactions;     /* this won't change */
	new_control.mbz2 = ""b;
	new_control.chairman = forum_control.chairman;

	if forum_control.msg_init then do;		/* put cmsg at front of proceedings */
	     new_control.message_loc = 0;
	     new_proc_len = 64;
	     trans_len = 256;
	     old_trans_ptr = ptr (proceedings_ptr, forum_control.message_loc);
	     new_proc_ptr -> trans = old_trans_ptr -> trans;
	end;
%page;	
	/* now let's gc the participants */

	do idx = 1 to forum_control.no_attendees;
	     if damaged_user (idx) then users_damaged = users_damaged + 1;
	     else if ^switches.users | ^forum_control.attendee (idx).deleted then do;
		attendee_count = attendee_count + 1;
		unspec (new_control.attendee (attendee_count)) = unspec (forum_control.attendee (idx));
		new_control.attendee (attendee_count).unused_flags = "0"b;

		if forum_control.attendee (idx).highest_trans_seen < 0 then
		     new_control.attendee (attendee_count).highest_trans_seen = forum_control.no_transactions;
		else new_control.attendee (attendee_count).highest_trans_seen =
		     min (forum_control.attendee (idx).highest_trans_seen, forum_control.no_transactions);
	     end;
	     else users_deleted = users_deleted + 1;
	end;
	
	new_control.no_attendees = attendee_count;


	/* and now the proceedings */

	unspec (damaged_transaction) = ""b;
	damaged_transaction.gone, damaged_transaction.deleted = "1"b;

	do idx = 1 to forum_control.no_transactions;
	     if unspec (forum_control.transactions (idx)) = unspec (damaged_transaction) then
		 unspec (new_control.transactions (idx)) = unspec (damaged_transaction);
	     else if damaged (idx) then do;
		trans_damaged = trans_damaged + 1;
		unspec (new_control.transactions (idx)) = ""b;
		new_control.transactions (idx).gone, new_control.transactions (idx).deleted = "1"b;
	     end;
	     else do;
		unspec (new_control.transactions (idx)) = unspec (forum_control.transactions (idx));
		if switches.transactions & forum_control.transactions (idx).deleted then do;
		     deleted_count = deleted_count + 1;
		     if ^forum_control.transactions (idx).gone then do;
			trans_deleted = trans_deleted + 1;
			if forum_control.transactions (idx).prior_ref_index > 0 then
			     new_control.transactions (forum_control.transactions (idx).prior_ref_index).next_ref_index =
				forum_control.transactions (idx).next_ref_index;
			if forum_control.transactions (idx).next_ref_index > 0 then
			     forum_control.transactions (forum_control.transactions (idx).next_ref_index).prior_ref_index =
				forum_control.transactions (idx).prior_ref_index;
		     end;
		     new_control.transactions (idx).gone = "1"b;
		     new_control.transactions (idx).offset, new_control.transactions (idx).length = 0;
		end;
		else do;
		     new_control.transactions (idx).offset = new_proc_len;
		     trans_len = forum_control.transactions (idx).length;
		     new_trans_ptr = ptr (new_proc_ptr, new_proc_len);
		     current_loc = forum_control.transactions (idx).offset;
		     old_trans_ptr = ptr (proceedings_ptr, current_loc);
		     
		     new_trans_ptr -> trans = old_trans_ptr -> trans;
		     new_proc_len = new_proc_len + (trans_len + 3)/4;
		end;
	     end;
	end;

	new_control.no_deleted = deleted_count;
	new_control.next_trans_loc = new_proc_len;

	/* COPY THE MEETING BACK HERE */

	seg_len = currentsize (new_control);
	forum_control_ptr -> seg = new_control_ptr -> seg;
	seg_len = new_proc_len;
	proceedings_ptr -> seg = new_proc_ptr -> seg;
%page;
	/* Now truncate proceedings segment and clean up */

	call hcs_$truncate_seg (proceedings_ptr, new_proc_len, status);
	if status ^= 0 then call error (status);

	call v1_forum_mgr_$unlock (forum_control_ptr);

	call release_temp_segment_ (me, new_proc_ptr, status);
	if status ^= 0 then call error (status);

	call release_temp_segment_ (me, new_control_ptr, status);
	if status ^= 0 then call error (status);

	call hcs_$level_set (user_ring);

	P_participants_deleted = users_deleted;
	P_trans_deleted = trans_deleted;
	P_participants_damaged = users_damaged;
	P_trans_damaged = trans_damaged;
	P_status = 0;
	return;

	
PUNT:	P_status = status;
	call hcs_$level_set (user_ring);
	P_participants_deleted, P_trans_deleted, P_participants_damaged, P_trans_damaged = 0;
	return;
%page;
damaged_user:
     proc (idx) returns (bit (1) aligned);

declare	idx			fixed bin;

	if verify (forum_control.attendee (idx).project_id, substr (collate (), 9)) ^= 0 then return ("1"b);

	if verify (forum_control.attendee (idx).project_id, substr (collate (), 9)) ^= 0 then return ("1"b);

	if forum_control.attendee (idx).project_id = "" | forum_control.attendee (idx).person_id = "" then
	     return ("1"b);

	return ("0"b);
     end damaged_user;


/* Check to see if a transaction looks like a transaction */

damaged:
     proc (idx) returns (bit (1) aligned);

declare	idx			fixed bin;

	if verify (forum_control.transactions (idx).person_id, substr (collate (), 9)) ^= 0 then return ("1"b);

	if verify (forum_control.transactions (idx).project_id, substr (collate (), 9)) ^= 0 then return ("1"b);

	if forum_control.transactions (idx).prior_ref_index < 0 |
	     forum_control.transactions (idx).prior_ref_index >= idx then return ("1"b);

	if (forum_control.transactions (idx).next_ref_index <= idx & forum_control.transactions (idx).next_ref_index > 0) |
	     forum_control.transactions (idx).next_ref_index > forum_control.no_transactions then return ("1"b);
	
	if forum_control.transactions (idx).offset >= 1044480 then return ("1"b);
	if forum_control.transactions (idx).offset < current_loc &
	     ^(forum_control.transactions (idx).offset = 0 & forum_control.transactions (idx).gone) then return ("1"b);
	if forum_control.transactions (idx).length >= 1044480 then return ("1"b);

	if forum_control.transactions (idx).time > clock () then return ("1"b);
	return ("0"b);
     end damaged;


error:
     proc (P_status);
     
declare	P_status			fixed bin (35);

          call v1_forum_mgr_$unlock (forum_control_ptr);
	status = P_status;
	goto PUNT;
     end error;

end v1_forum_gc_$expunge;




		    v1_forum_mgr_.pl1               08/16/86  1418.7r w 08/16/86  1354.8      546804



/* ***************************************************************
   *                                                             *
   * Copyright (c) 1982 by Massachusetts Institute of Technology *
   *                                                             *
   *************************************************************** */



/* This module is part of the forum inner ring side.  It maintains the correspondence between forum pathnames
   (from the user ring), forum indexes (for the user ring) and pointers to the forum segments which are used only
   in the inner ring.  It also implements locking the forums.

   Original Coding 14 June 1981 by J. Spencer Love
   Modified 01/12/82 Jay Pattin to add get_forum_path and change_chairman
   Modified 01/16/82 Jay Pattin to add list_users (was in trans_mgr_)
   renamed v1_forum_mgr_ with associated editing 01/21/82 Jay Pattin
   Modified 02/16/82 Jay Pattin added listening and set_event_channel
   Modified 03/29/82 Jay Pattin added priv_change_chairman
   Modified 05/05/82 Jay Pattin added read only support
   Modified 05/21/82 Jay Pattin added eligibility hacking
   Modified 06/23/82 Jay Pattin garbage collection
   Modified 06/23/82 Jay Pattin check for anonymous users
   Modified 9/25/82 Jay Pattin add adjourned switch, AIM support */
%page;
/* THIS IS DOCUMENTATION FOR THE INTERNAL INNER RING INTERFACES

They are to be called by other ring 3 procedures only.  The caller needn't change the validation level,
since all necessary validation level changes for initiating and terminating forum segments and determining
access are performed by these entrypoints.

Name:  v1_forum_mgr_$get_ptrs

Most inner ring forum interfaces should use a forum index to identify the forum.  The correspondence
between these identifiers and useful pointers is mapped by this entrypoint.  Pass the index by
reference; no need to copy, and get back the information you need to do your work.  The forum is also locked by
this entrypoint.  To unlock the forum, call v1_forum_mgr_$unlock.  You should have a cleanup handler to do
this in case of random lossage, and also check all exit points in your program, because it is very important that
the forum never be left locked when control is returned to the user ring.  You should also never return
pointers to the forum to the user ring, or other information like other processes' event channels or
process_ids.  Please also DO NOT TERMINATE THE POINTERS RETURNED BY THIS INTERFACE.


Name: v1_forum_mgr_$unlock

The following entrypoint is for cleaning up after v1_forum_mgr_$get_ptrs.  The following sequence or an
equivalent should be used in all code that accepts forum indexes as input:

forum_control_ptr = null ();
on cleanup call v1_forum_mgr_$unlock (forum_control_ptr);
call v1_forum_mgr_$get_ptrs (P_forum_idx, forum_control_ptr,
     proceedings_ptr, attendee_idx, status);
if status ^= 0 then do;
     P_status = status;
     return;
end;

It accepts a null pointer.  It traps faults.  There is no error code because nothing can go wrong that doesn't
kill your process, and that would be due to random damage in the environment, not this module.

Name:  v1_forum_mgr_$initiate

There is also an interface for dealing with forums that are not already open.  It optionally locks the forum.
Otherwise it performs essentially all the checks that forum_$open provides.  However, it can return with
a zero code and proceedings pointer = null.  In this case, the user has sufficient access to find out the name of
the chairman and the names of the participants.  Absolutely no information whatsoever should be returned about the
transactions.  Entrypoints that return no or partial information in this case should return
forum_error_table_$not_eligible after calling v1_forum_mgr_$terminate.  This interface is intended to be called
with a user ring validation level.  It can be called at the forum ring validation level, but the caller
probably shouldn't have its privileges enabled.  It is also intended that you pass the character string
arguments from the user ring by reference without copying so that truncation can be detected.


Name:  v1_forum_mgr_$terminate

The following is for cleaning up after v1_forum_mgr_$initiate.  It unlocks the forum if it is locked.  It
traps faults.  It eats null pointers.  It hacks its own validation level.  In nulls its arguments.  There is no
error code because nothing can go wrong that doesn't kill your process, and that is an act of God and the
initializer, not this module. */
%page;
v1_forum_mgr_$open_forum:
     procedure (P_forum_dir, P_forum_entry, P_forum_idx, P_status);

declare	P_forum_dir		char (*) parameter,
	P_forum_entry		char (*) parameter,
	P_forum_idx		fixed bin parameter,
	P_lock_switch		bit (1) aligned parameter,
	P_forum_control_ptr		ptr parameter,
	P_proceedings_ptr		ptr parameter,
	P_attendee_idx		fixed bin parameter,
	P_user_name		char (*) parameter,
	P_switch_name		char (*) parameter,
	P_switch_setting		bit (1) aligned parameter,
	P_event_channel		fixed bin (71) parameter,
	P_access_name		char (*) parameter,
	P_access_time		fixed bin (71) parameter,
	P_forum_info_ptr		ptr parameter,
	P_area_ptr		ptr parameter,
	P_user_list_ptr		ptr parameter,
	P_last_seen_trans_idx	fixed bin parameter,
	P_force_switch		bit (1) aligned parameter,
	P_chairman		char (*) parameter,
	P_write_allowed		bit (1) aligned parameter,
	P_status			fixed bin (35) parameter;

declare	(addr, after, before, clock, hbound, index, length, max, maxlength, min, null, rtrim, substr, unspec)
				builtin;

declare	(any_other, area, cleanup, no_read_permission, no_write_permission, seg_fault_error)
				condition;

declare	attendee_idx		fixed bin,	/* The users slot in the array forum_control.attendee	*/
	caller_validation		fixed bin (3),	/* The validation level to exit with.  Set by initialize.	*/
	dirname_buffer		char (168),	/* The REAL directory containing the forum		*/
	dirname_len		fixed bin,	/* The length returned by hcs_$fs_get_path_name		*/
	egress			label variable,	/* BAIL OUT AT 30,000 FEET.  Set by initialize.		*/
	force_switch		bit (1) aligned,	/* To max or not to max, for set_last_seen_trans_idx	*/
	last_seen_trans_idx		fixed bin,	/* copy of P_last_seen_trans_idx		          */
	forum_control_entry		char (32),	/* The REAL entryname of the control segment.		*/
	forum_name_len		fixed bin,	/* The length of the forum name without a suffix	*/
	forum_data_ptr		ptr,		/* If this ptr is nonnull the forum is open		*/
	forum_dir			char (168),	/* The copied directory input parameter			*/
	no_w_access		bit (1) aligned,
	privileged		bit (1) aligned,
	switch_name		char (32),
	switch_setting		bit (1) aligned,
	write_allowed		bit (1) aligned,
	status			fixed bin (35);	/* What went wrong */

declare	1 segment_acl		aligned,
	2 access_name		char (32),
	2 modes			bit (36),
	2 xmodes			bit (36),
	2 status			fixed bin (35);

declare	1 delete_acl		aligned,
	2 access_name		char (32),
	2 status			fixed bin (35);

/* The following is used by get_forum_info to accumulate data.  Automatic storage is safe and secure.		*/

declare	1 fmi			aligned like forum_info;

/* The following is used by find_forum_data and maintained by open_forum and close_forum to find openings.	*/

declare	first_forum_data_ptr	ptr static initial (null ());

/* The following are global static constants set by initialize the first time we are called.			*/

declare	static_initialized		bit (1) aligned static initial ("0"b),
	anon_switch		bit (1) aligned static initial ("0"b),
	my_authorization		bit (72) aligned static initial ("0"b),
          full_authorization		bit (72) aligned static initial ("0"b),
	my_process_id		bit (36) aligned static initial (""b),
	my_lock_id		bit (36) aligned static initial (""b),
	my_validation		fixed bin (3) static initial (5),
	project			char (9) static initial (""),
	user_name			char (22) static initial ("");

declare	directory			char (dirname_len) based (addr (dirname_buffer)),
	system_area		area based (get_system_free_area_ ()),
	P_area			area based (P_area_ptr);

declare   1 aim_bits aligned like aim_template based (addr (full_authorization));

declare	1 forum_data		aligned based (forum_data_ptr),
	  2 next_ptr		ptr,		/* Thread.  Used for searching.			*/
	  2 prev_ptr		ptr,		/* Thread.  Used for unthreading.			*/
	  2 name			char (24) unaligned,/* For debugging only.  Unsuffixed forum name.		*/
	  2 forum_control_ptr	ptr,		/* The control segment				*/
	  2 proceedings_ptr		ptr,		/* The proceedings segment				*/
	  2 forum_control_uid	bit (36),		/* The UID of the control segment.  For comparison.	*/
	  2 forum_idx		fixed bin,	/* The index of this opening.  For lookup.		*/
	  2 attendee_idx		fixed bin,	/* The slot in the attendee array.  For efficiency	*/
	  2 opening_count		fixed bin;	/* Don't initiate more than once.  See UID.		*/

declare	(forum_error_table_$cant_stop_msg_admin,
	forum_error_table_$cant_stop_msg_site,
	forum_error_table_$chairman_only,
	forum_error_table_$invalid_forum_idx,
	forum_error_table_$invalid_switch_name,
	forum_error_table_$invalid_trans_idx,
	forum_error_table_$long_forum_name,
	forum_error_table_$forum_deleted,
	forum_error_table_$meeting_adjourned,
	forum_error_table_$no_control_suffix,
	forum_error_table_$no_such_forum,
	forum_error_table_$no_such_user,
	forum_error_table_$not_a_forum,
	forum_error_table_$not_eligible,
	forum_error_table_$roster_full,
	forum_error_table_$switch_not_changed,
	forum_error_table_$unexpected_fault,
	forum_error_table_$you_twit,
	error_table_$ai_restricted,
	error_table_$bad_arg,
	error_table_$dirlong,
	error_table_$invalid_lock_reset,
	error_table_$lock_wait_time_exceeded,
	error_table_$locked_by_this_process,
	error_table_$moderr,
	error_table_$noalloc,
	error_table_$noentry,
	error_table_$null_info_ptr,
	error_table_$seg_busted,
	error_table_$unimplemented_version
	)			fixed bin (35) external;

declare	(forum_data_$print_eligibility_messages,
	forum_data_$chairman_override)
				bit (1) aligned external;

declare	get_authorization_		entry returns (bit (72) aligned),
	get_group_id_$tag_star	entry returns (char (32)),
	get_lock_id_		entry (bit(36) aligned),
	get_process_id_		entry returns (bit (36)),
	get_ring_			entry returns (fixed bin (3)),
	get_system_free_area_	entry returns (ptr),
	hcs_$add_acl_entries	entry (char (*), char (*), ptr, fixed bin, fixed bin (35)),
	hcs_$delete_acl_entries	entry (char(*), char(*), ptr, fixed bin, fixed bin(35)),
	hcs_$fs_get_brackets	entry (ptr, fixed bin (5), (3) fixed bin (3), fixed bin (35)),
	hcs_$fs_get_path_name	entry (ptr, char (*), fixed bin, char (*), fixed bin (35)),
	hcs_$get_access_class	entry (char(*), char(*), bit (72) aligned, fixed bin (35)),
          hcs_$get_authorization	entry (bit (72) aligned, bit (72) aligned),
	hcs_$get_uid_seg		entry (ptr, bit (36) aligned, fixed bin (35)),
	hcs_$get_user_effmode	entry (char (*), char (*), char (*), fixed bin (3), fixed bin (5), fixed bin (35)),
	hcs_$initiate		entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr,
				fixed bin (35)),
	hcs_$level_get		entry () returns (fixed bin (3)),
	hcs_$level_set		entry (fixed bin (3)),
	hcs_$terminate_noname	entry (ptr, fixed bin (35)),
	read_write_allowed_		entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned),
	set_lock_$lock		entry (bit (36) aligned, fixed bin, fixed bin (35)),
	set_lock_$unlock		entry (bit (36) aligned, fixed bin (35)),
	user_info_$login_data	entry (char (*), char (*), char (*), fixed bin, fixed bin, fixed bin,
				fixed bin (71), char (*));
%page;
%include v1_forum_structures;
%page;
%include forum_info;
%page;
%include forum_user_list;
%page;
%include aim_template;
%page;
%include access_mode_values;
%page;
/* This is the primary user ring interface to forum.  To enter a forum and read or enter transactions, the
   forum must first be opened.  This sets the attending flag and returns an integer to identify the opening.	*/

/* v1_forum_mgr_$open:  procedure (P_forum_dir, P_forum_entry, P_forum_idx, P_status);			*/

	call initialize (OPEN_EXIT);			/* Set up for "error" procedure and cleanup handler.	*/

	call copy_pathname_args ();			/* P_forum_dir and P_forum_entry			*/

	on cleanup call close_forum ();		/* If (heaven forbid) we should crawl out, die gracefully.	*/

	call initiate_forum ("1"b);			/* Set forum_control_ptr and proceedings_ptr.		*/

	if no_w_access then call error (forum_error_table_$not_eligible);

	call lock_forum ();				/* Lock out anyone else during update.			*/

	call open_forum ();				/* Find or allocate forum_data.			*/

	if forum_control.flags.adjourned then
	     if anon_switch | user_name ^= forum_control.chairman.person_id then
		call error (forum_error_table_$meeting_adjourned);

	call fill_attendee_slot ();			/* Update control segment.				*/
	forum_control.attendee (attendee_idx).public_wakeup_chan = 0;
	forum_control.attendee (attendee_idx).write_allowed = write_allowed;

	call unlock_forum ();			/* Finished updating, unlock.				*/

	P_forum_idx = forum_data.forum_idx;		/* Tell user how to access this forum in the future.	*/
	P_status = 0;				/* If we got this far there was no error.		*/

	return;

OPEN_EXIT:
	call close_forum ();			/* Clean up the mess, we didn't make it.		*/

	P_forum_idx = 0;				/* Lowest valid forum index is 1, so this won't be back.	*/
	P_status = status;				/* Tell user what went wrong.				*/

	return;
%page;
/* This performs the actual forum opening.  It requires that the forum be initiated and locked.  It sets
   forum_data_ptr.  If the forum was not previously opened, it changes first_forum_data_ptr; otherwise
   it sets attendee_idx.  It detects duplicate openings by comparing UIDs to avoid reused segment number bugs.	*/

open_forum:
     procedure ();

declare	forum_control_uid		bit (36) aligned;

	on cleanup forum_data_ptr = null ();

	call hcs_$get_uid_seg (forum_control_ptr, forum_control_uid, status);
	if status ^= 0 then call error (status);

	do forum_data_ptr = first_forum_data_ptr repeat (forum_data.next_ptr) while (forum_data_ptr ^= null ());

	     if forum_data.forum_control_uid = forum_control_uid
	     then do;
		     call terminate_forum ();	/* Initiated too many times.  Once is sufficient.		*/

		     forum_data.opening_count = forum_data.opening_count + 1;
		     forum_control_ptr = forum_data.forum_control_ptr;
		     proceedings_ptr = forum_data.proceedings_ptr;
		     attendee_idx = forum_data.attendee_idx;

		     return;
		end;
	end;

/* If we are here, forum was not previously opened, so we must allocate and fill in a forum_data block		*/

	call allocate_forum_data ();

	forum_data.name = substr (forum_control_entry, 1, forum_name_len);
	forum_data.forum_control_ptr = forum_control_ptr;
	forum_data.proceedings_ptr = proceedings_ptr;
	forum_data.forum_control_uid = forum_control_uid;
	forum_data.opening_count = 1;

	forum_data.prev_ptr = null ();		/* Thread the forum_data block into the list so we can	*/
	forum_data.next_ptr = first_forum_data_ptr;	/* find it later.  Bidirectional threads to unthread later	*/

	if forum_data.next_ptr = null ()
	then forum_data.forum_idx = 1;		/* Meeting index must have no duplications.		*/
	else do;
		forum_data.forum_idx = forum_data.next_ptr -> forum_data.forum_idx + 1;
		forum_data.next_ptr -> forum_data.prev_ptr = forum_data_ptr;
	     end;

	first_forum_data_ptr = forum_data_ptr;	/* Threads are OK, so now make him official		*/

	return;

     end open_forum;
%page;
/* We must set our validation level to 3 before allocating forum_data because forum_data is allocated in the
   inner ring's system free area.  If this area is extended by this allocation, a bug in get_next_area_component_
   creates the new component with brackets of validation level rather than copying the ring brackets from the
   first component of the area.  This is in its own procedure to satisfy my warped sense of esthetics.		*/

allocate_forum_data:
     procedure ();

	on any_other call error (forum_error_table_$unexpected_fault);
	on area call error (error_table_$noalloc);	/* Deal with inability to allocate gracefully.		*/
	on cleanup call hcs_$level_set (caller_validation);

	call hcs_$level_set (my_validation);

	allocate forum_data in (system_area);

	call hcs_$level_set (caller_validation);

	return;

     end allocate_forum_data;
%page;
/* This undoes the work of v1_forum_mgr_$close.  It zeros its first argument so you won't close the forum more
   times than you open it.										*/

v1_forum_mgr_$close_forum:
     entry (P_forum_idx, P_status);

	call initialize (CLOSE_EXIT);			/* Set up for "error" procedure and cleanup handler.	*/

	call lookup_forum_idx ();			/* Find forum_data node from P_forum_idx.		*/

	on cleanup call unlock_forum ();		/* Now I lay me down to crunch, if I should fault...	*/

	call lock_forum ();			/* Don't let anyone else see the forum while we frob it.	*/

	call check_attendee_idx ();			/* Just in case forum was garbage collected.		*/

	P_forum_idx = 0;				/* Make sure caller doesn't close this one twice.		*/

	call close_forum ();			/* Clean up forum opening, unlock, terminate		*/

	P_status = 0;				/* If we got this far then there is no error.		*/

	return;

CLOSE_EXIT:
	call unlock_forum ();			/* Clean up the mess, we didn't make it.		*/

	P_status = status;				/* Tell then use what went wrong.			*/

	return;
%page;
/* This procedure closes a forum.  It assumes that the forum is initiated (forum_control_ptr ^= null ()), that
   the forum is open (forum_data_ptr ^= null ()), that the forum is locked, and that attendee_idx is valid.
   However, it is also used as a cleanup handler for open relation, so it hedges each assumption with a check.	*/

close_forum:
     procedure ();

	if forum_data_ptr ^= null ()
	then do;
		forum_data.opening_count = forum_data.opening_count - 1;
		if forum_data.opening_count > 0
		then do;
			call unlock_forum ();
			return;
		     end;

/* If we get here, we are really closing a forum, so unthread the forum_data node and free it.  We check that
   first_forum_data_ptr = forum_data_ptr instead of prev_ptr = null as last ditch protection against inconsistency.	*/

		if first_forum_data_ptr = forum_data_ptr then first_forum_data_ptr = forum_data.next_ptr;

		if forum_data.prev_ptr ^= null ()
		then forum_data.prev_ptr -> forum_data.next_ptr = forum_data.next_ptr;

		if forum_data.next_ptr ^= null ()
		then forum_data.next_ptr -> forum_data.prev_ptr = forum_data.prev_ptr;

		free forum_data;
	     end;

/* See if we actually own an attendee slot.  If we do, then clear it out.  But if we don't have forum_control_ptr
   valid, or attendee_idx is zero, or some other process claims to own the slot, then we leave it alone.  We are
   protected from trying to modify the forum if it is not locked because attendee_idx is zero until after the
   forum has been locked, and unlock_forum zeros it again before unlocking.					*/

	if forum_control_ptr ^= null () & attendee_idx > 0 then
	   if forum_control.attendee (attendee_idx).process_id = my_process_id then do;
		forum_control.attendee (attendee_idx).project_id = project;
		forum_control.attendee (attendee_idx).last_time_attended = clock ();
		forum_control.attendee (attendee_idx).public_wakeup_chan = 0;
		forum_control.attendee (attendee_idx).attending = "0"b;
	     end;

	call unlock_forum ();

	call terminate_forum ();

	return;

     end close_forum;
%page;
/* This is an internal ring 3 interface.  A ring three entrypoint which accepts a forum index should call here
   to translate the forum index into pointers to the two segments and get the index of the current user's
   slot on the attendee array, which is a speed optimization.  If you get back a nonzero code, PUNT.  Return
   the code to the user ring.  Otherwise, you have the forum LOCKED, and you must call v1_forum_mgr_$unlock
   before returning to the user ring.  It is perfectly OK to call this entrypoint with a null pointer or an
   unlocked database, so put it in your cleanup handler.  DO NOT TERMINATE THESE POINTERS!			*/

v1_forum_mgr_$get_ptrs:
     entry (P_forum_idx, P_forum_control_ptr, P_proceedings_ptr, P_attendee_idx, P_write_allowed, P_status);

	call initialize (GET_PTRS_EXIT);		/* Set up for "error" procedure and cleanup handler. */

	call lookup_forum_idx ();			/* Find forum_data node from P_forum_idx. */

	on cleanup call unlock_forum ();		/* In case of crawlout, for whatever reason... */

	call lock_forum ();				/* We want the whole thing to ourselves for a while. */

	call fill_attendee_slot ();			/* Make sure that last_time_attended is updated. */

	P_forum_control_ptr = forum_control_ptr;
	P_proceedings_ptr = proceedings_ptr;
	P_attendee_idx = attendee_idx;		/* Tell caller this for efficiency. */
	P_write_allowed = forum_control.attendee (attendee_idx).write_allowed;
	P_status = 0;

	return;

GET_PTRS_EXIT:
	call unlock_forum ();			/* Clean up the mess, we didn't make it.		*/

	P_forum_control_ptr = null ();
	P_proceedings_ptr = null ();
	P_attendee_idx = 0;				/* This means that the slot number is unknown.		*/
	P_status = status;				/* Tell the caller what went wrong.			*/

	return;
%page;
/* The procedure looks up a forum index of the sort that passes for a forum pointer in the user ring.  Rather than
   have an array and hence a maximum number of forums that can easily be concurrently open, a linked list is
   employed.  It is expected that rarely will more than two forums be open in the same process, so search time
   should normally not be significant.  If the search is successful, we set forum_data_ptr, forum_control_ptr,
   proceedings_ptr and attendee_idx.  Otherwise, we set the error code and bail out.				*/

lookup_forum_idx:
     procedure ();

declare	forum_control_uid		bit (36) aligned,
	forum_idx		fixed bin;

	on cleanup forum_data_ptr = null ();		/* This ptr may be used be our callers' cleanup handlers.	*/

	forum_idx = P_forum_idx;			/* Copy the parameter in case it uses tally modifiers.	*/

	if forum_idx < 1 then call error (forum_error_table_$invalid_forum_idx);

/* So try to find the right forum_data node.  If we return out of the loop, forum_data_ptr will be correctly set.	*/

	do forum_data_ptr = first_forum_data_ptr repeat (forum_data.next_ptr) while (forum_data_ptr ^= null ());

	     if forum_data.forum_idx = forum_idx
	     then do;
		     call hcs_$get_uid_seg (forum_data.forum_control_ptr, forum_control_uid, status);
		     if status ^= 0 then call error (status);

		     if forum_data.forum_control_uid ^= forum_control_uid
		     then call error (forum_error_table_$forum_deleted);

		     forum_control_ptr = forum_data.forum_control_ptr;
		     proceedings_ptr = forum_data.proceedings_ptr;
		     attendee_idx = forum_data.attendee_idx;

		     return;
		end;
	end;

/* If we get here. forum_data_ptr is null, so we don't have the cleanup handler null it and save microseconds.	*/

	revert cleanup;

	call error (forum_error_table_$invalid_forum_idx);

     end lookup_forum_idx;
%page;
/* The contract of this procedure is to try very hard to lock the forum.  We assume that forum_control_ptr is
   valid.  Since it makes the first reference to the control segment for some pathways, and the first write to the
   segment for others, it has lots of handlers.  Once the forum is locked, the ACL cannot be changed by the
   forum primitives, nor the forum be deleted, so these handlers are not needed throughout the rest of the
   forum inner ring.										*/

lock_forum:
     procedure ();

declare	count			fixed bin,
	not_locked		bit (1) aligned;

	on any_other call error (forum_error_table_$unexpected_fault);
	on no_read_permission call error (error_table_$moderr);
	on no_write_permission call error (error_table_$moderr);
	on seg_fault_error call error (error_table_$seg_busted);

	not_locked = "1"b;
	do count = 1 to 10 while (not_locked);

	     call set_lock_$lock (forum_control.forum_lock, 2, status);
	     if status = 0 then not_locked = "0"b;
	     else if status ^= error_table_$lock_wait_time_exceeded then not_locked = "0"b;
	end;

	if status ^= 0
	then if status ^= error_table_$invalid_lock_reset then call error (status);

	return;					/* This implicitly reverts the handlers			*/

     end lock_forum;
%page;
/* This routine keeps the attendee slot for the current user up to date in the control segment.  Of particular
   interest is the last_time_attended field.  Meeting_control_ptr is assumed valid.  No variables are set.		*/

fill_attendee_slot:
     procedure ();

	call check_attendee_idx ();			/* Check this in case forum was garbage collected.	*/

/* The clock value is put in forum_control.last_time_attended every time we reference the forum.		*/

	forum_control.attendee (attendee_idx).last_time_attended = clock ();

/* Since we're changing the page anyway, we might as well always write out this info which must be written out when the
   forum is opened and which might be smashed if two processes for the same user both have the same forum open.	*/

	forum_control.attendee (attendee_idx).project_id = project;
	forum_control.attendee (attendee_idx).attending = "1"b;
	forum_control.attendee (attendee_idx).removed = "0"b;
	forum_control.attendee (attendee_idx).process_id = my_process_id;
	forum_control.attendee (attendee_idx).lock_id = my_lock_id;

	return;

     end fill_attendee_slot;
%page;
/* This procedure makes sure that the saved attendee_idx is still valid.  When opening, attendee_idx = 0, which means
   there is no saved index.  If it isn't, make it so, adding a new participant if necessary. */

check_attendee_idx:
     procedure ();

declare	idx			fixed bin;

/* If attendee_idx is nonzero, we must think the forum is locked and open.  See if the user's slot has moved, which
   could happen if the forum is garbage collected.  If it hasn't moved, then we can just return, saving lots of work. */

	if forum_data_ptr ^= null & attendee_idx > 0
	then if forum_control.attendee (attendee_idx).person_id = user_name then return;

/* See if there is a slot for the person.  If there is, we will set attendee_idx.				*/

	attendee_idx = 0;
	do idx = 1 to forum_control.no_attendees while (attendee_idx = 0);

	     if forum_control.attendee (idx).person_id = user_name then attendee_idx = idx;
	end;

/* If attendee_idx is still not set, then the person isn't currently participating.  Allocate her a slot.		*/

	if attendee_idx = 0	then do;
	     attendee_idx = forum_control.no_attendees + 1;
	     if attendee_idx > hbound (forum_control.attendee, 1) then call error (forum_error_table_$roster_full);

	     forum_control.no_attendees = attendee_idx;

	     forum_control.attendee (attendee_idx).person_id = user_name;
	     forum_control.attendee (attendee_idx).project_id = "";
	     forum_control.attendee (attendee_idx).message_changed = "1"b;	/* Well, sort of */
	end;

/* If the forum is open, then update this information in the forum_data node.				*/

	if forum_data_ptr ^= null () then forum_data.attendee_idx = attendee_idx;
	forum_control.attendee (attendee_idx).deleted = "0"b;
	return;

     end check_attendee_idx;

lookup_attendee:
     procedure (person_name);

declare	person_name		char (*),
	idx			fixed bin;

	attendee_idx = 0;
	do idx = 1 to forum_control.no_attendees while (attendee_idx = 0);
	     if forum_control.attendee (idx).person_id = person_name then attendee_idx = idx;
	end;

	if attendee_idx = 0 then
	     call error (forum_error_table_$no_such_user);

	return;
     end lookup_attendee;
%page;
/* This is an internal ring 3 interface.  Call it to clean up after calling v1_forum_mgr_$get_ptrs.  It accepts a
   null input argument so don't hesitate to put it in your cleanup handlers.					*/

v1_forum_mgr_$unlock:
     entry (P_forum_control_ptr);

	forum_control_ptr = P_forum_control_ptr;	/* Copy parameter for internal procedure.		*/

	if ^static_initialized then return;		/* If this isn't set, we have no business here.		*/

	call unlock_forum ();			/* ZAP.  We don't care about this forum anymore anyway.	*/

	return;



/* This procedure cleans up after lock_forum.  It goes in cleanup handlers so it has its own handlers.		*/

unlock_forum:
     procedure ();

	attendee_idx = 0;				/* This being nonzero implies that the forum is locked.	*/

	if forum_control_ptr = null () then return;	/* If we don't even have this, we can't be locked.	*/

	on any_other go to PUNT_UNLOCK;		/* If anything goes wrong, we can't unlock, so give up.	*/

	call set_lock_$unlock (forum_control.forum_lock, (0));

PUNT_UNLOCK:
	return;

     end unlock_forum;
%page;
/* This is an internal ring 3 interface.  It should be called by anyone wishing to initiate a forum forum
   given a dirname and entryname from the user ring.  Pass the dirname and entryname by reference that came from
   the calling ring so their lengths can be checked.  If a nonzero code is returned, pass it back to the caller.
   If proceedings_ptr is null, you have only "r" access to the ".control" segment and should not return any
   information to the user ring about transactions.  Otherwise, you have "rw" access to both segment.  You should call
   v1_forum_mgr_$terminate to terminate the pointers.  It doesn't mind getting null pointers so put it in your
   cleanup handler.  If you don't take kindly to a null proceedings_ptr, terminate and then return the code
   forum_error_table_$not_eligible.  It locks the forum if asked nicely.					*/

v1_forum_mgr_$initiate:
     entry (P_forum_dir, P_forum_entry, P_lock_switch, P_forum_control_ptr, P_proceedings_ptr, P_status);

	call initialize (INITIATE_EXIT);		/* set up for "error" procedure and cleanup handler	*/

	call copy_pathname_args ();			/* P_forum_dir and P_forum_entry			*/

	on cleanup call close_forum ();		/* Just unlock and terminate.  forum_data_ptr is null.	*/

	call initiate_forum ("1"b);			/* This is what we are here for.			*/

	if P_lock_switch then call lock_forum ();	/* If user asked for this, give it to him.		*/

	P_forum_control_ptr = forum_control_ptr;
	P_proceedings_ptr = proceedings_ptr;
	P_status = 0;				/* If we got this far there is no error.		*/

	return;

INITIATE_EXIT:
	call close_forum ();			/* Just unlock and terminate.  forum_data_ptr is null.	*/

	P_forum_control_ptr = null ();
	P_proceedings_ptr = null ();
	P_status = status;				/* Tell user what went wrong.				*/

	return;
%page;
/* See that the split pathname passed to us is plausible.  Ring zero will pass on the directory name later, so all
   we have to do is make sure it isn't truncated.  The entryname must end in the ".control" suffix.
   The rest of the checking we leave until later.  No global variables are referenced.				*/

copy_pathname_args:
     procedure ();

declare	forum_name_len		fixed bin;

	if length (rtrim (P_forum_dir)) > maxlength (forum_dir)
	then call error (error_table_$dirlong);
	else forum_dir = P_forum_dir;

	if length (rtrim (P_forum_entry)) > maxlength (forum_control_entry)
	then call error (forum_error_table_$long_forum_name);
	else forum_control_entry = P_forum_entry;

	forum_name_len = length (rtrim (forum_control_entry)) - length (".control");
	if forum_name_len < 1 then call error (forum_error_table_$no_control_suffix);

	if substr (forum_control_entry, forum_name_len + 1) ^= ".control"
	then call error (forum_error_table_$no_control_suffix);

	return;

     end copy_pathname_args;
%page;
/* This routine is the arbiter of acceptable forum format.  Since the pathname passed in could be a link, paranoia
   is indicated.  The name on the link needn't be on the forum, but the name on the forum must be on both
   forum segments.  If we only have "r" on the control segment, we don't bother to check the proceedings.		*/

initiate_forum:
     procedure (initiate_proceedings);

declare	initiate_proceedings	bit (1) aligned,
	access_class		bit (72) aligned,
	modes			fixed bin (5),
	proceedings_entry		char (32),
	rings			(3) fixed bin (3);

/* Handle unexpected errors.  We don't have the forum locked, so anything can happen.				*/

	on any_other call error (forum_error_table_$unexpected_fault);
	on cleanup call terminate_forum ();
	on no_read_permission call error (error_table_$moderr);
	on seg_fault_error call error (error_table_$seg_busted);

/* We have to initiate at the inner ring validation level, since the segments aren't accessible from the outer ring.	*/

	call hcs_$level_set (my_validation);

	call hcs_$get_access_class (forum_dir, forum_control_entry, access_class, status);
	if status ^= 0 then
	     if status = error_table_$noentry then call error (forum_error_table_$no_such_forum);
	     else call error (status);

	if ^read_write_allowed_ (my_authorization, access_class) then do;
	     call hcs_$get_authorization (full_authorization, (""b));
	     if ^aim_bits.privileges.ipc |
		^aim_bits.privileges.seg |
		^aim_bits.privileges.dir then
	     call error (error_table_$ai_restricted);
	end;

	call hcs_$initiate (forum_dir, forum_control_entry, "", 0, 0, forum_control_ptr, status);
	if forum_control_ptr = null () then call error (status);

/* Verify the access mode and ring brackets, which must be correct on a valid forum.  "r" access is OK.		*/

	call hcs_$fs_get_brackets (forum_control_ptr, modes, rings, status);
	if status ^= 0 then call error (status);

	if modes = RW_ACCESS_BIN then no_w_access = "0"b;
	else if modes = R_ACCESS_BIN then no_w_access = "1"b;
	else call error (forum_error_table_$not_a_forum);

	if (rings (1) ^= my_validation) | (rings (2) ^= rings (3)) then call error (forum_error_table_$not_a_forum);

/* Now, refer to the segment.  Faults may be taken here.  The attendee count must be plausible.			*/

	if forum_control.no_attendees < 0 | forum_control.no_attendees > hbound (forum_control.attendee, 1)
	then call error (forum_error_table_$not_a_forum);

/* The attendee count can be zero.  So check something that can't be, to eliminate uninitialized segments.		*/

	if unspec (forum_control.chairman) = ""b then call error (forum_error_table_$not_a_forum);

/* We don't trust the pathname the user gave us.  It might be a link.  Get one we can trust.			*/

	call hcs_$fs_get_path_name (forum_control_ptr, dirname_buffer, dirname_len, forum_control_entry, status);
	if status ^= 0 then call error (status);

/* If the primary name of the segment doesn't have the suffix, this can't be a forum.				*/

	forum_name_len = length (rtrim (forum_control_entry)) - length (".control");
	if forum_name_len < 1 | forum_name_len > 20 then call error (forum_error_table_$not_a_forum);

	if substr (forum_control_entry, forum_name_len + 1) ^= ".control"
	then call error (forum_error_table_$not_a_forum);

/* Leave forum_name_len set for open_forum.  If we have "rw" access on the ".control" segment, then we also
   initiate the ".proceedings" segment. */

	if modes = RW_ACCESS_BIN & initiate_proceedings then do;
		proceedings_entry = substr (forum_control_entry, 1, forum_name_len) || ".proceedings";

		call hcs_$initiate (directory, proceedings_entry, "", 0, 0, proceedings_ptr, status);
		if proceedings_ptr = null ()
		then if status = error_table_$noentry | status = error_table_$moderr
		     then call error (forum_error_table_$not_a_forum);
		     else call error (status);

		call hcs_$fs_get_brackets (proceedings_ptr, modes, rings, status);
		if status ^= 0 then call error (status);

		if modes ^= RW_ACCESS_BIN & modes ^= R_ACCESS_BIN then call error (forum_error_table_$not_a_forum);
		write_allowed = (modes = RW_ACCESS_BIN);

		if (rings (1) ^= my_validation) | (rings (2) ^= rings (3))
		then call error (forum_error_table_$not_a_forum);
	     end;

	call hcs_$level_set (caller_validation);	/* Close barn door behind.				*/

	return;

     end initiate_forum;
%page;
/* This is an internal ring 3 interface to clean up after v1_forum_mgr_$initiate.  It nulls its arguments if they
   aren't already, so put it in your cleanup handlers.							*/

v1_forum_mgr_$terminate:
     entry (P_forum_control_ptr, P_proceedings_ptr);

	forum_control_ptr = P_forum_control_ptr;	/* Copy parameters for internal procedures.		*/
	proceedings_ptr = P_proceedings_ptr;

	if ^static_initialized then return;		/* The static variable "my_validation" must be set.	*/

	caller_validation = hcs_$level_get ();		/* We will need this to revert after terminating.		*/

	P_forum_control_ptr = null ();		/* Make sure caller does not terminate these twice.	*/
	P_proceedings_ptr = null ();

	call unlock_forum ();			/* In case we locked it before, unlock it now.		*/

	call terminate_forum ();			/* This is what we are here for, so do it.		*/

	return;



/* This procedure cleans up after initiate forum.  It must affect the ring 3 address space.  It is robust.		*/

terminate_forum:
     procedure ();

declare	p			ptr;

	on cleanup call hcs_$level_set (caller_validation);

	call hcs_$level_set (my_validation);		/* Here we go.....					*/

	on any_other go to PUNT_TERMINATE;		/* Handle any unexpected faults.			*/

	p = proceedings_ptr;			/* Make SURE pointers aren't terminated twice.		*/
	proceedings_ptr = null ();
	if p ^= null () then call hcs_$terminate_noname (p, (0));

	p = forum_control_ptr;			/* Make SURE pointers aren't terminated twice.		*/
	forum_control_ptr = null ();
	if p ^= null () then call hcs_$terminate_noname (p, (0));

PUNT_TERMINATE:
	call hcs_$level_set (caller_validation);

	return;

     end terminate_forum;
%page;
/* This interface allows the attending switch to be turned off, and the notify and removed switches to be frobbed,
   by either the chairman or the user on his own entry. */

v1_forum_mgr_$priv_set_switch:
     entry (P_forum_dir, P_forum_entry, P_user_name, P_switch_name, P_switch_setting, P_status);

	privileged = "1"b;
	goto SS_COMMON;

v1_forum_mgr_$set_switch:
     entry (P_forum_dir, P_forum_entry, P_user_name, P_switch_name, P_switch_setting, P_status);

	privileged = "0"b;

SS_COMMON:
	call initialize (SET_SWITCH_EXIT);		/* set up for "error" procedure and cleanup handler	*/

	call copy_pathname_args ();			/* P_forum_dir and P_forum_entry			*/

	on cleanup call terminate_forum ();

	call initiate_forum ("1"b);			/* Get pointers to forum				*/
	if ^privileged & no_w_access then call error (forum_error_table_$not_eligible);

	call set_switch ();				/* Do the work					*/

	call terminate_forum ();			/* Clean up shop and go home				*/

	P_status = status;				/* If we got this far there was no error		*/

	return;

SET_SWITCH_EXIT:
	call terminate_forum ();			/* Clean up the mess, we couldn't do it.		*/

	P_status = status;				/* Tell the use what went wrong.			*/

	return;
%page;
/* This consolidates the interface to turn the various per-user flags on and off				*/

v1_forum_mgr_$set_switch_idx:
     entry (P_forum_idx, P_user_name, P_switch_name, P_switch_setting, P_status);

	privileged = "0"b;
	call initialize (SET_SWITCH_IDX_EXIT);		/* set up for "error" procedure and cleanup handler	*/

	call lookup_forum_idx ();			/* Find forum_data node from P_forum_idx		*/

	call set_switch ();				/* Do the work.					*/

	P_status = status;				/* If we get this far there was no error.		*/

	return;

SET_SWITCH_IDX_EXIT:
	P_status = status;				/* Tell the user what went wrong.			*/

	return;
%page;
/* Do all the work of setting a switch.  We have to copy and check all the arguments from the user ring, and
   decide whether to permit the operation.  Only the chairman can mess with other people's switches.		*/

set_switch:
     procedure ();

declare	person_name		char (20);

	if length (rtrim (P_user_name)) > maxlength (person_name)
	then call error (error_table_$bad_arg);
	else person_name = P_user_name;

	if person_name = "" then person_name = user_name;
	else if person_name ^= user_name
	then if anon_switch | user_name ^= forum_control.chairman.person_id
	     then call error (forum_error_table_$chairman_only);
	     else forum_data_ptr = null ();

	if length (rtrim (P_switch_name)) > maxlength (switch_name)
	then call error (forum_error_table_$invalid_switch_name);
	else switch_name = P_switch_name;

	switch_setting = P_switch_setting;

	on cleanup begin;
	     call unlock_forum ();
	     call hcs_$level_set (caller_validation);
	end;

	if privileged & no_w_access then do;
	     call hcs_$level_set (my_validation);
	     call force_access ();
	end;

	call lock_forum ();

	call lookup_attendee (person_name);

	if switch_name = "participating" | switch_name = "part" then
	     call set_the_switch (forum_control.attendee (attendee_idx).removed, ^switch_setting);
	else if switch_name = "notify" | switch_name = "nt" then
	     call set_the_switch (forum_control.attendee (attendee_idx).notify, switch_setting);
	else if switch_name = "message_seen" then
	     call set_the_switch (forum_control.attendee (attendee_idx).message_changed, ^switch_setting);
	else if switch_name = "access_changed" then
	     call set_the_switch (forum_control.attendee (attendee_idx).acl_change_pending, switch_setting);

						/* rest of switches may only be changed by the chairman */
	else if switch_name = "deleted" then do;
	     if ^privileged & (anon_switch | user_name ^= forum_control.chairman.person_id) then
		call error (forum_error_table_$chairman_only);
	     if user_name = person_name then call error (forum_error_table_$you_twit);	/* chairman can't delete himself */
	     call set_the_switch (forum_control.attendee (attendee_idx).deleted, switch_setting);
	end;
	else if switch_name = "adjourned" | switch_name = "adj" then do;
	     if ^privileged & (anon_switch | user_name ^= forum_control.chairman.person_id) then
		call error (forum_error_table_$chairman_only);
	     call set_the_switch (forum_control.flags.adjourned, switch_setting);
	end;
	else if switch_name = "meeting_eligibility_messages" | switch_name = "mtg_emsg" then do;
	     if ^privileged then do;
		if anon_switch | user_name ^= forum_control.chairman.person_id then call error (forum_error_table_$chairman_only);
		if ^switch_setting then do;
		     if ^forum_data_$chairman_override & forum_data_$print_eligibility_messages then
			call error (forum_error_table_$cant_stop_msg_site);
		     if forum_control.am_init & forum_control.am_print_acl_msg then
			call error (forum_error_table_$cant_stop_msg_admin);
		end;
		call set_the_switch (forum_control.cm_print_acl_msg, switch_setting);
		if ^forum_control.cm_init & status = forum_error_table_$switch_not_changed then status = 0;
		forum_control.cm_init = "1"b;
	     end;
	     else do;
		call set_the_switch (forum_control.am_print_acl_msg, switch_setting);
		if ^forum_control.am_init & status = forum_error_table_$switch_not_changed then status = 0;
		forum_control.am_init = "1"b;
	     end;
	end;
	else call error (forum_error_table_$invalid_switch_name);

	call unlock_forum ();

	if privileged & no_w_access then do;
	     call delete_access ();
	     call hcs_$level_set (caller_validation);
	end;

	return;

set_the_switch:
	proc (switch, value);

declare switch bit (1) unaligned;
declare value bit (1) aligned;

	if switch = value then status = forum_error_table_$switch_not_changed;
	else switch = value;

	return;
	end set_the_switch;

     end set_switch;
%page;
v1_forum_mgr_$set_global_switch:
     entry (P_switch_name, P_switch_setting, P_status);

	call initialize (SET_GLOBAL_EXIT);

	if length (rtrim (P_switch_name)) > maxlength (switch_name)
	then call error (forum_error_table_$invalid_switch_name);
	else switch_name = P_switch_name;

	switch_setting = P_switch_setting;

	on no_write_permission call error (error_table_$moderr);

	if switch_name = "print_eligibility_messages" | switch_name = "pemsg" then
	     forum_data_$print_eligibility_messages = switch_setting;
	else if switch_name = "chairman_set_eligibility_msg" | switch_name = "cm_set_emsg" then
	     forum_data_$chairman_override = switch_setting;
	else call error (forum_error_table_$invalid_switch_name);

	P_status = 0;
	return;

SET_GLOBAL_EXIT:
	P_status = status;
	return;
%page;
/* If you want to be told when a new transaction arrives in a forum you are attending, you gotta tell the guy where
   to send the wakeup.										*/
v1_forum_mgr_$set_event_channel:
     entry (P_forum_dir, P_forum_entry, P_event_channel, P_status);

	call initialize (SET_EVENT_CHANNEL_EXIT);

	call copy_pathname_args ();

	on cleanup begin;
	     call unlock_forum ();
	     call terminate_forum ();
	end;

	call initiate_forum ("0"b);
	if no_w_access then call error (forum_error_table_$not_eligible);

	call lookup_attendee (user_name);

	call lock_forum ();

	forum_control.attendee (attendee_idx).public_wakeup_chan = P_event_channel;
	forum_control.attendee (attendee_idx).process_id = my_process_id;

	call unlock_forum ();
	call terminate_forum ();
	P_status = 0;
	return;

SET_EVENT_CHANNEL_EXIT:
	call unlock_forum ();
	call terminate_forum ();
	P_status = status;
	return;
%page;
v1_forum_mgr_$set_event_channel_idx:
     entry (P_forum_idx, P_event_channel, P_status);

	call initialize (SET_EVENT_CHANNEL_IDX_EXIT);	/* set up for "error" procedure and cleanup handler	*/

	call lookup_forum_idx ();			/* Find forum_data node from P_forum_idx		*/

	on cleanup call unlock_forum ();

	call lock_forum ();

	forum_control.attendee (attendee_idx).public_wakeup_chan = P_event_channel;
	forum_control.attendee (attendee_idx).process_id = my_process_id;

	call unlock_forum ();

	P_status = 0;

	return;

SET_EVENT_CHANNEL_IDX_EXIT:
	call unlock_forum ();

	P_status = status;

	return;
%page;
/* Note:  This interface does not lock the forum so occasional rare lossages can occur.  It can return the code
   forum_error_table_$not_eligible to indicate that the caller or specified access name lacks access to open the
   forum.  Partial info is returned in this case.							*/

v1_forum_mgr_$forum_info:
     entry (P_forum_dir, P_forum_entry, P_access_name, P_access_time, P_forum_info_ptr, P_status);

	call initialize (FORUM_INFO_EXIT);		/* set up for "error" procedure and cleanup handler	*/

	call copy_pathname_args ();			/* P_forum_dir and P_forum_entry			*/

	on cleanup call terminate_forum ();
	on no_read_permission call error (error_table_$moderr);

	call initiate_forum ("0"b);

	call get_forum_info (no_w_access);

	if no_w_access then status = forum_error_table_$not_eligible;
	else status = 0;

	call terminate_forum ();

	forum_info = fmi;

	P_status = status;

	return;

FORUM_INFO_EXIT:
	call terminate_forum ();

	P_status = status;

	return;
%page;
/* This interface locks the database, since it must be openable to use it.  We assume that response time is not as
   critical for the "current" forum (after all, you went to the trouble of opening it) as it is for the
   dirname, entryname entrypoint which is used by the forum_list command.					*/

v1_forum_mgr_$forum_info_idx:
     entry (P_forum_idx, P_access_name, P_access_time, P_forum_info_ptr, P_status);

	call initialize (MEETING_INFO_IDX_EXIT);	/* set up for "error" procedure and cleanup handler	*/

	call lookup_forum_idx ();			/* Find forum_data node from P_forum_idx		*/

	on cleanup call unlock_forum ();

	call lock_forum ();

	call fill_attendee_slot ();

	call get_forum_info ("0"b);

	call unlock_forum ();

	forum_info = fmi;
	P_status = 0;

	return;

MEETING_INFO_IDX_EXIT:
	call unlock_forum ();

	P_status = status;

	return;
%page;
get_forum_info:
     procedure (no_w_access);

declare	no_w_access		bit (1) aligned,
	access_name		char (32),
	access_time		fixed bin (71),
	idx			fixed bin,
	person_name		char (20);

	if length (rtrim (P_access_name)) > maxlength (access_name)
	then call error (error_table_$bad_arg);
	else access_name = P_access_name;

	access_time = P_access_time;

	forum_info_ptr = P_forum_info_ptr;
	if forum_info_ptr = null () then call error (error_table_$null_info_ptr);

	if forum_info.version ^= forum_info_version_1 then call error (error_table_$unimplemented_version);
	unspec (fmi) = ""b;
	fmi.version = forum_info_version_1;

	fmi.chairman.username = forum_control.chairman.person_id;
	fmi.chairman.project = forum_control.chairman.project_id;
	fmi.chairman.pad = "";

	fmi.attendee_count = forum_control.no_attendees;

	do idx = 1 to forum_control.no_attendees;

	     if forum_control.attendee (idx).removed then fmi.removal_count = fmi.removal_count + 1;
	end;

	if forum_data_ptr ^= null () then fmi.forum_uid = forum_data.forum_control_uid;
	else do;
	     call hcs_$get_uid_seg (forum_control_ptr, fmi.forum_uid, status);
	     if status ^= 0 then call error (status);
	end;

	if access_name = "" then do;
	     person_name = user_name;
	     fmi.eligible = ^no_w_access;
	end;
	else do;
	     person_name = before (access_name, ".");
	     call check_eligible (access_name);
	     attendee_idx = 0;
	end;

	if person_name = "*" then attendee_idx = 0;
	else do idx = 1 to forum_control.no_attendees while (attendee_idx = 0);
		if forum_control.attendee (idx).person_id = person_name then attendee_idx = idx;
	     end;

	if attendee_idx = 0 then return;

	if ^no_w_access then forum_control.attendee (attendee_idx).lock_id = my_lock_id;
	fmi.removed = forum_control.attendee (attendee_idx).removed | forum_control.attendee (attendee_idx).deleted;
	fmi.last_time_attended = forum_control.attendee (attendee_idx).last_time_attended;
	fmi.last_seen_trans_idx = get_highest_seen (forum_control.attendee (attendee_idx).highest_trans_seen,
	     user_name);

	if ^fmi.removed then do;
	     fmi.notify = forum_control.attendee (attendee_idx).notify;
	     fmi.attending = forum_control.attendee (attendee_idx).attending;
	end;
	fmi.adjourned = forum_control.flags.adjourned;

	if no_w_access then return;

	fmi.read_only = ^forum_control.attendee (attendee_idx).write_allowed;
	do idx = forum_control.no_transactions by -1 to 1
	     while (forum_control.transactions (idx).time > access_time);
	end;

	fmi.transaction_count = idx;
	fmi.deletion_count = forum_control.no_deleted;

	if person_name ^= "*" & person_name ^= ""
	then do idx = min (fmi.transaction_count, forum_control.attendee (attendee_idx).highest_trans_seen) + 1
		to forum_control.no_transactions;

		if forum_control.transactions (idx).person_id ^= person_name
		     & ^forum_control.transactions (idx).deleted
		then fmi.changes_count = fmi.changes_count + 1;
	     end;

	idx = forum_control.no_transactions;
	if idx < 1 then return;

	do while (forum_control.transactions (idx).deleted | forum_control.transactions (idx).time > access_time);

	     idx = idx - 1;
	     if idx < 1 then return;
	end;

	fmi.last_time_changed = forum_control.transactions (idx).time;

	return;

     end get_forum_info;
%page;
/* This procedure checks if a person other than the caller is eligible to participate in a forum.  Since we
   require as a condition for a valid forum that the proceedings must have "rw" access if the control
   segment does, and we have already verified that the rings are correct on the control segment, we will
   punt checking to see that access_name has "rw" on both segments.  In fact, we may not even know that the
   second segment exists.  We make no attempt to use a saved pathname since we have a perfectly good pointer
   and we are paranoid about renamings and the like.  We initiated it before it was locked, and only after
   locking can we be sure that the name or ACL won't change.						*/

check_eligible:
     procedure (access_name);

declare	access_name		char (32),
	entryname			char (32),
	modes			fixed bin (5);

	on cleanup call hcs_$level_set (caller_validation);

	call hcs_$level_set (my_validation);

	call hcs_$fs_get_path_name (forum_control_ptr, dirname_buffer, dirname_len, entryname, status);
	if status ^= 0 then call error (status);

	call hcs_$get_user_effmode (directory, entryname, access_name, my_validation, modes, status);
	if status ^= 0 then call error (status);

	if modes = RW_ACCESS_BIN then fmi.eligible = "1"b;

	call hcs_$level_set (caller_validation);

	return;

     end check_eligible;
%page;
v1_forum_mgr_$set_last_seen_idx:
     entry (P_forum_idx, P_last_seen_trans_idx, P_force_switch, P_status);

	call initialize (SET_LAST_SEEN_IDX_EXIT);

	call lookup_forum_idx ();

	last_seen_trans_idx = P_last_seen_trans_idx;
	force_switch = P_force_switch;

	on cleanup call unlock_forum ();

	call lock_forum ();

	if last_seen_trans_idx < 0 | last_seen_trans_idx > forum_control.no_transactions
	then call error (forum_error_table_$invalid_trans_idx);

	call fill_attendee_slot ();

	if ^force_switch
	then last_seen_trans_idx =
		max (last_seen_trans_idx, forum_control.attendee (attendee_idx).highest_trans_seen);

	forum_control.attendee (attendee_idx).highest_trans_seen = last_seen_trans_idx;

	call unlock_forum ();

	P_status = 0;

	return;

SET_LAST_SEEN_IDX_EXIT:
	call unlock_forum ();

	P_status = status;

	return;
%page;
v1_forum_mgr_$list_users:
     entry (P_forum_dir, P_forum_entry, P_area_ptr, P_user_list_ptr, P_status);

	call initialize (LIST_USERS_EXIT);

	call copy_pathname_args ();

	on cleanup call terminate_forum ();

	call initiate_forum ("0"b);
	if no_w_access then call error (forum_error_table_$not_eligible);

	call get_user_list ();

	call terminate_forum ();

	P_status = 0;
	return;

LIST_USERS_EXIT:
	call terminate_forum ();

	P_status = status;
	return;
%page;
v1_forum_mgr_$list_users_idx:
     entry (P_forum_idx, P_area_ptr, P_user_list_ptr, P_status);

	call initialize (LIST_USERS_IDX_EXIT);

	call lookup_forum_idx ();

	on cleanup call unlock_forum ();

	call lock_forum ();

	call fill_attendee_slot ();

	call get_user_list ();

	call unlock_forum ();

	P_status = 0;
	return;

LIST_USERS_IDX_EXIT:
	call unlock_forum ();
	P_status = status;
	return;
%page;
get_user_list:
     procedure;

declare	(idx, jdx)		fixed bin;

	user_list_no_attendees = forum_control.no_attendees;
	allocate user_list in (P_area);

	unspec (user_list) = ""b;
	user_list.version = user_list_version_2;
	user_list.chairman.person_id = forum_control.chairman.person_id;
	user_list.chairman.project_id = forum_control.chairman.project_id;
	user_list.transaction_count = forum_control.no_transactions;

	jdx = 0;
	do idx = 1 to forum_control.no_attendees;
	     if ^forum_control.attendee (idx).deleted then do;
		jdx = jdx + 1;
		if forum_control.attendee (idx).attending then do;	/* check if he's really there */
		     call set_lock_$lock ((forum_control.attendee (idx).lock_id), 0, status);
		     if status ^= error_table_$lock_wait_time_exceeded & status ^= error_table_$locked_by_this_process then do;
			forum_control.attendee (idx).attending = "0"b;
			forum_control.attendee (idx).lock_id = "0"b;
		     end;
		end;

		user_list.attendees (jdx).person_id = forum_control.attendee (idx).person_id;
		user_list.attendees (jdx).project_id = forum_control.attendee (idx).project_id;
		user_list.attendees (jdx).attending = forum_control.attendee (idx).attending;
		user_list.attendees (jdx).notify = forum_control.attendee (idx).notify;
		user_list.attendees (jdx).removed = forum_control.attendee (idx).removed;
		user_list.attendees (jdx).read_only = ^forum_control.attendee (idx).write_allowed;
		user_list.attendees (jdx).last_time_attended =
		     forum_control.attendee (idx).last_time_attended;
		user_list.attendees (jdx).highest_trans_seen =
		     get_highest_seen (forum_control.attendee (idx).highest_trans_seen, forum_control.attendee (idx).person_id);
	     end;
	end;

	user_list.no_attendees = jdx;
	P_user_list_ptr = user_list_ptr;
	return;

     end get_user_list;


get_highest_seen:
     procedure (start, person) returns (fixed bin);

declare	start			fixed bin,
	person			char (22),
	highest			fixed bin,
	done			bit (1) aligned;

	done = "0"b;
	highest = start;
	do while ((highest + 1) <= forum_control.no_transactions & ^done);
	     if (forum_control.transactions (highest + 1).deleted | forum_control.transactions (highest + 1).person_id =
		person) then highest = highest + 1;
	     else done = "1"b;
	end;

	done = "0"b;
	do while (^done & highest ^= 0);
	     if forum_control.transactions (highest).deleted
	     then highest = highest - 1;
	     else done = "1"b;
	end;

	return (highest);
     end get_highest_seen;
%page;
v1_forum_mgr_$change_chairman_idx:
     entry (P_forum_idx, P_chairman, P_status);

	call initialize (CHANGE_CHAIRMAN_IDX_EXIT);

	call lookup_forum_idx ();

	on cleanup call unlock_forum ();

	call lock_forum ();

	privileged = "0"b;
	call change_the_chairman ();

	call unlock_forum ();

	P_status = 0;
	return;

CHANGE_CHAIRMAN_IDX_EXIT:
	call unlock_forum ();
	P_status = status;
	return;
%page;
v1_forum_mgr_$priv_change_chairman:
     entry (P_forum_dir, P_forum_entry, P_chairman, P_status);

	privileged = "1"b;
	goto CC_COMMON;

v1_forum_mgr_$change_chairman:
     entry (P_forum_dir, P_forum_entry, P_chairman, P_status);

	privileged = "0"b;

CC_COMMON:
	call initialize (CHANGE_CHAIRMAN_EXIT);

	call copy_pathname_args ();

	on cleanup call terminate_forum ();

	call initiate_forum ("0"b);

	call change_the_chairman ();

	call terminate_forum ();

	P_status = 0;
	return;

CHANGE_CHAIRMAN_EXIT:
	call terminate_forum ();
	P_status = status;
	return;
%page;
change_the_chairman:
     procedure ();

declare	chairman_name		char (32),
	chairman_personid		char (22),
	chairman_projectid		char (10),
	entryname			char (32);

	if ^privileged then
	     if anon_switch | user_name ^= forum_control.chairman.person_id then
		call error (forum_error_table_$chairman_only);

	if length (rtrim (P_chairman)) > maxlength (chairman_name) then
	     call error (error_table_$bad_arg);
	else chairman_name = P_chairman;

	if index (chairman_name, ".") = 0 |
	     index (chairman_name, ".") > maxlength (chairman_personid) + 1 then
	     call error (error_table_$bad_arg);

	chairman_personid = before (chairman_name, ".");
	chairman_projectid = rtrim (after (chairman_name, "."));

	call lookup_attendee (chairman_personid);

	on cleanup call hcs_$level_set (caller_validation);
	call hcs_$level_set (my_validation);

	if privileged & no_w_access then call force_access ();

	call hcs_$fs_get_path_name (forum_control_ptr, dirname_buffer, dirname_len, entryname, status);
	if status ^= 0 then call error (status);

	segment_acl.access_name = chairman_personid || ".*.*";
	segment_acl.modes = RW_ACCESS;
	segment_acl.xmodes = "0"b;
	segment_acl.status = 0;

	call hcs_$add_acl_entries (directory, entryname, addr (segment_acl), 1, status);
	if status ^= 0 then call error (status);

	entryname = substr (entryname, 1, length (rtrim (entryname)) - length ("control")) || "proceedings";

	call hcs_$add_acl_entries (directory, entryname, addr (segment_acl), 1, status);
	if status ^= 0 then call error (status);

	forum_control.chairman.person_id = chairman_personid;
	forum_control.chairman.project_id = chairman_projectid;

	if privileged & no_w_access then call delete_access ();

	call hcs_$level_set (caller_validation);

	return;
     end change_the_chairman;
%page;
/* Most entrypoints call this procedure to set up for error handling.  The caller's validation level is obtained,
   static "constants" are initialized, the emergency bailout at 30,000 feet label that the "error" procedure transfers
   to is set, and all automatic variables used in cleanup handlers are initialized.				*/

initialize:
     procedure (P_egress);

declare	P_egress			label variable,
	anon			fixed bin;

	egress = P_egress;

	caller_validation = hcs_$level_get ();

	if ^static_initialized then do;
	     my_authorization = get_authorization_ ();
	     my_validation = get_ring_ ();
	     my_process_id = get_process_id_ ();
	     call get_lock_id_ (my_lock_id);
	     call user_info_$login_data (user_name, project, (""), anon, 0, 0, 0, (""));
	     if anon = 1 then do;
		anon_switch = "1"b;
		user_name = "*" || user_name;
	     end;

	     static_initialized = "1"b;
	end;

	forum_control_ptr = null ();
	proceedings_ptr = null ();
	forum_data_ptr = null ();
	attendee_idx = 0;

	return;

     end initialize;



/* This is where we bail out at 30,000 feet by passing in an error code and knowing that this procedure never
   returns.  The label variable "egress" is set in "initialize".						*/

error:
     procedure (P_status);

declare	P_status			fixed bin (35) parameter;

	status = P_status;

	go to egress;

     end error;

force_access:
     procedure ();

	segment_acl.access_name = get_group_id_$tag_star ();
	segment_acl.modes = RW_ACCESS;
	segment_acl.xmodes = ""b;
	call hcs_$add_acl_entries (directory, forum_control_entry, addr (segment_acl), 1, status);
	if status ^= 0 then call error (status);

	return;
     end force_access;

delete_access:
     procedure ();

	delete_acl.access_name = get_group_id_$tag_star ();
	call hcs_$delete_acl_entries (directory, forum_control_entry, addr (delete_acl), 1, (0));

     end delete_access;

     end v1_forum_mgr_$open_forum;




		    v1_forum_seg_mgr_.pl1           04/10/85  0855.3r w 04/08/85  1131.7      167733



/* ***************************************************************
   *						     *
   * Copyright (c) 1982 by Massachusetts Institute of Technology *
   *						     *
   *************************************************************** */

v1_forum_seg_mgr_$create_forum:
     procedure (P_dir_name, P_forum_name, P_code);

/* 11/14/82 Jay Pattin split off from v1_forum_trans_mgr_, changed (add delete)_name to chname */
/* 8/12/83 Jay Pattin added get_uid_file */

declare	(P_access_name		char (*),
	P_acl_ptr			ptr,
	P_acl_count		fixed bin,
	P_code			fixed bin (35),
	P_dir_name		char (*),
	P_forum_idx		fixed bin,
	P_forum_name		char (*),
	P_new_name		char (*),
	P_old_name		char (*),
	P_output_area		ptr,
	P_real_dir		char (*),
	P_real_name		char (*),
	P_uid			bit (36) aligned,
	P_userp			bit (1) aligned,
	P_setp			bit (1) aligned,
	P_writep			bit (1) aligned)
				parameter;

declare	access_name		char (32),
	acl_count			fixed bin,
	acl_ptr			ptr,
	anon_sw			bit (1) aligned,
	attendee_idx		fixed bin,
	code			fixed bin (35),
	created			bit (1) aligned,
	dir_name			char (168),
	dirname_len		fixed bin,
	directory			char (dirname_len) based (addr (dir_name)),
	egress			label variable,
	forum_name		char (32),
	forum_name_len		fixed bin,
	idx			fixed bin,
	inner_ring		fixed bin (3),
	new_name			char (32),
	old_name			char (32),
	old_name_len		fixed bin,
	person_id			char (22),
	privileged		bit (1) aligned,
	proc_name			char (32),
	project_id		char (9),
	real_dir			char (168),
	real_name			char (32),
	user_ring			fixed bin (3);

declare	1 acl_term		aligned based,
	  2 access_name		char (32),
	  2 modes			bit (36),
	  2 xmodes		bit (36),
	  2 status_code		fixed bin (35);

declare	1 one_acl			like acl_term;
declare	1 two_acls		(2) aligned like acl_term;

declare	check_star_name_$entry	entry (char (*), fixed bin (35)),
	v1_forum_mgr_$get_ptrs		entry (fixed bin, ptr, ptr, fixed bin, bit (1) aligned, fixed bin (35)),
	v1_forum_mgr_$initiate		entry (char (*), char (*), bit (1) aligned, ptr, ptr, fixed bin (35)),
	v1_forum_mgr_$terminate	entry (ptr, ptr),
	v1_forum_mgr_$unlock		entry (ptr),
	get_group_id_		entry returns (char (32)),
	get_ring_			entry returns (fixed bin (3)),
	hcs_$add_acl_entries	entry (char (*), char (*), ptr, fixed bin, fixed bin (35)),
	hcs_$append_branch		entry (char (*), char (*), fixed bin (5), fixed bin (35)),
	hcs_$chname_seg		entry (ptr, char (*), char (*), fixed bin (35)),
	hcs_$delentry_file		entry (char (*), char (*), fixed bin (35)),
	hcs_$delentry_seg		entry (ptr, fixed bin (35)),
	hcs_$delete_acl_entries	entry (char(*), char(*), ptr, fixed bin, fixed bin(35)),
	hcs_$fs_get_path_name	entry (ptr, char (*), fixed bin, char (*), fixed bin (35)),
	hcs_$get_link_target	entry (char (*), char (*), char (*), char (*), fixed bin (35)),
	hcs_$get_uid_seg		entry (ptr, bit (36) aligned, fixed bin (35)),
	hcs_$initiate		entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)),
	hcs_$level_get		entry returns (fixed bin (3)),
	hcs_$level_set		entry (fixed bin (3)),
	hcs_$list_acl		entry (char(*), char(*), ptr, ptr, ptr, fixed bin, fixed bin(35)),
	hcs_$replace_acl		entry (char (*), char (*), ptr, fixed bin, bit (1), fixed bin (35)),
	hcs_$status_minf		entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)),
	hcs_$terminate_noname	entry (ptr, fixed bin (35)),
	set_lock_$lock		entry (bit (36) aligned, fixed bin, fixed bin (35)),
	set_lock_$unlock		entry (bit (36) aligned, fixed bin (35)),
	user_info_$login_data	entry (char (*), char (*), char (*), fixed bin, fixed bin, fixed bin,
				fixed bin (71), char (*));

declare	(error_table_$badstar,
	error_table_$namedup,
	error_table_$noentry,
	forum_error_table_$anon_chairman,
	forum_error_table_$blank_forum_name,
	forum_error_table_$chairman_only,
	forum_error_table_$long_forum_name,
	forum_error_table_$no_control_suffix,
	forum_error_table_$not_a_forum,
	forum_error_table_$unexpected_fault,
	forum_error_table_$you_twit)
				fixed bin (35) external static;

declare	(addr, clock, length, null, rtrim, string, substr, unspec)
				builtin;
declare	(any_other, cleanup)	condition;
%page;
%include v1_forum_structures;
%page;
%include access_mode_values;
%page;
	call initialize (CREATE_FORUM_EXIT);

	forum_name = P_forum_name;		/* copy into inner ring */
	dir_name = P_dir_name;
	created = "0"b;
	on cleanup call hcs_$level_set (user_ring);
	call hcs_$level_set (inner_ring);

	call validate_name (forum_name);
	proc_name = substr (forum_name, 1, forum_name_len) || ".proceedings";

	call check_star_name_$entry (forum_name, code);
	if code ^= 0 then call error (error_table_$badstar);

	if anon_sw then call error (forum_error_table_$anon_chairman);

	call hcs_$status_minf (dir_name, forum_name, 0, (0), (0), code);
	if code = 0 then call error (error_table_$namedup);
	else if code ^= error_table_$noentry then call error (code);

	call hcs_$status_minf (dir_name, proc_name, 0, (0), (0), code);
	if code = 0 then call error (error_table_$namedup);
	else if code ^= error_table_$noentry then call error (code);

	created = "1"b;
	call hcs_$append_branch (dir_name, forum_name, RW_ACCESS_BIN, code);
	if code ^= 0 then call error (code);
	call hcs_$append_branch (dir_name, proc_name, RW_ACCESS_BIN, code);
	if code ^= 0 then call error (code);

	two_acls (1).access_name = person_id || ".*.*";
	two_acls (1).modes = RW_ACCESS;
	two_acls (1).xmodes = "0"b;
	two_acls (2).access_name = "*.*.*";		/* Give the world r Access to the forum_control segment */
	two_acls (2).modes = R_ACCESS;
	two_acls (2).xmodes = "0"b;
	call hcs_$replace_acl (dir_name, forum_name, addr (two_acls), 2, "0"b, code);
	if code ^= 0 then call error (code);

	two_acls (2).access_name = "*.*.*";		/* Give the world null Access to the proceedings segment */
	two_acls (2).modes = N_ACCESS;
	two_acls (2).xmodes = "0"b;
	call hcs_$replace_acl (dir_name, proc_name, addr (two_acls), 2, "0"b, code);
	if code ^= 0 then call error (code);

	call hcs_$initiate (dir_name, forum_name, "", 0, 0, forum_control_ptr, code);
	if code ^= 0 then call error (code);
	call set_lock_$lock (forum_control.forum_lock, 3, code);
	if code ^= 0 then call error (code);

	forum_control.next_trans_loc = 0;		/* initialize some stuff */
	string (forum_control.flags) = ""b;
	forum_control.no_transactions = 0;
	forum_control.no_attendees = 1;
	forum_control.no_deleted = 0;
	forum_control.chairman.person_id = person_id;	/* we are the chairman */
	forum_control.chairman.project_id = project_id;
	unspec (forum_control.attendee (1)) = ""b;
	forum_control.attendee (1).person_id = person_id;
	forum_control.attendee (1).project_id = project_id;
	forum_control.attendee (1).last_time_attended = clock ();

	call set_lock_$unlock (forum_control.forum_lock, (0));
	call hcs_$terminate_noname (forum_control_ptr, code);
	if code ^= 0 then call error (code);

	call hcs_$level_set (user_ring);
	P_code = 0;
	return;

CREATE_FORUM_EXIT:
	if created then do;
	     call hcs_$delentry_file (dir_name, forum_name, (0));
	     call hcs_$delentry_file (dir_name, proc_name, (0));
	end;

	P_code = code;
	call hcs_$level_set (user_ring);
	return;
%page;
v1_forum_seg_mgr_$chname_forum:
     entry (P_dir_name, P_forum_name, P_old_name, P_new_name, P_code);

	call initialize (CHNAME_EXIT);
	on cleanup begin;
	     call v1_forum_mgr_$terminate (forum_control_ptr, proceedings_ptr);
	     call hcs_$level_set (user_ring);
	end;
	on any_other call error (forum_error_table_$unexpected_fault);

	call hcs_$level_set (inner_ring);
	call v1_forum_mgr_$initiate (P_dir_name, P_forum_name, "0"b, forum_control_ptr, proceedings_ptr, code);
	if code ^= 0 then call error (code);

	call chname ();

CHNAME_EXIT:
	call v1_forum_mgr_$terminate (forum_control_ptr, proceedings_ptr);
	call hcs_$level_set (user_ring);
	P_code = code;
	return;
	     
v1_forum_seg_mgr_$chname_forum_idx:
     entry (P_forum_idx, P_old_name, P_new_name, P_code);

	call initialize (CHNAME_IDX_EXIT);
	on cleanup begin;
	     call v1_forum_mgr_$unlock (forum_control_ptr);
	     call hcs_$level_set (user_ring);
	end;
	on any_other call error (forum_error_table_$unexpected_fault);

	call hcs_$level_set (inner_ring);
	call v1_forum_mgr_$get_ptrs (P_forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, ("0"b), code);
	if code ^= 0 then call error (code);

	call chname ();

CHNAME_IDX_EXIT:
	call v1_forum_mgr_$unlock (forum_control_ptr);
	call hcs_$level_set (user_ring);
	P_code = code;
	return;
%page;
chname:
     proc ();

	if anon_sw | forum_control.chairman.person_id ^= person_id then
	     call error (forum_error_table_$chairman_only);

	old_name = P_old_name;
	if old_name ^= "" then do;
	     call validate_name (old_name);
	     old_name_len = forum_name_len;
	end;

	new_name = P_new_name;
	if new_name ^= "" then do;
	     call validate_name (new_name);
	     call check_star_name_$entry (new_name, code);
	     if code ^= 0 then call error (error_table_$badstar);
	end;

	call hcs_$chname_seg (forum_control_ptr, old_name, new_name, code);
	if code ^= 0 then call error (code);

	if old_name ^= "" then
	     old_name = substr (old_name, 1, old_name_len) || ".proceedings";
	if new_name ^= "" then
	     new_name = substr (new_name, 1, forum_name_len) || ".proceedings";

	call hcs_$chname_seg (proceedings_ptr, old_name, new_name, code);
	if code ^= 0 then call error (code);

	return;
     end chname;
%page;
v1_forum_seg_mgr_$priv_delete_forum:
     entry (P_dir_name, P_forum_name, P_code);

	privileged = "1"b;
	goto DELETE_COMMON;

v1_forum_seg_mgr_$delete_forum:
     entry (P_dir_name, P_forum_name, P_code);

	privileged = "0"b;

DELETE_COMMON:
	call initialize (DELETE_FORUM_EXIT);

	on any_other call error (forum_error_table_$unexpected_fault);
	on cleanup call hcs_$level_set (user_ring);

	call hcs_$level_set (inner_ring);
	call force_acl ();				/* This will fail if no 'm' permission on dir */

	call v1_forum_mgr_$initiate (P_dir_name, P_forum_name, "1"b, forum_control_ptr, proceedings_ptr, code);
	if code ^= 0 then call error (code);		/* Get pointers to forums */

	unspec (forum_control.chairman) = ""b;

/* From here on this is no longer a valid forum... if we blow out from here down, a
   System maintainer will have to flush the thing */

	call hcs_$delentry_seg (forum_control_ptr, code);
	call hcs_$delentry_seg (proceedings_ptr, code);

DELETE_FORUM_EXIT:
	call hcs_$level_set (user_ring);
	P_code = code;
	return;
%page;
v1_forum_seg_mgr_$priv_set_forum_acl:
     entry (P_dir_name, P_forum_name, P_access_name, P_userp, P_setp, P_writep, P_code);

	privileged = "1"b;
	call initialize (SET_FORUM_ACL_EXIT);

	on any_other call error (forum_error_table_$unexpected_fault);
	call force_acl ();

	on cleanup begin;
	     call v1_forum_mgr_$terminate (forum_control_ptr, proceedings_ptr);
	     call hcs_$level_set (user_ring);
	end;

	call hcs_$level_set (inner_ring);
	call v1_forum_mgr_$initiate (P_dir_name, P_forum_name, "1"b, forum_control_ptr, proceedings_ptr, code);
	if code ^= 0 then call error (code);

	access_name = P_access_name;			/* So he can remove own acl */
	if P_userp & access_name = person_id then call v1_forum_mgr_$unlock (forum_control_ptr);

	goto SET_ACL_COMMON;



v1_forum_seg_mgr_$set_forum_acl:
     entry (P_forum_idx, P_access_name, P_userp, P_setp, P_writep, P_code);

	privileged = "0"b;
	call initialize (SET_FORUM_ACL_EXIT);

	on cleanup begin;
	     call v1_forum_mgr_$unlock (forum_control_ptr);
	     call hcs_$level_set (user_ring);
	end;
	on any_other call error (forum_error_table_$unexpected_fault);

	call hcs_$level_set (inner_ring);
	call v1_forum_mgr_$get_ptrs (P_forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, ("0"b), code);
	if code ^= 0 then call error (code);
	if anon_sw | forum_control.chairman.person_id ^= person_id then call error (forum_error_table_$chairman_only);
	access_name = P_access_name;
	if ((^P_setp & P_userp) | (P_setp & ^P_writep)) & access_name = person_id
	     then call error (forum_error_table_$you_twit);

SET_ACL_COMMON:
	if P_userp then one_acl.access_name = rtrim (access_name) || ".*.*";
	else one_acl.access_name = "*." || rtrim (access_name) || ".*";
	if P_setp then one_acl.modes = RW_ACCESS;
	else one_acl.modes = R_ACCESS;
	one_acl.xmodes = "0"b;
	call hcs_$fs_get_path_name (forum_control_ptr, dir_name, (0), forum_name, code);
	if code ^= 0 then call error (code);
	forum_name_len = length (rtrim (forum_name)) - length (".control");

	call hcs_$add_acl_entries (dir_name, forum_name, addr (one_acl), 1, code);
	if code ^= 0 then call error (code);

	if P_setp & ^P_writep then one_acl.modes = R_ACCESS;
	else if ^P_setp then one_acl.modes = N_ACCESS;	/* When removing people, leave them r access to forum_control segment
	     					   but null access to proceedings segment */

	call hcs_$add_acl_entries (dir_name, substr (forum_name, 1, forum_name_len) || ".proceedings",
	     addr (one_acl), 1, code);
	if code ^= 0 then call error (code);

	do idx = 1 to forum_control.no_attendees;
	     forum_control.attendee (idx).acl_change_pending = "1"b;
	end;
	if ^privileged then forum_control.attendee (attendee_idx).acl_change_pending = "0"b;

SET_FORUM_ACL_EXIT:

	if privileged then do;
	     call delete_forced_acl ();
	     call v1_forum_mgr_$terminate (forum_control_ptr, proceedings_ptr);
	end;
	else call v1_forum_mgr_$unlock (forum_control_ptr);

	call hcs_$level_set (user_ring);
	P_code = code;
	return;
%page;
validate_name:
     proc (name);

declare	name			char (32);

	if name = "" then call error (forum_error_table_$blank_forum_name);
	forum_name_len = length (rtrim (name)) - length (".control");
	if forum_name_len < 1 then
	     call error (forum_error_table_$no_control_suffix);
	else if forum_name_len > 20 then call error (forum_error_table_$long_forum_name);
	if substr (name, forum_name_len + 1) ^= ".control" then
	     call error (forum_error_table_$no_control_suffix);

	return;
     end validate_name;


force_acl:
	procedure ();

	one_acl.access_name = get_group_id_ ();
	one_acl.modes = RW_ACCESS;
	one_acl.xmodes = ""b;

	call hcs_$add_acl_entries (P_dir_name, P_forum_name, addr (one_acl), 1, code);
	if code ^= 0 then
	     if code = error_table_$noentry then call error (forum_error_table_$not_a_forum);
	     else call error (code);

	forum_name_len = length (rtrim (P_forum_name)) - length (".control");
	call hcs_$add_acl_entries (P_dir_name, substr (P_forum_name, 1, forum_name_len) || ".proceedings",
	     addr (one_acl), 1, code);
	if code ^= 0 then 
	     if code = error_table_$noentry then call error (forum_error_table_$not_a_forum);
	     else call error (code);

	return;
     end force_acl;

delete_forced_acl:
     procedure ();

declare	1 delete_acls		aligned,
	2 access_name		char (32),
	2 status			fixed bin (35);

	delete_acls.access_name = get_group_id_ ();
	call hcs_$delete_acl_entries (P_dir_name, P_forum_name, addr (delete_acls), 1, (0));

	forum_name_len = length (rtrim (P_forum_name)) - length (".control");
	call hcs_$delete_acl_entries (P_dir_name, substr (P_forum_name, 1, forum_name_len) || ".proceedings",
	     addr (delete_acls), 1, (0));

	return;
     end delete_forced_acl;
%page;
v1_forum_seg_mgr_$list_forum_acl:
     entry (P_dir_name, P_forum_name, P_output_area, P_acl_ptr, P_acl_count, P_code);

	call initialize (LIST_ACL_EXIT);

	dir_name = P_dir_name;
	forum_name = P_forum_name;
	call validate_name (forum_name);

	forum_name = substr (forum_name, 1, forum_name_len) || ".proceedings";
	on cleanup call hcs_$level_set (user_ring);
	call hcs_$level_set (inner_ring);

	call hcs_$list_acl (dir_name, forum_name, P_output_area, acl_ptr, null (), acl_count, code);
	if code ^= 0 then call error (code);
	call hcs_$level_set (user_ring);

	P_acl_ptr = acl_ptr;
	P_acl_count = acl_count;
	P_code = 0;
	return;

LIST_ACL_EXIT:
	call hcs_$level_set (user_ring);
	P_acl_ptr = null ();
	P_acl_count = 0;
	P_code = code;
	return;
%page;
v1_forum_seg_mgr_$get_forum_path:
     entry (P_dir_name, P_forum_name, P_real_dir, P_real_name, P_code);

	call initialize (GET_MEETING_PATH_EXIT);
	dir_name = P_dir_name;
	forum_name = P_forum_name;
	call validate_name (forum_name);
	
	on cleanup call hcs_$level_set (user_ring);
	call hcs_$level_set (inner_ring);

	call hcs_$get_link_target (dir_name, forum_name, real_dir, real_name, code);
	if code ^= 0 then call error (code);
	call validate_name (real_name);		/* make sure target is validly named */

	call hcs_$level_set (user_ring);
	P_real_dir = real_dir;
	P_real_name = real_name;
	P_code = 0;
	return;

GET_MEETING_PATH_EXIT:
	call hcs_$level_set (user_ring);
	P_real_dir = "";
	P_real_name = "";
	P_code = code;
	return;
%page;
v1_forum_seg_mgr_$get_forum_path_idx:
     entry (P_forum_idx, P_real_dir, P_real_name, P_code);

	call initialize (GET_MEETING_PATH_EXIT);

	on cleanup call v1_forum_mgr_$unlock (forum_control_ptr);

	call v1_forum_mgr_$get_ptrs (P_forum_idx, forum_control_ptr, proceedings_ptr, (0), ("0"b), code);
	if code ^= 0 then call error (code);

	call hcs_$fs_get_path_name (forum_control_ptr, dir_name, dirname_len, real_name, code);
	if code ^= 0 then call error (code);

	call v1_forum_mgr_$unlock (forum_control_ptr);
	P_real_dir = directory;
	P_real_name = real_name;
	P_code = 0;
	return;
%page;
v1_forum_seg_mgr_$get_uid_file:
     entry (P_dir_name, P_forum_name, P_uid, P_code);

	call initialize (UID_EXIT);
	on cleanup begin;
	     call v1_forum_mgr_$terminate (forum_control_ptr, proceedings_ptr);
	     call hcs_$level_set (user_ring);
	end;
	on any_other call error (forum_error_table_$unexpected_fault);

	call hcs_$level_set (inner_ring);
	call v1_forum_mgr_$initiate (P_dir_name, P_forum_name, "0"b, forum_control_ptr, proceedings_ptr, code);
	if code ^= 0 then call error (code);

	call hcs_$get_uid_seg (forum_control_ptr, P_uid, code);
	if code ^= 0 then call error (code);
	
UID_EXIT:	call v1_forum_mgr_$terminate (forum_control_ptr, proceedings_ptr);
	call hcs_$level_set (user_ring);
	P_code = code;
	return;
%page;
initialize:
     procedure (P_egress);

declare	P_egress			label variable,
	anon			fixed bin;

	egress = P_egress;
	inner_ring = get_ring_ ();
	user_ring = hcs_$level_get ();
	call user_info_$login_data (person_id, project_id, (""), anon, 0, 0, 0, (""));
	anon_sw = (anon = 1);

	forum_control_ptr, proceedings_ptr = null ();	/* no forum initialized yet, this call */
	code = 0;					/* no errors yet either */

	return;
     end initialize;

error:
     procedure (error_code);

declare	error_code		fixed bin (35);

	code = error_code;
	goto egress;				/* lets PUNT */

     end error;

end v1_forum_seg_mgr_$create_forum;




		    v1_forum_trans_mgr_.pl1         10/30/84  1244.0r   10/30/84  0958.6      228510



/* ***************************************************************
   *                                                             *
   * Copyright (c) 1982 by Massachusetts Institute of Technology *
   *                                                             *
   *************************************************************** */


/* 
 * v1_forum_trans_mgr_ Manager of forum transactions.  We call v1_forum_mgr_ to initiate or otherwise
    deal with forums as a whole */

/* Original code By Mike Auerbach and Jeff Schiller
   1/82 Jay Pattin Many changes for forum and general reorganization
   2/16/82 Jay Pattin added list_acl
   3/29/82 Jay Pattin added privileged entries
   4/16/82 Jay Pattin added force_acl to make privileged entries work correctly
   5/05/82 Jay Pattin added support for read only participants
   8/20/82 Jay Pattin to check entry names and anonymous users
   10/9/82 Jay Pattin added trans_time_info, user deletion of own transactions
   11/14/82 Jay Pattin split off forum_space_mgr_.
   8/5/83 Jay Pattin new notifications */

v1_forum_trans_mgr_$enter_trans:
     procedure (a_forum_idx, a_input_string, a_previous_trans, a_subject, a_filled_sw, a_trans_no, a_code);

declare	(a_attendee_idx		fixed bin,
	a_code			fixed bin (35),	/* returned status code */
	a_deleted_sw		bit (1) aligned,
	a_filled_sw		bit (1) aligned,
	a_first_trans_idx		fixed bin,
	a_flags_word		bit (36) aligned,
	a_forum_idx		fixed bin,	/* index in forum data of this forum */
	(a_high_time, a_low_time)	fixed bin (71),
	(a_high_trans, a_low_trans)	fixed bin,
	a_input_string		char (*),
	a_last_trans_idx		fixed bin,
	a_last_seen_trans_idx	fixed bin,
	a_new_trans_count		fixed bin,
	a_output_area		ptr,		/* pointer to area to allocate text in */
	a_output_ptr		ptr,		/* pointer to transaction structure (output) */
	(a_pref, a_nref)		fixed bin,
	a_previous_trans		fixed bin,	/* transaction to chain this one from, 0 if none */
	a_subject			char (*),
	a_trans_no		fixed bin,
	a_type			fixed bin,
	a_uid			bit (36) aligned,
	a_user_name		char (*),
	a_value_sw		bit (1) aligned) parameter;

declare	anon_sw			bit (1) aligned,
	attendee_idx		fixed bin,	/* index into attendee part of forum */
	chairman			bit (1) aligned,
	code			fixed bin (35),
	dir_name			char (168),
	done			bit (1) aligned,
	forum_idx			fixed bin,
	forum_name		char (32),
	input_len			fixed bin,
	(high_time, low_time)	fixed bin (71),
	(high_trans, low_trans)	fixed bin,
	i			fixed bin,
	message			char (256),
	new_trans_count		fixed bin,
	next_trans_ptr		ptr,		/* pointer to next transaction in proceedings segment */
	person_id			char (22),
	(nref, pref)		fixed bin,
	project_id		char (9),
	transx			fixed bin,
	trans_no			fixed bin,
	trans_ptr			ptr,		/* pointer to transaction in proceedings segment */
	type			fixed bin,
	uid			bit (36) aligned,
	user_name			char (32),
	value_sw			bit (1) aligned,
	(write_allowed, privileged)	bit (1) aligned,
	(any_other, area, out_of_bounds, record_quota_overflow, seg_fault_error, cleanup)
				condition,
	(addr, clock, rtrim, length, null, ptr, substr)
				builtin;

declare	v1_forum_mgr_$get_ptrs		entry (fixed bin, ptr, ptr, fixed bin, bit (1) aligned, fixed bin (35)),
	v1_forum_mgr_$unlock		entry (ptr),
	forum_notify_gate_$lookup	entry (char (*), bit (1) aligned, fixed bin (35)),
	hcs_$fs_get_path_name	entry (ptr, char (*), fixed bin, char (*), fixed bin (35)),
	hcs_$force_write		entry (ptr, bit (36), fixed bin (35)),
	hcs_$get_uid_seg		entry (ptr, bit (36) aligned, fixed bin (35)),
	hcs_$wakeup		entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)),
	ioa_$rsnnl		entry options (variable),
	send_mail_		entry (char (*), char (*), ptr, fixed bin (35)),
	user_info_$login_data	entry (char (*), char (*), char (*), fixed bin, fixed bin, fixed bin,
				fixed bin (71), char (*));

declare	(error_table_$noalloc,
	error_table_$seg_busted)	fixed bin (35) external;

declare	(forum_error_table_$cant_notify,
	forum_error_table_$no_message,
	forum_error_table_$message_too_long,
	forum_error_table_$incorrect_uid,
	forum_error_table_$meeting_bloat,
	forum_error_table_$invalid_trans_idx,
	forum_error_table_$read_only,
	forum_error_table_$rqo,
	forum_error_table_$trans_deleted,
	forum_error_table_$chairman_only,
	forum_error_table_$trans_reaped,
	forum_error_table_$invalid_att_idx,
	forum_error_table_$unexpected_fault)
				fixed bin (35) external;

declare	(forum_data_$print_eligibility_messages,
	forum_data_$chairman_override)
				bit (1) aligned external;

declare	egress			label variable,
	output_area		area based (a_output_area),
	proceeding_string		char (alloc_text_length) based (trans_ptr),
	transaction		char (input_len) based;
%page;
%include v1_forum_structures;
%page;
%include forum_flags;
%page;
%include forum_user_trans;
%page;
%include send_mail_info;
%page;
/* v1_forum_trans_mgr_$enter_trans:
     entry (a_forum_idx, a_input_string, a_previous_trans,	a_subject, a_filled_sw, a_trans_no, a_code); */

	forum_idx = a_forum_idx;			/* copy for safety against user ring */

	call initialize (ENTER_PUNT);

	on cleanup call v1_forum_mgr_$unlock (forum_control_ptr);
	on seg_fault_error call error (error_table_$seg_busted);
	on any_other call error (forum_error_table_$unexpected_fault);

	call v1_forum_mgr_$get_ptrs (forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, write_allowed, code);
	if code ^= 0 then call error (code);
	if ^write_allowed then call error (forum_error_table_$read_only);

	next_trans_ptr = ptr (proceedings_ptr, forum_control.next_trans_loc);
	on out_of_bounds call error (forum_error_table_$meeting_bloat);
	on record_quota_overflow call error (forum_error_table_$rqo);

	input_len = length (a_input_string);

	next_trans_ptr -> transaction = a_input_string;

	revert out_of_bounds;

	call hcs_$force_write (proceedings_ptr, (""b), (0));

	transx = forum_control.no_transactions + 1;

	forum_control.transactions (transx).offset = forum_control.next_trans_loc;
	forum_control.transactions (transx).length = input_len;

	forum_control.transactions (transx).person_id = forum_control.attendee (attendee_idx).person_id;
	forum_control.transactions (transx).project_id = forum_control.attendee (attendee_idx).project_id;
	forum_control.transactions (transx).time = clock ();
	forum_control.transactions (transx).subject = a_subject;
	forum_control.transactions (transx).prior_ref_index,
	     forum_control.transactions (transx).next_ref_index = 0;
	forum_control.transactions (transx).unfilled = a_filled_sw;
	forum_control.transactions (transx).deleted,
	     forum_control.transactions (transx).gone = "0"b;

	pref = a_previous_trans;			/* copy into lower ring */

	if pref ^= 0 then /* link this transaction into reply chain if apropriate */
	     do;
		do while (forum_control.transactions (pref).next_ref_index ^= 0);
		     pref = forum_control.transactions (pref).next_ref_index;
		end;
		forum_control.transactions (pref).next_ref_index = transx;
		forum_control.transactions (transx).prior_ref_index = pref;
	     end;

	forum_control.next_trans_loc = forum_control.next_trans_loc + (input_len + 3) / 4;
	a_trans_no, forum_control.no_transactions = transx;    /* atomic commit point */

	revert seg_fault_error;
	revert record_quota_overflow;
	on any_other call error (forum_error_table_$cant_notify);

	call hcs_$get_uid_seg (forum_control_ptr, uid, code);
	if code ^= 0 then call error (code);

	msg_ptr = addr (forum_message);
	forum_message.forum_uid = uid;		/* for validation purposes */
	forum_message.index = attendee_idx;

	call hcs_$fs_get_path_name (forum_control_ptr, dir_name, (0), forum_name, code);
	if code ^= 0 then call error (code);

	forum_name = substr (forum_name, 1, length (rtrim (forum_name)) - length (".control"));
	call ioa_$rsnnl ("A new transaction has just been added to the ^a>^a meeting.", message, (0),
	     dir_name, forum_name);

	send_mail_info.version = 2;
	send_mail_info.sent_from = "forum";
	string (send_mail_info.switches) = ""b;
	send_mail_info.wakeup, send_mail_info.always_add = "1"b;

	do transx = 1 to forum_control.no_attendees;
	     if transx = attendee_idx then goto NEXT;
	     if forum_control.attendee (transx).attending & ^forum_control.attendee (transx).removed then
		call hcs_$wakeup (forum_control.attendee (transx).process_id,
		     forum_control.attendee (transx).public_wakeup_chan, ipc_message, (0));
	     else if forum_control.attendee (transx).notify & ^forum_control.attendee (transx).removed then do;
		call forum_notify_gate_$lookup (forum_control.attendee (transx).person_id, done, code);
		if done & code = 0 then
		     call send_mail_ (rtrim (forum_control.attendee (transx).person_id) || "." ||
			rtrim (forum_control.attendee (transx).project_id),
			rtrim (message), addr (send_mail_info), (0));
	     end;
NEXT:	end;
	code = 0;

ENTER_PUNT:

	call v1_forum_mgr_$unlock (forum_control_ptr);
	a_code = code;
	return;
%page;
v1_forum_trans_mgr_$read_trans:
     entry (a_forum_idx, a_trans_no, a_output_area, a_output_ptr, a_code);

	trans_no = a_trans_no;			/* copy trans_no to inner ring */

	call initialize (READ_PUNT);

	on cleanup call v1_forum_mgr_$unlock (forum_control_ptr);
	on seg_fault_error call error (error_table_$seg_busted);
	on any_other call error (forum_error_table_$unexpected_fault);

	call v1_forum_mgr_$get_ptrs (a_forum_idx, forum_control_ptr, proceedings_ptr,
	     attendee_idx, (""b), code);
	if code ^= 0 then call error (code);

	if trans_no < 1 | trans_no > forum_control.no_transactions then
	     call error (forum_error_table_$invalid_trans_idx);

	if forum_control.transactions (trans_no).deleted then
	     if person_id ^= forum_control.chairman.person_id & person_id ^= forum_control.transactions (trans_no).person_id then
		call error (forum_error_table_$trans_deleted);
	     else if forum_control.transactions (trans_no).gone then call error (forum_error_table_$trans_reaped);

	alloc_subject_length = length (forum_control.transactions (trans_no).subject);
	alloc_text_length = forum_control.transactions (trans_no).length;

	on area call error (error_table_$noalloc);
	allocate forum_user_trans in (output_area) set (forum_user_trans_ptr); /* allocate structure in desired area */
	revert area;

	trans_ptr = ptr (proceedings_ptr, forum_control.transactions (trans_no).offset);

	forum_user_trans.type = user_trans_type;
	forum_user_trans.person_id = forum_control.transactions (trans_no).person_id;
	forum_user_trans.project_id = forum_control.transactions (trans_no).project_id;
	forum_user_trans.trans_no = trans_no;
	forum_user_trans.time = forum_control.transactions (trans_no).time;
	forum_user_trans.prev_trans_ptr, forum_user_trans.next_trans_ptr = null (); /* these are used by user ring code */
	forum_user_trans.subject = forum_control.transactions (trans_no).subject;
	forum_user_trans.text = proceeding_string;
	forum_user_trans.unfilled = forum_control.transactions (trans_no).unfilled;

	if forum_control.transactions (trans_no).deleted then a_code = forum_error_table_$trans_deleted;
	else a_code = 0;

	a_output_ptr = forum_user_trans_ptr;
	call v1_forum_mgr_$unlock (forum_control_ptr);
	return;

READ_PUNT:
	call v1_forum_mgr_$unlock (forum_control_ptr);
	a_output_ptr = null ();
	a_code = code;
	return;
%page;
v1_forum_trans_mgr_$set_message:
     entry (a_forum_idx, a_input_string, a_code);

	forum_idx = a_forum_idx;

	call initialize (SET_MESSAGE_EXIT);

	on cleanup call v1_forum_mgr_$unlock (forum_control_ptr);
	on any_other call error (forum_error_table_$unexpected_fault);

	if length (a_input_string) > 256 then call error (forum_error_table_$message_too_long);

	call v1_forum_mgr_$get_ptrs (forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, ("0"b), code);
	if code ^= 0 then call error (code);

	if anon_sw | forum_control.chairman.person_id ^= person_id then
	     call error (forum_error_table_$chairman_only);

	input_len = 256;

	if ^forum_control.flags.msg_init then do;
	     next_trans_ptr = ptr (proceedings_ptr, forum_control.next_trans_loc);
	     forum_control.message_loc = forum_control.next_trans_loc;
	     forum_control.next_trans_loc = forum_control.next_trans_loc + 64;
	     forum_control.flags.msg_init = "1"b;
	     next_trans_ptr -> transaction = "";
	end;
	
	next_trans_ptr = ptr (proceedings_ptr, forum_control.message_loc);

	on out_of_bounds call error (forum_error_table_$meeting_bloat);
	next_trans_ptr -> transaction = a_input_string;
	revert out_of_bounds;

	do attendee_idx = 1 to forum_control.no_attendees;
	     forum_control.attendee (attendee_idx).message_changed = "1"b;
	end;

	code = 0;

SET_MESSAGE_EXIT:
	call v1_forum_mgr_$unlock (forum_control_ptr);
	a_code = code;
	return;
%page;
v1_forum_trans_mgr_$get_message:
     entry (a_forum_idx, a_input_string, a_code);

	forum_idx = a_forum_idx;
	call initialize (GET_MESSAGE_EXIT);

	on cleanup call v1_forum_mgr_$unlock (forum_control_ptr);
	on any_other call error (forum_error_table_$unexpected_fault);

	call v1_forum_mgr_$get_ptrs (forum_idx, forum_control_ptr, proceedings_ptr, (0), ("0"b), code);
	if code ^= 0 then call error (code);

	if ^forum_control.flags.msg_init then call error (forum_error_table_$no_message);

	trans_ptr = ptr (proceedings_ptr, forum_control.message_loc);

	input_len = 256;
	a_input_string = trans_ptr -> transaction;

GET_MESSAGE_EXIT:
	call v1_forum_mgr_$unlock (forum_control_ptr);
	a_code = code;
	if code ^= 0 then a_input_string = "";
	return;
%page;
v1_forum_trans_mgr_$trans_time_info:
     entry (a_forum_idx, a_low_time, a_high_time, a_low_trans, a_high_trans, a_code);

	call initialize (TRANS_REF_PUNT);

	on any_other call error (forum_error_table_$unexpected_fault);
	on cleanup call v1_forum_mgr_$unlock (forum_control_ptr);

	call v1_forum_mgr_$get_ptrs (a_forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, ("0"b), code);
	if code ^= 0 then call error (code);

	low_time = a_low_time;
	high_time = a_high_time;
	low_trans = 1;
	high_trans = forum_control.no_transactions;

	if high_time ^= 0 & high_time < forum_control.transactions (1).time then high_trans = 0;
	else if low_time > forum_control.transactions (high_trans).time then low_trans = high_trans;
	else do;
	     if low_time > forum_control.transactions (1).time then low_trans = find (low_time, 1, (high_trans));
	     if high_time ^= 0 & high_time < forum_control.transactions (high_trans).time then
		high_trans = find (high_time, (low_trans), (high_trans)) + 1;
	end;

	a_high_trans = high_trans;
	a_low_trans = low_trans;
	call v1_forum_mgr_$unlock (forum_control_ptr);
	a_code = 0;
	return;


find:	proc (t, low, high) returns (fixed bin);

declare	t			fixed bin (71),
	(idx, low, high, h, l)	fixed bin;

	do idx = (high + low) / 2 repeat idx;
	     if forum_control.transactions (idx).time = 0 then do;	/* The garbage collector has been here */
		do h = idx to high while (forum_control.transactions (h).time = 0);
		end;
		do l = idx to low by -1 while (forum_control.transactions (l).time = 0);
		end;
		if t < forum_control.transactions (h).time then high = l;
		else low = h;
	     end;
	     else if forum_control.transactions (idx).time < t then do;
		if forum_control.transactions (idx + 1).time > t then return (idx);
		else do;
		     low = idx;
		     idx = idx + (high - idx) / 2;
		end;
	     end;
	     else if forum_control.transactions (idx - 1).time < t then return (idx - 1);
	     else do;
		high = idx;
		idx = idx - (idx - low) / 2;
	     end;
	end;
     end find;
%page;
v1_forum_trans_mgr_$real_trans_ref_info:
     entry (a_forum_idx, a_trans_no, a_type, a_pref, a_nref, a_deleted_sw, a_code);

	type = a_type;
	goto TRANS_REF_COMMON;

v1_forum_trans_mgr_$trans_ref_info:
     entry (a_forum_idx, a_trans_no, a_pref, a_nref, a_deleted_sw, a_code);

	type = ONLY_UNDELETED;

TRANS_REF_COMMON:
	call initialize (TRANS_REF_PUNT);

	on any_other call error (forum_error_table_$unexpected_fault);

	on cleanup call v1_forum_mgr_$unlock (forum_control_ptr);

	call v1_forum_mgr_$get_ptrs (a_forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, ("0"b), code);
	if code ^= 0 then call error (code);

	trans_no = a_trans_no;			/* copy this argument into the inner ring */

	if trans_no < 1 | trans_no > forum_control.no_transactions then
	     call error (forum_error_table_$invalid_trans_idx);
	if forum_control.transactions (trans_no).gone then
	     call error (forum_error_table_$trans_reaped);

	chairman = (person_id = forum_control.chairman.person_id);
	pref, nref = -1;				/* so loops work */

	done = "0"b;
	do i = trans_no repeat pref while (^done & pref ^= 0);
	     pref = forum_control.transactions (i).prior_ref_index;
	     call check (pref);
	end; 

	done = "0"b;
	do i = trans_no repeat nref while (^done & nref ^= 0);
	     nref = forum_control.transactions (i).next_ref_index;
	     call check (nref);
	end;

	a_pref = pref;
	a_nref = nref;
	a_deleted_sw = forum_control.transactions (trans_no).deleted;

TRANS_REF_PUNT:
	call v1_forum_mgr_$unlock (forum_control_ptr);
	if code ^= 0 then do;
	     a_pref, a_nref = 0;
	     a_deleted_sw = "0"b;
	end;
	a_code = code;
	return;
%page;
v1_forum_trans_mgr_$set_delete_sw:
     entry (a_forum_idx, a_trans_no, a_value_sw, a_code);

	call initialize (SET_DELETE_EXIT);

	on any_other call error (forum_error_table_$unexpected_fault);

	on cleanup call v1_forum_mgr_$unlock (forum_control_ptr);

	value_sw = a_value_sw;			/* copy into inner ring */

	call v1_forum_mgr_$get_ptrs (a_forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, ("0"b), code);
	if code ^= 0 then call error (code);

	trans_no = a_trans_no;			/* copy this to inner ring */

	if trans_no < 1 | trans_no > forum_control.no_transactions then
	     call error (forum_error_table_$invalid_trans_idx);

	if forum_control.transactions (trans_no).gone & ^value_sw then
	     call error (forum_error_table_$trans_reaped);	/* transaction has been reaped by garbage collection */

	if person_id = forum_control.transactions (trans_no).person_id then privileged = "0"b;	/* so chair can retrieve own */
	else if ^anon_sw & person_id = forum_control.chairman.person_id then privileged = "1"b;
	else call error (forum_error_table_$chairman_only);

	if ^value_sw & ^privileged & ^forum_control.transactions (trans_no).deleted_by_author then
	     call error (forum_error_table_$chairman_only);

	forum_control.transactions (trans_no).deleted_by_author = value_sw & ^privileged &
	     (^forum_control.transactions (trans_no).deleted | value_sw);

	if forum_control.transactions (trans_no).deleted & value_sw then goto SET_DELETE_EXIT;
	if ^forum_control.transactions (trans_no).deleted & ^value_sw then goto SET_DELETE_EXIT;

	forum_control.transactions (trans_no).deleted = value_sw; /* well one way or the other... */

	if value_sw then forum_control.no_deleted = forum_control.no_deleted + 1;
	else forum_control.no_deleted = forum_control.no_deleted - 1;

SET_DELETE_EXIT:

	call v1_forum_mgr_$unlock (forum_control_ptr);
	a_code = code;
	return;
%page;
v1_forum_trans_mgr_$forum_limits:
     entry (a_forum_idx, a_last_seen_trans_idx, a_first_trans_idx,
	a_last_trans_idx, a_new_trans_count, a_flags_word, a_code);

	type = ONLY_UNDELETED;
	goto LIMITS_COMMON;

v1_forum_trans_mgr_$real_forum_limits:
     entry (a_forum_idx, a_type, a_last_seen_trans_idx, a_first_trans_idx,
	a_last_trans_idx, a_new_trans_count, a_flags_word, a_code);

	type = a_type;

LIMITS_COMMON:
	call initialize (FORUM_LIMITS_PUNT);

	on cleanup call v1_forum_mgr_$unlock (forum_control_ptr);

	call v1_forum_mgr_$get_ptrs (a_forum_idx, forum_control_ptr,
	     proceedings_ptr, attendee_idx, ("0"b), code);
	if code ^= 0 then call error (code);

	chairman = (^anon_sw & forum_control.chairman.person_id = person_id);
	forum_flags_word = ""b;
	forum_flags.chairman = chairman;
	forum_flags.adjourned = forum_control.flags.adjourned;
	forum_flags.read_only = ^forum_control.attendee (attendee_idx).write_allowed;
	forum_flags.print_cm_message = forum_control.attendee (attendee_idx).message_changed;
	forum_flags.acl_has_changed = forum_control.attendee (attendee_idx).acl_change_pending;

/* The following statement is dedicated to IS-14 and HBD */

	forum_flags.print_acl_message = forum_control.cm_print_acl_msg | (forum_control.am_init & forum_control.am_print_acl_msg) |
	     (forum_data_$print_eligibility_messages & ^(forum_control.am_init & ^forum_control.am_print_acl_msg) &
	     ^(forum_data_$chairman_override & forum_control.cm_init & ^forum_control.cm_print_acl_msg));

	a_flags_word = forum_flags_word;

	if forum_control.attendee (attendee_idx).highest_trans_seen < 0 |
	     forum_control.attendee (attendee_idx).highest_trans_seen > forum_control.no_transactions then
	     	forum_control.attendee (attendee_idx).highest_trans_seen, a_last_seen_trans_idx = 0;

	else a_last_seen_trans_idx = get_highest_seen ((forum_control.attendee (attendee_idx).highest_trans_seen));

	done = "0"b;
	do i = 1 repeat i + 1 while (^done & i <= forum_control.no_transactions);
	     call check (i);
	end;
	if ^done then a_first_trans_idx = 0;
	else a_first_trans_idx = i - 1;

	done = "0"b;
	do i = forum_control.no_transactions repeat i - 1 while (^done & i ^= 0);
	     call check (i);
	end;
	a_last_trans_idx = i + 1;

	new_trans_count = 0;
	do i = a_last_seen_trans_idx + 1 to forum_control.no_transactions;
	     if forum_control.transactions (i).person_id ^= person_id &
		^forum_control.transactions (i).deleted then
		new_trans_count = new_trans_count + 1;
	end;

	a_new_trans_count = new_trans_count;

FORUM_LIMITS_PUNT:
	call v1_forum_mgr_$unlock (forum_control_ptr);
	a_code = code;
	return;
%page;
check:	proc (idx);

declare	idx			fixed bin,
	del			bit (1) aligned;

	if forum_control.transactions (idx).gone then return;
	del = forum_control.transactions (idx).deleted;
	if type = ONLY_UNDELETED & del then return;
	else if type = ONLY_DELETED & ^del then return;
	else if del & ^chairman & forum_control.transactions (idx).person_id ^= person_id then return;
	else done = "1"b;

	return;
     end check;


get_highest_seen:
     procedure (start) returns (fixed bin);

declare	start			fixed bin;

	done = "0"b;
	do while ((start + 1) <= forum_control.no_transactions & ^done);
	     if forum_control.transactions (start + 1).person_id = person_id then start = start + 1;
	     else done = "1"b;
	end;

	done = "0"b;
	do start = start repeat start - 1 while (^done & start ^= 0);
	     call check (start);
	end;

	return (start + 1);
     end get_highest_seen;
%page;
v1_forum_trans_mgr_$check_user:
     entry (a_forum_idx, a_user_name, a_trans_no, a_code);

	call initialize (CHECK_USER_EXIT);

	on any_other call error (forum_error_table_$unexpected_fault);
	on cleanup call v1_forum_mgr_$unlock (forum_control_ptr);
	call v1_forum_mgr_$get_ptrs (a_forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, ("0"b), code);
	if code ^= 0 then call error (code);

	user_name = a_user_name;			/* copy into lower ring */
	a_trans_no = 0;				/* to start with, none seen for this user */

	do i = forum_control.no_transactions by -1 to 1;
	     if forum_control.transactions (i).person_id = user_name then
		a_trans_no = i;
	end;

CHECK_USER_EXIT:

	call v1_forum_mgr_$unlock (forum_control_ptr);
	a_code = code;
	return;
%page;
v1_forum_trans_mgr_$convert_attendee_idx:
     entry (a_forum_idx, a_attendee_idx, a_user_name, a_code);

	call initialize (CONV_ATT_EXIT);

	on cleanup call v1_forum_mgr_$unlock (forum_control_ptr);
	on any_other call error (forum_error_table_$unexpected_fault);

	call v1_forum_mgr_$get_ptrs (a_forum_idx, forum_control_ptr, proceedings_ptr, (0), ("0"b), code);
	if code ^= 0 then call error (code);

	attendee_idx = a_attendee_idx;
	if attendee_idx < 1 | attendee_idx > forum_control.no_attendees then
	     call error (forum_error_table_$invalid_att_idx);

	user_name = rtrim (forum_control.attendee (attendee_idx).person_id) || "." ||
	     rtrim (forum_control.attendee (attendee_idx).project_id);

	a_user_name = user_name;			/* copy to user ring storage */

CONV_ATT_EXIT:

	call v1_forum_mgr_$unlock (forum_control_ptr);
	a_code = code;
	return;
%page;
v1_forum_trans_mgr_$validate_uid:
     entry (a_forum_idx, a_uid, a_code);

	call initialize (VALIDATE_UID_EXIT);

	on cleanup call v1_forum_mgr_$unlock (forum_control_ptr);
	on any_other call error (forum_error_table_$unexpected_fault);

	call v1_forum_mgr_$get_ptrs (a_forum_idx, forum_control_ptr, proceedings_ptr, attendee_idx, ("0"b), code);
	if code ^= 0 then call error (code);

	call hcs_$get_uid_seg (forum_control_ptr, uid, code);
	if code ^= 0 then call error (code);

	if uid ^= a_uid then call error (forum_error_table_$incorrect_uid);

VALIDATE_UID_EXIT:
	call v1_forum_mgr_$unlock (forum_control_ptr);
	a_code = code;
	return;
%page;	
initialize:
     procedure (P_egress);

declare	P_egress			label variable,
	anon			fixed bin;

	egress = P_egress;
	call user_info_$login_data (person_id, project_id, (""), anon, 0, 0, 0, (""));
	anon_sw = (anon = 1);
	if anon_sw then person_id = "*" || person_id;
	forum_control_ptr, proceedings_ptr = null ();	/* no forum initialized yet, this call */
	code = 0;					/* no errors yet either */

	return;
     end initialize;

error:
     procedure (error_code);

declare	 error_code		 fixed bin (35);

	code = error_code;
	goto egress;				/* let's PUNT */

     end error;

     end v1_forum_trans_mgr_$enter_trans;





		    bull_copyright_notice.txt       08/30/05  1008.4r   08/30/05  1007.3    00020025

                                          -----------------------------------------------------------


Historical Background

This edition of the Multics software materials and documentation is provided and donated
to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. 
as a contribution to computer science knowledge.  
This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology,
Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull
and Bull HN Information Systems Inc. to the development of this operating system. 
Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970),
renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership
of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for 
managing computer hardware properly and for executing programs. Many subsequent operating systems
incorporated Multics principles.
Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., 
as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. .

                                          -----------------------------------------------------------

Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without
fee is hereby granted,provided that the below copyright notice and historical background appear in all copies
and that both the copyright notice and historical background and this permission notice appear in supporting
documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining
to distribution of the programs without specific prior written permission.
    Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc.
    Copyright 2006 by Bull HN Information Systems Inc.
    Copyright 2006 by Bull SAS
    All Rights Reserved
