


		    PNOTICE_forum.alm               10/27/88  1508.7r w 10/27/88  1508.6        3222


	dec	1			"version 1 structure
	dec	2			"no. of pnotices
	dec	3			"no. of STIs
	dec	119			"lgth of all pnotices + no. of pnotices
          acc       "Copyright (c) 1988 by Massachusetts Institute of Technology"
          acc       "Copyright, (C) Massachusetts Institute of Technology, 1988"

	aci	"C1FRMM0E0000"
	aci	"C2FRMM0E0000"
	aci	"C3FRMM0E0000"
	end
  



		    convert_forum.pl1               10/30/84  1243.8r w 10/30/84  1201.1       16056


/* **************************************************************
   *                                                            *
   * Copyright, (C) Massachusetts Institute of Technology, 1984 *
   *                                                            *
   ************************************************************** */
convert_forum:
	proc ();

/* Converts version 1 forum to version 2 forum
    Jay Pattin 1/8/83 */

declare	arg			char (arg_len) based (arg_ptr),
	arg_count			fixed bin,
	arg_idx			fixed bin,
	arg_len			fixed bin (21),
	arg_ptr			ptr,
	directory			char (168),
	name			char (32),
	status			fixed bin (35),
	whoami			char (32) static options (constant) init ("convert_forum");

declare	(com_err_, com_err_$suppress_name)
				entry options (variable),
	cu_$arg_count		entry (fixed bin, fixed bin (35)),
	cu_$arg_ptr		entry (fixed bin, ptr, fixed bin (21), fixed bin (35)),
	expand_pathname_$add_suffix	entry (char (*), char (*), char (*), char (*), fixed bin (35)),
	forum_$convert		entry (char (*), char (*), fixed bin (35));

	call cu_$arg_count (arg_count, status);
	if status ^= 0 then do;
ERR:	     call com_err_ (status, whoami);
	     return;
	end;

	if arg_count = 0 then do;
	     call com_err_$suppress_name (0, whoami, "Usage:  convert_forum meeting_path");
	     return;
	end;

	call cu_$arg_ptr (1, arg_ptr, arg_len, status);
	if status ^= 0 then goto ERR;
	call expand_pathname_$add_suffix (arg, "control", directory, name, status);
	if status ^= 0 then do;
	     call com_err_ (status, whoami, "Finding ""^a"".", arg);
	     return;
	end;

	call forum_$convert (directory, rtrim (name), status);
	if status ^= 0 then do;
	     call com_err_ (status, whoami, "Converting ""^a"".", arg);
	     return;
	end;

	return;
     end convert_forum;



		    forum.pl1                       08/16/86  1414.1rew 08/16/86  1354.0      139059


/****^  ***************************************************************
        *                                                             *
        * Copyright, (C) Massachusetts Institute of Technology, 1986  *
        *                                                             *
        * Copyright (c) 1982 by Massachusetts Institute of Technology *
        *                                                             *
        *************************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-07-29,Pattin), approve(86-07-29,MCR7354),
     audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128):
     Added -tfmt control argument, changed handling of area to make it
     non-extensible.  Use goto request to enter initial meeting.
                                                   END HISTORY COMMENTS */


forum:
     procedure ();

/* Jay Pattin modified from continuum 1/82
   Jay Pattin 03/07/82 added enter_first_trans
   Jay Pattin 9/29/82 added -start_up */

dcl	(substr, addr, codeptr, null, maxlength, min, string)
				builtin;

declare	cleanup			condition;

declare   abbrev_switch		bit (1) aligned,
	arg_count			fixed bin,
	arg_idx			fixed bin,
	arg_len			fixed bin (21),
	arg_ptr			ptr,
	argmap_ptr		ptr,
	first_trans		bit (1) aligned,
	list			bit (1) aligned,
	list_arg			fixed bin,
	profile_dir		char (168),
	profile_entry		char (32),
	profile_ptr		ptr,
	prompt			char (64) varying,
	quit_switch		bit (1) aligned,
	request			char (256),
	request_arg		fixed bin,
	saved_state		fixed bin,
	start_up_switch		bit (1) aligned,
	state			fixed bin,
	status			fixed bin (35);

declare	PROMPT_			fixed bin static options (constant) initial (1),	/* avoid name conflict with ssu_prompt_modes */
	REQUEST_LINE		fixed bin static options (constant) initial (2),
	LINE_LENGTH		fixed bin static options (constant) initial (3),
	MEETING			fixed bin static options (constant) initial (4),
	DONE			fixed bin static options (constant) initial (5),
	PROFILE			fixed bin static options (constant) initial (6),
	LIST			fixed bin static options (constant) initial (7),
	INPUT_LENGTH		fixed bin static options (constant) initial (8),
	OUTPUT_LENGTH		fixed bin static options (constant) initial (9),
	TRAILER_FORMAT		fixed bin static options (constant) init (10),
	whoami			char (32) static options (constant) initial ("forum");

declare	1 auto_area_info		aligned like area_info;
declare	arg			char (arg_len) based (arg_ptr),
	argmap			bit (arg_count) based (argmap_ptr),
	system_free_area		area based (get_system_free_area_ ());

declare	iox_$user_input		ptr external;

declare	(
	forum_request_tables_$user_requests,
	error_table_$bad_arg,
	error_table_$badopt,
	error_table_$bad_conversion,
	error_table_$noarg,
	error_table_$noentry,
	ssu_request_tables_$standard_requests,
	ssu_et_$exec_com_aborted,
	ssu_et_$program_interrupt,
	ssu_et_$request_line_aborted,
	ssu_et_$subsystem_aborted
	)			fixed binary (35) external;

declare	com_err_			entry () options (variable),
	com_err_$suppress_name	entry () options (variable),
	forum_requests_$add_passport	entry (ptr),
	forum_requests_$remove_passport
				entry (ptr),
	forum_requests_$set_forum
				entry (ptr, char (*), fixed bin (35)),
	forum_$close_forum	entry (fixed bin, fixed bin (35)),
	cu_$arg_count		entry (fixed bin, fixed bin (35)),
	cu_$arg_list_ptr		entry () returns (ptr),
	cu_$arg_ptr		entry (fixed bin, pointer, fixed bin (21), fixed binary (35)),
	cu_$generate_call		entry (entry, ptr),
	cv_dec_check_		entry (char (*), fixed bin (35)) returns (fixed bin (35)),
	expand_pathname_$add_suffix	entry (char(*), char(*), char(*), char(*), fixed bin(35)),
	get_system_free_area_	entry () returns (ptr),
	hcs_$initiate		entry (char(*), char(*), char(*), fixed bin(1), fixed bin(2), ptr, fixed bin(35)),
	requote_string_		entry (char (*)) returns (char (*)),
	ssu_$add_request_table	entry (ptr, ptr, fixed bin, fixed bin (35)),
	ssu_$create_invocation	entry (char (*), char (*), ptr, ptr, char (*), ptr, fixed binary (35)),
	ssu_$destroy_invocation	entry (ptr),
	ssu_$execute_line		entry (ptr, ptr, fixed bin (21), fixed bin (35)),
	ssu_$execute_start_up	entry options (variable),
	ssu_$execute_string		entry (ptr, char (*), fixed bin (35)),
	ssu_$get_area		entry (ptr, ptr, char (*), ptr),
	ssu_$listen		entry (ptr, ptr, fixed bin (35)),
	ssu_$print_message		entry options (variable),
	ssu_$record_usage		entry (ptr, ptr, fixed bin (35)),
	ssu_$set_abbrev_info	entry (ptr, ptr, ptr, bit (1) aligned),
	ssu_$set_ec_search_list	entry (ptr, char (32)),
     	ssu_$set_ec_suffix		entry (ptr, char (32)),
	ssu_$set_prompt		entry (ptr, char (64) varying),
	ssu_$set_prompt_mode	entry (ptr, bit (*));
%page;
%include forum_passport;
%page;
%include ssu_prompt_modes;
%page;
%include area_info;
%page;
	passport_info_ptr = null ();
	on cleanup call clean_things_up ();

	first_trans = "0"b;
	start_up_switch = "1"b;
	call allocate_passport ();

	call cu_$arg_count (arg_count, status);
	if status ^= 0 then do;
	     call com_err_ (status, whoami);
	     return;
	end;

	allocate argmap in (system_free_area);

	state = MEETING;
	do arg_idx = 1 to arg_count;
	     call cu_$arg_ptr (arg_idx, arg_ptr, arg_len, status);

	     if state = LIST then do;
		if substr (arg, 1, 1) = "-" then goto CTL_ARG;
		list_arg = arg_idx;
		state = saved_state;
	     end;

	     else if state = PROMPT_
	     then do;
		     if arg_len > maxlength (prompt)
		     then call error (0, whoami, "The prompt may be a maximum of ^d characters.",
			     maxlength (prompt));
		     prompt = arg;
		     state = saved_state;
		end;

	     else if state = PROFILE then do;
		     call get_profile (arg);
		     abbrev_switch = "1"b;
		     state = saved_state;
		end;

	     else if state = REQUEST_LINE then do;
		     request_arg = arg_idx;
		     state = saved_state;
		end;

 	     else if state = LINE_LENGTH
	     then do;
		     passport.input_fill_width, passport.output_fill_width = cv_dec_check_ (arg, status);
		     if status ^= 0 then call error (error_table_$bad_conversion, whoami, "^a", arg);
		     state = saved_state;
		end;

	     else if state = INPUT_LENGTH
	     then do;
		     passport.input_fill_width = cv_dec_check_ (arg, status);
		     if status ^= 0 then call error (error_table_$bad_conversion, whoami, "^a", arg);
		     state = saved_state;
		end;

 	     else if state = OUTPUT_LENGTH
	     then do;
		     passport.output_fill_width = cv_dec_check_ (arg, status);
		     if status ^= 0 then call error (error_table_$bad_conversion, whoami, "^a", arg);
		     state = saved_state;
		end;

	     else if state = TRAILER_FORMAT then do;
		if arg = "none" then passport.trailer_format = TFMT_none;
		else if arg = "number" | arg = "nb" then passport.trailer_format = TFMT_number;
		else if arg = "more" then passport.trailer_format = TFMT_more;
		else if arg = "references" | arg = "refs" then passport.trailer_format = TFMT_reference;
		else call error (error_table_$bad_arg, whoami, "Invalid trailer format: ^a.", arg);
		state = saved_state;
	     end;

	     else if substr (arg, 1, min (1, arg_count)) = "-" then
CTL_ARG:		if arg = "-abbrev" | arg = "-ab" then abbrev_switch = "1"b;
		else if arg = "-no_abbrev" | arg = "-nab" then abbrev_switch = "0"b;
		else if arg = "-auto_write" then passport.auto_write = "1"b;
		else if arg = "-no_auto_write" then passport.auto_write = "0"b;
		else if arg = "-brief" | arg = "-bf" then passport.brief_sw = "1"b;
		else if arg = "-list" | arg = "-ls" then do;
		     call want_arg (LIST);
		     list = "1"b;
		end;
		else if arg = "-long" | arg = "-lg" then passport.brief_sw = "0"b;
		else if arg = "-meeting" | arg = "-mtg" then do;
		     if argmap ^= ""b then call error (0, whoami, "Only one meeting may be specified.");
		     call want_arg (MEETING);
		end;
		else if arg = "-no_start_up" | arg = "-ns" | arg = "-nsu" then start_up_switch = "0"b;
		else if arg = "-start_up" | arg = "-su" then start_up_switch = "1"b;
		else if arg = "-profile" | arg = "-pf" then call want_arg (PROFILE);
		else if arg = "-prompt" then call want_arg (PROMPT_);
		else if arg = "-no_prompt" then prompt = "";
		else if arg = "-quit" then quit_switch = "1"b;
		else if arg = "-rq" | arg = "-request" then call want_arg (REQUEST_LINE);
		else if arg = "-ll" | arg = "-line_length" then call want_arg (LINE_LENGTH);
		else if arg = "-ill" | arg = "-input_line_length" then call want_arg (INPUT_LENGTH);
		else if arg = "-oll" | arg = "-output_line_length" then call want_arg (OUTPUT_LENGTH);
		else if arg = "-output_fill" | arg = "-ofi" then passport.print_fill = "1"b;
		else if arg = "-no_output_fill" | arg = "-nof" then passport.print_fill = "0"b;
		else if arg = "-input_fill" | arg = "-ifi" then passport.talk_fill = "1"b;
		else if arg = "-no_input_fill" | arg = "-nif" then passport.talk_fill = "0"b;
		else if arg = "-trailer_format" | arg = "-tfmt" then call want_arg (TRAILER_FORMAT);

		else call error (error_table_$badopt, whoami, "^a", arg);

	     else if state = MEETING
	     then do;
		     substr (argmap, arg_idx, 1) = "1"b;
		     state = DONE;
		end;

	     else do;
		     call com_err_$suppress_name (0, whoami, "Usage:  forum {meeting_name} {-control_args}");
		     return;
		end;
	end;

	if state ^= LIST & state ^= MEETING & state ^= DONE then
	     call error (error_table_$noarg, whoami, "Following ""^a"".", arg);

	if argmap = ""b & list then call error (0, whoami, "-list may not be specified if no meeting_name is given.");
	goto CREATE_SUBSYSTEM;
%page;
forum$enter_first_trans:
     entry (P_forum);

declare	P_forum			char (*);

	first_trans = "1"b;
	start_up_switch = "0"b;

	passport_info_ptr = null ();
	on cleanup call clean_things_up ();

	call allocate_passport ();

CREATE_SUBSYSTEM:
	call ssu_$create_invocation (whoami, forum_data_$version_string, passport_info_ptr,
	     addr (forum_request_tables_$user_requests), forum_data_$info_directory, passport.ssu_ptr, status);
	if status ^= 0 then call error (status, whoami, "Creating subsystem invocation.");

	call ssu_$add_request_table (passport.ssu_ptr, addr (ssu_request_tables_$standard_requests), 2, status);
	if status ^= 0 then call error (status, whoami, "Adding standard request table.");

	call ssu_$record_usage (passport.ssu_ptr, codeptr (forum), (0));

	call ssu_$set_prompt (passport.ssu_ptr, prompt);

	call ssu_$set_prompt_mode (passport.ssu_ptr, PROMPT);
	call ssu_$set_abbrev_info (passport.ssu_ptr, profile_ptr, profile_ptr, abbrev_switch);
	call ssu_$set_ec_suffix (passport.ssu_ptr, "fmec");
	call ssu_$set_ec_search_list (passport.ssu_ptr, "exec_com");

	unspec (auto_area_info) = ""b;
	auto_area_info.version = area_info_version_1;
	auto_area_info.zero_on_free = "1"b;

	call ssu_$get_area (passport.ssu_ptr, addr (auto_area_info), "forum_area", passport.area_ptr);

	if start_up_switch then do;
	     call ssu_$execute_start_up (passport.ssu_ptr, status);
	     if status ^= 0 then
		if status ^= error_table_$noentry & status ^= ssu_et_$exec_com_aborted then do;
		     if status = ssu_et_$subsystem_aborted then goto MAIN_RETURN;
		     else call ssu_$print_message (ssu_ptr, status, "Executing start_up.");
		end;
	end;

	if ^first_trans then do;
	     do arg_idx = 1 to arg_count;
		if substr (argmap, arg_idx, 1) then do;
		     call cu_$arg_ptr (arg_idx, arg_ptr, arg_len, (0));
		     request = "goto " || requote_string_ (arg);
		     call ssu_$execute_line (ssu_ptr, addr (request), length (rtrim (request)), status);
		     if status = ssu_et_$request_line_aborted | status = ssu_et_$subsystem_aborted then goto MAIN_RETURN;
		     else if status ^= 0 & status ^= ssu_et_$program_interrupt then
			call error (status, whoami, "Going to the ^a meeting.", arg);
		end;
	     end;
	     free argmap;

	     if list then do;
		if list_arg > 0 then do;
		     call cu_$arg_ptr (list_arg, arg_ptr, arg_len, (0));
		     call ssu_$execute_string (passport.ssu_ptr, "list " || arg, status);
		end;
		else call ssu_$execute_string (passport.ssu_ptr, "list", status);
		if status ^= 0 then
		     if status ^= ssu_et_$request_line_aborted  & status ^= ssu_et_$program_interrupt then
			call error (status, whoami, "Listing transactions.");
	     end;
	     
	     if request_arg > 0 then do;
		call cu_$arg_ptr (request_arg, arg_ptr, arg_len, (0));
		call ssu_$execute_string (passport.ssu_ptr, arg, status);
		if status = ssu_et_$subsystem_aborted then goto MAIN_RETURN;
		if status = ssu_et_$request_line_aborted | status = ssu_et_$program_interrupt then;
		else if status ^= 0 then
		     call error (status, whoami, "Executing initial request.");
	     end;
	end;

	else do;
	     passport.brief_sw = "1"b;
	     call forum_requests_$set_forum (passport_info_ptr, P_forum, status);
	     if status ^= 0 then call error (status, whoami, "Unable to access the ""^a"" meeting.", P_forum);
	     passport.print_message = "0"b;
	     call ssu_$execute_string (passport.ssu_ptr, "talk -sj ""Reason for this meeting""", (0));
	     if passport.unprocessed_trans_ptr = null () then goto MAIN_RETURN;
	end;


	if ^quit_switch then do;
	     call ssu_$listen (passport.ssu_ptr, iox_$user_input, status);
	     if status ^= 0 & status ^= ssu_et_$subsystem_aborted then
		call error (status, whoami, "Unable to call listener.");
	end;

MAIN_RETURN:
	call clean_things_up ();

	return;
%page;
want_arg:
     procedure (new_state);

declare	new_state			fixed bin;

	saved_state = state;
	state = new_state;

	return;

     end want_arg;

get_profile:
     procedure (path);

dcl path				char (*);

	call expand_pathname_$add_suffix (path, "profile", profile_dir, profile_entry, status);
	if status ^= 0 then do;
