



		    run_test_as.pl1                 08/04/87  1530.5rew 08/04/87  1221.9       75285



/****^  ********************************************
        *                                          *
        * Copyright, (C) Honeywell Bull Inc., 1987 *
        *                                          *
        ******************************************** */

/* format: style4,indattr */

/****^  HISTORY COMMENTS:
  1) change(86-04-18,Swenson), approve(87-07-13,MCR7741),
     audit(87-07-13,GDixon), install(87-08-04,MR12.1-1055):
     Created in order to run answering service in a test process.
                                                   END HISTORY COMMENTS */
/* Automatic */

run_test_as:
     procedure options (variable);

/* Automatic */

dcl  atd		        char (512) automatic;
dcl  1 auto_log_salvage_arg aligned like log_salvage_arg automatic;
dcl  code		        fixed bin (35) automatic;
dcl  log_salv_code	        fixed bin (35) automatic;
dcl  log_salv_err_cnt       fixed bin (35) automatic;
dcl  sci_ptr	        ptr automatic;
dcl  system_control_dirname char (168) automatic;

/* Entries */

dcl  absentee_user_manager_$term_aum entry options (variable);
dcl  as_$as_init	        entry (fixed bin (35));
dcl  as_$go	        entry (fixed bin (35));
dcl  as_$startup	        entry (fixed bin (35));
dcl  com_err_	        entry () options (variable);
dcl  ioa_$rsnnl	        entry () options (variable);
dcl  iox_$attach_name       entry (char (*), ptr, char (*), ptr, fixed bin (35));
dcl  iox_$control	        entry (ptr, char (*), ptr, fixed bin (35));
dcl  iox_$open	        entry (ptr, fixed bin, bit (1) aligned, fixed bin (35));
dcl  log_write_$open        entry (char (*), char (*), bit (1) aligned, ptr, fixed bin (35));
dcl  log_salvage_	        entry (char (*), char (*), ptr, fixed bin (35));
dcl  mrdim_$test_mrd        entry (char (*));
dcl  pathname_	        entry (char (*), char (*)) returns (char (168));
dcl  probe	        entry options (variable);
dcl  sc_create_sci_	        entry (ptr, fixed bin (35));
dcl  ssu_$abort_subsystem   entry () options (variable);
dcl  ssu_$destroy_invocation entry (ptr);
dcl  ssu_$print_message     entry () options (variable);
dcl  ssu_$standalone_invocation entry (ptr, char (*), char (*), ptr, entry, fixed bin (35));

/* External */

dcl  iox_$error_output      ptr external static;
dcl  iox_$user_output       ptr external static;

/* Constant */

dcl  FALSE	        bit (1) aligned initial ("0"b) internal static options (constant);
dcl  ME		        char (32) initial ("run_test_as") internal static options (constant);
dcl  TRUE		        bit (1) aligned initial ("1"b) internal static options (constant);

/* Conditions */

