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