BAD_PROFILE:
	     call com_err_ (status, whoami, "^a", path);
	     goto MAIN_RETURN;
	end;

	call hcs_$initiate (profile_dir, profile_entry, "", 0, 0, profile_ptr, status);
	if profile_ptr = null () then do;
	     if status = error_table_$noentry then do;
		call com_err_ (status, whoami, "^a>^a does not exist.", profile_dir, profile_entry);
		goto MAIN_RETURN;
	     end;
	     else goto BAD_PROFILE;
	end;
	return;
     end get_profile;
%page;
allocate_passport:
     procedure ();

	abbrev_switch, list, quit_switch = "0"b;
	request_arg, list_arg = 0;
	prompt = "^/forum^[ (^d)^]:^2x";
	argmap_ptr, profile_ptr = null ();

	allocate passport in (system_free_area);
	passport.version = passport_version_2;
	passport.forum_dir = "";
	passport.forum_name = "";
	passport.input_fill_width = 0;
	passport.output_fill_width = 0;
	string (passport.flags) = "0"b;
	passport.talk_fill = "1"b;
	passport.public_channel = 0;
	passport.first_trans_ptr, passport.last_trans_ptr = null ();
	passport.unprocessed_trans_ptr = null ();
	passport.ssu_ptr = null ();
	passport.trailer_format = TFMT_reference;

	call forum_requests_$add_passport (passport_info_ptr);
	return;
     end allocate_passport;
%page;
clean_things_up:
     procedure ();

     if argmap_ptr ^= null () then free argmap;

     if passport_info_ptr ^= null () then do;
	if passport.forum_idx ^= 0 then call forum_$close_forum (passport.forum_idx, (0));
	call forum_requests_$remove_passport (passport_info_ptr);

	if passport.ssu_ptr ^= null () then call ssu_$destroy_invocation (passport.ssu_ptr);
	free passport;
      end;

      return;

     end clean_things_up;


error:
     procedure () options (variable);

	call cu_$generate_call (com_err_, cu_$arg_list_ptr ());

	go to MAIN_RETURN;

     end error;

end forum;
 



		    forum_accept_notifications.pl1  10/31/84  0924.9rew 10/31/84  0924.1       13680


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

forum_accept_notifications:
fant:	proc ();

/* Jay Pattin 03/26/82 turns forum notifications on and off */

declare	arg_count			fixed bin,
	status			fixed bin (35);

declare	(com_err_, com_err_$suppress_name)
				entry options (variable),
	cu_$arg_count		entry (fixed bin, fixed bin (35)),
	forum_$accept_notifications	entry (fixed bin (35)),
	forum_$refuse_notifications	entry (fixed bin (35));

	call cu_$arg_count (arg_count, status);
	if status ^= 0 then do;
	     call com_err_ (status, "forum_accept_notifications");
	     return;
	end;

	if arg_count > 0 then do;
	     call com_err_$suppress_name (0, "", "Usage:  fant");
	     return;
	end;

	call forum_$accept_notifications (status);
	if status ^= 0 then call com_err_ (status, "forum_accept_notifications");

	return;

forum_refuse_notifications:
frnt:	entry ();


	call cu_$arg_count (arg_count, status);
	if status ^= 0 then do;
	     call com_err_ (status, "forum_refuse_notifications");
	     return;
	end;

	if arg_count > 0 then do;
	     call com_err_$suppress_name (0, "", "Usage:  frnt");
	     return;
	end;

	call forum_$refuse_notifications (status);
	if status ^= 0 then call com_err_ (status, "forum_refuse_notifications");

	return;
     end forum_accept_notifications;



		    forum_add_meeting.pl1           08/16/86  1414.1rew 08/16/86  1354.0      257418


/****^  **************************************************************
        *                                                            *
        * Copyright, (C) Massachusetts Institute of Technology, 1983 *
        *                                                            *
        ************************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-07-29,Pattin), approve(86-07-29,MCR7354),
     audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128):
     Added -brief and -long to (add remove)_meeting.  Added -cmtg to
     remove_meeting.   Fixed some error messages.
                                                   END HISTORY COMMENTS */


forum_add_meeting:
fam:	proc ();

/* Adds and removes links in the user's forum search list.

   Jay Pattin 6/2/83 */

declare	(P_passport_info_ptr	ptr,
	P_ssu_ptr			ptr)
				parameter;

declare	active_function		bit (1) aligned,
	absolute_path		bit (1) aligned,
	arg_count			fixed bin,
	arg_idx			fixed bin,
	arg_len			fixed bin (21),
	arg_ptr			ptr,
	arg			char (arg_len) based (arg_ptr),
	brief			bit (1) aligned,
	chair			char (32),
	chairman			bit (1) aligned,
	check_switch		bit (1) aligned,
	cleanup_switch		bit (1) aligned,
	cmtg_switch		bit (1) aligned,
	directory			char (168),
	entry_name		bit (1) aligned,
	force			bit (1) aligned,
	forum_name		char (32),
	idx			fixed bin,
	link_dir			char (168),
	no_match			bit (1) aligned,
	path			char (168),
	ret_len			fixed bin (21),
	ret_ptr			ptr,
	ret_string		char (ret_len) based (ret_ptr) varying,
	ssu_ptr			ptr,
	start			fixed bin,
	status			fixed bin (35),
	subsystem			bit (1) aligned,
	type			fixed bin (2),
	update			bit (1) aligned,
	whoami			char (32);

declare	1 sb			aligned like status_branch,
	1 sl			aligned like status_link;
declare	NL			char (1) static options (constant) init ("
");

declare	(addr, after, before, index, ltrim, null, pointer, reverse, rtrim, search, substr, sum)
				builtin;
declare	cleanup			condition;

declare	(error_table_$badopt,
	error_table_$inconsistent,
	error_table_$namedup,
	error_table_$noarg,
	error_table_$no_s_permission,
	error_table_$noentry,
	error_table_$nomatch,
	error_table_$segnamedup,
	forum_et_$no_forum,
	forum_et_$no_such_forum,
	forum_et_$not_eligible)	fixed bin (35) external;

declare	active_fnc_err_		entry options (variable),
	check_star_name_$entry	entry (char (*), fixed bin (35)),
	com_err_			entry options (variable),
	cu_$af_return_arg		entry (fixed bin, ptr, fixed bin (21)) returns (fixed bin (35)),
	cu_$arg_list_ptr		entry returns (ptr),
	expand_pathname_		entry (char (*), char (*), char (*), fixed bin (35)),
	expand_pathname_$add_suffix	entry (char (*), char (*), char (*), char (*), fixed bin (35)),
	forum_$close_forum		entry (fixed bin, fixed bin (35)),
	forum_$get_forum_path	entry (char (*), char (*), char (*), char (*), fixed bin (35)),
	forum_$get_forum_path_idx	entry (fixed bin, char (*), char (*), fixed bin (35)),
	forum_$get_uid_file		entry (char (*), char (*), bit (36) aligned, fixed bin (35)),
	forum_requests_$find_forum	entry (char (*), char (*), char (*), fixed bin, fixed bin (35)),
	forum_requests_$open_forum	entry (char (*), fixed bin, char (*), char (*), fixed bin (35)),
	forum_trans_specs_$parse_specs
				entry (ptr, fixed bin, bit (36) aligned, entry, fixed bin, char (*), char (*),
				ptr),
	forum_trans_util_$read_trans	entry (ptr, fixed bin, fixed bin, ptr, fixed bin (35)),
	get_system_free_area_	entry returns (ptr),
	get_wdir_			entry returns (char (168)),
	hcs_$append_link		entry (char (*), char (*), char (*), fixed bin (35)),
	hcs_$chname_file		entry (char (*), char (*), char (*), char (*), fixed bin (35)),
	hcs_$delentry_file		entry (char (*), char (*), fixed bin (35)),
	hcs_$get_link_target	entry (char (*), char (*), char (*), char (*), fixed bin (35)),
	hcs_$get_uid_file		entry (char (*), char (*), bit (36) aligned, fixed bin (35)),
	hcs_$star_		entry (char (*), char (*), fixed bin (2), ptr, fixed bin, ptr, ptr, fixed bin (35)),
	hcs_$status_		entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)),
	hcs_$status_minf		entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)),
	ioa_			entry options (variable),
	nd_handler_		entry (char (*), char (*), char (*), fixed bin (35)),
	pathname_			entry (char (*), char (*)) returns (char (168)),
	ssu_$abort_line		entry options (variable),
	ssu_$arg_count		entry (ptr, fixed bin),
	ssu_$arg_ptr		entry (ptr, fixed bin, ptr, fixed bin (21)),
	ssu_$destroy_invocation	entry (ptr),
	ssu_$get_subsystem_and_request_name
				entry (ptr) returns (char (72) var),
	ssu_$print_message		entry options(variable),
	ssu_$return_arg		entry (ptr, fixed bin, bit (1) aligned, ptr, fixed bin (21)),
	ssu_$standalone_invocation	entry (ptr, char (*), char (*), ptr, entry, fixed bin (35)),
	user_info_$whoami		entry (char (*), char (*), char (*));
%page;
%include status_structures;
%page;
%include star_structures;
%page;
%include forum_passport;
%page;
%include forum_trans_list;
%page;
%include forum_user_trans;
%page;
	subsystem = "0"b;
	whoami = "forum_add_meeting";
	on cleanup call ssu_$destroy_invocation (ssu_ptr);
	call create_subsystem ();

	goto ADD_COMMON;

add_meeting:
	entry (P_ssu_ptr, P_passport_info_ptr);

	ssu_ptr = P_ssu_ptr;
	passport_info_ptr = P_passport_info_ptr;
	subsystem = "1"b;
	whoami = ssu_$get_subsystem_and_request_name (ssu_ptr);

	forum_trans_list_ptr = null ();
	on cleanup begin;
	     if forum_trans_list_ptr ^= null () then free forum_trans_list;
	end;

	goto ADD_COMMON;

ADD_COMMON:
	call ssu_$arg_count (ssu_ptr, arg_count);
	if arg_count = 0 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: ^[am {trans_specs}^;fam^] meeting_paths {-control_args}", subsystem);
	status_area_ptr = get_system_free_area_ ();

	link_dir = "";
	brief, cmtg_switch, force, update = "0"b;
	no_match = "1"b;
	start = 1;

	if subsystem then
	     if  passport.forum_idx ^= 0 then do;
		arg_idx = 0;
		parse_flags_word = DISALLOW_MTG | DISALLOW_CMSG | CALL_ON_BAD_ARGS | DEFAULT_TO_NONE;

		call forum_trans_specs_$parse_specs (passport_info_ptr, 1, parse_flags_word, args, (0), (""), (""),
		     forum_trans_list_ptr);
		do idx = 1 to forum_trans_list.size;
		     call add_from_trans (forum_trans_list.trans_num (idx));
		end;
		free forum_trans_list;
		if arg_idx = 0 then start = arg_count + 1;
		else start = arg_idx;
	     end;

	do arg_idx = start to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
	     if index (arg, "-") = 1 then
		if arg = "-brief" | arg = "-bf" then brief = "1"b;
		else if subsystem & (arg = "-current_meeting" | arg = "-cmtg") then cmtg_switch = "1"b;
		else if arg = "-directory" | arg = "-dr" then call get_link_dir_arg (arg_idx);
		else if arg = "-force" | arg = "-fc" then force = "1"b;
		else if arg = "-long" | arg = "-lg" then brief = "0"b;
		else if arg = "-no_force" | arg = "-nfc" then force = "0"b;
		else if arg = "-update" | arg = "-ud" then update = "1"b;
		else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
	end;

	if cmtg_switch then do;
	     if passport.forum_idx = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);
	     path = rtrim (passport.forum_dir) || ">" || no_suffix_name;
	     call add_the_link ();
	end;

	do arg_idx = start to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
	     if index (arg, "-") = 1 then
		if arg = "-directory" | arg = "-dr" then arg_idx = arg_idx + 1;
		else;
	     else do;
		if search (arg, "<>") = 0 & arg_len > 0 then
		     path = pathname_ (get_wdir_ (), arg);
		else path = arg;
		call add_the_link ();
	     end;
	end;

	if update then do;
	     force = "1"b;				/* so it can update not_eligible links */
	     no_match = "1"b;
	     if link_dir = "" then call get_link_dir ("1"b);

	     call update_links ("**.control");
	     call update_links ("**.forum");
	     if ^brief & no_match then call ssu_$print_message (ssu_ptr, 0, "There were no meetings to update.");
	end;
	else if no_match then call ssu_$abort_line (ssu_ptr, 0, "No meeting names were given.");

EGRESS:	if ^subsystem then call ssu_$destroy_invocation (ssu_ptr);
	return;
%page;	
forum_remove_meeting:
frm:
     entry ();

	subsystem = "0"b;
	whoami = "forum_remove_meeting";

	on cleanup call ssu_$destroy_invocation (ssu_ptr);
	call create_subsystem ();

	goto REMOVE_COMMON;

remove_meeting:
	entry (P_ssu_ptr, P_passport_info_ptr);

	ssu_ptr = P_ssu_ptr;
	passport_info_ptr = P_passport_info_ptr;
	subsystem = "1"b;
	whoami = ssu_$get_subsystem_and_request_name (ssu_ptr);

	goto REMOVE_COMMON;

REMOVE_COMMON:
	call ssu_$arg_count (ssu_ptr, arg_count);
	if arg_count = 0 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: ^[f^]rm meeting_names {-control_args}", ^subsystem);

	brief, check_switch, cleanup_switch, cmtg_switch, update = "0"b;
	status_area_ptr = get_system_free_area_ ();
	link_dir = "";

	do arg_idx = 1 to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
	     if index (arg, "-") = 1 then
		if arg = "-brief" | arg = "-bf" then brief = "1"b;
		else if arg = "-check" | arg = "-ck" then check_switch = "1"b;
		else if arg = "-cleanup" then cleanup_switch = "1"b;
		else if subsystem & (arg = "-current_meeting" | arg = "-cmtg") then cmtg_switch = "1"b;
		else if arg = "-directory" | arg = "-dr" then call get_link_dir_arg (arg_idx);
		else if arg = "-long" | arg = "-lg" then brief = "0"b;
		else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
	end;

	if link_dir = "" then call get_link_dir ("0"b);
	if cmtg_switch then do;
	     if passport.forum_idx = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);
	     forum_name = passport.forum_name;
	     call remove_link ("1"b);
	end;

	do arg_idx = 1 to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
	     if index (arg, "-") = 1 then
		if arg = "-directory" | arg = "-dr" then arg_idx = arg_idx + 1;
		else;
	     else do;
		if search (arg, "<>") > 0 then
		     call ssu_$abort_line (ssu_ptr, 0, "Meeting names may not contain "">"" or ""<"". ^a""", arg);

		call expand_pathname_$add_suffix (arg, "forum", "", forum_name, status);
		if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Expanding ^a.", arg);

		call check_star_name_$entry (arg, status);
		if status = 0 then call remove_link ("0"b);
		else if (status = 1) | (status = 2) then call remove_links ("0"b);
		else call ssu_$abort_line (ssu_ptr, status, "^a", arg);
	     end;
	end;

	if check_switch & cleanup_switch then
	     call ssu_$abort_line (ssu_ptr, error_table_$inconsistent, """-check"" and ""-cleanup""");

	if check_switch | cleanup_switch then call remove_links ("1"b);

	goto EGRESS;
%page;
create_subsystem:
     procedure ();

	call ssu_$standalone_invocation (ssu_ptr, whoami, "1", cu_$arg_list_ptr (), punt, status);
	if status ^= 0 then do; 	/* UGH */
	     if cu_$af_return_arg ((0), null (), (0)) = 0 then
		call active_fnc_err_ (status, whoami, "Unable to create subsystem invocation.");
	     else call com_err_ (status, whoami, "Unable to create subsystem invocation.");
	     goto EGRESS;
	end;

	return;
     end create_subsystem;


punt:
     proc ();

	goto EGRESS;

	end punt;

args:
     proc (P_arg_idx);

declare	P_arg_idx			fixed bin;

	call ssu_$arg_ptr (ssu_ptr, P_arg_idx, arg_ptr, arg_len);
	if index (arg, "-") = 1 then
	     if arg = "-brief" | arg = "-bf" then brief = "1"b;
	     else if (arg = "-current_meeting" | arg = "-cmtg") then cmtg_switch = "1"b;
	     else if arg = "-directory" | arg = "-dr" then call get_link_dir_arg (P_arg_idx);
	     else if arg = "-force" | arg = "-fc" then force = "1"b;
	     else if arg = "-long" | arg = "-lg" then brief = "0"b;
	     else if arg = "-no_force" | arg = "-nfc" then force = "0"b;
	     else if arg = "-update" | arg = "-ud" then update = "1"b;
	     else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
	else do;
	     arg_idx = P_arg_idx;
	     P_arg_idx = arg_count + 1;
	end;

	return;
     end args;
%page;
get_link_dir:
     proc (create_switch);

declare	create_switch		bit (1) aligned,
	home_dir			char (40),
     	person			char (22),
	project			char (9);

	call user_info_$whoami (person, project, "");
	home_dir = ">udd>" || rtrim (project) || ">" || person;
	call hcs_$status_minf (home_dir, "meetings", 1, type, (0), status);

	if status = error_table_$noentry then do;	/* no meetings dir - create a link pointing at homedir */
	     if ^create_switch then
		call ssu_$abort_line (ssu_ptr, 0, "^a>meetings not found. There are no meetings to remove.",
		     home_dir);
	     call ssu_$print_message (ssu_ptr, 0, "Creating ^a>meetings.", home_dir);
	     call hcs_$append_link (home_dir, "meetings", home_dir, status);
	     if status ^= 0 then
		call ssu_$abort_line (ssu_ptr, status, "Unable to create meeting directory.");
	end;
	else if status ^= 0 then
	     call ssu_$abort_line (ssu_ptr, status, "Unable to access meeting directory.");
	else if type ^= Directory then
	     call ssu_$abort_line (ssu_ptr, 0, "^a>meetings is not a directory.", home_dir);

	link_dir = rtrim (home_dir) || ">meetings";

	return;
     end get_link_dir;