dcl  cleanup	        condition;
%page;
/* Program */

	sci_ptr = null ();
	on cleanup
	     call Clean_Up ();

	call ssu_$standalone_invocation (sci_ptr, ME, "1.0", null (),
	     Abort_Subsystem, code);
	if code ^= 0 then do;
	     call com_err_ (code, ME,
		"Creating standalone subsystem invocation.");
	     goto RETURN;
	end;

	call Process_Arguments ();

	sc_stat_$test_mode = TRUE;
	sc_stat_$as_log_write_ptr = null ();
	sc_stat_$admin_log_write_ptr = null ();
	sc_stat_$admin_log_iocb = null ();
	sc_stat_$mc_iocb = null ();
	sc_stat_$mc_is_on = FALSE;

	call Process_Arguments ();

	sc_stat_$Multics = FALSE;
	sc_stat_$sysdir = system_control_dirname;
	sc_stat_$log_dir = rtrim (system_control_dirname) || ">as_logs";

	call Attach_IO_Switches ();

	call log_write_$open (sc_stat_$log_dir, "log",
	     "1"b /* create */, sc_stat_$as_log_write_ptr, code);
	if code ^= 0 then
	     call ssu_$abort_subsystem (sci_ptr, code,
		"Attempting to open ^a>^a.", sc_stat_$log_dir, "log");

	call ioa_$rsnnl ("log_output_ ^a>admin_log", atd, (0),
	     sc_stat_$log_dir);
	call iox_$attach_name ("admin_log_", sc_stat_$admin_log_iocb, (atd),
	     codeptr (run_test_as), code);
	if code ^= 0 then
	     call ssu_$abort_subsystem (sci_ptr, code,
		"Could not attach admin_log log.");
	call iox_$open (sc_stat_$admin_log_iocb, Stream_output, "1"b, code);
	if code ^= 0 then do;
	     log_salv_err_cnt = 0;
	     unspec (auto_log_salvage_arg) = ""b;
	     log_salvage_arg_ptr = addr (auto_log_salvage_arg);
	     log_salvage_arg.version = LOG_SALVAGE_ARG_VERSION_1;
	     log_salvage_arg.reporter_proc = print_log_salv_error;
	     call log_salvage_ (sc_stat_$log_dir, "admin_log",
		log_salvage_arg_ptr, log_salv_code);
	     if log_salv_code = 0 then do;
		call iox_$open (sc_stat_$admin_log_iocb, Stream_output,
		     "1"b, code);
		if code ^= 0 then
		     call ssu_$abort_subsystem (sci_ptr, code,
			"Could not open admin_log log.");
	     end;
	     else
		call ssu_$abort_subsystem (sci_ptr, code,
		     "Could not salvage admin_log log.");
	end;
	call iox_$control (sc_stat_$admin_log_iocb, "get_log_write_data_ptr",
	     addr (sc_stat_$admin_log_write_ptr), code);
	if code ^= 0 then
	     call ssu_$abort_subsystem (sci_ptr, code,
		"Could not get log_write_data_ptr for admin_log log.");

	call sc_create_sci_ (sc_stat_$master_sci_ptr, code);
	if code ^= 0 then
	     call ssu_$abort_subsystem (sci_ptr, code,
		"Could not create system control ssu_ invocation.");

	sc_stat_$Multics_typed = TRUE;
	sc_stat_$Star_typed = TRUE;

/**** Prevent a call to hardcore to initialize lct */
	as_data_$lct_initialized = TRUE;

	call mrdim_$test_mrd (system_control_dirname);

	call absentee_user_manager_$term_aum ();	/* no absentees */
	call as_$startup (code);
	if code ^= 0 then
	     call ssu_$abort_subsystem (sci_ptr, code,
		"Calling as_$startup.");

	sc_stat_$Multics = TRUE;
	sc_stat_$Go_typed = TRUE;
	call as_$go (code);
	if code ^= 0 then
	     call ssu_$abort_subsystem (sci_ptr, code,
		"Calling as_$go.");
	sc_stat_$Go = TRUE;
RETURN:
	return;
%page;
Process_Arguments:
     procedure ();

dcl  argument_idx	        fixed bin automatic;
dcl  argument_lth	        fixed bin (21) automatic;
dcl  argument_ptr	        ptr automatic;
dcl  n_arguments	        fixed bin automatic;

dcl  argument	        char (argument_lth) based (argument_ptr);

dcl  absolute_pathname_     entry (char (*), char (*), fixed bin (35));
dcl  ssu_$arg_count	        entry (ptr, fixed bin);
dcl  ssu_$arg_ptr	        entry (ptr, fixed bin, ptr, fixed bin (21));

	call ssu_$arg_count (sci_ptr, n_arguments);
	if n_arguments ^= 1 then
	     call ssu_$abort_subsystem (sci_ptr,
		"Syntax is: ^a system_control_dirname.", ME);

	call ssu_$arg_ptr (sci_ptr, 1, argument_ptr, argument_lth);

	call absolute_pathname_ (argument, system_control_dirname, code);
	if code ^= 0 then
	     call ssu_$abort_subsystem (sci_ptr, "^a", argument);
	return;
     end Process_Arguments;
%page;
Abort_Subsystem:
     procedure ();

	call Clean_Up ();
	goto RETURN;
     end Abort_Subsystem;
%page;
Attach_IO_Switches:
     procedure ();

	call iox_$attach_name ("severity1", sc_stat_$sv1_iocb,
	     "syn_ user_i/o", codeptr (run_test_as), code);
	if code ^= 0 then
	     call ssu_$abort_subsystem (sci_ptr, code,
		"Could not attach sc_stat_$sv1_iocb.");
	call iox_$attach_name ("severity2", sc_stat_$sv2_iocb,
	     "syn_ user_i/o", codeptr (run_test_as), code);
	if code ^= 0 then
	     call ssu_$abort_subsystem (sci_ptr, code,
		"Could not attach sc_stat_$sv2_iocb.");
	call iox_$attach_name ("severity3", sc_stat_$sv3_iocb,
	     "syn_ user_i/o", codeptr (run_test_as), code);
	if code ^= 0 then
	     call ssu_$abort_subsystem (sci_ptr, code,
		"Could not attach sc_stat_$sv3_iocb.");
	call iox_$attach_name ("master_i/o", sc_stat_$master_iocb,
	     "syn_ user_i/o", codeptr (run_test_as), code);
	if code ^= 0 then
	     call ssu_$abort_subsystem (sci_ptr, code,
		"Could not attach sc_stat_$master_iocb.");
	return;
     end Attach_IO_Switches;
%page;
Clean_Up:
     procedure ();
	if sci_ptr ^= null () then
	     call ssu_$destroy_invocation (sci_ptr);
	return;
     end Clean_Up;
%page;
print_log_salv_error:
     procedure (P_msg);

dcl  P_msg	        char (*) parameter;
dcl  msg		        char (1024) varying;

	msg = P_msg;

	log_salv_err_cnt = log_salv_err_cnt + 1;

	if log_salv_err_cnt = 1 then
	     call ssu_$print_message (sci_ptr, "Messages from log salvage of ^a:", pathname_ (sc_stat_$log_dir, "admin_log"));
	call ssu_$print_message (sci_ptr, "^a", msg);
	return;
     end print_log_salv_error;

/* format: off */
%page; %include as_data_;
%page; %include iox_modes;
%page; %include log_salvage_arg;
%page; %include sc_stat_;

     end run_test_as;




		    test_pnt_manager_.pl1           02/07/85  0958.9rew 02/06/85  1406.1      120591



/* ***********************************************************
   *                                                         *
   * Copyright, (C) Honeywell Information Systems Inc., 1984 *
   *                                                         *
   *********************************************************** */
/* format: style2 */

/* TEST_PNT_MANAGER_:  This program is used to support the 
   pnt_manager_$test interface.  It plays with refnames so that
   all future references to pnt_manager_ will be made to this
   program.  This program will then serve as a transfer vector
   to the pnt_db_util_ entrypoints.  The result is that the 
   pnt_manager_ entrypoints will function on a designated copy 
   of the PNT in the user ring. */

test_pnt_manager_:
     procedure (P_dirname);

/* Written 1984-09-14 by E. Swenson */
/* Modified 1985-01-25 by E. Swenson for auditing */

/* Parameters */

	dcl     P_acl_ptr		 ptr parameter;
	dcl     P_area_ptr		 ptr parameter;
	dcl     P_code		 fixed bin (35) parameter;
	dcl     P_desired_version	 char (*) parameter;
	dcl     P_dirname		 char (*) parameter;
	dcl     P_entryname		 char (*) parameter;
	dcl     P_error_on_target	 bit (1) aligned parameter;
	dcl     P_new_entryname	 char (*) parameter;
	dcl     P_no_sysdaemon	 bit (1) aligned parameter;
	dcl     P_num_entries	 fixed bin (35) parameter;
	dcl     P_old_entryname	 char (*) parameter;
	dcl     P_password		 char (*) parameter;
	dcl     P_person_id		 char (*) parameter;
	dcl     P_pnt_entry_ptr	 ptr parameter;
	dcl     P_pnt_info_ptr	 ptr parameter;
	dcl     P_pnt_size		 fixed bin (35) parameter;
	dcl     P_record_no		 fixed bin (35) parameter;
	dcl     P_set_network_password bit (1) aligned parameter;
	dcl     P_set_password	 bit (1) aligned parameter;
	dcl     P_short_password	 bit (1) aligned parameter;
	dcl     P_target_dirname	 char (*) parameter;
	dcl     P_target_entryname	 char (*) parameter;