get_link_dir_arg:
     proc (P_arg_idx);

declare	name			char (32);
declare	P_arg_idx			fixed bin;

	if P_arg_idx = arg_count then call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Following -directory");
	P_arg_idx = P_arg_idx + 1;

	call ssu_$arg_ptr (ssu_ptr, P_arg_idx, arg_ptr, arg_len);
	call expand_pathname_ (arg, link_dir, name, status);
	if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "^a", arg);

	call hcs_$status_minf (link_dir, name, 1, type, (0), status);
	if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "^a", arg);
	if type ^= Directory then call ssu_$abort_line (ssu_ptr, 0, "^a is not a directory.", arg);

	link_dir = pathname_ (link_dir, name);
	return;
     end get_link_dir_arg;
%page;
dissect_trans:
     proc (trans_idx, dir, name, chairman, error_proc);

declare	trans_idx			fixed bin parameter,
	(dir, name, chairman)	char (*) parameter,
	error_proc		entry variable options (variable) parameter,
	(idx, jdx)		fixed bin;

	call forum_trans_util_$read_trans (passport_info_ptr, 0, trans_idx, forum_user_trans_ptr, status);
	if status ^= 0 then
	     call ssu_$abort_line (ssu_ptr, status, "Reading transaction ^d.", trans_idx);

	if index (forum_user_trans.subject,  " meeting") = 0 then do;
BAD:	     call error_proc (ssu_ptr, 0, "Transaction ^d is not a meeting announcement.", trans_idx);
	     dir = "";				/* for error return */
	     return;
	end;

	name = reverse (after (reverse (forum_user_trans.subject), "gniteem "));

	idx = index (forum_user_trans.text, "Location:	") + 10;
	if idx = 10 then goto BAD;
	jdx = index (substr (forum_user_trans.text, idx), NL) - 1;
	dir = substr (forum_user_trans.text, idx, jdx);

	idx = index (forum_user_trans.text, "Chairman:	") + 10;
	if idx = 10 then goto BAD;
	jdx = index (substr (forum_user_trans.text, idx), NL) - 1;
	chairman = substr (forum_user_trans.text, idx, jdx);

	return;
     end dissect_trans;

add_from_trans:
     proc (trans_idx);

declare	trans_idx			fixed bin,
	name			char (32),
	dir			char (168),
	chairman			char (32);

	call dissect_trans (trans_idx, dir, name, chairman, ssu_$print_message);
	if dir = "" then return;

	path = pathname_ (dir, name);
	call add_the_link ();

	return;
     end add_from_trans;
%page;
add_the_link:
     proc ();

declare	forum_idx			fixed bin,
	idx			fixed bin,
	link_path			char (168),
	(uid1, uid2)		bit (36) aligned;

	no_match = "0"b;
	forum_idx = 0;
	if link_dir = "" then call get_link_dir ("1"b);

	on cleanup call forum_$close_forum (forum_idx, 0);

     	call forum_requests_$open_forum (path, forum_idx, "", "", status);
	if status ^= 0 then
	     if force & status = forum_et_$not_eligible then do;
		call forum_requests_$find_forum (path, directory, forum_name, (0), (0));
		call forum_$get_forum_path ((directory), (forum_name), directory, forum_name, status);
	     end;
	     else do;
		call ssu_$print_message (ssu_ptr, status, "Locating ^a.", path);
		return;
	     end;
	else call forum_$get_forum_path_idx (forum_idx, directory, forum_name, status);

	if status ^= 0 then
	     call ssu_$abort_line (ssu_ptr, status, "Getting names for ^a.", path);
	if forum_idx ^= 0 then call forum_$close_forum (forum_idx, 0);

     	link_path = pathname_ (directory, forum_name);
RETRY_ADD_LINK:
	call hcs_$append_link (link_dir, forum_name, link_path, status);
	if status ^= 0 then
	     if status = error_table_$namedup then do;
		uid2 = "0"b;
		call forum_$get_uid_file (directory, forum_name, uid1, status);
		if status ^= 0 then do;
BAD_DUP:		     call ssu_$print_message (ssu_ptr, 0, "A^[nother^] meeting named ^a is already in the meeting directory.",
			(uid2 ^= ""b), forum_name);
		     return;
		end;

		call forum_$get_uid_file (link_dir, forum_name, uid2, status);
		if status ^= 0 then do;
		     if status ^= forum_et_$no_such_forum then goto BAD_DUP;
		     if ^brief then call ssu_$print_message (ssu_ptr, 0, "Replacing null link to ^a.", forum_name);
		     call hcs_$delentry_file (link_dir, forum_name, status);
		     if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Unable to delete null link.");
		     goto RETRY_ADD_LINK;
		end;
		else if uid1 ^= uid2 then goto BAD_DUP;

		call hcs_$status_minf (link_dir, forum_name, 0, type, (0), status);
		if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Unable to get status information for ^a.",
		     forum_name);
		if type = Directory then do;
		     if ^brief then
			call ssu_$print_message (ssu_ptr, 0,
			     "The ^a meeting is in the meetings directory. No link created.", forum_name);
		     return;
		end;
		
		if ^brief then call ssu_$print_message (ssu_ptr, 0, "^a is already in the meeting directory.  Link will be updated.",
		     forum_name);
		call hcs_$delentry_file (link_dir, forum_name, status);
		if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Unable to delete old link.");
		goto RETRY_ADD_LINK;
	     end;
	     else do;
		call ssu_$print_message (ssu_ptr, status, "Unable to create link to ^a.", link_path);
		return;
	     end;

	status_ptr = addr (sb);
	sb.names_relp = ""b;

	on cleanup begin;
	     if sb.names_relp ^= ""b then free status_entry_names;
	end;

	call hcs_$status_ (directory, forum_name, 0, status_ptr, status_area_ptr, status);
	if status ^= 0 then do;
	     call ssu_$print_message (ssu_ptr, status, "Unable to add additional names to the link for ^a.", path);
	     return;
	end;

	if status_branch.nnames < 1 then do;
	     call ssu_$print_message (ssu_ptr, 0, "Unable to obtain names for ^a.", path);
	     return;
	end;

SET_PRIMARY:
	call hcs_$chname_file (link_dir, forum_name, forum_name, (status_entry_names (1)), status);
	if check_code (1) then goto SET_PRIMARY;

	do idx = 2 to status_branch.nnames;
AGAIN:	     call hcs_$chname_file (link_dir, (status_entry_names (1)), "", (status_entry_names (idx)), status);
	     if check_code (idx) then goto AGAIN;
	end;
	     
	free status_entry_names;

	return;
     end add_the_link;

check_code:
    procedure (idx) returns (bit (1) aligned);

declare	idx			fixed bin;

	if status ^= 0 then
	     if status = error_table_$segnamedup then;
	     else if status = error_table_$namedup then do;
		call nd_handler_ (whoami, link_dir, (status_entry_names (idx)), status);
		if status = 0 then return ("1"b);
	     end;
	     else call ssu_$print_message (ssu_ptr, status, "Unable to add name ^a to ^a>^a.",
		status_entry_names (idx), link_dir, forum_name);
	return ("0"b);
     end check_code;
%page;
remove_link:
     proc (cmtg);

declare	cmtg			bit (1) aligned;

	call hcs_$status_minf (link_dir, forum_name, 0, type, (0), status);
	if status = error_table_$noentry then do;
	     if cmtg then
		call ssu_$abort_line (ssu_ptr, 0, "The current meeting is not in the meeting directory.");

	     call expand_pathname_$add_suffix (arg, "control", "", forum_name, status);
	     if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Expanding ^a.", arg);
	     call hcs_$status_minf (link_dir, forum_name, 0, type, (0), status);
	end;

	if status = error_table_$noentry then
	     call ssu_$abort_line (ssu_ptr, 0, "The ^a meeting is not in the meeting directory.", arg);
	else if type ^= Link then
	     call ssu_$abort_line (ssu_ptr, 0, "The ^a meeting itself is in the meeting directory.^/^-This command does not delete meetings.", arg);

	call hcs_$delentry_file (link_dir, forum_name, status);
	if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Unable to remove the ^a meeting.", arg);

	return;
     end remove_link;
%page;
remove_links:
     proc (null_switch);

declare	null_switch		bit (1) aligned;

	star_names_ptr, star_entry_ptr = null ();
	on cleanup begin;
	     if star_names_ptr ^= null () then free star_names;
	     if star_entry_ptr ^= null () then free star_entries;
	end;

	no_match = "1"b;				/* Until proven otherwise */

	if null_switch then forum_name = "**.forum";
	call do_the_work ();

	if null_switch then forum_name = "**.control";
	else call expand_pathname_$add_suffix (arg, "control", "", forum_name, status);
	call do_the_work ();

	if no_match & ^brief then
	     if null_switch then call ssu_$print_message (ssu_ptr, 0, "There were no meetings to clean up.");
	     else call ssu_$print_message (ssu_ptr, error_table_$nomatch, "^a", arg);

	return;

do_the_work:
	proc ();

declare	name			char (32);

	call hcs_$star_ (link_dir, forum_name, star_LINKS_ONLY, status_area_ptr, star_entry_count, star_entry_ptr,
	     star_names_ptr, status);
	if status ^= 0 then
	     if status = error_table_$nomatch then return;
	     else call ssu_$abort_line (ssu_ptr, status, "Finding matching names for ^a.", forum_name);

	do idx = 1 to star_entry_count;
	     name = star_names (star_entries.nindex (idx));
	     if null_switch then do;
		call hcs_$status_minf (link_dir, name, 1, type, (0), status);
		if type ^= Link & status = 0 then goto SKIP;
		no_match = "0"b;			/* We found one. */

		if check_switch then do;
		     call ioa_ ("The ^a meeting would be removed.", reverse (after (reverse (name), ".")));
		     goto SKIP;
		end;
		call ioa_ ("Removing the ^a meeting.", reverse (after (reverse (name), ".")));
	     end;
	    
	     call hcs_$delentry_file (link_dir, name, status);
	     if status ^= 0 then
		call ssu_$print_message (ssu_ptr, status, "Unable to remove the ^a meeting.",
		     reverse (after (reverse (name), ".")));
SKIP:	end;

	free star_names;
	free star_entries;
	return;

     end do_the_work;

     end remove_links;

update_links:
	proc (forum_name);

declare	forum_name		char (32);

	star_names_ptr, star_entry_ptr = null ();
	on cleanup begin;
 	     if star_names_ptr ^= null () then free star_names;
	     if star_entry_ptr ^= null () then free star_entries;
	end;

	call hcs_$star_ (link_dir, forum_name, star_LINKS_ONLY, status_area_ptr, star_entry_count, star_entry_ptr,
	     star_names_ptr, status);
	if status ^= 0 then
	     if status = error_table_$nomatch then;
	     else call ssu_$abort_line (ssu_ptr, status, "Listing old meetings.");

	do idx = 1 to star_entry_count;
	     call check_updated (star_names (star_entries.nindex (idx)));
	end;

	if star_names_ptr ^= null () then free star_names;
	if star_entry_ptr ^= null () then free star_entries;

	return;


check_updated:
     proc (name);

declare	name			char (32),
	name_idx			fixed bin,
	new_name			char (32),
	old_names			bit (1) aligned,
	target_dir		char (168),
	target_exists		bit (1) aligned,
	target_name		char (32),
	(uid1, uid2)		bit (36) aligned;

declare	status_link_names		(sl.nnames) char (32) aligned
				based (pointer (status_area_ptr, sl.names_relp)),
	status_pathname		char (sl.pathname_length) based
				(pointer (status_area_ptr, sl.pathname_relp));

	sl.names_relp, sl.pathname_relp = ""b;
	on cleanup begin;
	     if sl.pathname_relp ^= ""b then free status_pathname;
	     if sl.names_relp ^= ""b then free status_link_names;
	end;
	status_ptr = addr (sl);

	call hcs_$status_ (link_dir, name, 0, status_ptr, status_area_ptr, status);
	if status ^= 0 then goto SKIP;

	call hcs_$get_link_target (link_dir, name, target_dir, target_name, status);
	if status = 0 then target_exists = "1"b;
	else if status = error_table_$noentry then target_exists = "0"b;
	else goto SKIP;

	if ltrim (before (reverse (target_name), ".")) = "murof" then do;
	     if target_exists then goto CHECK_SHORTEN;
	     goto SKIP;
	end;

	target_name = reverse (after (reverse (target_name), ".")) || ".forum";
	call hcs_$status_minf (target_dir, target_name, 0, (0), (0), status);
	if status = 0 then do;			/* meeting has been converted */
	     path = pathname_ (target_dir, target_name);
	     call add_the_link ();
	     call hcs_$delentry_file (link_dir, name, (0));
	     call ioa_ ("Updated the ^a meeting.", reverse (after (reverse (name), ".")));
	     no_match, old_names = "0"b;
	end;
	else if target_exists then do;
CHECK_SHORTEN:
	     call expand_pathname_ (target_dir, path, target_name, status);
	     if status ^= 0 then goto SKIP;
	     call hcs_$get_uid_file (path, target_name, uid1, status);
	     if status ^= 0 then goto SKIP;

	     call expand_pathname_ ((status_pathname), path, target_name, status);
	     if status ^= 0 then goto SKIP;
	     call expand_pathname_ (path, path, target_name, status);
	     if status ^= 0 then goto SKIP;
	     call hcs_$get_uid_file (path, target_name, uid2, status);
	     if status ^= 0 then goto SKIP;

	     if uid1 = uid2 then goto SKIP;
	     old_names = "1"b;
	     no_match = "0"b;

	     call hcs_$delentry_file (link_dir, name, status);
	     if status ^= 0 then goto SKIP;

	     path = pathname_ (target_dir, name);
	     call hcs_$append_link (link_dir, name, path, status);
	     if status ^= 0 then goto SKIP;

	     call ioa_ ("Shortened link path for ^a.", name);
	     target_name = name;
	end;
	else goto SKIP;

	do name_idx = 1 to sl.nnames;
	     new_name = status_link_names (name_idx);
	     if ^old_names then new_name = reverse (after (reverse (new_name), ".")) || ".forum";
RETRY:	     call hcs_$chname_file (link_dir, target_name, "", new_name, status);
	     if check_code (name_idx) then goto RETRY;
	end;

SKIP:	if sl.names_relp ^= ""b then free status_link_names;
	if sl.pathname_relp ^= ""b then free status_pathname;
	revert cleanup;

	return;
     end check_updated;

     end update_links;
%page;
announcement_info:
     entry (P_ssu_ptr, P_passport_info_ptr);

	ssu_ptr = P_ssu_ptr;
	passport_info_ptr = P_passport_info_ptr;
	forum_idx = passport.forum_idx;
	chairman, absolute_path, entry_name = "0"b;

	forum_trans_list_ptr = null ();
	on cleanup begin;
	     if forum_trans_list_ptr ^= null () then free forum_trans_list;
	end;

	call ssu_$return_arg (ssu_ptr, arg_count, active_function, ret_ptr, ret_len);

	parse_flags_word = ONLY_ONE | DISALLOW_MTG | DISALLOW_REV | DISALLOW_INITIAL | DISALLOW_CMSG |
	     DISALLOW_BYCHAIN;
	call forum_trans_specs_$parse_specs (passport_info_ptr, 1, parse_flags_word, announce_args, (0), (""),
	     (""), forum_trans_list_ptr);

	call dissect_trans (forum_trans_list.trans_num (1), directory, forum_name, chair, ssu_$abort_line);
	free forum_trans_list;

	if active_function then do;
	     if ^(chairman | entry_name | absolute_path) then
USAGE:		call ssu_$abort_line (ssu_ptr, 0, "Usage:  [ai -control_arg]");

	     if (chairman & entry_name) | (chairman & absolute_path) | (absolute_path & entry_name) then
		goto USAGE;

	     if chairman then ret_string = chair;
	     else if entry_name then ret_string = forum_name;
	     else ret_string = pathname_ (directory, forum_name);
	end;
	else do;
	     if ^(chairman | entry_name | absolute_path) then
		chairman, entry_name, absolute_path = "1"b;
	     if absolute_path then call ioa_ ("The meeting path is ^a.", pathname_ (directory, forum_name));
	     else if entry_name then call ioa_ ("The name of the meeting is ^a.", forum_name);
	     if chairman then call ioa_ ("The chairman is ^a.", chair);
	end;

	return;

announce_args:
     procedure (P_arg_idx);
declare	P_arg_idx			fixed bin parameter;

	call ssu_$arg_ptr (ssu_ptr, P_arg_idx, arg_ptr, arg_len);
	if arg = "-absolute_pathname" | arg = "-absp" then absolute_path = "1"b;
	else if arg = "-chairman" | arg = "-cm" then chairman = "1"b;
	else if arg = "-entry_name" | arg = "-etnm" then entry_name = "1"b;
	else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);

	return;
     end announce_args;

end forum_add_meeting;
  



		    forum_add_participant.pl1       08/16/86  1414.1r w 08/16/86  1354.6      110214


/* **************************************************************
   *                                                            *
   * Copyright, (C) Massachusetts Institute of Technology, 1984 *
   *                                                            *
   ************************************************************** */

forum_add_participant:
fapt:
     proc;

/* v2 support for v1 access control commands/requests
   removed from v1 forum_create 7/13/83 Jay Pattin
   added v2 xobj hacking 4/15/84 Jay Pattin */