/* Automatic */

	dcl     code		 fixed bin (35);
	dcl     dirname		 char (168);
	dcl     dirname_lth		 fixed bin (21);
	dcl     entryname		 char (32);
	dcl     seg_ptr		 ptr;

/* External Entries */

	dcl     hcs_$fs_get_path_name	 entry (ptr, char (*), fixed bin, char (*), fixed bin (35));
	dcl     hcs_$fs_get_seg_ptr	 entry (char (*), ptr, fixed bin (35));
	dcl     hcs_$initiate	 entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr,
				 fixed bin (35));
	dcl     pathname_		 entry (char (*), char (*)) returns (char (168));
	dcl     pnt_db_util_$add_entry entry (ptr, bit (1) aligned, char (*), ptr, fixed bin (35));
	dcl     pnt_db_util_$admin_get_entry
				 entry (ptr, bit (1) aligned, char (*), ptr, fixed bin (35));
	dcl     pnt_db_util_$close	 entry (ptr, bit (1) aligned, fixed bin (35));
	dcl     pnt_db_util_$get_abs_entry
				 entry (ptr, bit (1) aligned, fixed bin (35), ptr, fixed bin (35));
	dcl     pnt_db_util_$get_network_password
				 entry (ptr, bit (1) aligned, char (*), char (*), bit (1) aligned, fixed bin (35))
				 ;
	dcl     pnt_db_util_$login_get_entry
				 entry (ptr, bit (1) aligned, char (*), char (*), ptr, fixed bin (35));
	dcl     pnt_db_util_$network_get_entry
				 entry (ptr, bit (1) aligned, char (*), char (*), ptr, fixed bin (35));
	dcl     pnt_db_util_$open	 entry (char (*), char (*), bit (1) aligned, ptr, fixed bin (35));
	dcl     pnt_db_util_$priv_get_abs_entry
				 entry (ptr, bit (1) aligned, fixed bin (35), ptr, fixed bin (35));
	dcl     pnt_db_util_$priv_get_entry
				 entry (ptr, bit (1) aligned, char (*), ptr, fixed bin (35));
	dcl     pnt_db_util_$remove_entry
				 entry (ptr, bit (1) aligned, char (*), fixed bin (35));
	dcl     pnt_db_util_$table_data
				 entry (ptr, bit (1) aligned, ptr, fixed bin (35), fixed bin (35));
	dcl     pnt_db_util_$update_entry
				 entry (ptr, bit (1) aligned, ptr, bit (1) aligned, bit (1) aligned,
				 fixed bin (35));
	dcl     pnt_db_util_$validate_entry
				 entry (ptr, bit (1) aligned, char (*), fixed bin (35));

	dcl     pnt_fs_util_$add_acl_entries
				 entry (char (*), char (*), ptr, fixed bin (35));
	dcl     pnt_fs_util_$chname_file
				 entry (char (*), char (*), char (*), char (*), fixed bin (35));
	dcl     pnt_fs_util_$copy	 entry (char (*), char (*), char (*), char (*), bit (1) aligned, fixed bin (35));
	dcl     pnt_fs_util_$create	 entry (char (*), char (*), fixed bin (35), fixed bin (35));
	dcl     pnt_fs_util_$delete	 entry (char (*), char (*), fixed bin (35));
	dcl     pnt_fs_util_$delete_acl_entries
				 entry (char (*), char (*), ptr, fixed bin (35));
	dcl     pnt_fs_util_$list_acl	 entry (char (*), char (*), char (*), ptr, ptr, fixed bin (35));
	dcl     pnt_fs_util_$replace_acl
				 entry (char (*), char (*), ptr, bit (1) aligned, fixed bin (35));
	dcl     pnt_fs_util_$validate	 entry (char (*), char (*), fixed bin (35));
	dcl     sub_err_		 entry () options (variable);
	dcl     term_$single_refname	 entry (char (*), fixed bin (35));
	dcl     unique_chars_	 entry (bit (*)) returns (char (15));
	dcl     unique_bits_	 entry () returns (bit (70));

/* Internal Static */

	dcl     already_swapped_refnames
				 bit (1) aligned internal static initial ("0"b);
	dcl     pnt_ptr		 ptr initial (null ()) internal static;

	dcl     saved_pnt_dir	 char (168) initial (" ") internal static;

/* External Static */

	dcl     error_table_$segknown	 fixed bin (35) external static;

/* Constant */

	dcl     ME		 char (32) initial ("test_pnt_manager_") internal static options (constant);
	dcl     NO_AUDIT		 bit (1) aligned initial ("0"b) internal static options (constant);
	dcl     PNT_NAME		 char (7) initial ("PNT.pnt") internal static options (constant);

/* Conditions */

	dcl     cleanup		 condition;

/* Builtin */

	dcl     (addr, codeptr, null)	 builtin;
%page;
/* Program */

test:
     entry (P_dirname);				/* In case we try to run pnt_manager_$test again. */

	if saved_pnt_dir = ""
	then saved_pnt_dir = P_dirname;
	else if P_dirname = saved_pnt_dir
	then return;
	else do;					/* New test directory */
		saved_pnt_dir = P_dirname;
		if pnt_ptr ^= null ()
		then /* We had an old one */
		     call CLEAN_UP ();
	     end;

	if already_swapped_refnames
	then /* only need do this once */
	     return;

/**** We first add a shriekname reference name to pnt_manager_, then
      we terminate the reference name "pnt_manager_" and initiate
      this program with the reference name "pnt_manager_".  All future
      calls to pnt_manager_ will actually be made to this program. */

	call hcs_$fs_get_seg_ptr ("pnt_manager_", seg_ptr, code);
	if code ^= 0
	then do;
		call CLEAN_UP ();
		call sub_err_ (code, ME, ACTION_CANT_RESTART, null (), (0), "Attempting to get ptr to pnt_manager_.");
		return;
	     end;

	call hcs_$fs_get_path_name (seg_ptr, dirname, (0), entryname, code);
	if code ^= 0
	then do;
		call CLEAN_UP ();
		call sub_err_ (code, ME, ACTION_CANT_RESTART, null (), (0),
		     "Attempting to get pathname of ""pnt_manager_"".");
		return;
	     end;

	call hcs_$initiate ((dirname), entryname, unique_chars_ (unique_bits_ ()), 0, 0, seg_ptr, code);
	if code ^= error_table_$segknown & code ^= 0
	then do;
		call CLEAN_UP ();
		call sub_err_ (code, ME, ACTION_CANT_RESTART, null (), (0),
		     "Attempting to add shriekname reference name to ^a", pathname_ (dirname, entryname));
		return;
	     end;

	call term_$single_refname ("pnt_manager_", code);
	if code ^= 0
	then do;
		call CLEAN_UP ();
		call sub_err_ (code, ME, ACTION_CANT_RESTART, null (), (0),
		     "Attempting to terminate reference name ""pnt_manager_""");
		return;
	     end;

	call hcs_$fs_get_path_name (codeptr (test_pnt_manager_), dirname, (0), entryname, code);
	if code ^= 0
	then do;
		call CLEAN_UP ();
		call sub_err_ (code, ME, ACTION_CANT_RESTART, null (), (0), "Attempting to get pathname of ^a", ME);
		return;
	     end;

	call hcs_$initiate (dirname, entryname, "pnt_manager_", 0, 0, seg_ptr, code);
	if code ^= 0 & code ^= error_table_$segknown
	then do;
		call CLEAN_UP ();
		call sub_err_ (code, ME, ACTION_CANT_RESTART, null (), (0),
		     "Attempting to add refname of ""pnt_manager_"" to ^a", pathname_ (dirname, entryname));
		return;
	     end;

	already_swapped_refnames = "1"b;

	return;
%page;
/**** Here follow entries which correspond to the entries in the real
      pnt_manager_.  In this program, we just transfer to the appropriate
      pnt_db_util_ or pnt_fs_util_ entrypoint after possibly changing
      the first argument. */