declare	ioa_			entry options (variable),
	com_err_			entry options (variable),
	com_err_$suppress_name	entry options (variable),
	active_fnc_err_		entry options (variable),
	forum_requests_$find_forum	entry (char (*), char (*), char (*), fixed bin, fixed bin (35)),
	cu_$af_return_arg		entry (fixed bin, ptr, fixed bin(21)) returns (fixed bin (35)),
	cu_$arg_count		entry (fixed bin),
	cu_$arg_list_ptr		entry returns (ptr),
	cu_$arg_ptr		entry (fixed bin, ptr, fixed bin (21), fixed bin (35)),

	forum_$open_forum		entry (char (*), char (*), fixed bin, fixed bin (35)),
	forum_$close_forum		entry (fixed bin, fixed bin (35)),
	forum_$set_switch_idx	entry (fixed bin, char (*), char (*), bit (1) aligned, fixed bin (35)),
	forum_$delete_forum		entry (char (*), char (*), fixed bin (35)),
	forum_$set_forum_acl	entry (char(*), char(*), ptr, fixed bin, fixed bin (35)),
	forum_$set_v1_forum_acl	entry (fixed bin, char (*), bit (1) aligned, bit (1) aligned, bit (1) aligned,
				fixed bin (35)),
	ssu_$abort_line		entry options (variable),
	ssu_$arg_count		entry (ptr, fixed bin),
	ssu_$arg_ptr		entry (ptr, fixed bin, ptr, fixed bin(21)),
	ssu_$return_arg		entry (ptr, fixed bin, bit(1) aligned, ptr, fixed bin(21)),
	ssu_$destroy_invocation	entry (ptr),
	ssu_$standalone_invocation	entry (ptr, char(*), char(*), ptr, entry, fixed bin(35));

declare	(P_ssu_ptr, P_passport_info_ptr)
				ptr parameter;

declare	code			fixed bin (35),
	arg_idx			fixed bin,
	whoami			char (32),
	forum_name		char (168),
	full_forum_name		char (32),
	forum_no			fixed bin,
	ssu_ptr			ptr,
	subsystem_entry		bit (1) aligned,
	forum_directory		char (168),
	name_len			fixed bin,
	person_id			char (22),
	argp			ptr,
	argl			fixed bin (21),
	argument			char (argl) based (argp),
	nargs			fixed bin,
	chairman			bit (1) aligned init (""b),
	public_switch		bit (1) aligned init (""b),
	person_switch		bit (1) aligned init (""b),
	read_only			bit (1) aligned init (""b),
	add_switch		bit (1) aligned,
	v2			bit (1) aligned,
	cleanup			condition,
	(index, null, substr)	builtin;

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

declare	(RWC_XACL			init ("111"b),
	 RW_XACL			init ("110"b),
	 R_XACL			init ("100"b))
				bit (36) static aligned options (constant);

declare	(forum_et_$no_forum,
	forum_et_$no_such_user,
	error_table_$not_act_fnc,
	error_table_$inconsistent,
	error_table_$badopt)	external fixed binary (35);
%page;
%include forum_passport;
%page;
%include access_mode_values;
%page;
	whoami = "forum_add_participant";
	call create_subsystem ();
	if nargs < 2 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: fapt meeting_name person_id {-control_arg}");
	person_switch, add_switch = "1"b;
	goto common;

forum_add_participant$add_participant:
     entry (P_ssu_ptr, P_passport_info_ptr);

	whoami = "add_participant";
	call setup_request ();
	if nargs < 1 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: apt person_id {-control_arg}");
	person_switch, add_switch = "1"b;

common:
	forum_no = 0;
	chairman, read_only = ""b;

	on cleanup begin;
	     if ^subsystem_entry then do;
		call forum_$close_forum (forum_no, (0));
		call ssu_$destroy_invocation (ssu_ptr);
	     end;
	end;

	if ^subsystem_entry then do;
	     call ssu_$arg_ptr (ssu_ptr, 1, argp, argl);

	     call forum_requests_$find_forum (argument, forum_directory, full_forum_name, name_len, code);
	     if code ^= 0 then call ssu_$abort_line (ssu_ptr, code, "^a", argument);
	     forum_name = substr (full_forum_name, 1, name_len);

	     if public_switch then arg_idx = 2;
	     else arg_idx = 3;
	end;

	do arg_idx = arg_idx to nargs;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, argp, argl);

	     if add_switch & (argument = "-read_only" | argument = "-ro") then read_only = "1"b;
	     else if add_switch & (argument = "-chairman" | argument = "-cm") then chairman = "1"b;
	     else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", argument);
	end;

	if chairman & read_only then
	     call ssu_$abort_line (ssu_ptr, error_table_$inconsistent, """-chairman"" and ""-read_only""");

	if subsystem_entry then do;
	     forum_no = passport.forum_idx;
	     forum_directory = passport.forum_dir;
	     full_forum_name = passport.forum_name;
	     forum_name = no_suffix_name;
	     if forum_no = 0 then
		call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);
	end;
	else do;
	     call forum_$open_forum (forum_directory, full_forum_name, forum_no, code);
	     if code ^= 0 then
		call ssu_$abort_line (ssu_ptr, code, "Unable to open the ^a meeting.", forum_name);
	end;

	v2 = (forum_no < 0);
	if ^v2 & chairman then
	     call ssu_$abort_line (ssu_ptr, 0, "The -chairman control argument may not be used with version 1 meetings.");	

	acl.modes = RW_ACCESS;
	if ^add_switch then acl.xmodes = N_ACCESS;
	else if chairman then acl.xmodes = RWC_XACL;
	else if read_only then acl.xmodes = R_XACL;
	else acl.xmodes = RW_XACL;
	acl.code = 0;

	if public_switch then do;
	     if v2 then do;
		acl.access_name = "*.*.*";
		call forum_$set_forum_acl (forum_directory, full_forum_name, addr (acl), 1, code);
	     end;
	     else call forum_$set_v1_forum_acl (forum_no, "*", "1"b, add_switch, ^read_only, code);
	     if code ^= 0 then
		call ssu_$abort_line (ssu_ptr, code, "Unable to make ^a meeting ^[public^;private^].", forum_name, add_switch);
	end;

	else do;
	     if subsystem_entry then arg_idx = 1;
	     else arg_idx = 2;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, argp, argl);

	     if index (argument, "*") > 0 | index (argument, ".") > 0 then
		call ssu_$abort_line (ssu_ptr, 0, "^[Person^;Project^]_ids may not contain ""."" or ""*"".", person_switch);
	     person_id = argument;

	     if v2 then do;
		if person_switch then acl.access_name = argument || ".*.*";
		else acl.access_name = "*." || argument || ".*";
		call forum_$set_forum_acl (forum_directory, full_forum_name, addr (acl), 1, code);
	     end;
	     else call forum_$set_v1_forum_acl (forum_no, person_id, person_switch, add_switch, ^read_only, code);

	     if code ^= 0 then
		call ssu_$abort_line (ssu_ptr, code, "Unable to ^[add ^a to^;remove ^a from^] ^a meeting.", add_switch,
		     person_id, forum_name);

	     if ^add_switch then do;
		call forum_$set_switch_idx (forum_no, person_id, "participating", "0"b, code);
		if code ^= 0 then
		     if code ^= forum_et_$no_such_user then
			call ssu_$abort_line (ssu_ptr, code, "Unable to turn off participating switch for ^a.", person_id);
			else code = 0;
	     end;
	end;
	if ^subsystem_entry then call forum_$close_forum (forum_no, (0));

	if public_switch then
	     call ioa_ ("The ^a meeting is ^[now^;no longer^] public^[ly readable^].", forum_name, (add_switch), (read_only));
	else call ioa_ ("^[^a^;The ^a project^] ^[may now read^s^;has been ^[added to^;removed from^]^] the ^a meeting.",
	     person_switch, person_id, (read_only), (add_switch), forum_name);

	return;

PUNT:	if ssu_ptr ^= null () & ^subsystem_entry then call ssu_$destroy_invocation (ssu_ptr);

	if ^subsystem_entry & forum_no ^= 0 then call forum_$close_forum (forum_no, 0);
	return;
%page;
forum_add_project: fapj:				/* Entry to add project to existing forum */
     entry ();

	whoami = "forum_add_project";
	call create_subsystem ();
	if nargs < 2 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: fapj meeting_name project_id {-control_arg}");

	person_switch = "0"b;
	add_switch = "1"b;
	goto common;

forum_add_participant$add_project:
     entry (P_ssu_ptr, P_passport_info_ptr);

	whoami = "add_project";
	call setup_request ();
	if nargs < 1 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: apj project_id {-control_arg}");
	person_switch = "0"b;
	add_switch = "1"b;
	goto common;
%page;
forum_remove_project: frpj:				/* Entry to remove project to existing forum */
     entry ();

	whoami = "forum_remove_project";
	call create_subsystem ();
	if nargs ^= 2 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: frpj meeting_name project_id.");
	person_switch, add_switch = "0"b;
	goto common;

forum_add_participant$remove_project:
     entry (P_ssu_ptr, P_passport_info_ptr);

	whoami = "remove_project";
	call setup_request ();
	if nargs ^= 1 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: rpj project_id");
	person_switch, add_switch = "0"b;
	goto common;
%page;
forum_remove_participant: frpt:				/* Entry to remove participant to existing forum */
     entry ();

	whoami = "forum_remove_participant";
	call create_subsystem ();
	if nargs ^= 2 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: frpt meeting_name person_id");
	person_switch = "1"b;
	add_switch = "0"b;

	goto common;

forum_add_participant$remove_participant:
     entry (P_ssu_ptr, P_passport_info_ptr);

	whoami = "remove_participant";
	call setup_request ();
	if nargs ^= 1 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: rpt person_id");
	person_switch = "1"b;
	add_switch = "0"b;
	goto common;
%page;						
forum_make_public: fmp:				/* Entry to make public an existing forum */
     entry ();

	whoami = "forum_make_public";
	call create_subsystem ();
	if nargs < 1 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: fmp meeting_name {-control_arg}");

	add_switch, public_switch = "1"b;
	goto common;

forum_add_participant$make_public:
     entry (P_ssu_ptr, P_passport_info_ptr);

	whoami = "make_public";
	call setup_request ();
	arg_idx = 1;
	public_switch, add_switch = "1"b;
	goto common;
%page;
forum_unmake_public: fump:				/* Entry to unmake public an existing forum */
     entry ();

	whoami = "forum_unmake_public";
	call create_subsystem ();
	if nargs ^= 1 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: fump meeting_name");

	add_switch = "0"b;
	public_switch = "1"b;
	goto common;

forum_add_participant$unmake_public:
     entry (P_ssu_ptr, P_passport_info_ptr);

	whoami = "unmake_public";
	call setup_request ();
	if nargs ^= 0 then
	     call ssu_$abort_line (ssu_ptr, 0, "Usage: ump");
	public_switch = "1"b;
	add_switch = "0"b;
	goto common;
%page;
forum_delete: fdl:
     entry ();

	whoami = "forum_delete";
	call cu_$arg_count (nargs);
	if nargs ^= 1 then do;
	     call com_err_$suppress_name (0, whoami, "Usage: fdl meeting_name.");
	     return;
	end;

	call cu_$arg_ptr (1, argp, argl, (0));

	call forum_requests_$find_forum (argument, forum_directory, forum_name, name_len, code);
	if code ^= 0 then do;
	     call com_err_ (code, whoami, "^a", argument);
	     return;
	end;

	call forum_$delete_forum (forum_directory, forum_name, code);
	if code ^= 0 then do;
	     call com_err_ (code, whoami, "Unable to delete the ^a meeting.", substr (forum_name, 1, name_len));
	     return;
	end;
	return;
%page;
setup_request:
   procedure ();

	subsystem_entry = "1"b;
	passport_info_ptr = P_passport_info_ptr;
	ssu_ptr = P_ssu_ptr;

	forum_name = no_suffix_name;
	call ssu_$arg_count (ssu_ptr, nargs);
	arg_idx = 2;

	return;
     end setup_request;


create_subsystem:
     procedure ();

declare	active_function		bit (1) aligned;

	call ssu_$standalone_invocation (ssu_ptr, whoami, "1", cu_$arg_list_ptr (), punt, code);
	if code ^= 0 then do; 	/* UGH */
	     if cu_$af_return_arg ((0), null (), (0)) = 0 then
		call active_fnc_err_ (code, whoami, "Unable to create subsystem invocation.");
	     else call com_err_ (code, whoami, "Unable to create subsystem invocation.");
	     goto PUNT;
	end;

	subsystem_entry = "0"b;
	call ssu_$return_arg (ssu_ptr, nargs, active_function, null (), (0));
	if active_function then
	     call ssu_$abort_line (ssu_ptr, error_table_$not_act_fnc);

	return;
     end create_subsystem;

punt:	proc ();

	go to PUNT;

     end punt;

end forum_add_participant;
  



		    forum_admin.pl1                 08/16/86  1414.1rew 08/16/86  1354.5       59508


/****^  ***************************************************************
        *                                                             *
        * Copyright, (C) Massachusetts Institute of Technology, 1986  *
        *                                                             *
        * Copyright (c) 1982 by Massachusetts Institute of Technology *
        *                                                             *
        *************************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-07-29,Pattin), approve(86-07-29,MCR7354),
     audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128):
     CHanged to use check_gate_access_, handle versions better.
                                                   END HISTORY COMMENTS */


forum_admin:
	procedure ();
	
/* Jay Pattin 03/29/82  Privileged forum interface - don't have to be chairman
  Use of this command requires access to the forum_admin_ gate

  added eligiblility message stuff 5/20/82 Jay Pattin */

declare	arg_count			fixed bin,
	arg_len			fixed bin (21),
	arg_ptr			ptr,
	arg			char (arg_len) based (arg_ptr),
	1 fi			aligned like forum_info,
	forum_dir			char (168),
	forum_name		char (32),
	status			fixed bin (35),
	whoami			char (16) static options (constant) init ("forum_admin");

declare	(addr, codeptr, index)	builtin;

declare	(error_table_$entlong, forum_et_$not_eligible, forum_et_$no_such_forum)
				fixed bin (35) external;

declare	check_gate_access_		entry (char (*), ptr, fixed bin (35)),
	cu_$arg_count		entry (fixed bin, fixed bin (35)),
	cu_$arg_ptr		entry (fixed bin, ptr, fixed bin (21), fixed bin (35)),
	(com_err_, com_err_$suppress_name)
				entry options (variable),
	expand_pathname_$add_suffix	entry (char(*), char(*), char(*), char(*), fixed bin (35)),
	forum_$get_forum_path	entry (char (*), char (*), char (*), char (*), fixed bin (35)),
	forum_admin_$change_chairman	entry (char (*), char (*), char (*), fixed bin (35)),
	forum_admin_$v1_change_chairman	entry (char (*), char (*), char (*), fixed bin (35)),
	forum_admin_$convert	entry (char (*), char (*), fixed bin (35)),
	forum_admin_$init_notifications
				entry (fixed bin (35)),
	forum_admin_$set_forum_acl	entry (char (*), char (*), char (*), bit (1) aligned, bit (1) aligned,
				bit (1) aligned, fixed bin (35)),
	forum_admin_$set_switch	entry (char (*), char (*), char (*), char (*), bit (1) aligned, fixed bin (35)),
	forum_admin_$set_global_switch
				entry (char (*), bit (1) aligned, fixed bin (35)),
	forum_$forum_info		entry (char (*), char (*), char (*), fixed bin (71), ptr, fixed bin (35)),
	ioa_			entry options (variable),
	pathname_			entry (char (*), char (*)) returns (char (168));
%page;
%include forum_info;
%page;
	call cu_$arg_count (arg_count, status);
	if status ^= 0 then do;
	     call com_err_ (status, whoami);
	     return;
	end;

	if arg_count = 0 then do;
	     call com_err_$suppress_name (0, "", "Usage:  forum_admin key {arguments}");
	     return;
	end;

	call check_gate_access_ ("forum_admin_", codeptr (forum_admin), status);
	if status ^= 0 then do;
	     call com_err_ (status, whoami, "This command requires access to the forum_admin_ gate");
	     return;
	end;

	call get_arg (1);

	if arg = "init_notifications" then do;
	     if arg_count ^= 1 then do;
WRONG_ARGS:	call com_err_ (0, whoami, "Wrong number of arguments for this keyword.");
		return;
	     end;
	     call forum_admin_$init_notifications (status);
	     if status ^= 0 then call com_err_ (status, whoami);
	end;
	
	else if arg = "convert" then do;
	     if arg_count ^= 2 then goto WRONG_ARGS;
	     call get_path (2, "1"b);
	     call forum_admin_$convert (forum_dir, forum_name, status);
	     if status ^= 0 then call com_err_ (status, whoami, "Converting meeting.");
	end;

	else if arg = "change_chairman" then do;
	     if arg_count ^= 3 then goto WRONG_ARGS;
	     call get_path (2, "0"b);
	     call get_arg (3);
	     fi.version = forum_info_version_1;
	     call forum_$forum_info (forum_dir, forum_name, "", (0), addr (fi), status);
	     if status = 0 | status = forum_et_$not_eligible then do;
		call ioa_ ("Changing chairman from ^a.^a to ^a.", fi.chairman.username, fi.chairman.project, arg);
		call forum_admin_$change_chairman (forum_dir, forum_name, arg, status);
		if status ^= 0 then call com_err_ (status, whoami, "Changing chairman.");
	     end;
	     else call com_err_ (status, whoami, "Getting forum info.");
	end;
	else if arg = "switch_on" | arg = "swn" then call set_switch ("1"b);
	else if arg = "switch_off" | arg = "swf" then call set_switch ("0"b);
	else call com_err_ (0, whoami, "Unrecognized key. ""^a""", arg);

PUNT:	return;
%page;
get_arg:
     procedure (arg_num);

declare	arg_num			fixed bin;

	call cu_$arg_ptr (arg_num, arg_ptr, arg_len, status);
	if status ^= 0 then do;
	     call com_err_ (status, whoami, "Argument #^d.", arg_num);
	     goto PUNT;
	end;

	return;
     end get_arg;


get_path:
     procedure (path_arg, must_be_v1);

declare	path_arg			fixed bin,
	must_be_v1		bit (1) aligned;

	call get_arg (path_arg);
	if must_be_v1 then goto VERSION1;
	call expand_pathname_$add_suffix (arg, "forum", forum_dir, forum_name, status);
	if status ^= 0 then do;
	     if status = error_table_$entlong then goto VERSION1;
EXPANDERR:    
	     call com_err_ (status, whoami, "Expanding ""^a"".", arg);
	     goto PUNT;
	end;

	call forum_$get_forum_path (forum_dir, forum_name, forum_dir, forum_name, status);
	if status = 0 then return;

VERSION1:	call expand_pathname_$add_suffix (arg, "control", forum_dir, forum_name, status);
	if status ^= 0 then goto EXPANDERR;
	
	return;
     end get_path;
%page;
set_switch:
     procedure (value);

declare	value			bit (1) aligned,
	switch_name		char (32);

	if arg_count < 2 then goto WRONG_ARGS;
	call get_arg (2);
	switch_name = arg;

	if switch_name = "meeting_eligibility_messages" | switch_name = "mtg_emsg" |
	     switch_name = "adjourned" | switch_name = "adj" then do;
	     if arg_count ^= 3 then goto WRONG_ARGS;
	     call get_path (3, "0"b);
	     call forum_admin_$set_switch (forum_dir, forum_name, "", switch_name, value, status);
	     if status ^= 0 then
		call com_err_ (status, whoami, "^[S^;Res^]etting ""^a"" switch for the ^a meeting",
		value, switch_name, pathname_ (forum_dir, forum_name));
	end;
	else do;
	     if arg_count ^= 2 then goto WRONG_ARGS;
	     call forum_admin_$set_global_switch (arg, value, status);
	     if status ^= 0 then call com_err_ (status, whoami, "^[S^;Res^]etting ""^a"" switch.", value, arg);
	end;

     end set_switch;

end forum_admin;



		    forum_create.pl1                08/19/86  2046.3rew 08/19/86  2045.0      218502


/****^  ***************************************************************
        *                                                             *
        * Copyright, (C) Massachusetts Institute of Technology, 1986  *
        *                                                             *
        * Copyright (c) 1982 by Massachusetts Institute of Technology *
        *                                                             *
        *************************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-07-29,Pattin), approve(86-07-29,MCR7354),
     audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128):
     Added 'do you really want to announce?' query and -force,
     -no_force to suppress it.   Made announce report read_only
     public.
  2) change(86-08-19,Pattin), approve(86-08-19,MCR7354),
     audit(86-08-19,Margolin), install(86-08-19,MR12.0-1135):
     PBF to above change.  Copy user's long_name into fname with the char
     builtin instead of substr, which does not pad with blanks.
                                                   END HISTORY COMMENTS */


forum_create:
fcr:
     procedure ();

/* Version 2 Forum - Create Forum meetings
  1/4/83 Jay Pattin from version 1 fcr
  Modified 6/4/83 Jay Pattin for meeting announcements */

declare	active_fnc_err_		entry options (variable),
	command_query_		entry options (variable),
	com_err_			entry options (variable),
	cu_$af_return_arg		entry (fixed bin, ptr, fixed bin (21)) returns (fixed bin (35)),
	cu_$arg_list_ptr		entry returns (ptr),
	expand_pathname_		entry (char (*), char (*), char (*), fixed bin (35)),
	format_document_$string	entry (char (*), char (*), fixed bin (21), ptr, fixed bin (35)),
	forum$enter_first_trans	entry (char (*)),
	forum_requests_$find_forum	entry (char (*), char (*), char (*), fixed bin, fixed bin (35)),
	forum_$chname_forum_idx	entry (fixed bin, char (*), char (*), fixed bin (35)),
	forum_$close_forum		entry (fixed bin, fixed bin (35)),
	forum_$create_forum		entry (char (*), char (*), fixed bin (35)),
	forum_$delete_forum		entry (char (*), char (*), fixed bin (35)),
	forum_$enter_trans		entry (fixed bin, char (*), fixed bin, char (*), bit (36) aligned, fixed bin,
				fixed bin (35)),
	forum_$forum_info		entry (char (*), char (*), char (*), fixed bin (71), ptr, fixed bin (35)),
	forum_$list_forum_acl	entry (char (*), char (*), ptr, ptr, ptr, fixed bin, fixed bin (35)),
	forum_$open_forum		entry (char (*), char (*), fixed bin, fixed bin (35)),
	forum_$read_trans		entry (fixed bin, fixed bin, ptr, ptr, fixed bin (35)),
	forum_$set_forum_acl	entry (char (*), char (*), ptr, fixed bin, fixed bin (35)),
	forum_$set_message		entry (fixed bin, char (*), fixed bin (35)),
	get_system_free_area_	entry returns (ptr),
	get_temp_segment_		entry (char (*), ptr, fixed bin (35)),
	get_wdir_			entry returns (char (168)),
	hcs_$list_acl		entry (char (*), char (*), ptr, ptr, ptr, fixed bin, fixed bin (35)),
	hcs_$status_		entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)),
	(ioa_, ioa_$rsnnl)		entry options (variable),
	iox_$get_line		entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)),
	pathname_			entry (char (*), char (*)) returns (char (168)),
	release_temp_segment_	entry (char (*), ptr, fixed bin (35)),
 	ssu_$abort_line		entry options (variable),
	ssu_$arg_count		entry (ptr, fixed bin),
	ssu_$arg_ptr		entry (ptr, fixed bin, ptr, fixed bin (21)),
	ssu_$destroy_invocation	entry (ptr),
	ssu_$get_subsystem_and_request_name
				entry (ptr) returns (char (72) var),
	ssu_$print_message		entry options(variable),
	ssu_$standalone_invocation	entry (ptr, char (*), char (*), ptr, entry, fixed bin (35)),
	user_info_$whoami		entry (char (*), char (*), char (*));

declare	(P_passport_info_ptr	ptr,
	P_ssu_ptr			ptr)
				parameter;

declare	arg_count			fixed bin,
	arg_idx			fixed bin,
	arg_len			fixed bin (21),
	arg_ptr			ptr,
	arg			char (arg_len) based (arg_ptr),
	answer			char (256) varying,
	area_ptr			ptr,
	code			fixed bin (35),
	enter_description		bit (1) aligned,
	force			bit (1) aligned,
	forum_name		char (32),
	fname			char (32),
	forum_idx			fixed bin,
	forum_directory		char (168),
	forum_dir_dir		char (168),
	forum_dir_ent		char (32),
	message			char (512),
	meeting_switch		bit (1) aligned,
	name_len			fixed bin,
	person_id			char (22),
	project			char (9),
	public_switch		bit (1) aligned,
	query_info_ptr		ptr,	
	read_only			bit (1) aligned,
	short_name		char (128),
	ssu_ptr			ptr,
	subsystem			bit (1) aligned,
	temp_seg			char (104480) based (temp_seg_ptr),
	temp_seg_ptr		ptr,
	text			char (text_len) based (temp_seg_ptr),
	text_len			fixed bin (21),
	trans_pic			pic "zz9999",
	whoami			char (32),
	cleanup			condition,
	(addr, after, before, char, index, length, ltrim, maxlength, null, pointer, reverse, rtrim, string, substr)
				builtin;

declare	1 fdoc			aligned like format_document_options,
	1 fi			aligned like forum_info,
	1 sb			aligned like status_branch;

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

declare	forum_data_$meetings_directory
				char (32) external,
	(error_table_$badopt,
	error_table_$noarg,
	forum_et_$cant_notify,
	forum_et_$no_forum)		fixed bin (35) external,
	iox_$user_input		ptr external;

declare	(RW_XACL			init ("110"b),
	R_XACL			init ("100"b),
	RW_ACCESS			init ("101"b))
				bit (3) static options (constant);

declare	(DIR			init ("Enter the pathname of the directory where the meeting is to be placed.^/Entering a carriage return will create the meeting in the current working directory.^/^/Pathname: "),
	NAME			init ("Enter the primary name of the new meeting. The name may be from 1 to 26 characters long.^/^/Primary name: "),
	SNAME			init ("Enter a secondary name for the meeting, or a carriage return if no second name is desired.^/^/Short name: "),
	PUBLIC			init ("Answering ""yes"" will allow all users on the system to participate in the meeting.^/Answering ""no"" will restrict participation to users you explicitly allow.^/"),
	PROJECT		init ("Answering ""yes"" will allow you to specify projects whose users will be allowed to participate in the meeting.^/Answering ""no"" will restrict participation to users you explicitly allow.^/"),
	PROJECTS			init ("Enter the name of a project whose users will be allowed to participate in the meeting.^/Enter a period (""."") if there are no more projects to be specified.^/"),
     	PERSON			init ("Answering ""yes"" will allow you to add individuals to the list of users allowed to participate in the meeting.^/"),
	PEOPLE			init ("Enter the person_id of a user to be allowed to participate in the meeting.^/Enter a period (""."") if there are no more users to be specified.^/"),
	ANNOUNCE			init ("Answering ""yes"" will allow you to enter an announcement of this meeting^/into another meeting so that others may easily add it to their search list.^/"),
	ANN_MTG			init ("Enter the name of the meeting in which the announcement should be entered.^/Enter a carriage return to announce it in the ^a meeting.^/Enter ""quit"" to not make the announcement.^/^/"))
				char (256) static options (constant);

declare	CMSG_EXP			char (300);	/* Not a constant because it's too big */
%page;
%include forum_passport;
%page;
%include forum_user_trans;
%page;
%include forum_info;
%page;
%include query_info;
%page;
%include format_document_options;
%page;
%include status_structures;
%page;
	whoami = "forum_create";
	subsystem = "0"b;
	call user_info_$whoami (person_id, project, "");
	forum_idx = 0;

	forum_user_trans_ptr, temp_seg_ptr = null ();
	forum_directory, forum_name = "";
	on cleanup call clean_up ("1"b);

	call ssu_$standalone_invocation (ssu_ptr, whoami, "1", cu_$arg_list_ptr (), punt, code);
	if code ^= 0 then do; 	/* UGH */
	     if cu_$af_return_arg ((0), null (), (0)) = 0 then
		call active_fnc_err_ (code, whoami, "Unable to create subsystem invocation.");
	     else call com_err_ (code, whoami, "Unable to create subsystem invocation.");
	     return;
	end;

	call ssu_$arg_count (ssu_ptr, arg_count);
	if arg_count ^= 0 then call ssu_$abort_line (ssu_ptr, 0, "Usage:  fcr");

	query_info_ptr = addr (query_info);
	query_info.version = query_info_version_6;
	query_info.suppress_spacing = "1"b;
	query_info.explanation_ptr = addr (DIR);
	query_info.explanation_len = length (rtrim (DIR));

	call command_query_ (query_info_ptr, answer, "",
	     "Enter pathname of meeting directory (carriage return for working_dir)^/");
	if answer = "" then
	     forum_directory = get_wdir_ ();
	else do;
	     forum_directory = answer;
	     call expand_pathname_ (forum_directory, forum_dir_dir, forum_dir_ent, code);
	     if code ^= 0 then 
		call ssu_$abort_line (ssu_ptr, code, "Expanding ""^a""", answer);
	     forum_directory = rtrim (forum_dir_dir) || ">" || rtrim (forum_dir_ent);
	end;

	query_info.suppress_spacing = "0"b;
	query_info.explanation_ptr = addr (NAME);
	query_info.explanation_len = length (rtrim (NAME));

BLANK:	     
	call command_query_ (query_info_ptr, answer, "", "Please enter long meeting name (<27 characters): ");
	if answer = "" then goto BLANK;

	forum_name = rtrim (answer) || ".forum";
	call forum_$create_forum (forum_directory, forum_name, code);
	if code ^= 0 then
	     call ssu_$abort_line (ssu_ptr, code, "Error creating meeting.");

	fname = char (answer, 32);

	call forum_$open_forum (forum_directory, forum_name, forum_idx, code);
	if code ^= 0 then
	     call ssu_$abort_line (ssu_ptr, code, "Unable to open newly created meeting.");

	query_info.explanation_ptr = addr (SNAME);
	query_info.explanation_len = length (rtrim (SNAME));

	call command_query_ (query_info_ptr, answer, "", "Now enter abbreviated meeting name: ");

	short_name = answer;
	if short_name ^= "" then do;
	     call forum_$chname_forum_idx (forum_idx, "", rtrim (short_name) || ".forum", code);
	     if code ^= 0 then
		call ssu_$abort_line (ssu_ptr, code, "Unable to add short name to meeting ^a.", fname);
	end;

	query_info.explanation_ptr = addr (PUBLIC);
	query_info.explanation_len = length (rtrim (PUBLIC));

	one_acl.modes = RW_ACCESS;
	query_info.yes_or_no_sw = "1"b;
	query_info.prompt_after_explanation = "1"b;
	call command_query_ (query_info_ptr, answer, "", "Should the meeting be public? ");
	if answer = "yes" then do;
	     public_switch = "1"b;
	     read_only = "0"b;
	     one_acl.access_name = "*.*.*";
	     one_acl.xmodes = RW_XACL;
	     call forum_$set_forum_acl (forum_directory, forum_name, addr (one_acl), 1, code);
	     if code ^= 0 then
		call ssu_$print_message (ssu_ptr, code, "Unable to make meeting public.");
	     goto CMSG;
	end;

	public_switch = "0"b;
	query_info.explanation_ptr = addr (PERSON);
	query_info.explanation_len = length (rtrim (PERSON));

	query_info.yes_or_no_sw = "1"b;
	call command_query_ (query_info_ptr, answer, "", "Should specified individuals be allowed to participate?");
	if answer = "yes" then do;
	     query_info.yes_or_no_sw = ""b;
	     call ioa_ ("^/Now please type person_id's of attendees when prompted.");
	     call ioa_ ("Signal the end of the list by typing a period only.");

	     query_info.explanation_ptr = addr (PEOPLE);
	     query_info.explanation_len = length (rtrim (PEOPLE));

	     call set_acl ("1"b);
	end;

	query_info.explanation_ptr = addr (PROJECT);
	query_info.explanation_len = length (rtrim (PROJECT));

	query_info.yes_or_no_sw = "1"b;
	call command_query_ (query_info_ptr, answer, "", "Should specified projects be allowed to participate?");
	if answer = "yes" then do;
	     call ioa_ ("^/Now please type project_ids when prompted.");
	     call ioa_ ("Signal the end of the list by typing a period only.");
	     query_info.explanation_ptr = addr (PROJECTS);
	     query_info.explanation_len = length (rtrim (PROJECTS));

	     query_info.yes_or_no_sw = ""b;
	     call set_acl ("0"b);
	end;

CMSG:	CMSG_EXP = "The chairman message is printed each time a participant attends a meeting^/after the message has changed and the first time he enters a transaction^/after going to a meeting.";
	CMSG_EXP = rtrim (CMSG_EXP) || "  It is intended to a serve as a reminder of the^/purpose of the meeting and of the meeting's audience.^2/Do you want to enter a chairman message? ";
				
	query_info.yes_or_no_sw = "1"b;
	query_info.prompt_after_explanation = "0"b;
	query_info.explanation_ptr = addr (CMSG_EXP);
	query_info.explanation_len = length (rtrim (CMSG_EXP));
	call command_query_ (query_info_ptr, answer, "", "Do you want to enter a chairman message (? for explanation)?");

	if answer = "yes" then call get_message ();

	call ioa_ ("The ^a meeting has been established in ^a.", fname, forum_directory);

	call ioa_ ("You must now enter the first transaction in the ^a meeting, which will^/act as an introduction.", fname);
	call forum$enter_first_trans (rtrim (forum_directory) || ">" || fname);

	query_info.prompt_after_explanation = "1"b;
	query_info.explanation_ptr = addr (ANNOUNCE);
	query_info.explanation_len = length (rtrim (ANNOUNCE));
	call command_query_ (query_info_ptr, answer, "", "Do you want to announce this meeting?");
	if answer = "yes" then call announce ();

EGRESS:	call clean_up ("0"b);
	return;
%page;
set_acl:
     proc (person);

declare	person			bit (1) aligned;

	do while ("1"b);
	     call command_query_ (query_info_ptr, answer, "", "^[Person^;Project^]_id: ", person);
	     if answer = "." then return;

	     read_only = "1"b;
	     if substr (answer, length (answer) - length (" -ro") + 1) = " -ro" then
		answer = substr (answer, 1, length (answer) - length (" -ro"));
	     else if substr (answer, length (answer) - length (" -read_only") + 1) = " -read_only" then
		answer = substr (answer, 1, length (answer) - length (" -read_only"));
	     else read_only = "0"b;
		
	     if index (answer, ".") > 0 | index (answer, "*") > 0 then
		call ssu_$print_message (ssu_ptr, 0, "^[Person^;Project^]_ids may not contain ""."" or ""*"".", person);
	     else if answer ^= "" then do;
		if person then do;
		     if answer = person_id then do;
			call ssu_$print_message (ssu_ptr, 0, "You are already a participant.");
			goto NEXT_ID;
		     end;
		     one_acl.access_name = rtrim (answer) || ".*.*";
		end;
		else one_acl.access_name = "*." || rtrim (answer) || ".*";
		if read_only then one_acl.xmodes = R_XACL;
		else one_acl.xmodes = RW_XACL;
		call forum_$set_forum_acl (forum_directory, forum_name, addr (one_acl), 1, code);
		if code ^= 0 then
		     call ssu_$print_message (ssu_ptr, code, "Unable to add ^[project ^]^a to new meeting.",
			^person, answer);
	     end;
NEXT_ID:	end;
     end set_acl;
%page;
get_message:
     proc ();

	call ioa_ ("Message (End with "".""):");

	call get_input ();
	call forum_$set_message (forum_idx, rtrim (message), code);
	if code ^= 0 then
	     call ssu_$print_message (ssu_ptr, code, "Setting chairman message.");
	return;
     end get_message;

get_input:
     proc ();