add_acl_entries:
     entry (P_dirname, P_entryname, P_acl_ptr, P_code);

	call pnt_fs_util_$add_acl_entries (P_dirname, P_entryname, P_acl_ptr, P_code);
	return;

add_entry:
     entry (P_person_id, P_pnt_entry_ptr, P_code);

	call INITIALIZE ();
	call pnt_db_util_$add_entry (pnt_ptr, NO_AUDIT, P_person_id, P_pnt_entry_ptr, P_code);
	return;

admin_get_entry:
     entry (P_person_id, P_pnt_entry_ptr, P_code);

	call INITIALIZE ();
	call pnt_db_util_$admin_get_entry (pnt_ptr, NO_AUDIT, P_person_id, P_pnt_entry_ptr, P_code);
	return;

chname_file:
     entry (P_dirname, P_entryname, P_old_entryname, P_new_entryname, P_code);

	call pnt_fs_util_$chname_file (P_dirname, P_entryname, P_old_entryname, P_new_entryname, P_code);
	return;

copy:
     entry (P_dirname, P_entryname, P_target_dirname, P_target_entryname, P_error_on_target, P_code);

	call pnt_fs_util_$copy (P_dirname, P_entryname, P_target_dirname, P_target_entryname, P_error_on_target, P_code)
	     ;
	return;

create:
     entry (P_dirname, P_entryname, P_pnt_size, P_code);

	call pnt_fs_util_$create (P_dirname, P_entryname, P_pnt_size, P_code);
	return;

delete:
     entry (P_dirname, P_entryname, P_code);

	call pnt_fs_util_$delete (P_dirname, P_entryname, P_code);
	return;

delete_acl_entries:
     entry (P_dirname, P_entryname, P_acl_ptr, P_code);

	call pnt_fs_util_$delete_acl_entries (P_dirname, P_entryname, P_acl_ptr, P_code);
	return;

get_abs_entry:
     entry (P_record_no, P_pnt_entry_ptr, P_code);

	call INITIALIZE ();
	call pnt_db_util_$get_abs_entry (pnt_ptr, NO_AUDIT, P_record_no, P_pnt_entry_ptr, P_code);
	return;

get_entry:
     entry (P_person_id, P_pnt_entry_ptr, P_code);

	call INITIALIZE ();
	call pnt_db_util_$admin_get_entry (pnt_ptr, NO_AUDIT, P_person_id, P_pnt_entry_ptr, P_code);
	return;

get_network_password:
     entry (P_person_id, P_password, P_short_password, P_code);

	call INITIALIZE ();
	call pnt_db_util_$get_network_password (pnt_ptr, NO_AUDIT, P_person_id, P_password, P_short_password, P_code);
	return;

list_acl:
     entry (P_dirname, P_entryname, P_desired_version, P_area_ptr, P_acl_ptr, P_code);

	call pnt_fs_util_$list_acl (P_dirname, P_entryname, P_desired_version, P_area_ptr, P_acl_ptr, P_code);
	return;

login_get_entry:
     entry (P_person_id, P_password, P_pnt_entry_ptr, P_code);

	call INITIALIZE ();
	call pnt_db_util_$login_get_entry (pnt_ptr, NO_AUDIT, P_person_id, P_password, P_pnt_entry_ptr, P_code);
	return;

network_get_entry:
     entry (P_person_id, P_password, P_pnt_entry_ptr, P_code);

	call INITIALIZE ();
	call pnt_db_util_$network_get_entry (pnt_ptr, NO_AUDIT, P_person_id, P_password, P_pnt_entry_ptr, P_code);
	return;

priv_get_abs_entry:
     entry (P_record_no, P_pnt_entry_ptr, P_code);

	call INITIALIZE ();
	call pnt_db_util_$priv_get_abs_entry (pnt_ptr, NO_AUDIT, P_record_no, P_pnt_entry_ptr, P_code);
	return;

priv_get_entry:
     entry (P_person_id, P_pnt_entry_ptr, P_code);

	call INITIALIZE ();
	call pnt_db_util_$priv_get_entry (pnt_ptr, NO_AUDIT, P_person_id, P_pnt_entry_ptr, P_code);
	return;