declare	buffer			char (256),
	len			fixed bin (21);

	message = "";
	do while ("1"b);
	     buffer = "";
	     call iox_$get_line (iox_$user_input, addr (buffer), 256, len, code);
	     if code ^= 0 then do;
		call ssu_$print_message (ssu_ptr, code, "Reading message.");
		return;
	     end;

	     if len > 0 then do;
		if len = 2 & substr (buffer, 1, 1) = "." then return;
		buffer = substr (buffer, 1, len);
		if length (rtrim (message)) + length (rtrim (buffer)) > maxlength (message) then
		     call ssu_$abort_line (ssu_ptr, 0, "Input must be less than 512 characters.");
		message = rtrim (message) || buffer;
	     end;
	end;
     end get_input;
%page;
announce_meeting:
     entry (P_ssu_ptr, P_passport_info_ptr);

	ssu_ptr = P_ssu_ptr;
	passport_info_ptr = P_passport_info_ptr;
	forum_idx = passport.forum_idx;

	subsystem = "1"b;
	meeting_switch, enter_description, force = "0"b;
	forum_user_trans_ptr, temp_seg_ptr = null ();
	sb.names_relp = ""b;
	on cleanup call clean_up ("1"b);

	call ssu_$arg_count (ssu_ptr, arg_count);

	do arg_idx = 1 to arg_count;
	     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
	     if index (arg, "-") ^= 1 then
		call ssu_$abort_line (ssu_ptr, 0, "Usage:  anm {-control_arg}");
	     else if arg = "-enter_description" | arg = "-eds" then enter_description = "1"b;
	     else if arg = "-force" | arg = "-fc" then force = "1"b;
	     else if arg = "-meeting" | arg = "-mtg" then do;
		meeting_switch = "1"b;
		arg_idx = arg_idx + 1;
		if arg_idx > arg_count then
		     call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Following ^a.", arg);
		call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
		call forum_requests_$find_forum (arg, forum_dir_dir, forum_dir_ent, name_len, code);
		if code ^= 0 then
		     call ssu_$abort_line (ssu_ptr, code, "Locating ^a.", arg);
	     end;
	     else if arg = "-no_force" | arg = "-nfc" then force = "0"b;
	     else call ssu_$abort_line (ssu_ptr, error_table_$badopt, "^a", arg);
	end;
		
	if forum_idx = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);
	if ^meeting_switch then do;
	     forum_dir_dir = forum_data_$central_directory;
	     forum_dir_ent = forum_data_$meetings_directory;
	     name_len = index (forum_data_$meetings_directory, ".forum") - 1;
	     if name_len < 0 then name_len = index (forum_data_$meetings_directory, ".control") - 1;
	end;
	forum_directory = passport.forum_dir;
	forum_name = passport.forum_name;
	fname = no_suffix_name;

	if ^force then do;
	     query_info.version = query_info_version_6;
	     string (query_info.switches) = ""b;
	     query_info.yes_or_no_sw = "1"b;
	     query_info.explanation_ptr, query_info.question_iocbp, query_info.answer_iocbp = null ();
	     call command_query_ (addr (query_info), answer, ssu_$get_subsystem_and_request_name (ssu_ptr),
		"Do you really want to announce the ^a meeting in the ^a meeting?",
		fname, pathname_ (forum_dir_dir, substr (forum_dir_ent, 1, name_len)));
	     if answer = "no" then return;
	end;

	area_ptr, status_area_ptr = passport.area_ptr;
	status_ptr = addr (sb);

	short_name = "";
	call hcs_$status_ (forum_directory, forum_name, 0, status_ptr, area_ptr, code);
	if code = 0 then do;
	     fname = reverse (after (reverse (status_entry_names (1)), "."));
	     if sb.nnames > 1 then
		short_name = reverse (after (reverse (status_entry_names (2)), "."));
	     do arg_idx = 3 to sb.nnames while (length (rtrim (short_name)) < 102);
		short_name = rtrim (short_name) || ", " || reverse (after (reverse (status_entry_names (arg_idx)), "."));
	     end;
	end;

	fi.version = forum_info_version_1;
	call forum_$forum_info (forum_directory, forum_name, "", 0, addr (fi), code);
	if code ^= 0 then call ssu_$abort_line (ssu_ptr, code);
	person_id = fi.chairman.username;
	project = fi.chairman.project;

	one_acl.access_name = "*.*.*";
	if forum_idx < 0 then do;
	     call forum_$list_forum_acl (forum_directory, forum_name, null (), null (), addr (one_acl), 1, code);
	     if code ^= 0 then public_switch = "0"b;
	     else do;
		public_switch = (one_acl.xmodes ^= ""b);
		read_only = (one_acl.xmodes = R_XACL);
	     end;
	end;
	else do;
	     call hcs_$list_acl (forum_directory, forum_name, null (), null (), addr (one_acl), 1, code);
	     if code ^= 0 then public_switch = "1"b;
	     else public_switch = (one_acl.modes = RW_ACCESS);
	end;

	call announce_existing ();
	return;
%page;
announce:
     proc ();

declare	(announce_idx, idx)		fixed bin,
	announce_path		char (168);

     	query_info.yes_or_no_sw, query_info.prompt_after_explanation = "0"b;
	query_info.suppress_spacing = "1"b;

	query_info.explanation_ptr = addr (ANN_MTG);
	query_info.explanation_len = length (rtrim (ANN_MTG));
AGAIN:	call command_query_ (query_info_ptr, answer, "", "^/Enter the name of the meeting where the announcement should be made.^/(Enter carriage return for ^a>^a.)^/",
	     forum_data_$central_directory, before (forum_data_$meetings_directory, "."));
	if answer = "quit" then return;

	if answer = "" then do;
	     forum_dir_dir = forum_data_$central_directory;
	     forum_dir_ent = forum_data_$meetings_directory;
	end;
	else do;
	     call forum_requests_$find_forum ((answer), forum_dir_dir, forum_dir_ent, (0), code);
	     if code ^= 0 then do;
BADMTG:		call ssu_$print_message (ssu_ptr, code, "Unable to locate ^a meeting.", answer);
		goto AGAIN;
	     end;
	end;

	area_ptr =  get_system_free_area_ ();
	call user_info_$whoami (person_id, project, "");
	enter_description = "0"b;
	goto JOIN;

announce_existing:
     entry ();

JOIN:     announce_idx = 0;
	on cleanup call forum_$close_forum (announce_idx, (0));

	call forum_$open_forum (forum_dir_dir, forum_dir_ent, announce_idx, code);
	if code ^= 0 then
	     if subsystem then call ssu_$abort_line (ssu_ptr, code, "Opening ^a>^a.", forum_dir_dir, forum_dir_ent);
	     else goto BADMTG;

	announce_path = rtrim (forum_dir_dir) || ">" || forum_dir_ent;
	call get_temp_segment_ (whoami, temp_seg_ptr, code);
	if code ^= 0 then
	     call ssu_$abort_line (ssu_ptr, code, "Unable to obtain temp segment.");

	call ioa_$rsnnl (" Names:^2-^a^[, ^a^;^s^]^/ Location:^-^a^/ Chairman:^-^a.^a^/ Participation:^-^[Public^[ (read-only)^]^/^/^]",
	     temp_seg, text_len, fname, (short_name ^= ""), short_name, forum_directory, person_id, project,
	     public_switch, read_only);

	if ^public_switch then do;
	     call ioa_ ("Enter a short description of the access to the meeting (End with ""."").");
	     call get_input ();

	     idx = length (rtrim (message));
	     if idx = 0 then do;
		substr (temp_seg, text_len, 2) = "

";
		text_len = text_len + 2;
	     end;
	     else begin;

declare	temp			char (2 * idx + 20),
	len			fixed bin (21);

		fdoc.version_number = format_document_version_2;
		fdoc.indentation = 20;
		fdoc.line_length = 52;
		string (fdoc.switches) = ""b;
		fdoc.galley_sw, fdoc.literal_sw, fdoc.dont_break_indented_lines_sw = "1"b;
		fdoc.syllable_size = 3;		/* Make fdoc happy */

		call format_document_$string (substr (message, 1, idx), temp, len, addr (fdoc), code);
		if code ^= 0 then
		     call ssu_$abort_line (ssu_ptr, code, "Unable to fill announcement.");

		len = len - 20;			/* remove indentation from first line. */
		substr (temp_seg, text_len + 1, len + 1) = substr (temp, 21, len) || "
";
		text_len = text_len + len + 1;
	     end;					/* BEGIN */
	end;

	if enter_description then call enter_meeting_description ();
	else do;
	     call forum_$read_trans (forum_idx, 1, area_ptr, forum_user_trans_ptr, code );
	     if code ^= 0 then do;
		call ssu_$print_message (ssu_ptr, code, "Unable to read first transaction.");
		call enter_meeting_description ();
	     end;
	     else do;
		substr (temp_seg, text_len + 1, forum_user_trans.text_length) = forum_user_trans.text;
		text_len = text_len + forum_user_trans.text_length;
	     end;
	end;

	forum_dir_dir = rtrim (fname) || " meeting";
	call forum_$enter_trans (announce_idx, text, 0, forum_dir_dir, "11"b, idx, code);
	if code ^= 0 then
	     if code ^= forum_et_$cant_notify then
		call ssu_$abort_line (ssu_ptr, code, "Unable to enter announcement.");

	trans_pic = idx;
	call ioa_ ("Announcement [^a] entered in the ^a meeting.", ltrim (trans_pic), announce_path);

	call forum_$close_forum (announce_idx, (0));

	return;
     end announce;
%page;
enter_meeting_description:
     proc ();

declare	idx			fixed bin (21);

	call ioa_ ("Please enter a short description of the meeting (End with ""."").");
	call get_input ();

	idx = length (rtrim (message));
	substr (temp_seg, text_len + 1, idx) = message;
	text_len = text_len + idx;
	return;
     end enter_meeting_description;

clean_up:
     proc (cleanup_sw);

declare	cleanup_sw		bit (1) aligned;

     	if forum_user_trans_ptr ^= null () then free forum_user_trans;
	if temp_seg_ptr ^= null () then
	     call release_temp_segment_ (whoami, temp_seg_ptr, (0));

	if subsystem then do;
	     if sb.names_relp ^= ""b then free status_entry_names;
	     return;
	end;

	call forum_$close_forum (forum_idx, (0));
	if ^cleanup_sw then return;

	call forum_$delete_forum (forum_directory, forum_name, (0));
	call ssu_$destroy_invocation (ssu_ptr);

	return;
     end clean_up;


punt:
     proc ();

	goto EGRESS;

	end punt;
	
end forum_create;
  



		    forum_find_v1.pl1               04/09/85  1614.8r w 04/08/85  1130.6       94221


/* **************************************************************
   *                                                            *
   * Copyright, (C) Massachusetts Institute of Technology, 1985 *
   *                                                            *
   ************************************************************** */
ffv1:
forum_find_v1:
     proc ();

%include star_structures;
%include status_structures;
%include access_mode_values;

declare	arg_count			fixed bin,
	arg_ptr			ptr,
	arg_len			fixed bin (21),
	arg			char (arg_len) based (arg_ptr),
	(dir, dir_dir)		char (168),
	dir_name			char (32),
	dir_quota			fixed bin (18),
	dir_qused			fixed bin (18),
	idx			fixed bin,
	modes			bit (36) aligned,
	name			char (32),
	v1_recs_used		fixed bin,
	v2_qused			fixed bin (18),
	status			fixed bin (35);

declare	cu_$arg_count		entry (fixed bin, fixed bin(35)),
	cu_$arg_ptr		entry (fixed bin, ptr, fixed bin (21), fixed bin (35)),
	check_gate_access_		entry (char (*), ptr, fixed bin (35)),
	com_err_			entry options (variable),
	convert_status_code_	entry (fixed bin(35), char(8) aligned, char(100) aligned),
	expand_pathname_		entry (char(*), char(*), char(*), fixed bin(35)),
	forum_$delete_forum		entry (char(*), char(*), fixed bin(35)),
	forum_$get_forum_path	entry (char(*), char(*), char(*), char(*), fixed bin(35)),
	forum_$get_uid_file		entry (char (*), char (*), bit (36) aligned, fixed bin (35)),
	forum_admin_$convert	entry (char (*), char (*), fixed bin (35)),
	get_system_free_area_	entry returns (ptr),
	get_wdir_			entry returns (char (168)),
	hcs_$get_link_target	entry (char(*), char(*), char(*), char(*), fixed bin(35)),
	hcs_$get_user_access_modes	entry (char(*), char(*), char(*), fixed bin, bit(36) aligned, bit(36) aligned,
				fixed bin(35)),
	hcs_$quota_read		entry (char(*), fixed bin(18), fixed bin(71), bit(36) aligned, bit(36), fixed bin(1),
				fixed bin(18), fixed bin(35)),
	hcs_$star_		entry (char(*), char(*), fixed bin(2), ptr, fixed bin, ptr, ptr, fixed bin(35)),
	hcs_$status_		entry (char(*), char(*), fixed bin(1), ptr, ptr, fixed bin(35)),
	hphcs_$restore_quota	entry (),
	hphcs_$suspend_quota	entry (),
	ioa_$ioa_switch		entry options (variable),
	iox_$look_iocb		entry (char(*), ptr, fixed bin(35)),
	pathname_			entry (char(*), char(*)) returns(char(168));

declare	(link_switch, link_err_switch, meeting_switch, meeting_err_switch)
				pointer static init (null ()),
	iox_$error_output		pointer external;

declare	(error_table_$wrong_no_of_args,
	 error_table_$noaccess,
	 error_table_$noentry,
	 error_table_$no_info,
	 error_table_$nomatch,
	 forum_et_$not_a_forum,
	 forum_et_$no_suffix,
	 forum_et_$no_such_forum) fixed bin (35) external;

declare	(length, addr, binary, sum, reverse, rtrim)
				builtin,
	(cleanup, linkage_error)	condition;

declare	1 sb			aligned like status_branch;
%page;
	call cu_$arg_count (arg_count, status);
	if status ^= 0 then do;
PUNT:	     call com_err_ (status, "forum_find_v1_links");
	     return;
	end;

	if arg_count > 1 then do;
	     status = error_table_$wrong_no_of_args;
	     goto PUNT;
	end;
	if arg_count = 1 then do;
	     call cu_$arg_ptr (1, arg_ptr, arg_len, status);
	     if status ^= 0 then goto PUNT;
	     call expand_pathname_ (arg, dir, name, status);
	     if status ^= 0 then goto PUNT;
	     dir = pathname_ (dir, name);
	end;
	else dir = get_wdir_ ();

	star_entry_ptr, star_names_ptr = null ();
	on cleanup begin;
	     if star_names_ptr ^= null () then free star_names;
	     if star_entry_ptr ^= null () then free star_entries;
	end;

	call hcs_$star_ (dir, "**.*.control", star_LINKS_ONLY, get_system_free_area_ (), star_entry_count,
	     star_entry_ptr, star_names_ptr, status);
	if status ^= 0 then do;
	     if status = error_table_$nomatch then goto LOOK_FOR_MEETINGS;
	     else do;
		call ioa_$ioa_switch (iox_$error_output, "^a ^a", get_message (status), dir);
		return;
	     end;
	end;
	
	do idx = 1 to star_entry_count;
	     if test_link (star_names (star_entries (idx).nindex)) then do;
		free star_names;
		free star_entries;
		call ioa_$ioa_switch (link_switch, "^a", dir);
		goto LOOK_FOR_MEETINGS;
	     end;
	end;
	free star_names;
	free star_entries;
/* Now look for meetings */

LOOK_FOR_MEETINGS:
	call hcs_$star_ (dir, "**.*.control", star_ALL_ENTRIES, get_system_free_area_ (), star_entry_count,
	     star_entry_ptr, star_names_ptr, status);
	if status ^= 0 then do;
	     if status = error_table_$nomatch then return;
	     else do;
		call ioa_$ioa_switch (iox_$error_output, "^a ^a", get_message (status), dir);
		return;
	     end;
	end;
	
	do idx = 1 to star_entry_count;
	     if star_entries (idx).type = star_SEGMENT then
		call test_meeting (star_names (star_entries (idx).nindex));
	end;

	free star_names;
	free star_entries;
	return;

test_link:
     procedure (name) returns (bit (1) aligned);

declare	name			char (32),
	target_dir		char (168),
	target_name		char (32);

	call forum_$get_forum_path (dir, name, target_dir, target_name, status);
	if status = 0 then return ("1"b);

	call hcs_$get_link_target (dir, name, target_dir, target_name, status);
	if status = 0 then return ("0"b);		/* target exists, not a meeting */

	if status = error_table_$noentry then do;
	     target_name = reverse (after (reverse (target_name), ".")) || ".forum";
	     call forum_$get_forum_path (target_dir, target_name, target_dir, target_name, status);
	     if status = 0 then return ("1"b);		/* already converted */
	     if status ^= forum_et_$no_such_forum & status ^= forum_et_$no_suffix then 
		call ioa_$ioa_switch (link_err_switch, "^a In noentry ^a in ^a.", get_message (status), name, dir);
	end;
	else if status ^= error_table_$no_info & status ^= error_table_$noaccess then
	   call ioa_$ioa_switch (link_err_switch, "^a link target for ^a in ^a.",
		get_message (status), name, dir);

	return ("0"b);
     end test_link;

test_meeting:
     procedure (name);

declare	name			char (32),
	uid			bit (36) aligned;

	call forum_$get_uid_file (dir, name, uid, status);
	if status = 0 then do;
	     call ioa_$ioa_switch (meeting_switch, "^a", pathname_ (dir, name));
	     return;
	end;

	if status ^= forum_et_$not_a_forum then
	     call ioa_$ioa_switch (meeting_err_switch, "^a ^a in ^a.", get_message (status), name, dir);
	
	return;
     end test_meeting;

get_message:
     procedure (status) returns (char (100) aligned);
     
declare	status			fixed bin (35),
	short			char (8) aligned,
	long			char (100) aligned;

	call convert_status_code_ (status, short, long);
	return (long);
     end get_message;

init_search:
     entry ();