remove_entry:
     entry (P_person_id, P_code);

	call INITIALIZE ();
	call pnt_db_util_$remove_entry (pnt_ptr, NO_AUDIT, P_person_id, P_code);
	return;

replace_acl:
     entry (P_dirname, P_entryname, P_acl_ptr, P_no_sysdaemon, P_code);

	call pnt_fs_util_$replace_acl (P_dirname, P_entryname, P_acl_ptr, P_no_sysdaemon, P_code);
	return;

table_data:
     entry (P_pnt_info_ptr, P_num_entries, P_code);

	call INITIALIZE ();
	call pnt_db_util_$table_data (pnt_ptr, NO_AUDIT, P_pnt_info_ptr, P_num_entries, P_code);
	return;

update_entry:
     entry (P_pnt_entry_ptr, P_set_password, P_set_network_password, P_code);

	call INITIALIZE ();
	call pnt_db_util_$update_entry (pnt_ptr, NO_AUDIT, P_pnt_entry_ptr, P_set_password, P_set_network_password,
	     P_code);
	return;

validate:
     entry (P_dirname, P_entryname, P_code);

	call pnt_fs_util_$validate (P_dirname, P_entryname, P_code);
	return;

validate_entry:
     entry (P_person_id, P_code);

	call INITIALIZE ();
	call pnt_db_util_$validate_entry (pnt_ptr, NO_AUDIT, P_person_id, P_code);
	return;
%page;
INITIALIZE:
     procedure ();

	if pnt_ptr ^= null				/* already initialized */
	then return;

TRY_TO_OPEN_PNT:
	call pnt_db_util_$open (saved_pnt_dir, PNT_NAME, NO_AUDIT, pnt_ptr, code);
	if code ^= 0
	then do;
		call sub_err_ (code, ME, ACTION_CAN_RESTART, null (), (0), "Cannot open  the PNT in ^a.",
		     pathname_ (saved_pnt_dir, PNT_NAME));
		goto TRY_TO_OPEN_PNT;
	     end;

	return;
     end INITIALIZE;
%page;
CLEAN_UP:
     procedure ();

/**** This internal procedure is called in the event of an error in the
      reference name manipulation to close the PNT since it is of no
      use in the case of an error. */

	call pnt_db_util_$close (pnt_ptr, NO_AUDIT, (0));
	return;
     end CLEAN_UP;

/* format: off */
%page; %include sub_err_flags;
/* format: on */

     end test_pnt_manager_;




		    test_system_control.pl1         08/04/87  1532.8rew 08/04/87  1221.9       48897



/****^  ********************************************
        *                                          *
        * Copyright, (C) Honeywell Bull Inc., 1987 *
        *                                          *
        ******************************************** */

/* format: style4,indattr */

test_system_control:
     procedure options (variable);

/* This command allows a system control (SC) environment to be set up
   from which an answering service (AS) may be started for the purposes
   of debugging the SC and AS software.  The command's only argument is
   the pathname of a test >sc1 directory (do not use the real >sc1
   directory).  In this directory should already be set up all the
   segments needed to run a SC and AS invocation.  If segments are
   missing or incorrectly formatted, error messages will result and the
   SC or AS initialization will fail.  The SC/AS environment is not the most
   robust one, so fatal process errors (although not common) may occur if
   things are improperly setup.  The best way to get a SC/AS running is
   to try to get an >sc1 directory set up with the required segments
   (refer to the acct_start_up.ec to see what needs to be in the >sc1
   directory) and then invoke this command.  Fix all errors which result.
   Another (more frustrating) approach is to invoke this command with
   an empty directory and fix all the errors.

   WARNING:  The SC environment plays with the I/O switches.  Do not expect
   it to work in anything but a virgin environment (no auditing, no video).
   And don't be surprised if your favorite commands (emacs) won't work once
   you've started SC in your process.  (But then, anyone who knows the SC
   environment running in the Initializer process knows what a limited
   environment there is.  */

/****^  HISTORY COMMENTS:
  1) change(86-04-18,Swenson), approve(87-07-13,MCR7741),
     audit(87-07-13,GDixon), install(87-08-04,MR12.1-1055):
     Created in order to run system control in a test process.
                                                   END HISTORY COMMENTS */
/* Automatic */

dcl  code		        fixed bin (35) automatic;
dcl  sci_ptr	        ptr automatic;
dcl  system_control_dirname char (168) automatic;

/* Entries */

dcl  absentee_user_manager_$term_aum entry ();
dcl  as_who$as_who_init     entry (char (*));
dcl  com_err_	        entry () options (variable);
dcl  mrdim_$test_mrd        entry (char (*));
dcl  pnt_manager_$test      entry (char (*));
dcl  ssu_$abort_subsystem   entry () options (variable);
dcl  ssu_$destroy_invocation entry (ptr);
dcl  ssu_$standalone_invocation entry (ptr, char (*), char (*), ptr, entry, fixed bin (35));
dcl  system_control_        entry ();

/* Conditions */

dcl  cleanup	        condition;

/* Constant */

dcl  ME		        char (32) initial ("test_system_control") internal static options (constant);
dcl  TRUE		        bit (1) aligned initial ("1"b) internal static options (constant);
%page;
/* Program */

	sci_ptr = null ();
	on cleanup
	     call Clean_up ();

	call ssu_$standalone_invocation (sci_ptr, ME, "1.0", null (),
	     Abort_subsystem, code);
	if code ^= 0 then do;
	     call com_err_ (code, ME, "Creating standalone subsystem invocation.");
	     goto RETURN;
	end;

	call Process_arguments ();

	sc_stat_$test_mode = TRUE;
	sc_stat_$sysdir = system_control_dirname;
	sc_stat_$log_dir = rtrim (system_control_dirname) || ">as_logs";

	/*** No executing of the system_start_up.ec */

	sc_stat_$did_part1 = TRUE;
	sc_stat_$did_part2 = TRUE;
	sc_stat_$did_part3 = TRUE;

	/*** No ring-0 MCS initialization */

	as_data_$lct_initialized = TRUE;

/**** Ensure we use the test PNT for the admin mode password */
	call pnt_manager_$test (system_control_dirname);
/**** Make sure we don't use the REAL message coordinator */
	call mrdim_$test_mrd (system_control_dirname);
/**** Let's not start up the absentee facility.  If we need to test it,
      we can start it manually. */
	call absentee_user_manager_$term_aum ();
/**** Make as_who in this process use the test answer_table */
	call as_who$as_who_init (system_control_dirname);
	call system_control_ ();
RETURN:
	call Clean_up ();
	return;
%page;
Process_arguments:
     procedure ();

dcl  argument_idx	        fixed bin automatic;
dcl  argument_lth	        fixed bin (21) automatic;
dcl  argument_ptr	        ptr automatic;
dcl  n_arguments	        fixed bin automatic;

dcl  argument	        char (argument_lth) based (argument_ptr);

dcl  absolute_pathname_     entry (char (*), char (*), fixed bin (35));
dcl  ssu_$arg_count	        entry (ptr, fixed bin);
dcl  ssu_$arg_ptr	        entry (ptr, fixed bin, ptr, fixed bin (21));

	call ssu_$arg_count (sci_ptr, n_arguments);
	if n_arguments ^= 1 then
	     call ssu_$abort_subsystem (sci_ptr, code,
		"Syntax is: ^a system_control_dirname.", ME);

	call ssu_$arg_ptr (sci_ptr, 1, argument_ptr, argument_lth);

	call absolute_pathname_ (argument, system_control_dirname, code);
	if code ^= 0 then
	     call ssu_$abort_subsystem (sci_ptr, code, "^a", argument);
	return;
     end Process_arguments;
%page;
Abort_subsystem:
     procedure ();

	goto RETURN;
     end Abort_subsystem;
%page;
Clean_up:
     procedure ();
	if sci_ptr ^= null () then
	     call ssu_$destroy_invocation (sci_ptr);
	return;
     end Clean_up;

/* format: off */
%page; %include as_data_;
%page; %include sc_stat_;
/* format: on */
     end test_system_control;


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