declare	no_switch_		condition;

	call iox_$look_iocb ("forum_links_", link_switch, status);
	if link_switch = null () then signal no_switch_;

	call iox_$look_iocb ("forum_meetings_", meeting_switch, status);
	if meeting_switch = null () then signal no_switch_;

	call iox_$look_iocb ("forum_link_errors_", link_err_switch, status);
	if link_switch = null () then signal no_switch_;

	call iox_$look_iocb ("forum_meeting_errors_", meeting_err_switch, status);
	if meeting_switch = null () then signal no_switch_;

	return;

init_convert:
     entry ();

	call check_gate_access_ ("hphcs_", codeptr (init_convert), status);
	if status ^= 0 then do;
	     call com_err_ (status, "convert_meetings", "This command requires access to the hphcs_ gate.");
	     return;
	end;

	call check_gate_access_ ("forum_admin_", codeptr (init_convert), status);
	if status ^= 0 then do;
	     call com_err_ (status, "convert_meetings", "This command requires access to the forum_admin_ gate.");
	     return;
	end;

	call hphcs_$suspend_quota ();
	return;

cleanup_convert:
     entry ();

	call hphcs_$restore_quota ();
	return;

/* convert one meeting. This is called as a command by the exec_com, don't
   bother checking the arguments. */

convert_one_meeting:
     entry (meeting_path);

declare	meeting_path		char (*),
	v2_name			char (32),
	proceedings_name		char (32);

	call expand_pathname_ (meeting_path, dir, name, status);
	if status ^= 0 then do;
BADPATH:	     call ioa_$ioa_switch (iox_$error_output, "^a for ^a.", get_message (status), meeting_path);
	     return;
	end;

	call expand_pathname_ (dir, dir_dir, dir_name, status);
	if status ^= 0 then goto BADPATH;

	call hcs_$get_user_access_modes (dir_dir, dir_name, "", -1, modes, ""b, status);
	if modes ^= SMA_ACCESS then do;
	     call ioa_$ioa_switch (iox_$error_output, "No sma permission on containing directory for ^a.", meeting_path);
	     return;
	end;

	call find_terminal_quota (dir_quota, dir_qused);

	call forum_admin_$convert (dir, name, status);
	if status ^= 0 then goto BADPATH;

	v2_name = reverse (substr (reverse (rtrim (name)), 9)) || ".forum";

	call hcs_$quota_read (pathname_ (dir, v2_name), 0, 0, ""b, ""b, 0, v2_qused, status);
	if status ^= 0 then do;
DELV2:	     call forum_$delete_forum (dir, v2_name, (0));
	     call ioa_$ioa_switch (iox_$error_output, "^a after conversion of ^a.", get_message (status), meeting_path);
	end;

	if v2_qused + dir_qused <= dir_quota then do;	/* obviously enough quota */
	     call forum_$delete_forum (dir, name, (0));
	     return;
	end;

/* Now we need to determine how much quota the v1 meeting is using */

	proceedings_name = reverse (substr (reverse (rtrim (name)), 9)) || ".proceedings";

	call hcs_$status_ (dir, name, 0, addr (sb), null (), status);
	if status ^= 0 then goto DELV2;
	
	v1_recs_used = sb.records_used;

	call hcs_$status_ (dir, proceedings_name, 0, addr (sb), null (), status);
	if status ^= 0 then goto DELV2;

	v1_recs_used = v1_recs_used + sb.records_used;
	if dir_qused + v2_qused - v1_recs_used <= dir_quota + 5 /* SLOP */then do;
	     call forum_$delete_forum (dir, name, (0));
	     return;
	end;

	call ioa_$ioa_switch (iox_$error_output, "Insufficient quota to convert ^a.", meeting_path);
	call forum_$delete_forum (dir, v2_name, (0));

	return;

find_terminal_quota:
	procedure (dir_quota, dir_qused);

declare	(dir_quota, dir_qused)	fixed bin (18),
	local_dir			char (168);

declare	cant_find_terminal_quota	condition;

	local_dir = dir;
	do while ("1"b);
	     call hcs_$quota_read (local_dir, dir_quota, 0, ""b, ""b, 0, dir_qused, status);
	     if status ^= 0 then goto BADPATH;

	     if dir_quota > 0 then return;
	     local_dir = reverse (after (reverse (local_dir), ">"));

	     if local_dir = "" then signal cant_find_terminal_quota;
	end;
     end find_terminal_quota;

     end forum_find_v1;
   



		    forum_input_requests_.pl1       04/27/92  1054.2r w 04/27/92  1032.0      458262


/****^  ***************************************************************
        *                                                             *
        * Copyright, (C) BULL HN Information Systems Inc., 1990       *
        *                                                             *
        * Copyright, (C) Massachusetts Institute of Technology, 1986  *
        *                                                             *
        * Copyright (c) 1982 by Massachusetts Institute of Technology *
        *                                                             *
        *************************************************************** */


/****^  HISTORY COMMENTS:
  1) change(86-07-29,Pattin), approve(86-07-29,MCR7354),
     audit(86-08-07,Margolin), install(86-08-16,MR12.0-1128):
     Fixed bug in apply request causing null ptr faults.
  2) change(90-09-03,Bubric), approve(90-09-03,MCR8200),
     audit(90-09-26,Blackmore), install(90-10-05,MR12.4-1038):
     Fix the forum request "apply" so that it doesn't change an unprocessed
     transaction's meeting to the current meeting.
  3) change(91-09-05,Huen), approve(91-09-05,MCR8249),
     audit(92-01-08,Zimmerman), install(92-04-27,MR12.5-1014):
     phx20579: Fix the "apply" request to create new unproc trans when
     no unproc trans exists and no trans_specs is given.
     phx20578: Generate a complete header when printing an unproc trans which
     is created iwth the use of the "spply" request.
  4) change(91-09-05,Huen), approve(91-09-05,MCR8250),
     audit(92-01-08,Zimmerman), install(92-04-27,MR12.5-1014):
     phx20898 & 20899: Fix the "enter" request to handle trans created with
     "reply -mtg"
                                                   END HISTORY COMMENTS */
/* This module contains the following forum requests:

   talk   reply   set_message   enter   subject   fill
   apply   qedx   ted

   Original coding 6/81 J. Spencer Love
   Modified for ssu_ 8/21/81 Jay Pattin
   added set_message 2/27/82 Jay Pattin
   changed to use format_document_ and apply_request_util_ 6/27/82 Jay Pattin
   changed to use qedx_ (FINALLY !!) 1/18/83 Jay Pattin */

forum_input_requests_$talk_request:
     procedure (P_ssu_ptr, P_passport_info_ptr);

	declare (P_ssu_ptr, P_passport_info_ptr)
				 ptr parameter;

	declare (addr, codeptr, divide, index, length, ltrim, min, null, rtrim, string, substr, translate, verify)
				 builtin;

	declare (cleanup, linkage_error) condition;

	declare answer		 char (6) varying,
	        arg_count		 fixed bin,
	        arg_idx		 fixed bin,
	        arg_len		 fixed bin (21),
	        arg_ptr		 ptr,
	        auto_rql		 bit (1) aligned,
	        auto_write		 bit (1) aligned,
	        bit_count		 fixed bin (24),
	        brief_switch	 bit (1),
	        buffer_len		 fixed bin (21),
	        buffer_ptr		 ptr,
	        default_switch	 bit (1) aligned,
	        dirname		 char (168),
	        entryname		 char (32),
	        fill_switch		 fixed bin,
	        first_nonwhite_pos	 fixed bin (21),
	        force		 bit (1) aligned,
	        idx		 fixed bin (21),
	        inhibit_auto_fill	 bit (1) aligned,
	        inhibit_input_cp_escape bit (1) aligned,
	        line_length		 fixed bin,
	        mask		 bit (36) aligned,
	        message		 char (256),
	        message_sw		 bit (1) aligned,
	        forum_idx		 fixed bin,
	        forum_dir		 char (168),
	        forum_name		 char (32),
	        full_forum_name	 char (32),
	        new_buffer_ptr	 ptr,
	        new_buffer_len	 fixed bin (21),
	        no_chars_read	 fixed bin (21),	/* used for iox_ calls */
	        reply_switch	 bit (1),
	        reply_trans_idx	 fixed bin,
	        request_loop	 bit (1) aligned,
	        return_arg_len	 fixed bin (21),
	        return_arg_ptr	 ptr,
	        ssu_ptr		 ptr,
	        status		 fixed binary (35),
	        subject_arg_len	 fixed bin (21),
	        subject_arg_ptr	 ptr,
	        subject_switch	 bit (1) aligned,
	        ted_data_p		 ptr,
	        temp_forum		 bit (1) aligned,
	        text_len		 fixed bin (21),
	        temp_seg_ptr	 ptr,
	        terminal_switch	 bit (1) aligned,
	        trans_pic		 pic "zz9999",	/* pretty picture of trans no */
	        user_file_len	 fixed bin (21),
	        user_file_ptr	 ptr,
	        whoami		 char (32),
	        whoami_really	 char (32);

	declare 1 ted_info		 aligned like ted_data,
	        1 fdoc		 aligned like format_document_options,
	        1 qi		 aligned,
		2 header		 like qedx_info.header,
		2 buffers		 (2) like qedx_info.buffers;

	declare arg		 char (arg_len) based (arg_ptr),
	        buffer		 char (buffer_len) based (buffer_ptr),
	        new_buffer		 char (new_buffer_len) based (new_buffer_ptr),
	        return_arg		 char (return_arg_len) varying based (return_arg_ptr),
	        subject		 char (no_chars_read - first_nonwhite_pos)
				 based (add_char_offset_ (buffer_ptr, first_nonwhite_pos)),
	        subject_arg		 char (subject_arg_len) based (subject_arg_ptr),
	        temp_seg		 char (4 * sys_info$max_seg_size) based (temp_seg_ptr),
	        temp_text		 char (text_len) based (temp_seg_ptr),
	        user_file		 char (user_file_len) based (user_file_ptr);

	declare static_initialized	 bit (1) aligned static initial ("0"b),
	        my_person_id	 char (20) static,
	        my_project_id	 char (9) static;

	declare NORMAL_TERMINATION	 initial (1) fixed bin static options (constant),
	        ENTER_REQUEST_LOOP	 initial (2) fixed bin static options (constant),
	        ENTER_EDITOR	 initial (3) fixed bin static options (constant);

	declare LOWER_CASE		 initial ("abcdefghijklmnopqrstuvwxyz") char (26) static options (constant),
	        UPPER_CASE		 initial ("ABCDEFGHIJKLMNOPQRSTUVWXYZ") char (26) static options (constant);

	declare NL		 char (1) static options (constant) initial ("
"),
	        SPACE_AND_TAB	 char (2) static options (constant) initial ("	 "),
	        WHITE_CHARS		 char (5) static options (constant) initial ("
	 ");					/* NL VT FF HT SPACE				*/

	declare (forum_et_$cant_notify,
	        forum_et_$no_forum,
	        forum_et_$no_unprocessed,
	        forum_et_$read_only,
	        error_table_$bad_conversion,
	        error_table_$badopt,
	        error_table_$fatal_error,
	        error_table_$inconsistent,
	        error_table_$long_record,
	        error_table_$noarg,
	        error_table_$oldnamerr,
	        error_table_$recoverable_error,
	        error_table_$zero_length_seg,
	        sys_info$max_seg_size) fixed bin (35) external,
	        iox_$user_input	 ptr external;

	declare add_char_offset_	 entry (ptr, fixed bin (21)) returns (ptr) reducible,
	        command_query_	 entry () options (variable),
	        format_document_$string entry (char (*), char (*), fixed bin (21), ptr, fixed bin (35)),
	        forum_requests_$open_forum
				 entry (char (*), fixed bin, char (*), char (*), fixed bin (35)),
	        forum_trans_specs_$parse_specs
				 entry (ptr, fixed bin, bit (36) aligned, entry, fixed bin, char (*), char (*), ptr),
	        forum_trans_util_$read_trans entry (ptr, fixed bin, fixed bin, ptr, fixed bin (35)),
	        forum_$close_forum	 entry (fixed bin, fixed bin (35)),
	        forum_$enter_trans	 entry (fixed bin, char (*), fixed bin, char (*), bit (1) aligned, fixed bin,
				 fixed bin (35)),
	        forum_$get_message	 entry (fixed bin, char (*), fixed bin (35)),
	        forum_$set_message	 entry (fixed bin, char (*), fixed bin (35)),
	        forum_$open_forum	 entry (char (*), char (*), fixed bin, fixed bin (35)),
	        cu_$cp		 entry (ptr, fixed bin (21), fixed bin (35)),
	        cv_dec_check_	 entry (char (*), fixed bin (35)) returns (fixed bin (35)),
	        expand_pathname_	 entry (char (*), char (*), char (*), fixed bin (35)),
	        get_temp_segment_	 entry (char (*), ptr, fixed bin (35)),
	        hcs_$fs_get_path_name	 entry (ptr, char (*), fixed bin, char (*), fixed bin (35)),
	        hcs_$initiate_count	 entry (char (*), char (*), char (*), fixed bin (24), fixed bin (2), ptr,
				 fixed bin (35)),
	        hcs_$reset_ips_mask	 entry (bit (36) aligned, bit (36) aligned),
	        hcs_$set_bc_seg	 entry (ptr, fixed bin (24), fixed bin (35)),
	        hcs_$set_ips_mask	 entry (bit (36) aligned, bit (36) aligned),
	        hcs_$status_mins	 entry (ptr, fixed bin (2), fixed bin (24), fixed bin (35)),
	        hcs_$terminate_noname	 entry (ptr, fixed bin (35)),
	        iox_$get_line	 entry (ptr, ptr, fixed bin (21), fixed bin (21), fixed bin (35)),
	        ioa_		 entry options (variable),
	        ioa_$nnl		 entry options (variable),
	        ipc_$cutoff		 entry (fixed bin (71), fixed bin (35)),
	        ipc_$reconnect	 entry (fixed bin (71), fixed bin (35)),
	        qedx_		 entry (ptr, fixed bin (35)),
	        release_temp_segment_	 entry (char (*), ptr, fixed bin (35)),
	        requote_string_	 entry (char (*)) returns (char (*)),
	        ssu_$abort_line	 entry options (variable),
	        ssu_$apply_request_util entry (ptr, fixed bin, ptr, fixed bin (21), fixed bin (21)),
	        ssu_$arg_ptr	 entry (ptr, fixed bin, ptr, fixed bin (21)),
	        ssu_$get_request_name	 entry (ptr) returns (char (32) varying),
	        ssu_$get_subsystem_and_request_name
				 entry (ptr) returns (char (72) varying),
	        ssu_$print_message	 entry options (variable),
	        ssu_$return_arg	 entry (ptr, fixed bin, bit (1) aligned, ptr, fixed bin (21)),
	        user_info_$whoami	 entry (char (*), char (*), char (*)),
	        value_$get		 entry options (variable);
%page;
%include forum_passport;
%page;
%include forum_user_trans;
%page;
%include forum_trans_list;
%page;
%include query_info;
%page;
%include ted_;
%page;
%include qedx_info;
%page;
%include format_document_options;
%page;
/* forum_input_requests_$talk_request:  procedure (P_ssu_ptr, P_passport_info_ptr);		*/

	call setup_request (1);

	reply_switch = "0"b;
	auto_rql = "1"b;

	on cleanup call clean_up_talk ();

	do arg_idx = 1 to arg_count;
	     call parse_arg (arg_idx);
	end;

	call process_transaction ();

	call clean_up_talk ();

	return;
%page;
forum_input_requests_$reply_request:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call setup_request (1);
	if passport.forum_idx = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);

	reply_switch = "1"b;
	auto_rql = "1"b;

	on cleanup call clean_up_talk ();

	parse_flags_word = ""b;
	parse_flags.only_one = "1"b;
	parse_flags.disallow_unproc = "1"b;
	parse_flags.disallow_meeting = "1"b;
	parse_flags.disallow_reverse = "1"b;
	parse_flags.disallow_idl = "1"b;
	parse_flags.dont_read = "1"b;
	parse_flags.disallow_cmsg = "1"b;
	parse_flags.disallow_by_chain = "1"b;
	call forum_trans_specs_$parse_specs (passport_info_ptr, 1, parse_flags_word, parse_arg, forum_idx, forum_dir,
	     forum_name, forum_trans_list_ptr);

	if forum_idx ^= 0 then do;
		temp_forum = "1"b;
		if forum_idx < 0 then
		     full_forum_name = rtrim (forum_name) || ".forum";
		else full_forum_name = rtrim (forum_name) || ".control";
	     end;
	else forum_idx = passport.forum_idx;
	reply_trans_idx = forum_trans_list.list (1).trans_num; /* get correct subject */

	free forum_trans_list;

	call process_transaction ();

	call clean_up_talk ();

	return;
%page;
forum_input_requests_$set_message:
     entry (P_ssu_ptr, P_passport_info_ptr);

	call setup_request (1);

	message_sw, auto_rql = "1"b;

	on cleanup call clean_up_talk ();

	do arg_idx = 1 to arg_count;
	     call parse_arg (arg_idx);
	end;

	call process_transaction ();
	call clean_up_talk ();

	return;
%page;
parse_arg:
     procedure (arg_idx);

	declare arg_idx		 fixed bin;

	call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);

	if substr (arg, 1, min (1, arg_len)) = "-"
	then if arg = "-brief" | arg = "-bf" then brief_switch = "1"b;
	     else if arg = "-auto_write" then auto_write = "1"b;
	     else if arg = "-no_auto_write" then auto_write = "0"b;
	     else if arg = "-fill" | arg = "-fi" then fill_switch = 1;
	     else if arg = "-force" | arg = "-fc" then force = "1"b;
	     else if arg = "-input_file" | arg = "-if" then call get_input_file (arg_idx);
	     else if arg = "-line_length" | arg = "-ll" then do;
		     if arg_idx = arg_count then
			call ssu_$abort_line (ssu_ptr, error_table_$noarg, "Following ^a.", arg);
		     arg_idx = arg_idx + 1;
		     call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);
		     line_length = cv_dec_check_ (arg, status);
		     if status ^= 0 then
			call ssu_$abort_line (ssu_ptr, error_table_$bad_conversion, "^a", arg);

		     if line_length < 40 then call ssu_$abort_line (ssu_ptr, 0, "Line length must be at least 40.");
		     fill_switch = 1;
		end;
	     else if arg = "-long" | arg = "-lg" then brief_switch = "0"b;
	     else if ^message_sw & (arg = "-meeting" | arg = "-mtg") then call get_forum (arg_idx);
	     else if arg = "-no_fill" | arg = "-nfi" then fill_switch = -1;
	     else if arg = "-no_force" | arg = "-nfc" then force = "0"b;
	     else if arg = "-no_request_loop" | arg = "-nrql" then do;
		     request_loop = "0"b;
		     auto_rql = "0"b;
		end;
	     else if arg = "-request_loop" | arg = "-rql" then do;
		     request_loop = "1"b;
		     auto_rql = "0"b;
		end;
	     else if ^message_sw & (arg = "-subject" | arg = "-sj") then call get_subject (arg_idx);
	     else if arg = "-terminal_input" | arg = "-ti" then terminal_switch = "1"b;

	     else call ssu_$abort_line (ssu_ptr, error_table_$badopt, """^a""", arg);

	else call ssu_$abort_line (ssu_ptr, 0, "Usage:  ^a ^[{trans_spec} ^]{-control_args}", whoami, reply_switch);

	return;

     end parse_arg;
%page;
get_input_file:
     procedure (arg_idx);

	declare arg_idx		 fixed bin;

	if user_file_ptr ^= null () then call ssu_$abort_line (ssu_ptr, 0, "Only one -input_file is permitted.");

	arg_idx = arg_idx + 1;
	call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);

	call expand_pathname_ (arg, dirname, entryname, status);
	if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "^a", arg);

	call hcs_$initiate_count (dirname, entryname, "", bit_count, 0, user_file_ptr, status);
	if user_file_ptr = null ()
	then call ssu_$abort_line (ssu_ptr, status, "Initiating ^a^[>^]^a.", dirname, dirname ^= ">", entryname);

	user_file_len = divide (bit_count, 9, 21, 0);
	if user_file_len <= 0 then
	     call ssu_$abort_line (ssu_ptr, error_table_$zero_length_seg, "^a^[>^]^a", dirname, dirname ^= ">", entryname);

	return;

     end get_input_file;
%page;
get_forum:
     procedure (arg_idx);

	declare arg_idx		 fixed bin;

	if temp_forum then call ssu_$abort_line (ssu_ptr, 0, "-meeting may only be specified once.");

	arg_idx = arg_idx + 1;
	call ssu_$arg_ptr (ssu_ptr, arg_idx, arg_ptr, arg_len);

	call forum_requests_$open_forum (arg, forum_idx, forum_dir, forum_name, status);
	if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "^a", arg);

	temp_forum = "1"b;
	if forum_idx < 0 then
	     full_forum_name = rtrim (forum_name) || ".forum";
	else full_forum_name = rtrim (forum_name) || ".control";
	return;

     end get_forum;
%page;
get_subject:
     procedure (arg_idx);

	declare arg_idx		 fixed bin;

	if subject_arg_ptr ^= null ()
	then call ssu_$abort_line (ssu_ptr, 0, "Only one ""-subject"" may be specified.");

	arg_idx = arg_idx + 1;
	call ssu_$arg_ptr (ssu_ptr, arg_idx, subject_arg_ptr, subject_arg_len);

	subject_arg_len = length (rtrim (subject_arg, WHITE_CHARS));
	idx = verify (subject_arg, WHITE_CHARS) - 1;
	if idx < 0 then idx = 0;
	subject_arg_len = subject_arg_len - idx;
	subject_arg_ptr = add_char_offset_ (subject_arg_ptr, idx);

	if subject_arg_len = 0 then call ssu_$abort_line (ssu_ptr, 0, "The subject field may not be blank.");

	return;

     end get_subject;

ask_subject:
     procedure ();

	no_chars_read, first_nonwhite_pos = 0;
	do while (no_chars_read <= first_nonwhite_pos);
	     call get_line ("Subject:  ");
	end;

	call allocate_transaction (subject, "", inhibit_auto_fill);

	return;

     end ask_subject;

add_to_subject:
     procedure ();

	if buffer_ptr = null () then do;
		buffer_len = 256;
		allocate buffer in (forum_area);
	     end;

	do while (subject_arg_len + arg_len + 1 > buffer_len);
	     call make_bigger_buffer (subject_arg_len);
	end;

	buffer = substr (buffer, 1, subject_arg_len) || arg || " ";
	subject_arg_len = subject_arg_len + arg_len + 1;

	return;
     end add_to_subject;
%page;
process_transaction:
     procedure ();

	if forum_idx = 0 then call ssu_$abort_line (ssu_ptr, forum_et_$no_forum);

	if user_file_ptr ^= null () & terminal_switch then
	     call ssu_$abort_line (ssu_ptr, error_table_$inconsistent, """-input_file"" and ""-terminal_input""");

	if user_file_ptr ^= null () then
	     if auto_rql then request_loop = "1"b;
	     else ;
	else auto_rql = "0"b;

	if fill_switch = 0 then
	     if user_file_ptr ^= null () | ^passport.talk_fill then fill_switch = -1;
	     else fill_switch = 1;

	if passport.unprocessed_trans_ptr ^= null ()
	then if user_file_ptr ^= null () & ^request_loop
	     then forum_user_trans_ptr = null ();	/* Don't affect unprocessed in this case. */
	     else if ^force then do;
		     query_info.version = query_info_version_5;
		     query_info.suppress_name_sw = ""b;
		     query_info.yes_or_no_sw = "1"b;
		     call command_query_ (addr (query_info), answer, whoami_really,
			"A previous unprocessed transaction has not been entered.^/Do you wish to overwrite it?");
		     if answer = "no" then call ssu_$abort_line (ssu_ptr);
		end;

	inhibit_auto_fill = (fill_switch < 0);

	if ^message_sw then do;
		if ^brief_switch & passport.print_message then do;
			call forum_$get_message (forum_idx, message, status);
			if status = 0 then call ioa_$nnl ("^a", message);
			passport.print_message = "0"b;
		     end;

		if reply_switch then call print_subject ("", inhibit_auto_fill);
		else if subject_arg_ptr ^= null () then call allocate_transaction (subject_arg, "", inhibit_auto_fill);
		else call ask_subject ();
	     end;
	else call allocate_transaction ((""), (""), inhibit_auto_fill);

	if user_file_ptr ^= null () then do;
		call allocate_transaction (forum_user_trans.subject, user_file, forum_user_trans.unfilled);
		if ^request_loop then call enter_the_transaction ();
		if auto_rql then
		     call ioa_ ("Use the ""enter"" request to enter the ^[message^;transaction^].", message_sw);
	     end;

	else call build_transaction ();

	return;

     end process_transaction;
%page;
print_subject:
     procedure (P_text, P_inhibit_auto_fill);

	declare P_text		 char (*),
	        P_inhibit_auto_fill	 bit (1) aligned,
	        p			 ptr;


/* If -subject given in "reply" request, then override default subject specification.  We needn't tell him, he knows.	*/

	if subject_arg_len > 0 then do;
		call allocate_transaction (subject_arg, P_text, P_inhibit_auto_fill);
		return;
	     end;

/* Now read out the forum to reply to so we can get its subject.  Transaction is always from current meeting*/

	call forum_trans_util_$read_trans (passport_info_ptr, passport.forum_idx, reply_trans_idx, p, status);
	if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Transaction #^d.", reply_trans_idx);

/* If the unprocessed transaction has no associated forum_name, repair damage done by "subject -unthread".		*/

	if forum_name = "" then do;
		forum_dir = passport.forum_dir;
		full_forum_name = passport.forum_name;
		forum_name = no_suffix_name;
	     end;

/* If subject already begins with "Re: " then we shouldn't add another one.					*/

	if substr (p -> forum_user_trans.subject, 1, min (4, p -> forum_user_trans.subject_length)) = "Re: "
	then call allocate_transaction (p -> forum_user_trans.subject, P_text, P_inhibit_auto_fill);
	else call allocate_transaction ("Re: " || p -> forum_user_trans.subject, P_text, P_inhibit_auto_fill);

/* OK, now we can tell the user what the subject is. */

	call ioa_ ("Subject:  ^a", forum_user_trans.subject);

	return;

     end print_subject;
%page;
build_transaction:					/* Internal procedure to handle interactive 'talk' requests */
     procedure ();

	declare termination_type	 fixed bin;

	call get_temp_segment_ (whoami_really, temp_seg_ptr, status);
	if status ^= 0 then call ssu_$abort_line (ssu_ptr, status, "Getting temp segment.");

	call ipc_$cutoff (passport.public_channel, (0));

	call ioa_ ("^[Message^;Transaction^]:", message_sw);

	termination_type = add_lines ();

	if termination_type = ENTER_EDITOR then call enter_the_editor ();

	if termination_type = ENTER_REQUEST_LOOP & no_chars_read > first_nonwhite_pos + 2
	then do;
		first_nonwhite_pos = first_nonwhite_pos + 2;
		if substr (buffer, no_chars_read, 1) = NL then no_chars_read = no_chars_read - 1;
		if no_chars_read = first_nonwhite_pos then ;
		else if translate (substr (buffer, first_nonwhite_pos + 1, no_chars_read - first_nonwhite_pos),
		     LOWER_CASE, UPPER_CASE) = "nf"
		then forum_user_trans.unfilled = "1"b;
		else call ssu_$print_message (ssu_ptr, 0, "Characters following ""q"" ignored.");
	     end;

	call clean_up_talk ();

	if termination_type = NORMAL_TERMINATION & ^request_loop then call enter_the_transaction ();

	return;

     end build_transaction;
%page;
add_lines:
     procedure () returns (fixed bin);

	declare idx		 fixed bin (21),
	        quote_switch	 bit (1) aligned,
	        second_char		 char (1) based (addr (substr (buffer, first_nonwhite_pos + 2))),
	        third_char		 char (1) based (addr (substr (buffer, first_nonwhite_pos + 3)));

	quote_switch = "0"b;
	text_len = 0;
	do while ("1"b);
	     call get_line ("");
	     if no_chars_read = 2
	     then if substr (buffer, 1, 2) = "." || NL then return (NORMAL_TERMINATION);

	     first_nonwhite_pos = 0;
	     idx = index (substr (buffer, 1, no_chars_read), "\") - 1;
	     do while (idx >= 0);
		if idx > 0 then call add_to_trans (buffer, first_nonwhite_pos, idx);

		if quote_switch | no_chars_read - first_nonwhite_pos < 2 then
		     call add_to_trans (buffer, first_nonwhite_pos, 1);
		else if second_char = "c" | second_char = "C" then do;
			first_nonwhite_pos = first_nonwhite_pos + 2;
			quote_switch = "1"b;
		     end;
		else if second_char = "q" | second_char = "Q" then return (ENTER_REQUEST_LOOP);
		else if second_char = "f" | second_char = "F" then do;
			if idx ^= 0 then text_len = text_len - 1; /* In this case, the new line goes on the request */
			if no_chars_read - first_nonwhite_pos < 3 then return (ENTER_EDITOR);
			else if third_char ^= "q" & third_char ^= "Q" then return (ENTER_EDITOR);
			else do;
				first_nonwhite_pos = first_nonwhite_pos + 1;
				return (ENTER_REQUEST_LOOP);
			     end;
		     end;
		else call add_to_trans (buffer, first_nonwhite_pos, 1);

		idx = index (substr (buffer, first_nonwhite_pos + 1, no_chars_read - first_nonwhite_pos), "\") - 1;
	     end;

	     call add_to_trans (buffer, first_nonwhite_pos, no_chars_read - first_nonwhite_pos);
	end;

add_to_trans:
     procedure (buffer, pos, len);

	declare buffer		 char (*),
	        pos		 fixed bin (21),
	        len		 fixed bin (21);

	substr (temp_seg, text_len + 1, len) = substr (buffer, pos + 1, len);
	text_len = text_len + len;
	first_nonwhite_pos = first_nonwhite_pos + len;
	quote_switch = "0"b;

	return;
     end add_to_trans;

     end add_lines;
%page;
/* This procedure is used for the subject prompt and by the talk and reply requests to read in a transaction.
   It returns its results in the global variables buffer, no_chars_read, and first_nonwhite_pos.  It removes
   the trailing newline from the line, if any, and trims off trailing whitespace.  It optionally accepts the
   ".." escape to execute command lines while doing input.  The ".." must be the first white characters on the
   line.  The ".." is always accepted when the prompt field is nonblank; otherwise the "value" variable
   "forum.input_cp_escape" is consulted.								*/

get_line:
     procedure (prompt);

	declare prompt		 char (*),
	        newline		 bit (1) aligned;

	do while ("1"b);
	     call read_a_line ();

	     newline = "0"b;			/* Now hack off whitespace */
	     if substr (buffer, no_chars_read, 1) = NL
	     then do;
		     newline = "1"b;
		     no_chars_read = no_chars_read - 1;
		end;
	     no_chars_read = length (rtrim (substr (buffer, 1, no_chars_read), SPACE_AND_TAB));
	     if newline & prompt = ""
	     then do;
		     substr (buffer, no_chars_read + 1, 1) = NL;
		     no_chars_read = no_chars_read + 1;
		end;

	     first_nonwhite_pos = verify (substr (buffer, 1, no_chars_read), WHITE_CHARS) - 1;
	     if first_nonwhite_pos < 0
	     then do;
		     first_nonwhite_pos = no_chars_read;
		     return;			/* Line is blank.  Can't contain command processeor escape. */
		end;

	     if no_chars_read - first_nonwhite_pos < 2 then return;
	     if substr (buffer, first_nonwhite_pos + 1, 2) ^= ".." then return;

	     if prompt = ""
	     then if ^input_cp_escape_allowed () then return;

	     call cu_$cp (add_char_offset_ (addr (buffer), first_nonwhite_pos + 2),
		no_chars_read - first_nonwhite_pos - 2, (0));

	     if prompt = "" then call ioa_ ("Please continue entering your ^[reply^;transaction^].", reply_switch);
	end;
%page;
/* The following internal procedure of get_line actually reads an entire line into a buffer.  This is done as
   a separate level to compensate for the losing I/O system behavior when the input buffer is too small.		*/

read_a_line:
     procedure ();

	declare long_record		 bit (1) aligned,
	        no_new_chars_read	 fixed bin (21);

	if buffer_ptr = null ()
	then do;
		buffer_len = 256;
		allocate buffer in (forum_area);
	     end;

	long_record = "0"b;
	no_chars_read = 0;
	do while (long_record | no_chars_read = 0);

	     if prompt ^= "" & ^long_record then call ioa_$nnl (prompt);

	     call iox_$get_line (iox_$user_input, add_char_offset_ (buffer_ptr, no_chars_read),
		buffer_len - no_chars_read, no_new_chars_read, status);
	     no_chars_read = no_chars_read + no_new_chars_read;
	     if status = 0 then long_record = "0"b;
	     else if status ^= error_table_$long_record then call ssu_$abort_line (ssu_ptr, status);
	     else do;
		     call make_bigger_buffer (no_chars_read);
		     long_record = "1"b;
		end;
	end;

	return;

     end read_a_line;

     end get_line;

make_bigger_buffer:
     proc (copy_len);

	declare copy_len		 fixed bin (21);

	new_buffer_len = 2 * buffer_len;
	allocate new_buffer in (forum_area);
	substr (new_buffer, 1, copy_len) = substr (buffer, 1, copy_len);
	free buffer;
	buffer_ptr = new_buffer_ptr;
	buffer_len = new_buffer_len;
	new_buffer_ptr = null ();

	return;
     end make_bigger_buffer;
%page;
input_cp_escape_allowed:
     procedure () returns (bit (1) aligned);

	declare tf_string		 char (5);

	if inhibit_input_cp_escape then return ("0"b);

	call value_$get (null (), "11"b, rtrim (my_person_id) || ".forum.input_cp_escape", tf_string, status);
	if status ^= 0
	then if status ^= error_table_$oldnamerr
	     then return ("0"b);
	     else do;
		     call value_$get (null (), "11"b, "forum.input_cp_escape", tf_string, status);
		     if status ^= 0 then return ("0"b);
		end;

	tf_string = translate (tf_string, LOWER_CASE, UPPER_CASE);

	if tf_string = "true" then return ("1"b);
	if tf_string = "t" then return ("1"b);
	if tf_string = "on" then return ("1"b);
	if tf_string = "yes" then return ("1"b);
	if tf_string = "y" then return ("1"b);

	inhibit_input_cp_escape = "1"b;

	return ("0"b);

     end input_cp_escape_allowed;
%page;
enter_the_editor:
     procedure ();

	first_nonwhite_pos = first_nonwhite_pos + 2;	/* Skip the \f */

	call allocate_transaction (forum_user_trans.subject, temp_text, forum_user_trans.unfilled);
	text_len = -1;

	if standard_default_editor () then call call_qedx (subject);
	else call call_ted (add_char_offset_ (buffer_ptr, first_nonwhite_pos), no_chars_read - first_nonwhite_pos);

	return;
     end enter_the_editor;


standard_default_editor:
     procedure () returns (bit (1) aligned);

	declare editor		 char (4);

	on linkage_error go to USE_QEDX;

	call value_$get (null (), "11"b, rtrim (my_person_id) || ".forum.editor", editor, status);
	if status ^= 0 then
	     if status ^= error_table_$oldnamerr then return ("1"b);
	     else do;
		     call value_$get (null (), "11"b, "forum.editor", editor, status);
		     if status ^= 0 then return ("1"b);
		end;

	editor = translate (editor, LOWER_CASE, UPPER_CASE);

	if editor ^= "ted" then return ("1"b);

	if codep