call_ec_.pl1 11/11/89 1102.8rew 11/11/89 0808.7 153756 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* The purpose of this program is to trap, handle, and report conditions signalled while executing an exec_com, and resume execution with the next line of the exec_com without aborting it. The callers of this program may supply a varying number of arguments just as would be supplied to exec_com itself. A pointer to an argument list is provided for the purpose of calling the exec_com_ subroutine which will subsequently initiate the processing of the exec_com input lines. If an error is encountered while this interface is being called by a daemon process all messages will be placed in the system logs via signal_io_ and printed on the message coordinator terminal. If an error is encountered while running in an interactive user process the messages will be printed on the user terminal via ioa_. A temporary command_processor and active_functon_processor are established here to determine whether the condition error is resulting from a command or active function. The process' command_processor and active_function_processor will be restored to its original before exiting this program. An asdump will be created in the process' working directory for error conditions other than command_error and/or active_function_error. */ /****^ HISTORY COMMENTS: 1) change(87-03-05,Parisek), approve(87-07-23,MCR7716), audit(87-07-30,Fawcett), install(87-08-11,MR12.1-1079): Program to handle condition errors encountered while executing an exec_com. Display error data and continue execution after conditions are encountered. 2) change(87-08-12,Parisek), approve(87-08-12,PBF7716), audit(87-08-12,Fawcett), install(87-08-13,MR12.1-1085): Changed call to trace_stack to call as_dump_ and only make this call for unusual error conditions. 3) change(87-08-18,Parisek), approve(87-08-18,PBF7716), audit(87-09-03,Farley), install(87-09-10,MR12.1-1104): Define constant values and check pointer validity before referencing them. 4) change(87-09-18,Parisek), approve(87-09-18,PBF7716), audit(87-09-18,Farley), install(87-09-21,MR12.1-1111): Implement a counter that increments each time an error is reported and if this counter reaches five, then return thus aborting the exec_com. END HISTORY COMMENTS */ call_ec_: proc options (variable); dcl argp ptr, argl fixed bin(21), arg char(argl) based(argp), arg_count fixed bin, arg_list_ptr ptr; dcl RETURN_FALSE_AF_VALUE label variable, code fixed bin(35), error_counter fixed bin, /* Count number of reported errors */ ec_arg char(168), ec_dir char(168), ec_entry char(32), ec_path char(168), iop ptr, last_active_string_len fixed bin(21), last_active_string_ptr ptr, last_command_line_len fixed bin(21), last_command_line_ptr ptr, lg_status char(100) aligned, old_cp entry (ptr, fixed bin(21), fixed bin(35)) variable, old_eval entry (ptr, char(*), fixed bin, char(*) var, fixed bin(35)) variable, (seg_name, seg_name2, seg_name3) char(500) aligned, seg_ptr ptr, st_status char(8) aligned; dcl last_active_string char(last_active_string_len) based(last_active_string_ptr), last_command_line char(last_command_line_len) based(last_command_line_ptr); dcl 1 ec_info aligned like exec_com_info; dcl (addr, length, null, rtrim, substr) builtin; dcl (any_other, cleanup, command_abort_, linkage_error, signal_io_) condition; dcl com_err_ entry options (variable), condition_interpreter_ entry (ptr, ptr, fixed bin, fixed bin, ptr, char(*), ptr, ptr), continue_to_signal_ entry (fixed bin(35)), convert_status_code_ entry (fixed bin(35), char(8) aligned, char(100) aligned), cu_$arg_count entry (fixed bin, fixed bin(35)), cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin(21), fixed bin(35), ptr), cu_$arg_list_ptr entry (ptr), cu_$get_command_processor entry (entry), cu_$get_evaluate_active_string entry (entry), cu_$make_entry_value entry (ptr, entry), cu_$set_command_processor entry (entry), cu_$set_evaluate_active_string entry (entry), exec_com_ entry (char(*), char(*), char(*), ptr, fixed bin(35)), expand_pathname_ entry (char(*), char(*), char(*), fixed bin(35)), find_condition_frame_ entry (ptr) returns(ptr), find_condition_info_ entry (ptr, ptr, fixed bin(35)), get_ppr_ entry (fixed bin, ptr, ptr, char(500) aligned, char(500) aligned, char(500) aligned), ioa_$ioa_switch entry() options(variable), ioa_$rsnnl entry() options(variable), pathname_ entry (char(*), char(*)) returns(char(168)), sc_signal_io_handler_ entry (), as_dump_ entry (char (*)); dcl FALSE init("0"b) bit(1) int static options(constant), NL char(1) int static options(constant) init(" "); /* External */ dcl iox_$user_io ptr ext static; /* Constants */ dcl ACTIVE_FUNCT_ERROR_TYPE fixed bin int static options (constant) init (2), ALL_OTHERS_TYPE fixed bin int static options (constant) init (3), COMMAND_ERROR_TYPE fixed bin int static options (constant) init (1), FIRST_EC_ARG fixed bin int static options (constant) init (2), MAX_ERROR_CNT fixed bin int static options (constant) init (5), MAX_ERROR_INFO fixed bin int static options (constant) init (2); %page; if iox_$user_io = null then do; call com_err_ (0, "call_ec_", "iox_$user_io is null"); /* Have caller handle this with an asdump */ return; end; else iop = iox_$user_io; call cu_$get_command_processor (old_cp); call cu_$get_evaluate_active_string (old_eval); on cleanup call janitor(); call cu_$arg_count (arg_count, code); /* If we get any bad codes we'll signal command_error and get an asdump */ if code ^= 0 then do; call com_err_ (code, "call_ec_", "From cu_$arg_count."); return; end; call cu_$arg_list_ptr (arg_list_ptr); ec_path, ec_arg = ""; call cu_$arg_ptr_rel (1, argp, argl, code, arg_list_ptr); if code ^= 0 then do; call com_err_ (code, "call_ec_", "From cu_$arg_ptr_rel."); return; end; ec_path = (arg); call expand_pathname_ (ec_path, ec_dir, ec_entry, code); if code ^= 0 then do; call com_err_ (code, "call_ec_", "From expand_pathname_."); return; end; ec_path = pathname_ (ec_dir, rtrim(ec_entry) || ".ec"); last_command_line_ptr, last_active_string_ptr = null; on signal_io_ call sc_signal_io_handler_ (); error_counter = 0; /* Init */ on any_other begin; error_counter = error_counter + 1; call handle_ec_conditions (); if error_counter = MAX_ERROR_CNT then do; call ioa_$ioa_switch (iop, "Aborting the exec_com due to too many error conditions."); goto EXIT; end; end; call cu_$set_command_processor (call_cp); call cu_$set_evaluate_active_string (call_eval); ec_info.version = exec_com_info_version_1; ec_info.arg_list_ptr = arg_list_ptr; ec_info.first_arg = FIRST_EC_ARG; ec_info.execute_line = call_cp; ec_info.eval_string = call_eval; call cu_$make_entry_value (null (), ec_info.ready); call cu_$make_entry_value (null (), ec_info.set_ready_mode); call cu_$make_entry_value (null (), ec_info.error); call exec_com_ (rtrim(ec_path), "", "call_ec_", addr (ec_info), code); if code ^= 0 then call com_err_ (code, "call_ec_", "From exec_com_."); EXIT: call janitor(); return; %page; handle_ec_conditions: proc (); dcl type fixed bin(2); call find_condition_info_ (null, addr(ci), code); if code = 0 then do; if ci.condition_name = "command_abort_" then do; call begin_error_message(type, ""); call ioa_$ioa_switch (iop, " Error: command_abort_ signalled by call_ec_ not handled by command_processor_. ******************************"); end; else /* Pass thru standard conditions which should be */ if ci.condition_name = "alrm" /* handled by the default error handler. */ | ci.condition_name = "command_question" | ci.condition_name = "cput" | ci.condition_name = "dm_shutdown_scheduled_" | ci.condition_name = "dm_shutdown_warning_" | ci.condition_name = "dm_user_shutdown_" | ci.condition_name = "end_file" | ci.condition_name = "end_page" | ci.condition_name = "finish" | ci.condition_name = "mme2" | ci.condition_name = "storage" | ci.condition_name = "quit" | ci.condition_name = "sus_" | ci.condition_name = "system_shutdown_scheduled_" | ci.condition_name = "trm_" then call continue_to_signal_ (code); else if condition_default_restart() then do; /* Don't signal command_abort_ for errors which */ /* are default_restartable. */ if ci.condition_name = "command_error" then do; call begin_error_message(type, ci.condition_name); if ci.info_ptr ^= null then if ci.info_ptr->com_af_error_info.errmess_ptr ^= null then do; call ioa_$ioa_switch (iop, "^/^a", com_err_message); ci.info_ptr -> com_af_error_info.print_sw = FALSE; end; end; else do; call begin_error_message(type, ci.condition_name); if ci.info_ptr ^= null then call condition_interpreter_(null, null, 0, 3, ci.mc_ptr, (ci.condition_name), ci.wc_ptr, ci.info_ptr); end; call end_error_message (type, "continues"); end; else do; /* Diagnose all other, unexpected conditions. */ if ci.condition_name = "active_function_error" then do; call begin_error_message(type, ci.condition_name); if ci.info_ptr ^= null then call ioa_$ioa_switch (iop, "^a", com_err_message); if type = ACTIVE_FUNCT_ERROR_TYPE then do; call end_error_message (type, "continues by returning ""false"" as the active function value"); go to RETURN_FALSE_AF_VALUE; end; else do; if ci.info_ptr ^= null then ci.info_ptr -> com_af_error_info.print_sw = FALSE; call end_error_message (type, "continues"); end; end; else do; call as_dump_ (rtrim(ci.condition_name) || " condition encountered."); call begin_error_message(type, ci.condition_name); if condition_quiet_restart() /* Specially handle conditions that */ then do; /* condition_interpreter_ is silent for. */ if ci.loc_ptr ^= null then do; seg_ptr = ci.user_loc_ptr; on linkage_error begin; /* get_ppr_ may call routines unavailable */ call format_name (seg_ptr, seg_name); seg_name2, seg_name3 = ""; /* at the time. If an error occurs, use */ go to QUIET_REVERT; /* format_name as a backup name-getter. */ end; call get_ppr_ (MAX_ERROR_INFO, find_condition_frame_(null), addr(ci), seg_name, seg_name2, seg_name3); QUIET_REVERT: revert linkage_error; call ioa_$ioa_switch (iop, "^/Error: ^a at ^a ^a ^a", ci.condition_name, seg_name, seg_name2, seg_name3); end; else do; call ioa_$ioa_switch (iop, "Error: ^a at UNKNOWN LOCATION.", ci.condition_name); end; if ci.condition_name = "stringsize" then call end_error_message (type, "continues with truncation of the string"); else call end_error_message (type, "continues"); end; else do; call condition_interpreter_(null, null, 0, 3, ci.mc_ptr, (ci.condition_name), ci.wc_ptr, ci.info_ptr); call end_error_message (type, "continues with the next line of the exec_com"); if last_command_line_ptr ^= null then signal command_abort_; /* Then abort the current command line of the ec. */ end; end; end; end; end handle_ec_conditions; %page; begin_error_message: proc (case, condition_name); dcl case fixed bin(2), condition_name char(*) varying; if last_command_line_ptr ^= null then do; case = COMMAND_ERROR_TYPE; call ioa_$ioa_switch (iop, " ****************************** While executing the command line: ^a^[^; ^]in ^a.ec, an unexpected ^[^a condition^;error^s^] occurred:", last_command_line, substr(last_command_line,length(last_command_line),length(NL))=NL, ec_entry, condition_name^="", condition_name); end; else if last_active_string_ptr ^= null then do; case = ACTIVE_FUNCT_ERROR_TYPE; call ioa_$ioa_switch (iop, " ****************************** While evaluating the active string: ^a^[^; ^]in ^a.ec, an unexpected ^[^a condition^;error^s^] occurred:", last_active_string, substr(last_active_string,length(last_active_string), length(NL))=NL, ec_entry, condition_name^="", condition_name); end; else do; case = ALL_OTHERS_TYPE; call ioa_$ioa_switch (iop, " ****************************** An unexpected ^[^a condition^;error^s^] occurred in ^a.ec:", condition_name^="", condition_name, ec_entry); end; if ci.condition_name = "io_error" then do; call convert_status_code_ (ci.info_ptr -> io_error_info.status.code, st_status, lg_status); call ioa_$ioa_switch (iop, "Status returned by ""io_error"" condition is: ^a", rtrim(lg_status)); end; return; end_error_message: entry (case, further_action); dcl further_action char(*); call ioa_$ioa_switch (iop, " ^[Execution of the command^;Evaluation of the active string^;Execution^] ^a. ******************************^/", case, further_action); end begin_error_message; %page; call_cp: proc (Aline_ptr, Aline_len, Acode); dcl Aline_ptr ptr, Aline_len fixed bin(21), Acode fixed bin(35); last_command_line_ptr = Aline_ptr; last_command_line_len = Aline_len; call old_cp (Aline_ptr, Aline_len, Acode); last_command_line_ptr = null; end call_cp; %page; call_eval: proc (Ainfo_ptr, Aactive_string, Astring_type, Areturn_value, Acode); dcl Ainfo_ptr ptr, Aactive_string char(*), Astring_type fixed bin, Areturn_value char(*) varying, Acode fixed bin(35); last_active_string_ptr = addr(Aactive_string); last_active_string_len = length(Aactive_string); RETURN_FALSE_AF_VALUE = RETURN_FALSE; call old_eval (Ainfo_ptr, Aactive_string, Astring_type, Areturn_value, Acode); last_active_string_ptr = null; return; RETURN_FALSE: Areturn_value = "false"; Acode = 0; last_active_string_ptr = null; end call_eval; %page; condition_default_restart: proc () returns(bit(1)); if ci.info_ptr ^= null then return (ci.info_ptr -> condition_info_header.default_restart); else return (FALSE); condition_quiet_restart: entry () returns(bit(1)); if ci.info_ptr ^= null then return (ci.info_ptr -> condition_info_header.quiet_restart); else return (FALSE); end condition_default_restart; %page; format_name: proc (p, name); dcl p ptr; dcl code fixed bin (35); dcl find_pathname_ entry (ptr, ptr, fixed bin (35)); dcl name char (500) aligned; dcl 1 name_info aligned like find_pathname_info automatic; call find_pathname_ (p, addr (name_info), code); if name_info.component_ename ^= "" then /* use name from bindmap */ call ioa_$rsnnl ("^a^a (^a^a^a^a^a)^a", name, 0, name_info.component_ename, name_info.adjusted_offset, name_info.dirname, name_info.gt_char, name_info.real_ename, name_info.real_offset, name_info.pdir_string, name_info.offset_msg); else call ioa_$rsnnl ("^a^a^a^a^a^a", name, 0, name_info.dirname, name_info.gt_char, name_info.real_ename, name_info.real_offset, name_info.pdir_string, name_info.offset_msg); return; end format_name; %page; janitor: proc; call cu_$set_command_processor (old_cp); call cu_$set_evaluate_active_string (old_eval); end janitor; %page; %include com_af_error_info; dcl com_err_message char(ci.info_ptr->com_af_error_info.errmess_lth) based(ci.info_ptr->com_af_error_info.errmess_ptr); %page; %include condition_info; dcl 1 ci aligned like condition_info; %page; %include condition_info_header; %page; %include exec_com_info; %page; %include find_pathname_info; %page; %include io_error_info; %page; %include iox_modes; %page; end call_ec_;  lock_mca.pl1 11/11/89 1102.8r 11/11/89 0808.7 46386 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-01-09,Fawcett), approve(86-03-26,MCR7359), audit(86-09-05,Lippard), install(86-09-16,MR12.0-1159): Allow the MCA operator interface to be either disabled (locked) or enabled (unlocked). Main part of code taken from bce_lock_mca.pl1 END HISTORY COMMENTS */ /* format: style4,indattr,ifthenstmt,ifthen,idind35,^indcomtxt */ lock_mca: proc; dcl Me char (10); dcl P99 pic "99" based; dcl V1 char (4) static options (constant) init ("1.00"); dcl MCA_LOW_NUM fixed bin (17) static options (constant) init (0); dcl MCA_HIGH_NUM fixed bin (17) static options (constant) init (31); dcl a_sci_ptr ptr parameter; dcl arg_count fixed bin; dcl arg char (arg_len) based (arg_ptr); dcl arg_len fixed bin (21); dcl arg_ptr ptr; dcl args_expected fixed bin; dcl code fixed bin (35); dcl entry_var entry variable; dcl lock_mca bit (1); dcl mca_number fixed bin (35); dcl mca_to_unlock char (4); dcl sci_ptr ptr; dcl standalone_invocation bit (1); dcl com_err_ entry () options (variable); dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); dcl hphcs_$ocdcm_reconfigure entry (char (4), fixed bin, fixed bin (35)); dcl ssu_$abort_line entry () options (variable); dcl ssu_$print_message entry () options (variable); dcl ssu_$arg_count entry (ptr, fixed bin); dcl ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin (21)); dcl ssu_$destroy_invocation entry (ptr); dcl ssu_$standalone_invocation entry (ptr, char (*), char (*), ptr, entry, fixed bin (35)); dcl (convert, null) builtin; dcl error_table_$wrong_no_of_args fixed bin (35) ext static; dcl error_table_$not_privileged fixed bin (35) ext static; dcl MAX_MCA fixed bin (17) init (31) internal static options (constant); dcl MIN_MCA fixed bin (17) init (0) internal static options (constant); dcl cleanup condition; dcl linkage_error condition; %page; Me = "lock_mca"; lock_mca = "1"b; standalone_invocation = "0"b; args_expected = 0; sci_ptr = null; goto common_standalone; lock_mca$sc_lock_mca: entry (a_sci_ptr); Me = "lock_mca"; standalone_invocation = "0"b; lock_mca = "1"b; args_expected = 0; sci_ptr = a_sci_ptr; goto join; lock_mca$unlock_mca: entry; Me = "unlock_mca"; standalone_invocation = "0"b; lock_mca = "0"b; sci_ptr = null; args_expected = 1; common_standalone: on cleanup begin; if sci_ptr ^= null then call ssu_$destroy_invocation (sci_ptr); end; call ssu_$standalone_invocation (sci_ptr, Me, V1, null (), abort_entry, code); if code ^= 0 then do; call com_err_ (code, Me, "Could not create ssu_ invocation."); goto DONE; end; standalone_invocation = "1"b; on linkage_error call ssu_$abort_line (sci_ptr, error_table_$not_privileged, "^/Access to hphcs_ gate is required."); entry_var = hphcs_$ocdcm_reconfigure; revert linkage_error; goto join; lock_mca$sc_unlock_mca: entry (a_sci_ptr); Me = "unlock_mca"; standalone_invocation = "0"b; lock_mca = "0"b; args_expected = 1; sci_ptr = a_sci_ptr; join: call ssu_$arg_count (sci_ptr, arg_count); if arg_count ^= args_expected then do; if lock_mca then call ssu_$abort_line (sci_ptr, error_table_$wrong_no_of_args, "This command takes NO arguments.^/Usage: lock_mca"); else call ssu_$abort_line (sci_ptr, error_table_$wrong_no_of_args, "This command requires one argument.^/Usage: unlock_mca MCA_NUMBER"); end; if lock_mca then do; call hphcs_$ocdcm_reconfigure ("", LOCK_MCA_INPUT, code); call ssu_$print_message (sci_ptr, code, "MCA interface^[ NOT^] locked.", (code ^= 0)); goto DONE; end; call ssu_$arg_ptr (sci_ptr, 1, arg_ptr, arg_len); mca_number = cv_dec_check_ (arg, code); if code ^= 0 | mca_number < MCA_LOW_NUM | mca_number > MCA_HIGH_NUM then call ssu_$abort_line (sci_ptr, 0, "Illegal MCA number. ^[^a is not a decimal number.^] Range is ^d - ^d.", (code ^= 0), arg, MIN_MCA, MAX_MCA); mca_to_unlock = "M_" || convert (P99, mca_number); call hphcs_$ocdcm_reconfigure (mca_to_unlock, UNLOCK_MCA_INPUT, code); if code = 0 then call ssu_$print_message (sci_ptr, code, "MCA(^a) interface unlocked.", convert (P99, mca_number)); else call ssu_$abort_line (sci_ptr, code, "MCA(^a) interface NOT unlocked.", convert (P99, mca_number)); DONE: if standalone_invocation then call ssu_$destroy_invocation (sci_ptr); return; abort_entry: proc; goto DONE; end abort_entry; %page; %include sc_subsystem_info_; %page; %include opc_reconfig_options; end lock_mca;  sc_abort_line_util_.pl1 11/11/89 1102.8rew 11/11/89 0808.7 61191 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1983 * * * *********************************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* sc_abort_line_util_.pl1 -- */ /* Procedure to implement (hopefully) temporary sc feature of mapping */ /* abort_line into "abort_request". The reasons for this mapping are not */ /* fully understood. */ /* */ /* This procedure also contains the ssu_-replacable procedure for */ /* ssu_$invoke_request. This replacement procedure sets up the label for */ /* the abort_request function, and also performs masking of IPC event calls */ /* on a per-request basis. This masking must properly be done on a */ /* per-request basis. Masking is done based upon the value of */ /* sc_request_flags.dont_mask_calls which is defined for each request in the */ /* sc_request_table_. */ /* */ /* The sequence in which procedures are called in order to invoke a */ /* request is as follows: */ /* */ /* ssu_$listen */ /* |__sc_execute_command_line_ */ /* |__check for special commands; if special */ /* |__INVOKE_SPECIAL_PROCEDURE */ /* if not special */ /* |__SSU's execute_command_line */ /* |__sc_abort_line_util_$invoke_request */ /* |__SSU's locate_request */ /* |__if event calls should be masked for this request */ /* | |__ipc_$mask_ev_calls */ /* | */ /* |__SSU's invoke_request */ /* | |__sc_execute_command_line_$locate_request */ /* | | |__SSU's locate request */ /* | | |__check_restrictions */ /* | | */ /* | |__REQUEST PROCEDURE */ /* | */ /* |__if event calls were masked */ /* |__ipc_$unmask_ev_calls */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* format: style2 */ sc_abort_line_util_: procedure; /**** Modification history: Created 1985-02-01, BIM */ /**** Modified 1985-02-18, E. Swenson: to allow a "real" abort_line. */ /****^ HISTORY COMMENTS: 1) change(87-02-22,GDixon), approve(87-05-25,MCR7680), audit(87-05-06,Parisek), install(87-08-05,MR12.1-1055): Moved per-request masking of IPC event calls from sc_execute_command_line_ into our $invoke_request procedure. 2) change(87-07-02,GDixon), approve(87-07-02,MCR7680), audit(87-05-06,Parisek), install(87-08-05,MR12.1-1055): A) Changed to determine whether to mask event calls, based upon per-request setting in sc_request_table_. B) Changed to unmask event calls based upon prior successful masking, rather than just a prior attempt to mask. END HISTORY COMMENTS */ declare P_sci_ptr pointer parameter; declare P_request_name char(*) parameter; declare P_arg_list_ptr ptr parameter; declare P_code fixed bin(35) parameter; declare cu_$arg_list_ptr entry returns (pointer); declare cu_$generate_call entry (entry, ptr); declare ipc_$mask_ev_calls entry (fixed bin (35)); declare ipc_$unmask_ev_calls entry (fixed bin (35)); declare ssu_$get_info_ptr entry (ptr) returns (ptr); declare ssu_$print_message entry () options (variable); declare 1 auto_request_data aligned like request_data automatic; declare code fixed bin(35); declare dont_mask bit(1); declare (masked_ev_calls_code, unmasked_ev_calls_code) fixed bin (35); declare saved_abort_label label; declare sci_ptr pointer; declare addr builtin; declare cleanup condition; declare FALSE init("0"b) bit(1) int static options(constant); /* * * * * * * * * * * * * * * * * * * * * * * * * */ abort_line: entry (P_sci_ptr); /* and many other args. */ call cu_$generate_call (ssu_$print_message, cu_$arg_list_ptr ()); /* print the message */ sci_ptr = P_sci_ptr; sc_subsystem_info_ptr = ssu_$get_info_ptr (sci_ptr); go to sc_subsystem_info.abort_request_label; /* Nonlocal unwind */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ invoke_request: entry (P_sci_ptr, P_request_name, P_arg_list_ptr, P_code); sci_ptr = P_sci_ptr; sc_subsystem_info_ptr = ssu_$get_info_ptr (sci_ptr); saved_abort_label = sc_subsystem_info.abort_request_label; masked_ev_calls_code, unmasked_ev_calls_code = -1; on cleanup begin; sc_subsystem_info.abort_request_label = saved_abort_label; if masked_ev_calls_code = 0 & unmasked_ev_calls_code ^= 0 then call ipc_$unmask_ev_calls (unmasked_ev_calls_code); end; sc_subsystem_info.abort_request_label = ABORT_REQUEST; dont_mask = FALSE; request_data_ptr = addr(auto_request_data); sc_rf_ptr = addr (request_data.user_flags); call sc_subsystem_info.real_locate_request (sci_ptr, P_request_name, addr(request_data), code); if code = 0 then /* nonzero code reported later by ssu_ */ dont_mask = sc_request_flags.dont_mask_calls; if ^dont_mask then call ipc_$mask_ev_calls (masked_ev_calls_code); call cu_$generate_call (sc_subsystem_info.real_invoke_request, cu_$arg_list_ptr ()); ABORT_REQUEST: sc_subsystem_info.abort_request_label = saved_abort_label; if masked_ev_calls_code = 0 & unmasked_ev_calls_code ^= 0 then call ipc_$unmask_ev_calls (unmasked_ev_calls_code); return; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ real_abort_line: entry (P_sci_ptr); /* and some other arguments */ /**** This entry is used to get the normal MR11 ssu_$abort_line functionality. It is used by sc_requests_$sign_on in order to abort the entire command line rather than just aborting the current request. */ sci_ptr = P_sci_ptr; sc_subsystem_info_ptr = ssu_$get_info_ptr (sci_ptr); call cu_$generate_call (sc_subsystem_info.real_abort_line, cu_$arg_list_ptr ()); return; /* * * * * * * * * * * * * * * * * * * * * * * * * */ %include sc_subsystem_info_; %include "_ssu_request_data"; end sc_abort_line_util_;  sc_admin_command_.pl1 03/03/92 1551.3r w 03/03/92 1548.6 222381 /****^ *********************************************************** * * * Copyright, (C) BULL HN Information Systems Inc., 1991 * * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-05-13,GJohnson), approve(86-05-13,MCR7387), audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056): Correct error message documentation. 2) change(87-04-05,GDixon), approve(87-05-28,MCR7707), audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055): Allow force_reset and reset requests via sac sc_command. (phx20281) 3) change(91-03-11,Vu), approve(91-03-11,MCR8241), audit(91-12-06,Zimmerman), install(92-03-03,MR12.5-1010): The sc_admin_command_ misidenfies itself as sc_admin_comamnd. END HISTORY COMMENTS */ /* format: style2,idind30 */ sc_admin_command_: procedure (ASR_info_ptr, ASR_sender_ptr); /**** This program handles requests from administrators for commands to be executed in the initializer process. */ /* Modified May 1982, E. N. Kittlitz. Cleanup */ /* Modified June 1982, E. N. Kittlitz. Fix command trailing NL handling */ /* Modified 1984-10-04 BIM to convert to as_request_ from old mechanism */ /* Modified 1984-11-03 BIM for new system control (ssu_) */ /* Modified 1984-12-20 BIM to unmask IPC in here. */ /* Modified 1985-01-07 BIM for access_control_name in sc_subsystem_info. */ /* Modified 1985-03-13 E. Swenson to make use Initializer.SysDaemon.* for for access control checking during sac commands */ /* Modified 1985-03-25 EJ Sharpe, use flush_pending_output control rather than forcing it with null message after admin command completion. */ /* Modified 1985-04-23 E. Swenson to fix signal_io_ handler to not catch signals not caused by the sc_admin_command_ command line. */ /* Modified 1985-05-13 E. Swenson to fix the above fix. Credits go to Mr. Sibert. */ /**** This procedure depends on sc_process_command_line_ to reattach switches and do all that other complex stuff. However, this procedure has its own signal_io_ handler to over-ride the normal one. This handler traps input and logs output. Furthermore, this procedure has other condition handlers to handle other problems. NOTE Some provisions are made for a "dialog" mode. dialog mode is intended to be a two-way channel utilizing message segments. dialog mode is intended to enter admin mode, NOT allow a user process to dial up and become a message coordinator source. */ declare (ASR_info_ptr, ASR_sender_ptr) pointer parameter; dcl acs_mode bit (36) aligned; dcl code fixed bin (35); dcl capture_output_ptr pointer; dcl capture_output_length fixed bin (21); dcl capture_overran bit (1) aligned; dcl completion_string char (200); dcl prev_iocb_name char (32); dcl finish_signalled bit (1) aligned; dcl evidence_of_error bit (1) aligned; dcl ignore_io bit (1) aligned; dcl sci_ptr pointer; dcl message_string char (1000); dcl test_switches bit (1) aligned; dcl error_string char (100) aligned; dcl unmask_count fixed bin; dcl as_send_user_mail_ entry (character (*), character (*), character (*), character (*), character (*), bit (72) aligned, character (*)); dcl as_send_user_message_ entry (character (*), character (*), character (*), character (*), bit (72) aligned, character (*), bit (1) aligned); dcl com_err_ entry () options (variable); dcl continue_to_signal_ entry (fixed bin (35)); dcl convert_status_code_ entry (fixed binary (35), character (8) aligned, character (100) aligned); dcl cu_$get_cl_intermediary entry (entry); dcl cu_$set_cl_intermediary entry (entry); dcl cu_$reset_cl_intermediary entry; dcl default_error_handler_$wall entry; dcl find_condition_info_ entry (pointer, pointer, fixed binary (35)); dcl get_group_id_ entry () returns (char (32)); dcl get_temp_segment_ entry (character (*), pointer, fixed binary (35)); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), bit (72) aligned, fixed bin (35)) ; dcl ioa_ entry () options (variable); dcl ioa_$ioa_switch_nnl entry () options (variable); dcl ioa_$ioa_switch entry () options (variable); dcl ioa_$rsnnl entry () options (variable); dcl ioa_$rsnp entry () options (variable); dcl release_temp_segment_ entry (character (*), pointer, fixed binary (35)); dcl sc_create_sci_ entry (pointer, fixed binary (35)); dcl sc_create_sci_$destroy entry (pointer); dcl sc_process_command_line_$multics_command entry (ptr, ptr, fixed bin (21)); dcl sc_ipc_mask_$unmask entry (fixed binary); dcl sc_ipc_mask_$remask entry (fixed binary); dcl ssu_$get_info_ptr entry (ptr) returns (ptr); dcl sys_log_ entry options (variable); dcl sys_log_$error_log entry options (variable); dcl up_sysctl_$check_acs entry (character (*), character (*), fixed binary, bit (36) aligned, fixed binary (35)); dcl error_table_$recoverable_error fixed bin (35) ext static; dcl error_table_$as_sac_command_read fixed bin (35) external static; dcl error_table_$insufficient_access fixed bin (35) ext static; dcl error_table_$unimplemented_version fixed bin (35) ext static; dcl error_table_$unexpected_condition fixed bin (35) ext static; dcl error_table_$undefined_order_request fixed bin (35) ext static; dcl cleanup condition; dcl command_error condition; dcl any_other condition; dcl finish condition; dcl signal_io_ condition; dcl addcharno builtin; dcl addr builtin; dcl length builtin; dcl min builtin; dcl null builtin; dcl substr builtin; dcl unspec builtin; dcl MAX_CAPTURE_LENGTH fixed bin (21) init (1024 * 240 * 4) int static options (constant); test_switches = "0"b; asr_admin_command_info_ptr = ASR_info_ptr; as_request_sender_ptr = ASR_sender_ptr; asr_replyp = addr (as_request_sender.reply_message); asr_reply_admin_command.code = 0; asr_reply_admin_command.flags = "0"b; if asr_admin_command_info.version ^= ASR_AC_VERSION_1 then do; asr_reply_admin_command.code = error_table_$unimplemented_version; go to ERROR_NO_EXECUTION; end; /**** Does the user have access to do this? */ call up_sysctl_$check_acs ("send_admin_command.acs", as_request_sender.group_id, (as_request_sender.validation_level), acs_mode, code); if code ^= 0 then do; call sys_log_$error_log (SL_LOG_SILENT, code, "sc_admin_command_", "Failed to check access for ^a.", as_request_sender.group_id); asr_reply_admin_command.code = error_table_$insufficient_access; go to ERROR_NO_EXECUTION; end; if (acs_mode & RW_ACCESS) ^= RW_ACCESS then do; call sys_log_ (SL_LOG_SILENT, "sc_admin_command_: Denied send_admin_command for ^a in ring ^d.", as_request_sender.group_id, as_request_sender.validation_level); asr_reply_admin_command.code = error_table_$insufficient_access; go to ERROR_NO_EXECUTION; end; /**** Okay, the sucker is authorized. Now log the command line. */ call sys_log_ (SL_LOG, "sc_admin_command_: ^a: ^a", as_request_sender.group_id, asr_admin_command_info.command); if ^(asr_admin_command_info.send_start_wakeup | asr_admin_command_info.send_completion_wakeup) then asr_admin_command_info.header.reply_channel = 0; /* inhibit as_request_sender_ reply wakeups in this case. */ call ioa_$ioa_switch (sc_stat_$admin_log_iocb, "sc_admin_command_: ^a: ^a", as_request_sender.group_id, asr_admin_command_info.command); ignore_io = "1"b; finish_signalled = "0"b; on signal_io_ call IO_SIGNAL_HANDLER; /**** Okay, we are now signalling whenever I/O on user_i/o tries to happen */ on finish begin; finish_signalled = "1"b; code = error_table_$unexpected_condition; go to UNWIND_LABEL; end; call cu_$set_cl_intermediary (CL_ENTRY); evidence_of_error = "0"b; on command_error begin; evidence_of_error = "1"b; end; ignore_io = "0"b; /* all set */ if asr_admin_command_info.send_start_wakeup then call SEND_START_WAKEUP; capture_output_ptr = null (); if asr_admin_command_info.send_completion_mail then call SETUP_CAPTURE_OUTPUT; begin; declare 1 restrictions aligned like rcodebits; restrictions = "1"b; /* all powers */ restrictions.admin_mode = "0"b; /* silly to allow sac to enter admin mode */ call sc_create_sci_ (sci_ptr, code); if code ^= 0 then do; call sys_log_$error_log (SL_LOG_SILENT, code, "sc_admin_command_", "Failed to create sci for execution of that command."); go to UNWIND_NO_REMASK_LABEL; end; sc_subsystem_info_ptr = ssu_$get_info_ptr (sci_ptr); sc_subsystem_info.source_name = "sc_admin_command_"; sc_subsystem_info.restriction_flags = unspec (restrictions); sc_subsystem_info.no_real_tty = "1"b; sc_subsystem_info.real_iocb = null (); sc_subsystem_info.mc_atep = null (); sc_subsystem_info.access_control_name = get_group_id_ (); end; prev_iocb_name = "user_output"; /* assume vanilla output */ call sc_ipc_mask_$unmask (unmask_count); on any_other call ANY_OTHER_HANDLER (); call sc_process_command_line_$multics_command (sci_ptr, addr (asr_admin_command_info.command), length (asr_admin_command_info.command)); /* Execute the command. */ call sc_ipc_mask_$remask (unmask_count); asr_reply_admin_command.code = 0; asr_reply_admin_command.flags = ""b; asr_reply_admin_command.command_completed = "1"b; asr_reply_admin_command.command_had_errors = evidence_of_error; go to RESTORE_RETURN; UNWIND_LABEL: call sc_ipc_mask_$remask (unmask_count); UNWIND_NO_REMASK_LABEL: if code ^= 0 then asr_reply_admin_command.code = code; asr_reply_admin_command.flags = ""b; asr_reply_admin_command.flags.command_completed = "1"b; asr_reply_admin_command.flags.command_aborted = "1"b; RESTORE_RETURN: ignore_io = "1"b; revert any_other; call cu_$reset_cl_intermediary; call sc_create_sci_$destroy (sci_ptr); if test_switches then do; call com_err_ (code, "sc_admin_command_$test_signal_handling", "Returned via unwind."); return; end; if ^asr_admin_command_info.send_completion_wakeup then asr_admin_command_info.header.reply_channel = 0; /* prevent as_request_server_ from returning any wakeup */ if code ^= 0 then call convert_status_code_ (code, "", error_string); else error_string = ""; call ioa_$rsnnl ( "Completed command^[ with errors^].^[ Finish condition signalled.^]^[ ^a^/^;^s^]^[ Command line aborted by error.^]", completion_string, (0), asr_reply_admin_command.flags.command_had_errors, finish_signalled, code ^= 0, error_string, asr_reply_admin_command.flags.command_aborted); call iox_$control (sc_stat_$admin_log_iocb, "flush_pending_output", null (), (0)); call ioa_$ioa_switch (sc_stat_$admin_log_iocb, "sc_admin_command_: ^a", completion_string); /* log completion text */ if asr_admin_command_info.send_completion_message then do; call ioa_$rsnnl ( "Completed command ^a^[ with errors^].^[ Finish condition signalled.^]^[ ^a^/^;^s^]^[ Command line aborted by error.^]", message_string, (0), substr (asr_admin_command_info.command, min (length (asr_admin_command_info.command), 50)), asr_reply_admin_command.flags.command_had_errors, finish_signalled, code ^= 0, error_string, asr_reply_admin_command.flags.command_aborted); call SEND_MESSAGE (asr_admin_command_info.mail_destination, completion_string); end; if asr_admin_command_info.send_completion_mail then call SEND_COMPLETION_MAIL (completion_string); /* complex enough for a proc */ /* this frees capture segment */ return; CL_ENTRY: procedure; code = error_table_$unexpected_condition; go to UNWIND_LABEL; end CL_ENTRY; %page; IO_SIGNAL_HANDLER: procedure; declare 1 CI aligned like condition_info; /**** Check if this signal_io_ is for us. If not, let someone else handle it. */ if sc_stat_$admin_sci_ptr ^= sci_ptr then do; call continue_to_signal_ ((0)); return; end; if ignore_io then return; CI.version = condition_info_version_1; call find_condition_info_ (null (), addr (CI), (0)); signal_io_info_ptr = CI.info_ptr; signal_io_info.returned_error_code = 0; if signal_io_info.operation = SGI_OP_GET_LINE then call GET_LINE; else if signal_io_info.operation = SGI_OP_GET_CHARS then call GET_CHARS; else if signal_io_info.operation = SGI_OP_PUT_CHARS then call PUT_CHARS; else if signal_io_info.operation = SGI_OP_POSITION then call POSITION; else if signal_io_info.operation = SGI_OP_CONTROL then call CONTROL; else if signal_io_info.operation = SGI_OP_MODES then call MODES; return; /* If we get here, then we needn't unwind */ %page; GET_LINE: procedure; call INPUT; return; end GET_LINE; GET_CHARS: procedure; call INPUT; return; end GET_CHARS; POSITION: procedure; call INPUT; return; end POSITION; INPUT: procedure; code = error_table_$as_sac_command_read; go to UNWIND_LABEL; end INPUT; MODES: procedure; signal_io_old_modes = ""; return; end MODES; PUT_CHARS: procedure; declare window_ptr pointer; declare window_length fixed bin (21); declare window char (window_length) based (window_ptr); if signal_io_info.iocb_ptr = iox_$error_output then evidence_of_error = "1"b; if test_switches then do; call ioa_ ("sc_admin_command_$test_signal_handling: ^a: ^a", signal_io_info.iocb_name, signal_io_io_buffer); return; end; if prev_iocb_name ^= signal_io_info.iocb_name then call ioa_$ioa_switch_nnl (sc_stat_$admin_log_iocb, "^/^a:^/^a", signal_io_info.iocb_name, signal_io_io_buffer); else call ioa_$ioa_switch_nnl (sc_stat_$admin_log_iocb, "^a", signal_io_io_buffer); prev_iocb_name = signal_io_info.iocb_name; /* log it */ if capture_output_ptr = null () /* not capturing */ | capture_overran /* more than we can mail */ then return; window_ptr = addcharno (capture_output_ptr, capture_output_length); window_length = length (signal_io_io_buffer); capture_output_length = capture_output_length + window_length; if capture_output_length > MAX_CAPTURE_LENGTH then do; capture_overran = "1"b; /* don't capture this message at all */ capture_output_length = capture_output_length - window_length; end; else window = signal_io_io_buffer; return; end PUT_CHARS; CONTROL: procedure; if signal_io_order_name = "hangup" then return; if signal_io_order_name = "listen" then return; if signal_io_order_name = "quit_enable" then return; if signal_io_order_name = "quit_disable" then return; if signal_io_order_name = "start" then return; if signal_io_order_name = "printer_on" then return; if signal_io_order_name = "printer_off" then return; if signal_io_order_name = "read_status" then call INPUT; signal_io_info.returned_error_code = error_table_$undefined_order_request; return; end CONTROL; end IO_SIGNAL_HANDLER; SEND_START_WAKEUP: procedure; if asr_admin_command_info.header.reply_channel = 0 then return; declare 1 l_reply aligned like asr_reply_admin_command; l_reply.code = 0; l_reply.flags = ""b; l_reply.command_started = "1"b; call hcs_$wakeup (as_request_sender.process_id, asr_admin_command_info.header.reply_channel, unspec (l_reply), (0)); return; end SEND_START_WAKEUP; test_signal_handling: entry; declare test_iocb pointer; declare default_cl_intermediary entry (1 aligned, 2 bit (1) unaligned, 2 bit (35) unaligned) variable; declare 1 cli_flags aligned, 2 reset bit (1) unaligned, 2 pad bit (35) unaligned; test_switches = "1"b; ignore_io = "0"b; on signal_io_ call IO_SIGNAL_HANDLER; call iox_$attach_name ("test_sc_admin_command", test_iocb, "signal_io_", null (), (0)); call iox_$open (test_iocb, Stream_input_output, "0"b, (0)); call cu_$get_cl_intermediary (default_cl_intermediary); call cu_$set_cl_intermediary (NEW_COMMAND_LEVEL); cli_flags = "0"b; on cleanup call cu_$set_cl_intermediary (default_cl_intermediary); call default_cl_intermediary (cli_flags); return; NEW_COMMAND_LEVEL: procedure (cl_flags); declare 1 cl_flags aligned, 2 reset bit (1) unaligned, 2 pad bit (35) unaligned; on signal_io_ call IO_SIGNAL_HANDLER; call default_cl_intermediary (cl_flags); return; end NEW_COMMAND_LEVEL; ERROR_NO_EXECUTION: call NOTIFY_REFUSAL; return; NOTIFY_REFUSAL: procedure; /**** If the sender set ^start_wakeup, then perhaps we can notify of the problem via an interactive message or mail. */ if asr_admin_command_info.send_start_wakeup then return; /* Let as_request_server_ pother about it. */ asr_admin_command_info.reply_channel = 0; /* prevent reply */ call convert_status_code_ (asr_reply_admin_command.code, "", error_string); message_string = ""; call ioa_$rsnnl ("^a Admin command line refused. Command line was:^/ ^a^/", message_string, (0), error_string, asr_admin_command_info.command); if asr_admin_command_info.send_completion_message then call SEND_MESSAGE (asr_admin_command_info.mail_destination, message_string); if asr_admin_command_info.send_completion_mail then call SEND_MAIL (asr_admin_command_info.mail_destination, "Admin command execution refused" /* subject */, message_string); if ^(asr_admin_command_info.send_completion_mail | asr_admin_command_info.send_completion_message) then call SEND_MESSAGE ("", message_string); /* pick a destination out of the air */ return; end NOTIFY_REFUSAL; SEND_MESSAGE: procedure (Destination, Message); declare (Destination, Message) char (*); call as_send_user_message_ ("sc_admin_command_", Destination, as_request_sender.group_id, Message, as_request_sender.authorization, "Admin command server", "0"b); return; end SEND_MESSAGE; SEND_MAIL: procedure (Destination, Subject, Message) options (non_quick); declare (Destination, Subject, Message) char (*); declare format_document_$string entry (character (*), character (*), fixed binary (21), pointer, fixed binary (35)); declare 1 fdo aligned like format_document_options; declare formatted_message char (1000); declare formatted_message_length fixed bin (21); declare message_to_send char (formatted_message_length) based (addr (formatted_message)); unspec (fdo) = ""b; fdo.version_number = format_document_version_2; fdo.indentation = 0; fdo.line_length = 65; fdo.switches.adj_sw = "1"b; fdo.switches.galley_sw = "1"b; fdo.switches.dont_compress_sw = "1"b; call format_document_$string (Message, formatted_message, formatted_message_length, addr (fdo), code); if code = error_table_$recoverable_error then code = 0; if code ^= 0 then do; formatted_message = Message; formatted_message_length = length (Message); end; call as_send_user_mail_ ("sc_admin_command_", Destination, as_request_sender.group_id, Subject, message_to_send, as_request_sender.authorization, "Admin command server"); return; end SEND_MAIL; SEND_COMPLETION_MAIL: procedure (Trailer); declare Trailer char (*); /* end to tack on to message */ declare remaining_string char (MAX_CAPTURE_LENGTH + 1000 - capture_output_length) based (remaining_ptr); /* the max is small enough that we always have some extra room */ declare remaining_ptr pointer; declare added_length fixed bin (21); declare total_message char (capture_output_length) based (capture_output_ptr); declare subject char (asr_admin_command_info.command_length + 20); /* room for "succeeded: " */ remaining_ptr = addcharno (capture_output_ptr, capture_output_length); call ioa_$rsnp ("^/^a^[^/The output (above) was truncated because it was too long to fit^/ in a mail message.", remaining_string, added_length, Trailer, capture_overran); capture_output_length = capture_output_length + added_length; /* total in message */ call ioa_$rsnnl ("^[Succeeded^;Failed^]: ^a", subject, (0), ^asr_reply_admin_command.flags.command_aborted & asr_reply_admin_command.code = 0, asr_admin_command_info.command); call as_send_user_mail_ ("sc_admin_command_", asr_admin_command_info.mail_destination, as_request_sender.group_id, subject, total_message, as_request_sender.authorization, "Admin command server"); call release_temp_segment_ ("sc_admin_command_", capture_output_ptr, (0)); return; end SEND_COMPLETION_MAIL; SETUP_CAPTURE_OUTPUT: procedure; declare initial_message char (10000) aligned based (capture_output_ptr); call get_temp_segment_ ("sc_admin_command_", capture_output_ptr, (0)); capture_output_length = 0; capture_overran = "0"b; call ioa_$rsnp ("Output of execution of admin command:^/^a^/", initial_message, capture_output_length, asr_admin_command_info.command); return; end SETUP_CAPTURE_OUTPUT; %page; ANY_OTHER_HANDLER: procedure (); /**** We really want the operation of default_error_handler_$wall for all conditions, except signal_io_, where we want the normal signal_io_ handlers action. So we peek at the condition being signaled -- if it is signal_io_, then we continue to signal. Otherwise we pass our work off to default_error_handler_$wall. */ dcl 1 CI aligned like condition_info; dcl code fixed bin (35); CI.version = condition_info_version_1; call find_condition_info_ (null (), addr (CI), code); if code = 0 then if CI.condition_name = "signal_io_" then do; call continue_to_signal_ ((0)); return; end; call default_error_handler_$wall; /* But note the CL intermediary */ return; end ANY_OTHER_HANDLER; /* format: off */ %page; %include as_data_; %page; %include format_document_options; %page; %include sc_stat_; %page; %include sc_subsystem_info_; %page; %include sys_log_constants; %page; %include access_mode_values; %page; %include as_request_header; %page; %include as_requests; %page; %include as_request_sender_; %page; %include condition_info_header; %page; %include signal_io_info; %page; %include condition_info; %page; %include iox_modes; %page; %include iox_entries; %page; %include mc_restriction_codes; /* BEGIN MESSAGE DOCUMENTATION Message: sc_admin_command_: PERSON: COMMANDLINE S: $sc T: $run M: A system administrator has sent a special command to the Initializer, which executes it in admin mode. A: $ignore Message: sc_admin_command_: Failed to check access for USER. S: $sc T: $run M: User USER requested the system to execute an admin command, but the system cound not determine their access to the admin_command acs. A: $ignore Message: sc_admin_command_: Denied send_admin_command for USER in ring RING. S: $sc T: $run M: User USER requested the system to execute an admin command, but lacked access to >sc1>admin_acs>admin_command.acs. A: $ignore END MESSAGE DOCUMENTATION */ end sc_admin_command_;  sc_admin_mode_.pl1 11/11/89 1102.8rew 11/11/89 0809.1 54018 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* format: style2,idind30 */ sc_admin_mode_: procedure; /**** System control request to enter admin mode. This assumes that I/O switches are already set up reasonably. */ /**** Written 1984-11-02 BIM */ /****^ HISTORY COMMENTS: 1) change(86-08-01,Swenson), approve(87-05-25,MCR7680), audit(87-02-19,GDixon), install(87-08-04,MR12.1-1055): Avoid calling hphcs_$syserr_error_code when running in system control test mode. 2) change(87-02-19,GDixon), approve(87-05-25,MCR7680), audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055): Correct coding standard violations. END HISTORY COMMENTS */ declare cu_$arg_list_ptr entry returns (ptr); declare cu_$get_cl_intermediary entry (entry); declare cu_$generate_call entry (entry, ptr); declare cu_$reset_command_processor entry; declare cu_$set_cl_intermediary entry (entry); declare default_error_handler_$wall entry; declare get_group_id_ entry () returns (char (32)); declare hcs_$fs_search_set_wdir entry (char (*), fixed bin (35)); declare hphcs_$syserr_error_code entry entry options (variable); declare ioa_ entry options (variable); declare listen_ entry (char (*) var); declare pnt_manager_$priv_get_entry entry (char (*), pointer, fixed bin (35)); declare read_password_ entry (character (*), character (*)); declare sc_ipc_mask_$unmask entry (fixed binary); declare sc_ipc_mask_$remask entry (fixed binary); declare sc_signal_io_handler_ entry; declare scramble_ entry (character (8)) returns (character (8)); declare ssu_$abort_line entry () options (variable); declare ssu_$get_info_ptr entry (ptr) returns (ptr); declare ssu_$print_message entry () options (variable); declare sys_log_ entry options (variable); declare code fixed bin (35); declare default_cl_intermediary entry variable; declare remask_count fixed bin; declare saved_access_name char (32); declare sci_ptr pointer; declare w_password char (8); declare (addr, null) builtin; declare any_other condition; declare cleanup condition; declare finish condition; declare signal_io_ condition; declare ssu_$null_label label ext static; sci_ptr = sc_stat_$admin_sci_ptr; if sc_stat_$admin_listener_switch then call ssu_$abort_line (sci_ptr, 0, "Admin mode busy."); call pnt_manager_$priv_get_entry (OPERATOR_ADMIN_MODE_USER_NAME, addr (PNTE), code); if code ^= 0 then do; if ^sc_stat_$test_mode then call hphcs_$syserr_error_code (LOG, code, "admin: Could not retrieve admin password from the PNT to check admin password. Entering admin mode." ); call ssu_$print_message (sci_ptr, code, "Could not retrieve admin password from the PNT to check admin password. Entering admin mode."); end; else if ^PNTE.has_password then ; /* no password required */ else do; call read_password_ ("Password", w_password); if ^(scramble_ (w_password) = PNTE.password) then do; call sys_log_ (SL_LOG_SILENT, "admin: incorrect admin mode password given."); call ssu_$abort_line (sci_ptr, 0, "Password incorrect."); end; end; call cu_$get_cl_intermediary (default_cl_intermediary); sc_subsystem_info_ptr = ssu_$get_info_ptr (sci_ptr); on finish go to FINISH_SIGNALLED; on any_other call default_error_handler_$wall; on signal_io_ call sc_signal_io_handler_; /* make sure our handler takes */ remask_count = 0; saved_access_name = sc_subsystem_info.access_control_name; on cleanup call clean; /* Allow for nonlocal exit */ sc_subsystem_info.access_control_name = get_group_id_ (); /* Act as the Initializer */ call cu_$set_cl_intermediary (ADMIN_CL_INTERMEDIARY); sc_stat_$admin_listener_exit_label = RETURN; sc_stat_$admin_listener_switch = "1"b; call iox_$control (iox_$user_io, "quit_enable", null (), (0)); call sc_ipc_mask_$unmask (remask_count); call listen_ (""); /* This dosen't usually return, but... */ go to RETURN; admin_mode_exit: ame: entry; if sc_stat_$admin_listener_switch then go to sc_stat_$admin_listener_exit_label; else call ioa_ ("""admin_mode_exit"" ignored."); /* else ignore exit command */ return; RETURN: revert any_other; call clean; /* borrow */ return; FINISH_SIGNALLED: revert any_other; call clean; call ssu_$abort_line (sci_ptr, 0, "finish condition signalled."); ADMIN_CL_INTERMEDIARY: procedure; on signal_io_ call sc_signal_io_handler_; call cu_$generate_call (default_cl_intermediary, cu_$arg_list_ptr ()); return; end ADMIN_CL_INTERMEDIARY; clean: procedure; sc_subsystem_info.access_control_name = saved_access_name; call sc_ipc_mask_$remask (remask_count); call iox_$control (iox_$user_io, "quit_disable", null (), (0)); call cu_$set_cl_intermediary (default_cl_intermediary); sc_stat_$admin_listener_switch = "0"b; sc_stat_$admin_listener_exit_label = ssu_$null_label; call hcs_$fs_search_set_wdir (sc_stat_$sysdir, (0)); call cu_$reset_command_processor; return; end clean; %include iox_entries; %include pnt_entry; declare 1 PNTE aligned like pnt_entry; %include sc_subsystem_info_; %include sc_stat_; %include special_person_names; %include sys_log_constants; %include syserr_constants; end sc_admin_mode_;  sc_command.pl1 11/11/89 1102.8rew 11/11/89 0809.1 46818 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style2,indcomtxt,idind30 */ sc_command: procedure options (variable); /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* SC_COMMAND - command level interface to system control. */ /* Concatenates its arguments and calls system_control_ subroutines to */ /* execute. Naturally, only works in the initializer process. */ /* Used for commands executed from */ /* . system_start_up.ec */ /* . admin.ec */ /* . admin mode */ /* . send_admin_command */ /* */ /* This command is to be called ONLY in the system control admin */ /* environment. It insists that sc_stat_$admin_sci_ptr is non_null, */ /* defining the source of the x command or admin mode. Note that */ /* sc_admin_command_ sets admin_sci_ptr as well, so that sac sc_command */ /* works. */ /* */ /* This procedure assumes that all I/O switches and handlers are already in */ /* place. It handles no conditions, and just call ssu_$execute_line. */ /* */ /* This procedure creates a subsystem invocation all its own so that error */ /* messages are prefaced with the actual request name. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* Created by THVV in antiquity. */ /* Modified to not add trailing blank by C. Hornig, November 1979 */ /* Cleaned up by E. N. Kittlitz, May 1982 */ /* 1984-12, BIM: SSU_ system control. */ /****^ HISTORY COMMENTS: 1) change(87-02-19,GDixon), approve(87-05-25,MCR7680), audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055): Correct coding standard violations. Use an automatic sc-command-line buffer instead of a based (allocated) buffer. END HISTORY COMMENTS */ dcl arg_count fixed bin; dcl al fixed bin (21); dcl ap ptr; dcl arg_list_ptr ptr; dcl argument char (al) based (ap); dcl argx fixed bin; dcl buffer_length fixed bin (21); dcl code fixed bin (35); dcl sci_ptr pointer; dcl test bit (1) aligned; dcl com_err_ entry () options (variable); dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl cu_$arg_list_ptr entry returns(ptr); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin(21), fixed bin(35), ptr); dcl sc_create_sci_ entry (pointer, fixed binary (35)); dcl sc_create_sci_$destroy entry (ptr); dcl ssu_$execute_line entry (ptr, ptr, fixed bin (21), fixed bin (35)); dcl (addr, addwordno, length, null) builtin; dcl cleanup condition; dcl SP char (1) int static options (constant) init (" "); test = "0"b; if sc_stat_$admin_sci_ptr = null () then do; call com_err_ (0, "sc_command", "This command may only be called in the system control environment."); return; end; sci_ptr = sc_stat_$admin_sci_ptr; go to COMMON; test: entry; test = "1"b; sci_ptr = null; on cleanup call sc_create_sci_$destroy (sci_ptr); call sc_create_sci_ (sci_ptr, code); if code ^= 0 then do; call com_err_ (code, "sc_command", "Failed to create test subsystem info."); return; end; COMMON: call cu_$arg_count (arg_count, code); if code ^= 0 then do; call com_err_ (code, "sc_command"); return; end; buffer_length = 0; do argx = 1 to arg_count; call cu_$arg_ptr (argx, ap, al, (0)); if argx > 1 then buffer_length = buffer_length + length (SP); buffer_length = buffer_length + al; end; arg_list_ptr = cu_$arg_list_ptr(); DCL_BLOCK: begin; dcl buffer char (buffer_length) varying; buffer = ""; do argx = 1 to arg_count; call cu_$arg_ptr_rel (argx, ap, al, (0), arg_list_ptr); buffer = buffer || argument; buffer = buffer || SP; end; call ssu_$execute_line (sci_ptr, addwordno (addr (buffer), 1), length (buffer), code); if test then if code ^= 0 then call com_err_ (code, "sc_command", "Error from ssu_$execute_line."); end DCL_BLOCK; if test then call sc_create_sci_$destroy (sci_ptr); %include sc_stat_; end sc_command;  sc_create_sci_.pl1 11/11/89 1102.8rew 11/11/89 0809.1 45801 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* sc_create_sci_ -- create an invocation of the system control ssu invocation. */ /* format: style2,idind30 */ /**** Written 1984-11-01 BIM */ /**** Modified 1985-01-07, BIM: for access_control_name in sc_subsystem_info */ /**** Modified 1985-02-01, BIM: invoke_request to intercept abort_line */ /**** Modified 1985-02-18, E. Swenson: to save real abort_line routine */ /****^ HISTORY COMMENTS: 1) change(87-02-22,GDixon), approve(87-05-25,MCR7680), audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055): Modified to correct coding standard violations. END HISTORY COMMENTS */ sc_create_sci_: procedure (Sci_ptr, Code); declare Sci_ptr pointer; declare Code fixed bin (35); dcl (addr, null) builtin; declare sc_get_error_name_ entry; declare sc_execute_command_line_ entry; declare sc_execute_command_line_$locate_request entry; declare sc_abort_line_util_$invoke_request entry; declare sc_abort_line_util_$abort_line entry; declare ssu_$create_invocation entry (char (*), char (*), ptr, ptr, char (*), ptr, fixed bin (35)); declare ssu_$destroy_invocation entry (ptr); declare ssu_$cpescape_disabled entry; declare ssu_$get_area entry (ptr, ptr, char (*), ptr); declare ssu_$set_info_ptr entry (ptr, ptr); declare ssu_$set_procedure entry (ptr, char (*), entry, fixed bin (35)); declare ssu_$set_prompt_mode entry (ptr, bit (*)); declare ssu_$get_procedure entry (ptr, char (*), entry, fixed bin (35)); declare ssu_$add_request_table entry (ptr, ptr, fixed bin, fixed bin (35)); declare ssu_$add_info_dir entry (ptr, char (*), fixed bin, fixed bin (35)); declare ssu_$null_label label ext static; declare sc_request_table_$system_control_requests ext bit (36) aligned; declare ssu_request_tables_$standard_requests bit (36) aligned ext static; declare sci_ptr pointer; call ssu_$create_invocation ("system_control", "", null (), null (), "", sci_ptr, Code); if Code ^= 0 then return; call ssu_$add_request_table (sci_ptr, addr (sc_request_table_$system_control_requests), 1, Code); if Code ^= 0 then return; call ssu_$add_request_table (sci_ptr, addr (ssu_request_tables_$standard_requests), 10000, Code); if Code ^= 0 then return; call ssu_$add_info_dir (sci_ptr, sc_stat_$info_dir, 0, (0)); call ssu_$add_info_dir (sci_ptr, ">documentation>ss>ssu_info_dirs>standard_requests", 10000, (0)); call ssu_$set_procedure (sci_ptr, "cpescape", ssu_$cpescape_disabled, (0)); call ssu_$set_procedure (sci_ptr, "get_subsystem_and_request_name", sc_get_error_name_, (0)); begin; declare temp_area_ptr pointer; call ssu_$get_area (sci_ptr, null (), "", temp_area_ptr); allocate sc_subsystem_info in (temp_area_ptr -> sc_ss_area); sc_subsystem_info.area_ptr = temp_area_ptr; end; sc_subsystem_info.mc_atep = null (); sc_subsystem_info.real_iocb = null (); sc_subsystem_info.restriction_flags = (36)"1"b; sc_subsystem_info.flags = "0"b; sc_subsystem_info.source_name = "system_control"; sc_subsystem_info.access_control_name = sc_stat_$unidentified_access_name; call ssu_$get_procedure (sci_ptr, "execute_line", sc_subsystem_info.real_execute_line, (0)); call ssu_$set_procedure (sci_ptr, "execute_line", sc_execute_command_line_, (0)); call ssu_$get_procedure (sci_ptr, "locate_request", sc_subsystem_info.real_locate_request, (0)); call ssu_$set_procedure (sci_ptr, "locate_request", sc_execute_command_line_$locate_request, (0)); call ssu_$get_procedure (sci_ptr, "invoke_request", sc_subsystem_info.real_invoke_request, (0)); call ssu_$set_procedure (sci_ptr, "invoke_request", sc_abort_line_util_$invoke_request, (0)); call ssu_$get_procedure (sci_ptr, "abort_line", sc_subsystem_info.real_abort_line, (0)); call ssu_$set_procedure (sci_ptr, "abort_line", sc_abort_line_util_$abort_line, (0)); sc_subsystem_info.hangup_entry = HANGUP_NOOP; sc_subsystem_info.abort_request_label = ssu_$null_label; call ssu_$set_info_ptr (sci_ptr, addr (sc_subsystem_info)); call ssu_$set_prompt_mode (sci_ptr, DONT_PROMPT); /* in case someone gets the idea ... */ Sci_ptr = sci_ptr; return; destroy: entry (Sci_ptr); call ssu_$destroy_invocation (Sci_ptr); return; HANGUP_NOOP: /* in case noone sets anything better */ entry; return; %include sc_stat_; %include sc_subsystem_info_; %include ssu_prompt_modes; end sc_create_sci_;  sc_edit_motd_.pl1 11/11/89 1102.8rew 11/11/89 0809.1 26100 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* format: style2,idind30 */ /**** Guts of the "message" request, which allows the operator to edit the MOTD. */ /**** Written 1984-11-01 BIM */ /****^ HISTORY COMMENTS: 1) change(87-02-08,GDixon), approve(87-05-25,MCR7680), audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055): Fix coding standard violations. END HISTORY COMMENTS */ sc_edit_motd_: procedure; dcl code fixed bin (35); dcl 1 my_qedx_info aligned, 2 header aligned like qedx_info.header, 2 buffers aligned like qedx_info.buffers; /* just one */ dcl motd_pathname char (168); /* Path name for message of the day */ dcl motd_entryname char (32) int static init ("message_of_the_day") options (constant); dcl saved_command_processor entry variable; dcl cu_$get_command_processor entry (entry); dcl cu_$set_command_processor entry (entry); dcl pathname_ entry (character (*), character (*)) returns (character (168)); dcl qedx_ entry (ptr, fixed bin (35)); dcl ssu_$print_message entry () options (variable); dcl (addr, unspec) builtin; dcl cleanup condition; call cu_$get_command_processor (saved_command_processor); on cleanup call cu_$set_command_processor (saved_command_processor); call cu_$set_command_processor (trap_editor_execute); /* Trap "E" requests. */ motd_pathname = pathname_ (sc_stat_$sysdir, motd_entryname); unspec (my_qedx_info) = "0"b; qedx_info_ptr = addr (my_qedx_info); qedx_info.version = QEDX_INFO_VERSION_1; qedx_info.editor_name = "message"; qedx_info.flags.no_rw_path = "1"b; qedx_info.flags.query_if_modified = "1"b; qedx_info.n_buffers = 1; qedx_info.buffers (1).buffer_name = "0"; qedx_info.buffers (1).buffer_pathname = motd_pathname; qedx_info.buffers (1).flags.locked_pathname = "1"b; qedx_info.buffers (1).flags.default_read_ok = "1"b; qedx_info.buffers (1).flags.default_write_ok = "1"b; call qedx_ (qedx_info_ptr, code); call cu_$set_command_processor (saved_command_processor); return; /* Done. */ trap_editor_execute: procedure; call ssu_$print_message (sc_stat_$admin_sci_ptr, 0, """e"" request not permitted."); end trap_editor_execute; %include qedx_info; %include sc_stat_; end sc_edit_motd_;  sc_exec_request_.pl1 11/11/89 1102.8rew 11/11/89 0806.8 27153 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* sc_exec_request_ -- calls exec_com for the x request */ /* format: style2,indcomtxt,idind30 */ /**** Written 1984-11-01 BIM */ /****^ HISTORY COMMENTS: 1) change(87-02-22,GDixon), approve(87-05-25,MCR7680), audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055): Corrected coding standard violations. END HISTORY COMMENTS */ sc_exec_request_: procedure (SCI_ptr, SSI_ptr); declare SCI_ptr pointer; declare SSI_ptr pointer; /* subsystem info -- unused for now */ declare cu_$make_entry_value entry (ptr, entry); declare exec_com_ entry (character (*), character (*), character (*), pointer, fixed binary (35)); declare pathname_ entry (character (*), character (*)) returns (character (168)); declare sc_ipc_mask_$unmask entry (fixed binary); declare sc_ipc_mask_$remask entry (fixed binary); declare ssu_$arg_list_ptr entry (ptr, ptr); declare ssu_$abort_line entry () options (variable); declare code fixed bin (35); declare sci_ptr pointer; declare remask_count fixed bin; declare saved_access_name char (32); declare (addr, null, unspec) builtin; declare cleanup condition; sci_ptr = SCI_ptr; sc_subsystem_info_ptr = SSI_ptr; unspec (eci) = ""b; eci.version = exec_com_info_version_1; call ssu_$arg_list_ptr (sci_ptr, eci.arg_list_ptr); eci.first_arg = 1; call cu_$make_entry_value (null (), eci.execute_line); call cu_$make_entry_value (null (), eci.eval_string); call cu_$make_entry_value (null (), eci.ready); call cu_$make_entry_value (null (), eci.set_ready_mode); call cu_$make_entry_value (null (), eci.error); code = 0; remask_count = 0; saved_access_name = sc_subsystem_info.access_control_name; on cleanup begin; call sc_ipc_mask_$remask (remask_count); sc_subsystem_info.access_control_name = saved_access_name; end; sc_subsystem_info.access_control_name = sc_stat_$exec_access_name; call sc_ipc_mask_$unmask (remask_count); call exec_com_ (pathname_ (sc_stat_$sysdir, "admin.ec"), "", "exec", addr (eci), code); call sc_ipc_mask_$remask (remask_count); sc_subsystem_info.access_control_name = saved_access_name; if code ^= 0 then call ssu_$abort_line (sci_ptr, code, "admin.ec"); return; %include exec_com_info; declare 1 eci aligned like exec_com_info; %include sc_stat_; %include sc_subsystem_info_; end sc_exec_request_;  sc_execute_command_line_.pl1 11/11/89 1102.8rew 11/11/89 0809.1 127305 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* format: style2,idind30 */ sc_execute_command_line_: procedure (Sci_ptr, Line_ptr, Line_lth, Code); /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* ssu_ replaceable execute_line procedure for the system control */ /* environment. */ /* */ /* This procedure has to peek at the request so as to determine whether it */ /* is a "special" request which does not parse its argument. */ /* */ /* It also performs masking of ipc events during execution of SPECIAL */ /* requests whose sc_request_table_ entries call for this service. */ /* sc_abort_line_util_$invoke_request masks for nonSPECIAL requests. */ /* */ /* The sequence in which procedures are called in order to invoke a request */ /* is as follows: */ /* */ /* ssu_$listen */ /* |__sc_execute_command_line_ */ /* |__check for special commands; if special */ /* |__INVOKE_SPECIAL_PROCEDURE */ /* if not special */ /* |__SSU's execute_command_line */ /* |__sc_abort_line_util_$invoke_request */ /* |__SSU's locate_request */ /* |__if event calls should be masked for this request */ /* | |__ipc_$mask_ev_calls */ /* | */ /* |__SSU's invoke_request */ /* | |__sc_execute_command_line_$locate_request */ /* | | |__SSU's locate request */ /* | | |__check_restrictions */ /* | | */ /* | |__REQUEST PROCEDURE */ /* | */ /* |__if event calls were masked */ /* |__ipc_$unmask_ev_calls */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ %page; /**** Written 1984-11-01 BIM */ /**** Modified 1985-01-07, BIM: Changed to allow installation_parms.require_operator_login to be changed on the fly. */ /**** Modified 1985-02-01, BIM: changed for mapping of abort_line into "abort_request" */ /**** Modified 1985-03-18, E. Swenson to fix sign_on aborts during special requests. */ /**** Modified 1985-04-17, E. Swenson to fix masking problems. */ /****^ HISTORY COMMENTS: 1) change(86-08-01,Swenson), approve(87-05-25,MCR7680), audit(87-02-05,GDixon), install(87-08-05,MR12.1-1055): Modified to avoid modifying disk_table_ when running in system control test mode. 2) change(87-02-05,GDixon), approve(87-05-25,MCR7690), audit(87-05-06,Parisek), install(87-08-05,MR12.1-1055): Modified for changes to mc_anstbl.incl.pl1. 3) change(87-02-05,GDixon), approve(87-05-25,MCR7680), audit(87-05-06,Parisek), install(87-08-05,MR12.1-1055): Modified to correct coding standard violations. Corrected failure to reset sc_subsystem_info.abort_request_label. Moved masking of IPC event channels for nonSPECIAL requests from this procedure into sc_abort_line_util_$invoke_request. 4) change(87-07-02,GDixon), approve(87-07-02,MCR7680), audit(87-05-06,Parisek), install(87-08-05,MR12.1-1055): A) Since our $locate_request is called by the SSU invoke_request procedure, which is called by sc_abort_line_util_$invoke_request, our $locate_request procedure cannot tell sc_abort_line_util_ whether or not to mask event call channels. It must make that decision itself, prior to calling the real SSU invoke_request. B) Since $locate_request no longer needs to communicate with sc_abort_line_util_, we can remove the sc_subsystem_info.dont_mask_calls element from the include file. C) We still do masking for SPECIAL procedures. Make unmasking dependent upon whether masking was successfully done, rather than upon whether we tried to do masking. D) Call sc_abort_line_util_$real_abort_line to abort the entire request line if a sign_on fails. END HISTORY COMMENTS */ declare Sci_ptr pointer; declare Line_ptr pointer; declare Line_lth fixed bin (21); declare Code fixed bin (35); declare disk_table_$general_mhv entry (fixed binary (35)); declare ipc_$mask_ev_calls entry (fixed bin (35)); declare ipc_$unmask_ev_calls entry (fixed bin (35)); declare sc_abort_line_util_$real_abort_line entry options(variable); declare sc_ipc_mask_$unmask entry (fixed bin); declare sc_ipc_mask_$remask entry (fixed bin); declare ssu_$abort_line entry () options (variable); declare ssu_$execute_line entry (ptr, ptr, fixed bin (21), fixed bin (35)); declare ssu_$get_info_ptr entry (ptr) returns (ptr); declare ssu_$print_message entry () options (variable); declare WHITESPACE char (6) aligned init (" ") int static options (constant); /* FF VT NL CR TAB SP */ declare ssu_et_$null_request_line fixed bin (35) ext static; declare begin_request_name fixed bin (21); declare code fixed bin (35); declare dont_mask bit (1) aligned; declare ip ptr defined (as_data_$rs_ptrs (0)); declare 1 l_request_data aligned like request_data; declare (masked_ev_calls_code, unmasked_ev_calls_code) fixed bin (35); declare remask_count fixed bin; /* depth of ipc event masking */ declare request_line_ptr pointer; declare request_line_lth fixed bin (21); declare request_line char (request_line_lth) based (request_line_ptr); declare request_name_lth fixed bin (21); declare rest_index fixed bin (21); declare special_command bit (1) aligned; declare ws_at_end fixed bin (21); dcl (addr, length, null, reverse, search, string, substr, verify) builtin; declare cleanup condition; %page; /* Program */ sci_ptr = Sci_ptr; sc_subsystem_info_ptr = ssu_$get_info_ptr (sci_ptr); request_data_ptr = addr (l_request_data); /* we have our own copy for special requests */ request_line_ptr = Line_ptr; request_line_lth = Line_lth; begin_request_name = verify (request_line, WHITESPACE); if begin_request_name = 0 then do; Code = ssu_et_$null_request_line; return; end; request_name_lth = search (substr (request_line, begin_request_name), WHITESPACE); if request_name_lth = 0 then request_name_lth = request_line_lth - begin_request_name + 1; else request_name_lth = request_name_lth - 1; /* this cannot come out zero. */ code = 0; special_command = "0"b; dont_mask = "0"b; /* most commands mask while executing */ call sc_subsystem_info . real_locate_request (sci_ptr, substr (request_line, begin_request_name, request_name_lth), addr (request_data), code); if code = 0 then do; sc_rf_ptr = addr (request_data.user_flags); if sc_request_flags.dont_parse_arguments then special_command = "1"b; if sc_request_flags.dont_mask_calls then dont_mask = "1"b; end; if special_command then do; rest_index = verify (substr (request_line, begin_request_name + request_name_lth), WHITESPACE); if rest_index = 0 then call INVOKE_SPECIAL_PROCEDURE (""); else do; ws_at_end = verify (reverse (request_line), WHITESPACE); if ws_at_end > 0 then ws_at_end = ws_at_end - 1; begin; /* format: off */ declare line_arg char (request_line_lth - (rest_index + begin_request_name + request_name_lth - 2) - ws_at_end ) /* flush the NL */ defined (request_line) pos (rest_index + begin_request_name + request_name_lth - 1); /* format: on */ call INVOKE_SPECIAL_PROCEDURE (line_arg); end; end; end; else do; call sc_subsystem_info.real_execute_line (sci_ptr, request_line_ptr, request_line_lth, code); /* this will call us to locate */ end; Code = code; return; %page; INVOKE_SPECIAL_PROCEDURE: procedure (rest_of_line) options (non_quick); declare rest_of_line char (*); declare saved_request_data_ptr pointer; declare saved_executing_request bit (1) aligned; declare saved_abort_request label; declare cu_$arg_list_ptr entry returns (ptr); saved_request_data_ptr = sci.request_processor_info.request_data_ptr; saved_executing_request = sci.executing_request; saved_abort_request = sc_subsystem_info.abort_request_label; masked_ev_calls_code, unmasked_ev_calls_code = -1; if ^dont_mask then on cleanup begin; sci.request_processor_info.request_data_ptr = saved_request_data_ptr; sc_subsystem_info.abort_request_label = saved_abort_request; sci.executing_request = saved_executing_request; if masked_ev_calls_code = 0 & unmasked_ev_calls_code ^= 0 then call ipc_$unmask_ev_calls (unmasked_ev_calls_code); end; sci.request_processor_info.request_data_ptr = addr (request_data); sci.executing_request = "1"b; sc_subsystem_info.abort_request_label = ABORT_SPECIAL_REQUEST; call check_restrictions (); request_data.call_info.arg_list_ptr = cu_$arg_list_ptr (); request_data.call_info.arg_count = 1; request_data.call_info.af_sw = "0"b; request_data.call_info.rv_ptr = null (); request_data.call_info.rv_lth = 0; if ^dont_mask then call ipc_$mask_ev_calls (masked_ev_calls_code); call request_data.entry (sci_ptr, addr (sc_subsystem_info)); ABORT_SPECIAL_REQUEST: if masked_ev_calls_code = 0 & unmasked_ev_calls_code ^= 0 then call ipc_$unmask_ev_calls (unmasked_ev_calls_code); sci.request_processor_info.request_data_ptr = saved_request_data_ptr; sci.executing_request = saved_executing_request; sc_subsystem_info.abort_request_label = saved_abort_request; return; end INVOKE_SPECIAL_PROCEDURE; %page(2); check_restrictions: procedure; declare sci_authority (1:36) bit (1) unaligned; declare SIGN_ON_COMMAND character (7) init ("sign_on") int static options (constant); /**** This program expects request_data to be set up */ sc_rf_ptr = addr (request_data.user_flags); string (sci_authority) = sc_subsystem_info.restriction_flags; if sc_request_flags.restriction_type ^= 0 then if ^sci_authority (sc_request_flags.restriction_type) then call ssu_$abort_line (sci_ptr, 0, "Terminal ^a lacks authority to execute the ^a command.", sc_subsystem_info.source_name, request_data.full_name); if sc_request_flags.obsolete then call ssu_$print_message (sci_ptr, 0, "Warning: the ^a command is obsolete.", request_data.full_name); if sc_request_flags.requires_no_as & sc_stat_$Multics then call ssu_$abort_line (sci_ptr, 0, "The Answering Service is already initialized.^[ Type ""go"" to start Multics service.^]", ^sc_stat_$Go); if sc_request_flags.requires_as & ^sc_stat_$Multics then call ssu_$abort_line (sci_ptr, 0, "The ^a request requires the Answering Service to be initialized.^/" || "Type ""startup"" or ""multics"" to initialize it.", request_data.full_name); if ip ^= null () then /* Is installations parms initiated? If not, assume no login required */ if ^(sc_request_flags.no_login_needed | sc_stat_$no_operator_login | sc_subsystem_info.mc_atep = null () | ^installation_parms.require_operator_login) then do; if ^sc_subsystem_info.mc_atep -> mc_ate.signed_on then do; call ssu_$print_message (sci_ptr, 0, "You must sign on before using the ^a command.", request_data.full_name); /**** We must unmask IPC event calls here to allow the answering service to function while an operator is being queried for his/her userid and password. We may have been masked during a previous call to ssu_$execute_line on the stack. */ call sc_ipc_mask_$unmask (remask_count); call ssu_$execute_line (sci_ptr, addr (SIGN_ON_COMMAND), length (SIGN_ON_COMMAND), code); /**** Reset the IPC event call mask to whatever it was before we unmasked above. */ call sc_ipc_mask_$remask (remask_count); if code ^= 0 then call sc_abort_line_util_$real_abort_line (sci_ptr, code, "Failed to sign on."); end; end; /**** We are prepared to execute command. Call disk_table_ as needed. */ if ^sc_stat_$test_mode & sc_request_flags.complete_disks_first then do; call disk_table_$general_mhv (code); if code ^= 0 then call ssu_$abort_line (sci_ptr, code, "Failed to mount logical volumes."); end; end check_restrictions; %page; /**** Note -- caller supplies request_data */ locate_request: entry (Sci_ptr, Request_name, Request_data_ptr, Code); declare Request_name char (*); declare Request_data_ptr pointer; sci_ptr = Sci_ptr; sc_subsystem_info_ptr = ssu_$get_info_ptr (sci_ptr); call sc_subsystem_info.real_locate_request (sci_ptr, Request_name, Request_data_ptr, Code); if Code ^= 0 then return; request_data_ptr = Request_data_ptr; call check_restrictions; /* can we execute this? */ if sc_request_flags.dont_parse_arguments then call ssu_$abort_line (sci_ptr, 0, "The ^a command was found in an invalid context. Special^/" || "commands may only occur at the beginning of lines.", request_data.full_name); return; /* format: off */ %page; %include as_data_; %page; %include installation_parms; %page; %include mc_anstbl; %page; %include sc_stat_; %page; %include sc_subsystem_info_; %page; %include "_ssu_sci"; %page; %include "_ssu_request_data"; end sc_execute_command_line_;  sc_get_error_name_.pl1 11/11/89 1102.8rew 11/11/89 0806.8 11961 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* procedure used to replace ssu_$get_subsystem_and_request_name */ /* format: style2,idind30 */ /* Created 1984-12, BIM */ /****^ HISTORY COMMENTS: 1) change(87-02-07,GDixon), approve(87-05-25,MCR7680), audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055): Modified to correct coding standard violations. END HISTORY COMMENTS */ sc_get_error_name_: procedure (SCI_ptr) returns (char (72) varying); declare SCI_ptr pointer; dcl (addr, rtrim) builtin; call ssu_check_sci (SCI_ptr); sci_ptr = SCI_ptr; if ^sci.executing_request then return ("system_control"); else return (rtrim (sci.request_data_ptr -> request_data.full_name)); %include "_ssu_sci"; %include "_ssu_check_sci"; %include "_ssu_request_data"; end sc_get_error_name_;  sc_init_.pl1 10/17/90 1139.3rew 10/17/90 1137.5 250659 /****^ *********************************************************** * * * Copyright, (C) BULL HN Information Systems Inc., 1990 * * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style2,idind30 */ sc_init_: procedure (); /* SC_INIT_ - initialize system control */ /* probably removed from system_control_ by THVV sometime in the dim past. Updated to remove tty console support for new iox_, April 1981, Benson I. Margulies */ /* Changed to heed iox_ error codes for all streams, August 1981, E. N. Kittlitz */ /* added back >unb to search rules after it was backed out once. 8/26/81 Holmstedt */ /* pit_ refname added Benson I. Margulies 81/12. */ /* call_bce change Keith Loepere 8/83 */ /* 09/23/84 by R. Michael Tague: Set up handler for system_shutdown_scheduled_ and dm_system_shutdown_ IPS signals */ /* Modified 1984-10-08 BIM for demise of communications */ /* Modified 1984-10-27 by E. Swenson to rename >sc1>admin_log to >sc1>as_logs since this is what sc_stat_$log_dir says this directory is supposed to be called. */ /* Modified 1984-11-01 BIM for ssu_ */ /* 12/11/84 by R. Michael Tague: Changed to use dm_misc_util_$shutdown_handler for the dm_system_shutodown_ IPS signal. */ /* Modified 1985-01-15, BIM: fixed to use syserr, not sys_log_, before as log is available. */ /* Modified 1985-03-27, E. Swenson: for forced emergency listener. */ /* Modified 1985-04-16, EJ Sharpe: for attempting log salvage on bad logs */ /****^ HISTORY COMMENTS: 1) change(85-11-27,Herbst), approve(87-05-25,MCR7680), audit(87-01-08,GDixon), install(87-08-04,MR12.1-1055): Added static handler for system_message_. 2) change(86-05-13,GJohnson), approve(86-05-13,MCR7387), audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056): Correct error message documentation. 3) change(86-06-27,Swenson), approve(87-05-25,MCR7680), audit(87-01-08,GDixon), install(87-08-04,MR12.1-1055): Modified to support a test system control environment. 4) change(86-12-03,Fawcett), approve(87-05-25,MCR7680), audit(87-01-08,GDixon), install(87-08-04,MR12.1-1055): Merged 2) with 1) & 3) DSA to MR12 conversion. 5) change(87-01-08,GDixon), approve(87-01-08,PBF7479), audit(87-01-08,Fawcett), install(87-01-12,MR12.0-1268): Make Initializer properly handle asynchronous event call channels (to prevent wkp_ signals from causing as_dumps). 6) change(87-02-06,GDixon), approve(87-05-25,MCR7680), audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055): Replace calls to the nonexistent kill_sc_process_ subroutine with calls to hphcs_$syserr_error_code. Corrected error message documentation, and code which creates log and admin_log if they are not found. Correct coding standard violations. 7) change(90-09-24,Schroth), approve(90-09-24,MCR8212), audit(90-10-10,Vu), install(90-10-17,MR12.4-1047): Correct possible fatal linkage error if booting nosc. END HISTORY COMMENTS */ %page; /* DECLARATION OF EXTERNAL SYMBOLS */ dcl active_all_rings_data$initializer_tty ext char (32); /* TTY channel ID for operator tty from boot deck. */ dcl active_all_rings_data$initializer_dim ext char (32); /* always ocd_ */ /* DECLARATION OF BUILTIN FUNCTIONS */ dcl (addr, codeptr, hbound, max, null, rtrim, substr, unspec) builtin; /* Entries */ dcl com_err_ entry () options (variable); dcl config_$find entry (char (4) aligned, ptr); dcl copy_on_write_handler_ entry (); dcl cu_$cl entry options (variable); dcl dm_misc_util_$shutdown_handler entry (); dcl get_pdir_ entry () returns (char (168)); dcl hcs_$append_branchx entry (char (*), char (*), fixed bin (5), (3) fixed bin (3), char (*), fixed bin (1), fixed bin (1), fixed bin (24), fixed bin (35)); dcl hcs_$chname_file entry (char (*), char (*), char (*), char (*), fixed bin (35)); dcl hcs_$fs_search_set_wdir entry (char (*), fixed bin (35)); dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); dcl hcs_$initiate_search_rules entry (ptr, fixed bin (35)); dcl hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)); dcl hphcs_$call_bce entry; dcl hphcs_$set_mask_ring entry; dcl hphcs_$syserr entry options (variable); dcl hphcs_$syserr_error_code entry options (variable); dcl ioa_ entry () options (variable); dcl ioa_$rsnnl entry () options (variable); dcl iox_$init_standard_iocbs entry; dcl log_salvage_ entry (char (*), char (*), ptr, fixed bin (35)); dcl log_write_$open entry (character (*), character (*), bit (1) aligned, pointer, fixed binary (35)); dcl pathname_ entry (char (*), char (*)) returns (char (168)); dcl pl1_resignaller_$establish_handlers entry; dcl sc_create_sci_ entry (pointer, fixed binary (35)); dcl sct_manager_$set entry (fixed bin, entry, fixed bin (35)); dcl ssu_$get_info_ptr entry (ptr) returns (ptr); dcl system_message_handler_ entry (); dcl timer_manager_$cpu_time_interrupt entry (); dcl timer_manager_$alarm_interrupt entry (); dcl system_shutdown_handler_ entry (); dcl wkp_signal_handler_ entry (); dcl unique_chars_ entry (bit (*)) returns (char (15)); dcl ( error_table_$noentry, error_table_$notadir ) fixed bin (35) ext static; /* DECLARATION OF AUTOMATIC STORAGE VARIABLES */ dcl atd char (200); /* Attach description for master console */ dcl 1 auto_log_salvage_arg aligned like log_salvage_arg; dcl code fixed bin (35); /* iox errcode */ dcl invoke_emergency_listener bit (1); /* should emergency listener be invoked */ dcl log_salv_code fixed bin (35); /* returned from log_salvage_ */ dcl log_salv_err_cnt fixed bin; /* count of errors occurring on each log */ dcl log_salv_name char (32); /* name of log being salvaged */ dcl type fixed bin (2); /* for status_minf */ /* Constant */ /* Here are the search rules used by the initializer process. */ dcl 1 search_rules int static options (constant) aligned, /* The search rules structure from SWS */ 2 number fixed bin init (7), 2 dirs (7) char (168) init ("initiated_segments", "referencing_dir", "working_dir", ">system_library_standard", ">system_library_1", ">system_library_tools", /* Important. answering service & opr cons */ ">system_library_unbundled"); /* bound_mcs_init_ */ declare DIR_RINGS (3) fixed bin (3) init (4, 5, 5) int static options (constant); dcl ME char (32) initial ("sc_init_") internal static options (constant); %page; /* Program */ invoke_emergency_listener = INVOKE_EMERGENCY_LISTENER (); if ^sc_stat_$test_mode then do; call pl1_resignaller_$establish_handlers; call sct_manager_$set (cput_sct_index, timer_manager_$cpu_time_interrupt, code); call sct_manager_$set (alrm_sct_index, timer_manager_$alarm_interrupt, code); call sct_manager_$set (no_write_permission_sct_index, copy_on_write_handler_, code); call sct_manager_$set (not_in_write_bracket_sct_index, copy_on_write_handler_, code); call sct_manager_$set (wkp_sct_index, wkp_signal_handler_, code); if ^invoke_emergency_listener then do; call sct_manager_$set (system_shutdown_scheduled_sct_index, system_shutdown_handler_, code); call sct_manager_$set (dm_shutdown_scheduled_sct_index, dm_misc_util_$shutdown_handler, code); call sct_manager_$set (system_message_sct_index, system_message_handler_, code); end; end; code = 0; /* ignore it */ begin; declare pp pointer; pp = null (); call hcs_$initiate (get_pdir_ (), "pit", "pit_", (0), (0), pp, code); /* the refname is important */ if pp = null () then do while ("1"b); if ^sc_stat_$test_mode then do; call hphcs_$syserr_error_code (BEEP, code, "sc_init_: Could not initiate the PIT for the Initializer."); call hphcs_$call_bce; end; else do; call com_err_ (code, ME, "Could not initiate the PIT for the Initializer."); call cu_$cl (); end; end; code = 0; end; /**** make sure we are in >sc1 */ call hcs_$fs_search_set_wdir ((sc_stat_$sysdir), code); if code ^= 0 then if ^sc_stat_$test_mode then call hphcs_$syserr_error_code (BEEP, code, "sc_init_: Could not set working directory to ^a.", sc_stat_$sysdir); else call com_err_ (code, ME, "Could not set working directory to ^a.", sc_stat_$sysdir); if sc_stat_$test_mode then do; call iox_$find_iocb ("master_i/o", sc_stat_$master_iocb, code); if code ^= 0 then do; call com_err_ (code, ME, "Could not create master_i/o switch."); return; end; call iox_$close (iox_$user_io, code); if code ^= 0 then do; call com_err_ (code, ME, "Could not close user_i/o switch."); return; end; /**** Can't print an error message if any of these fail. */ call iox_$move_attach (iox_$user_io, sc_stat_$master_iocb, code); call iox_$open (sc_stat_$master_iocb, Stream_input_output, ""b, code); call iox_$attach_ptr (iox_$user_io, "syn_ master_i/o", codeptr (sc_init_), code); end; else do; call hphcs_$set_mask_ring; /* Set "initial ring" to 4 so timer_manager_ work */ call hcs_$initiate_search_rules (addr (search_rules), code); if code ^= 0 then call hphcs_$syserr_error_code (BEEP, code, "sc_init_: Error from initiate_search_rules"); call iox_$init_standard_iocbs; /**** sc_stat_$master_channel is only declared as a char(6) while active_all_rings_data$initializer_tty is declared char(32). Note that the value of these character strings is always "otw_". */ sc_stat_$master_channel = substr (active_all_rings_data$initializer_tty, 1, 6); atd = rtrim (active_all_rings_data$initializer_dim) || " " || sc_stat_$master_channel; call iox_$attach_name ("master_i/o", sc_stat_$master_iocb, atd, codeptr (sc_init_), code); if code ^= 0 then call hphcs_$syserr_error_code (CRASH, code, "sc_init_: Error from iox_$attach master_i/o ^a", atd); /* attach to console. */ call iox_$open (sc_stat_$master_iocb, Stream_input_output, ""b, code); if code ^= 0 then call hphcs_$syserr_error_code (CRASH, code, "sc_init_: Error from iox_$open master_i/o stream_input_output"); call iox_$attach_name ("user_i/o", iox_$user_io, "syn_ master_i/o", codeptr (sc_init_), code); if code ^= 0 then call hphcs_$syserr_error_code (CRASH, code, "sc_init_: Error from iox_$attach user_i/o syn_ master_i/o"); end; /**** Here we check to see if the "nosc" parameter was specified on the BCE boot command line. If so, we invoke the emergency listener. This is useful in case we have problems with the logging software later on. */ if invoke_emergency_listener then do; call hphcs_$syserr (BEEP, "sc_init_: Invoking emergency listener because ""nosc"" parameter specified."); call EMERGENCY_LISTENER (); end; call iox_$attach_name ("severity3", sc_stat_$sv3_iocb, "syn_ user_i/o", codeptr (sc_init_), code); if code ^= 0 then go to SEVERITY_ERROR; call iox_$attach_name ("severity2", sc_stat_$sv2_iocb, "syn_ user_i/o", codeptr (sc_init_), code); if code ^= 0 then go to SEVERITY_ERROR; call iox_$attach_name ("severity1", sc_stat_$sv1_iocb, "syn_ user_i/o", codeptr (sc_init_), code); if code ^= 0 then go to SEVERITY_ERROR; call hcs_$status_minf (sc_stat_$sysdir, "as_logs", 1, type, (0), code); if code = 0 & type ^= 2 then code = error_table_$notadir; if code ^= 0 then do; if ^sc_stat_$test_mode then call hphcs_$syserr_error_code (BEEP, code, "sc_init_: ^a>as_logs does not exist or is not a directory.", sc_stat_$sysdir); else call com_err_ (code, ME, "^a>as_logs does not exist or is not a directory.", sc_stat_$sysdir); call hcs_$chname_file (sc_stat_$sysdir, "as_logs", "as_logs", "as_logs." || unique_chars_ (""b), code) ; /* rename if its there */ if code = 0 then if ^sc_stat_$test_mode then call hphcs_$syserr (ANNOUNCE, "sc_init_: Renamed non-directory object ^a>as_logs.", sc_stat_$sysdir); else call com_err_ (code, ME, "Renamed non-directory object ^a>as_logs.", sc_stat_$sysdir); call hcs_$append_branchx (sc_stat_$sysdir, "as_logs", SMA_ACCESS_BIN, DIR_RINGS, "*.SysDaemon.*", 1, 0, 0, code); if code = 0 then if ^sc_stat_$test_mode then call hphcs_$syserr (ANNOUNCE, "sc_init_: Created ^a>as_logs", sc_stat_$sysdir); else call ioa_ ("^a: Created ^a>as_logs.", ME, sc_stat_$sysdir); end; sc_stat_$as_log_write_ptr = null (); call log_write_$open (sc_stat_$log_dir, "log", "0"b /* don't create */, sc_stat_$as_log_write_ptr, code); if code ^= 0 then do; if code ^= error_table_$noentry then do; log_salv_err_cnt = 0; /* for the benefit of ... */ log_salv_name = "log"; /* ... print_log_salv_error */ 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, log_salv_name, log_salvage_arg_ptr, log_salv_code); end; else log_salv_code = 0; if log_salv_code = 0 then do; /* try again */ call log_write_$open (sc_stat_$log_dir, "log", "1"b /* create */, sc_stat_$as_log_write_ptr, code); end; if code ^= 0 then do; /* still didn't fly */ if ^sc_stat_$test_mode then call hphcs_$syserr_error_code (BEEP, code, "sc_init_: Failed to open the AS log (^a>log).", sc_stat_$log_dir); else call com_err_ (code, ME, "Failed to open the AS log (^a>log).", sc_stat_$log_dir); call EMERGENCY_LISTENER; end; end; /**** At this point we probably could use sys_log_, but syserr is surer */ call ioa_$rsnnl ("log_output_ ^a>admin_log -no_create", atd, (0), sc_stat_$log_dir); sc_stat_$admin_log_iocb = null (); call iox_$attach_name ("admin_log_", sc_stat_$admin_log_iocb, (atd), codeptr (sc_init_), code); if code ^= 0 /* switches are set, we can sys_log_ */ then do; if ^sc_stat_$test_mode then call hphcs_$syserr_error_code (BEEP, code, "sc_init_: Failed to attach admin_log log."); else call com_err_ (code, ME, "Failed to attach admin_log log."); call EMERGENCY_LISTENER; end; call iox_$open (sc_stat_$admin_log_iocb, Stream_output, "1"b, code); if code ^= 0 then do; if code ^= error_table_$noentry then do; log_salv_err_cnt = 0; /* for the benefit of ... */ log_salv_name = "admin_log"; /* ... print_log_salv_error */ 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, log_salv_name, log_salvage_arg_ptr, log_salv_code); end; else log_salv_code = 0; if log_salv_code = 0 then do; /* try again */ call iox_$detach_iocb (sc_stat_$admin_log_iocb, (0)); sc_stat_$admin_log_iocb = null (); call ioa_$rsnnl ("log_output_ ^a>admin_log -create", atd, (0), sc_stat_$log_dir); call iox_$attach_name ("admin_log_", sc_stat_$admin_log_iocb, (atd), codeptr (sc_init_), code); if code ^= 0 /* switches are set, we can sys_log_ */ then do; if ^sc_stat_$test_mode then call hphcs_$syserr_error_code (BEEP, code, "sc_init_: Failed to attach admin_log log."); else call com_err_ (code, ME, "Failed to attach admin_log log."); call EMERGENCY_LISTENER; end; call iox_$open (sc_stat_$admin_log_iocb, Stream_output, "1"b, code); end; if code ^= 0 then do; /* still didn't fly */ if ^sc_stat_$test_mode then call hphcs_$syserr_error_code (BEEP, code, "sc_init_: Failed to open admin_log log."); else call com_err_ (code, ME, "Failed to open admin_log log."); call iox_$detach_iocb (sc_stat_$admin_log_iocb, (0)); call EMERGENCY_LISTENER; end; 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 do; if ^sc_stat_$test_mode then call hphcs_$syserr_error_code (BEEP, code, "sc_init_: Failed to get log_write_ ptr for admin_log."); else call com_err_ (code, ME, "Failed to get log_write_ ptr for admin_log."); call EMERGENCY_LISTENER; end; call sc_create_sci_ (sc_stat_$master_sci_ptr, code); if code ^= 0 then do; if ^sc_stat_$test_mode then call hphcs_$syserr_error_code (BEEP, code, "sc_init_: Failed to create ssu invocation for system control."); else call com_err_ (code, ME, "Failed to create ssu invocation for system control."); call EMERGENCY_LISTENER; end; sc_subsystem_info_ptr = ssu_$get_info_ptr (sc_stat_$master_sci_ptr); sc_subsystem_info.source_name = "otw_"; sc_subsystem_info.real_iocb = sc_stat_$master_iocb; sc_subsystem_info.the_system_console = "1"b; return; SEVERITY_ERROR: if ^sc_stat_$test_mode then call hphcs_$syserr (BEEP, "sc_init_: Failed to attach one of the severityN (1, 2, 3) switches."); else call com_err_ (code, ME, "Failed to attach one of the severityN (1, 2, 3) switches."); call EMERGENCY_LISTENER; return; %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 if ^sc_stat_$test_mode then call hphcs_$syserr (SYSERR_PRINT_ON_CONSOLE, "sc_init_: Messages from log salvage of ^a:", pathname_ (sc_stat_$log_dir, log_salv_name)); else call com_err_ (code, ME, "Messages from log salvage of ^a:", pathname_ (sc_stat_$log_dir, log_salv_name)); if ^sc_stat_$test_mode then call hphcs_$syserr (SYSERR_PRINT_ON_CONSOLE, "sc_init_ (log_salvage_): ^a", msg); else call com_err_ (code, ME, "^a", msg); return; end print_log_salv_error; EMERGENCY_LISTENER: procedure; /**** We have enough I/O switches for a primitive ADMIN mode. */ declare default_error_handler_$wall entry; declare any_other condition; declare listen_ entry (character (*) var); on any_other call default_error_handler_$wall; call ioa_ ("sc_init_: A serious error was encountered setting up the system control"); call ioa_ (" environment. The system will attempt to establish a Multics"); call ioa_ (" listener level. You should repair the problem, and then type:"); call ioa_ (" ""hphcs_$shutdown"", and reboot the system."); call listen_ (""); end EMERGENCY_LISTENER; %page; INVOKE_EMERGENCY_LISTENER: procedure () returns (bit (1) aligned); dcl i fixed bin; /* loop index */ if sc_stat_$test_mode then return ("0"b); intk_cardp = null (); call config_$find (INTK_CARD_WORD, intk_cardp); if intk_cardp = null () then /* no INTK card? */ return ("0"b); /* then no emergency listener */ /**** INTK card found, check for "nosc" parameter */ do i = 1 to hbound (intk_card_array.parms, 1); if intk_card.parms (i) = "nosc" then return ("1"b); /* yes, it was specified */ end; return ("0"b); /* parameter not found */ end INVOKE_EMERGENCY_LISTENER; /* format: off */ %page; %include access_mode_values; %page; %include config_intk_card; %page; %include iox_entries; %page; %include iox_modes; %page; %include log_salvage_arg; %page; %include sc_stat_; %page; %include sc_subsystem_info_; %page; %include sys_log_constants; %page; %include syserr_constants; %page; %include static_handlers; /* format: on */ %page; /* BEGIN MESSAGE DOCUMENTATION Message: sc_init_: ERROR_MESSAGE. Error from iox_$attach master_i/o ATD S: $crash T: $init M: Some error was detected while attaching the master_i/o switch. ATD is the text of the attach description. This error is usually caused by a hardware failure in the operator's console. Correct the failure and reboot the system. A: $contact Message: sc_init_: ERROR_MESSAGE. Error from iox_$open master_i/o stream_input_output S: $crash T: $init M: Some error was detected while opening the master_i/o switch. This is usually caused by a hardware failure in the operator's console. Correct the failure and reboot the system. A: $contact Message: sc_init_: ERROR_MESSAGE. Error from iox_$attach user_i/o syn_ master_i/o S: $crash T: $init M: Some error was detected while attaching user_i/o as a synonym for the master_i/o switch in the Initializer process. This is usually caused by a hardware failure in the operator's console. Correct the failure and reboot the system. A: $contact Message: sc_init_: Invoking emergency listener because "nosc" parameter specified. S: $info T: $init M: The parm config card specified nosc (no system control). This parameter requests that an emergency listener be entered to allow repair of >sc1 or other parts of the system hierarchy at the earliest possible point during system initialization. Once the repairs are made, shutdown the system by typing: "hphcs_$shutdown" and then reboot the system. A: Repair the problem, shutdown the system, then reboot. Message: sc_init_: Messages from log salvage of LOG_PATHNAME: S: $info T: $init M: Some error was detected in opening the admin or answering service log specified by LOG_PATHNAME. A salvage was invoked to attempt correction of the problem. One or more messages will succeed this message which describe inconsistancies found in the log, repairs which were made, or conditions which prevent automatic repair. These will be of the form "sc_init_: (log_salvage_) MESSAGE". A: $contact Message: sc_init_: Failed to attach one of the severityN (1, 2, 3) switches. S: $info T: $init M: The Initializer failed to make a syn_ for one of the three switches severity1, severity2, or severity3. There may be a problem with the system tape, the libraries, or the hardware. A: The system attempts to enter a primitive listener environment on the bootload console. You should diagnose and/or correct the problem and then reboot the system. Message: sc_init_: A serious error was encountered setting up the system control environment. The system will attempt to establish a Multics listener level. You should repair the problem, and then type: "hphcs_$shutdown", and reboot the system. S: $info T: $init A: $contact Message: sc_init_: Cound not initiate the PIT for the Initializer. S: $crash T: $init M: The Initializer has failed to initiate the segment "pit" in its process directory. This could indicate problems with the bootload tape, the online libraries, or the hardware. A: $contact Message: sc_init_: ERROR_MESSAGE. Error from initiate_search_rules. S: $beep T: $init M: The Initializer is attempting to set its search rules and has encountered an error. This message may occur if an error has been introduced into the system tape, or it may indicate that one of the directories searched by the Initializer has been destroyed. A: $contact Message: sc_init_: ERROR_MESSAGE. Could not set working directory to PATH. S: $beep T: $init M: Either some program is in error, or the directory PATH does not exist. A: $contact Correct the problem, shut down, and reboot. Message: sc_init_: ERROR_MESSAGE. >system_control_dir>as_logs does not exist or is not a directory. S: $beep T: $init M: The directory >sc1>as_logs must exist for the ring 4 environment to be set up. A: The system continues operation, trying to repair the situation. Subsequent messages indicate the success or failure of repairs. Message: sc_init_: Created >system_control_dir>as_logs S: $beep T: $init M: The system has successfully created a new directory >sc1>as_logs. A: $ignore If this is not the first bootload of the system under MR11 or later, you may need to retrieve log segments lost in a crash into the new directory. Message: sc_init_: Renamed non-directory object >system_control_dir>as_logs. S: $beep T: $init M: The system found something that was not a directory in the place of the directory >sc1>as_logs, and renamed it to permit a new directory to be created. A: $ignore Message: sc_init_: ERROR_MESSAGE. Failed to attach admin_log log. S: $beep T: $init M: The system failed to attach a switch to write information to the admin log, >sc1>as_logs>admin_log. The segment >sc1>as_logs>admin_log may be damaged. The system enters a primitive Multics listener on the bootload console. A: Repair the problem. You may have to delete or rename the segment >sc1>as_logs>admin_log. Then shutdown and reboot. Message: sc_init_: ERROR_MESSAGE. Failed to open admin_log log. S: $beep T: $init M: The system failed to iox open the switch for the log >sc1>as_logs>admin_log. The segment >sc1>as_logs>admin_log may be damaged. The system enters a primitive Multics listener on the bootload console. A: Repair the problem. You may need to rename or delete the segment >sc1>as_logs>admin_log. Then shutdown and reboot. Message: sc_init_: ERROR_MESSAGE. Failed to get log_write_ ptr for admin_log. S: $beep T: $init M: This indicated an internal programming error. The online libraries may be damaged. A: $contact Message: sc_init_: ERROR_MESSAGE. Failed to open the AS log (>system_control_dir>as_logs>log). S: $beep T: $init M: The system was unable to open the log >sc1>as_logs>log. This may indicate damage to the segment >sc1>as_logs>log. The system enters a primitive Multics listener on the bootload console. A: Repair the problem. You may have to rename or delete >sc1>as_logs>log. Then shutdown and reboot. Message: sc_init_: Failed to create ssu invocation for system control. S: $beep T: $init M: The system failed to set up the subsystem data structure for the bootload console. This indicates a programming error or trouble with the system libraries. A: $contact END MESSAGE DOCUMENTATION */ end sc_init_;  sc_ipc_mask_.pl1 11/11/89 1102.8r w 11/11/89 0807.4 14931 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* sc_ipc_mask_.pl1 -- utility for getting to a guaranteed mask. */ /* format: style2 */ /* Modification history: Created 1984-12-05 BIM */ /**** NOTE: Normally, the AS runs masked while executing commands. it unmasks when it is executing an exec_com or entering admin mode, on the theory that the control point will not block in the middle of a database update. When sc_command is used signals are masked again for the duration. */ sc_ipc_mask_$unmask: procedure (P_remask_count); declare P_remask_count fixed bin; declare code fixed bin (35); declare ipc_$unmask_ev_calls entry (fixed bin (35)); declare ipc_$mask_ev_calls entry (fixed bin (35)); P_remask_count = 0; code = 0; do while (code = 0); call ipc_$unmask_ev_calls (code); if code = 0 then P_remask_count = P_remask_count + 1; end; return; sc_ipc_mask_$remask: entry (P_remask_count); declare remask_count_up fixed bin; do remask_count_up = 1 to P_remask_count; /* PL/I copies the limit */ call ipc_$mask_ev_calls ((0)); P_remask_count = P_remask_count - 1; /* so this is safe */ end; return; end sc_ipc_mask_$unmask;  sc_process_command_line_.pl1 11/11/89 1102.8rew 11/11/89 0809.2 160650 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* format: style2,idind30,indcomtxt */ /**** sc_process_command_line_.pl1 THIS program is the common interface for all parts of the Initializer that read command lines from operators. It is responsible for creating an environment that mimics a normal user process and then executing the command line in that environment. FIRST it sets up the I/O switches, saves the old value of sc_stat_$admin_sci_ptr, and sets sc_stat_$admin_sci_ptr to the given sci_ptr. It sets user_i/o to signal_io_. The sc_signal_io_handler_ established in system_control_ is depended on to handle I/O signals. sc_subsystem_info.real_iocb is assumed to be correct. SEND_ADMIN_COMMAND calls the special multics_command entrypoint which calls cu_$cp instead of ssu_$execute_line. SC_COMMAND does not call this. It assumes that it is called either in admin mode, which is entered through this program, or in the admin exec com, which is also entered via this program. sc_command call ssu_ directly. MASKING This program does not mask event calls. The rule for masking event calls is that the Initializer may never run an event_call handler while in one of its subsystems, for fear of recursion. initializer commands are presumed to enter the environment that requires this protection. Multics commands are not. Thus, masking takes place in sc_execute_command_line_ before entering the command, rather then in here. MEMOS and the like may NEVER be used in the Initializer process. when the alarm call handler goes off there is no code that will establish the correct environment. PROBE and DEBUG establish similiar limitations. Since there is a user_i/o (the system console) outside of this environment, careful use can be made to work. HISTORICAL NOTE This procedure includes the previous contents of admin_mode_, borrow_tty_from_mc_, and return_tty_to_mc_. */ sc_process_command_line_: procedure (SCI_ptr, Line_ptr, Line_lth); /* Written 1984-10-26 BIM */ /* Modified 1985-01-07, BIM: MC access control, access name in sc_subsystem_info_ */ /* Modified 1985-01-30, E. Swenson: Fixed operator login. */ /* Modified 1985-04-01, E. Swenson: to do sign_out on hangup in mc_tty_. */ /* Modified 1985-04-05, E. Swenson: to handle abort_lines correctly and to not log extra NL in admin_log. */ /****^ HISTORY COMMENTS: 1) change(86-08-01,Cox), approve(87-05-25,MCR7690), audit(87-03-13,GDixon), install(87-08-04,MR12.1-1055): Modified for change to mc_anstbl.incl.pl1. 2) change(86-08-03,Swenson), approve(87-05-25,MCR7680), audit(87-03-13,GDixon), install(87-08-04,MR12.1-1055): Also changed to support system_control_ test mode. 3) change(87-02-05,GDixon), approve(87-05-25,MCR7680), audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055): Also added System Message Documentation for calls to syserr and sys_log_. Made minor changes to improve code efficiency. END HISTORY COMMENTS */ declare SCI_ptr pointer; declare Line_ptr pointer; declare Line_lth fixed bin (21); declare code fixed bin (35); declare (ev_calls_masked_code, ev_calls_unmasked_code) fixed bin (35); declare hungup bit (1) aligned; declare line_ptr pointer; declare line_lth fixed bin (21); declare multics_switch bit (1) aligned; declare old_mask bit (36) aligned; declare old_operator_name char (32); declare request_line char (line_lth) based (line_ptr); declare saved_user_io pointer; declare saved_user_input pointer; declare saved_error_output pointer; declare saved_user_output pointer; declare saved_admin_sci_ptr pointer; declare sci_ptr pointer; declare switch_unique char (30); declare test_switch bit (1) aligned; /* Entries */ dcl com_err_ entry () options (variable); declare continue_to_signal_ entry (fixed binary (35)); declare cu_$cp entry (ptr, fixed bin (21), fixed bin (35)); declare hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); declare hcs_$set_ips_mask entry (bit (36) aligned, bit (36) aligned); declare hcs_$reset_ips_mask entry (bit (36) aligned, bit (36) aligned); declare hphcs_$syserr_error_code entry options (variable); declare hphcs_$syserr entry options (variable); declare ioa_$ioa_switch entry () options (variable); declare iox_$init_standard_iocbs entry; declare ipc_$decl_ev_wait_chn entry (fixed bin (71), fixed bin (35)); declare ipc_$decl_event_call_chn entry (fixed bin (71), entry, pointer, fixed bin, fixed bin (35)); declare lg_ctl_$logout_operator entry (ptr, char (*), char (*)); declare mc_commands_$note_input entry (char (*), pointer, fixed binary (35)); declare mc_commands_$sign_out entry (pointer, character (*), fixed binary (35)); declare ssu_$get_info_ptr entry (ptr) returns (ptr); declare ssu_$execute_line entry (ptr, ptr, fixed bin (21), fixed bin (35)); declare sys_log_ entry options (variable); declare unique_chars_ entry (bit (*)) returns (char (15)); dcl ME char (32) initial ("sc_process_command_line_") internal static options (constant); dcl NL char (1) int static options (constant) init (" "); declare cleanup condition; declare any_other condition; dcl addr builtin; dcl clock builtin; dcl codeptr builtin; dcl null builtin; dcl rtrim builtin; dcl substr builtin; %page; test_switch = "0"b; multics_switch = "0"b; go to COMMON; /**** The test entrypoint does switches for a normal user process. */ test: entry (SCI_ptr, Line_ptr, Line_lth); multics_switch = "0"b; test_switch = "1"b; go to COMMON; test_multics: entry (SCI_ptr, Line_ptr, Line_lth); multics_switch = "1"b; test_switch = "1"b; go to COMMON; multics_command: entry (SCI_ptr, Line_ptr, Line_lth); /**** SCI is required for Multics to find the real IOCB pointer. */ multics_switch = "1"b; test_switch = "0"b; COMMON: sci_ptr = SCI_ptr; line_ptr = Line_ptr; line_lth = Line_lth; code = 0; sc_subsystem_info_ptr = ssu_$get_info_ptr (sci_ptr); saved_admin_sci_ptr = sc_stat_$admin_sci_ptr; switch_unique = "sc" || unique_chars_ (""b); saved_user_io, saved_user_input, saved_user_output, saved_error_output = null (); ev_calls_masked_code = -1; ev_calls_unmasked_code = -1; on cleanup begin; call RESTORE_ATTACHMENTS; sc_stat_$admin_sci_ptr = saved_admin_sci_ptr; end; mc_atep = sc_subsystem_info.mc_atep; /* this may be null */ sc_subsystem_info.printer_offed = "0"b; /* log suppression is only permitted within a command line */ /**** Depend on the system_control_ handler for signal_io_, which uses sc_stat_$admin_sci_ptr to find the right real_iocb. */ call SAVE_ATTACHMENTS; /* we could assume correct switches and */ /* just depend on having the top signal handler. */ /* this, however, saves us from file_output */ sc_stat_$admin_sci_ptr = sci_ptr; if sc_stat_$mc_is_on & mc_atep ^= null () then do; call mc_commands_$note_input (request_line, mc_atep, (0)); /* broadcast input around */ if mc_ate.signed_on & sc_stat_$Multics then do; if clock () > mc_ate.last_input_time + (as_data_$rs_ptrs (0) -> installation_parms.operator_inactive_time * 1000 * 1000) then do; /* passed the deadline, tough bananas */ call mc_commands_$sign_out (mc_atep, old_operator_name, (0)); sc_subsystem_info.access_control_name = sc_stat_$unidentified_access_name; call lg_ctl_$logout_operator (sc_subsystem_info_ptr, old_operator_name, "autologout"); call ioa_$ioa_switch (sc_subsystem_info.real_iocb, "**********^2/ Operator ^a signed off due to inactivity.^2/**********^/", old_operator_name); end; end; mc_ate.last_input_time = clock (); end; if ^sc_subsystem_info.no_real_tty & mc_atep ^= null () /* don't bother if sci has no associated terminal, assume caller logs */ then do; /* log in both logs for easy reading */ call sys_log_ (SL_LOG_SILENT, " (input on ^a) ^a", mc_ate.real_tty_name, request_line); call ioa_$ioa_switch (sc_stat_$admin_log_iocb, " (input on ^a) ^a", mc_ate.real_tty_name, rtrim (request_line, NL)); end; /* and log it */ sc_subsystem_info.hangup_entry = HANGUP; sc_subsystem_info.abort_request_label = ABORT_LABEL; hungup = "0"b; if multics_switch then call cu_$cp (line_ptr, line_lth, code); else do; call ssu_$execute_line (sci_ptr, line_ptr, line_lth, code); if sc_subsystem_info.real_iocb ^= null () & sc_subsystem_info.print_ready then do; if ^sc_stat_$Multics then call ioa_$ioa_switch (sc_subsystem_info.real_iocb, "Ready"); else call ioa_$ioa_switch (sc_subsystem_info.real_iocb, "Ready^[ (^a)^;^s^]^[ (Not signed on.)^]", mc_ate.signed_on, mc_ate.personid, as_data_$rs_ptrs (0) -> installation_parms.require_operator_login & ^mc_ate.signed_on); end; end; ABORT_LABEL: sc_stat_$admin_sci_ptr = saved_admin_sci_ptr; call RESTORE_ATTACHMENTS; if hungup then call sys_log_ (SL_LOG_BEEP, "sc_process_command_line_: Terminal ^a hung up during execution of command.", sc_subsystem_info.source_name); return; HANGUP: procedure; /**** unwind the entire command execution and return to the frame that started this command. */ go to HANGUP_UNWIND; end HANGUP; HANGUP_UNWIND: hungup = "1"b; go to ABORT_LABEL; %page; SAVE_ATTACHMENTS: procedure; old_mask = ""b; on any_other call ERROR_MASKED; call hcs_$set_ips_mask (""b, old_mask); if test_switch then do; /* our caller is expected to have a signal_io_handler_ active */ call iox_$find_iocb ("real_i/o", real_iocb, (0)); call iox_$move_attach (iox_$user_io, real_iocb, (0)); call iox_$attach_ptr (iox_$user_io, "syn_ real_iocb", codeptr (sc_process_command_line_), (0)); sc_subsystem_info.real_iocb = real_iocb; end; call save_switch (iox_$user_io, saved_user_io, "user_i/o"); call save_switch (iox_$user_input, saved_user_input, "user_input"); call save_switch (iox_$user_output, saved_user_output, "user_output"); call save_switch (iox_$error_output, saved_error_output, "error_output"); call attach_switch (iox_$user_io, "signal_io_"); call iox_$init_standard_iocbs; /* attaches syn_'s */ if mc_atep ^= null () then if ^mc_ate.the_system_console then call ipc_$decl_ev_wait_chn (mc_ate.event, (0)); call hcs_$reset_ips_mask (old_mask, old_mask); end SAVE_ATTACHMENTS; RESTORE_ATTACHMENTS: procedure; on any_other call ERROR_MASKED; call hcs_$set_ips_mask (""b, old_mask); call restore_switch (saved_user_io, iox_$user_io); call restore_switch (saved_user_input, iox_$user_input); call restore_switch (saved_user_output, iox_$user_output); call restore_switch (saved_error_output, iox_$error_output); if test_switch then do; call iox_$detach_iocb (iox_$user_io, (0)); call iox_$move_attach (real_iocb, iox_$user_io, (0)); call iox_$destroy_iocb (real_iocb, (0)); end; else do; if mc_atep ^= null () then if ^mc_ate.the_system_console then do; mc_ansp = sc_stat_$mc_ansp; call ipc_$decl_event_call_chn (mc_ate.event, mc_anstbl.cons_cont_proc, addr (mc_ate), MC_PRIO, (0)); call hcs_$wakeup (mc_anstbl.mc_procid, mc_ate.queue_event, 0, code); end; end; call hcs_$reset_ips_mask (old_mask, old_mask); return; end RESTORE_ATTACHMENTS; save_switch: procedure (live_iocb, save_iocb, iocb_name); declare (live_iocb, save_iocb) pointer; declare iocb_name char (32) varying; declare save_name char (32); save_name = rtrim (switch_unique) || iocb_name; call iox_$find_iocb (save_name, save_iocb, code); if code ^= 0 then do; if ^sc_stat_$test_mode then call hphcs_$syserr_error_code (CRASH, code, "^a: Failed to find save iocb ^a.", ME, save_name); else call com_err_ (code, ME, "Failed to find save iocb ^a.", save_name); end; call iox_$close (save_iocb, (0)); call iox_$detach_iocb (save_iocb, (0)); call iox_$move_attach (live_iocb, save_iocb, code); if code ^= 0 then do; if ^sc_stat_$test_mode then call hphcs_$syserr_error_code (CRASH, code, "^a: Failed to move_attach iocb ^a.", ME, save_name); else call com_err_ (code, ME, "Failed to move_attach iocb ^a.", save_name); end; return; end save_switch; attach_switch: procedure (iocbp, atd); declare iocbp pointer; declare atd char (*); call iox_$attach_ptr (iocbp, atd, codeptr (sc_process_command_line_), code); if code ^= 0 then do; if ^sc_stat_$test_mode then call hphcs_$syserr_error_code (CRASH, code, "^a: Could not attach switch ^a (@ ^p)^/using attach description: ^a.", ME, iocbp -> iocb.name, iocbp, atd); else call com_err_ (code, ME, "Could not attach switch ^a (@ ^p)^/using attach description: ^a.", iocbp -> iocb.name, iocbp, atd); end; call iox_$open (iocbp, Stream_input_output, "0"b, code); if code ^= 0 then do; if ^sc_stat_$test_mode then call hphcs_$syserr_error_code (CRASH, code, "^a: Could not open switch ^a for stream_input_output.", ME, iocbp -> iocb.name); else call com_err_ (code, ME, "Could not open switch ^a for stream_input_output.", iocbp -> iocb.name) ; end; return; end attach_switch; restore_switch: procedure (saved_iocb, live_iocb); declare (saved_iocb, live_iocb) pointer; call iox_$close (live_iocb, (0)); call iox_$detach_iocb (live_iocb, (0)); call iox_$move_attach (saved_iocb, live_iocb, code); if code ^= 0 then do; if ^sc_stat_$test_mode then call hphcs_$syserr_error_code (CRASH, code, "^a: Could not restore attachment to switch ^a.", ME, live_iocb -> iocb.name); else call com_err_ (code, ME, "Could not restore attachment to switch ^a.", live_iocb -> iocb.name); end; call iox_$destroy_iocb (saved_iocb, (0)); return; end restore_switch; ERROR_MASKED: procedure; if substr (old_mask, 36, 1) = "0"b then call continue_to_signal_ ((0)); else do; if ^sc_stat_$test_mode then call hphcs_$syserr (CRASH, "^a: Error while reattaching critical I/O switches.", ME); else call com_err_ (0, ME, "Error while reattaching critical I/O switches."); end; return; end ERROR_MASKED; /* BEGIN MESSAGE DOCUMENTATION Message: (input on SWITCH_NAME) REQUEST_LINE S: as (severity 0) T: $response M: Logs a REQUEST_LINE typed by the operator, or by another user via the send_admin_command or send_initializer_command commands. A: $ignore Message: sc_process_command_line_: Terminal SOURCE_NAME hung up during execution of command. S: as (severity 2) T: $response M: Reports that execution of an Initializer command was interrupted when the message coordinator terminal identified by SOURCE_NAME hung. A: $ignore Message: sc_process_command_line_: ERROR_MESSAGE. Failed to find save iocb NAME. S: $sc T: $response M: $crashes $err ERROR_MESSAGE is the expansion of the system status code describing the actual error. A: $contact Message: sc_process_command_line_: ERROR_MESSAGE. Failed to move_attach iocb NAME. S: $sc T: $response M: $crashes $err ERROR_MESSAGE is the expansion of the system status code describing the actual error. A: $contact Message: sc_process_command_line_: ERROR_MESSAGE. Could not attach switch NAME (@ LOC) using attach description DESCRIP. S: $sc T: $response M: $crashes $err ERROR_MESSAGE is the expansion of the system status code describing the attach error. LOC gives the location of the I/O Control Block (IOCB). A: $contact Message: sc_process_command_line_: ERROR_MESSAGE. Could not open switch NAME for stream_input_output. S: $sc T: $response M: $crashes $err ERROR_MESSAGE is the expansion of the system status code describing the open error. A: $contact Message: sc_process_command_line_: ERROR_MESSAGE. Could not restore attachment to switch NAME. S: $sc T: $response M: $crashes $err ERROR_MESSAGE is the expansion of the system status code describing the move_attach error. A: $contact Message: sc_process_command_line_: Error while reattaching critical I/O switches. S: $sc T: $response M: $crashes $err A: $contact END MESSAGE DOCUMENTATION */ %include as_data_; %include as_wakeup_priorities; %include installation_parms; declare ip pointer; %include iocb; %include iox_entries; %include iox_modes; %include mc_anstbl; %include sc_stat_; %include sc_subsystem_info_; %include sys_log_constants; %include syserr_constants; end sc_process_command_line_;  sc_request_table_.alm 11/11/89 1102.8rew 11/11/89 0807.4 169344 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1984 * " * * " *********************************************************** " HISTORY COMMENTS: " 1) change(84-12-01,Margulies), approve(), audit(), install(): " Initially written. " 2) change(85-01-15,Swenson), approve(), audit(), install(): " Correct "no_start_up" request. " 3) change(85-04-01,Swenson), approve(), audit(), install(): " Have "." not require sign_on and not require the AS to be started for " the stop_mpx command. " 4) change(85-04-17,Swenson), approve(), audit(), install(): " to fix masking problems. " 5) change(86-01-09,MSharpe), approve(87-06-10,MCR7690), " audit(87-06-11,Parisek), install(87-08-04,MR12.1-1055): " Changed to find mc commands, process commands, and com_channel commands " in the newly created programs that hold them. (these commands were " previously in admin_). " 6) change(86-01-09,Fawcett), approve(86-03-28,MCR7359), " audit(86-04-25,Lippard), install(86-09-16,MR12.0-1159): " Add requests lock_mca and unlock_mca. " 7) change(86-04-30,GDixon), approve(86-09-26,MCR7499), " audit(86-10-10,Beattie), install(86-10-13,MR12.0-1182): " Allow the abs request to work prior to starting of the Answering Service " (ie, while at Standard level). " 8) change(86-12-02,Fawcett), approve(87-06-10,MCR7690), " audit(87-06-11,Parisek), install(87-08-04,MR12.1-1055): " Merged 6) & 7) into the code for 5, DSA to MR12 convertion. " 9) change(87-03-26,Lippard), approve(87-04-27,MCR7673), " audit(87-05-15,Fawcett), install(87-05-26,MR12.1-1036): " Add set_time_zone. " 10) change(88-04-14,Farley), approve(88-05-26,MCR7880), " audit(88-05-31,Parisek), install(88-07-05,MR12.2-1052): " Added list_lv_attachments (llva) request. " END HISTORY COMMENTS " request table for system control environment name sc_request_table_ include ssu_request_macros macro obsolete_request request &1,&2,(&3),(),(flags.dont_summarize,flags.dont_list,flags.allow_command),(sc_flags.obsolete,&4) &end macro obsolete_multics_request multics_request &1,(&2),(),&3,(flags.dont_summarize,flags.dont_list,flags.allow_command),(sc_flags.obsolete,&4) &end macro admin_request multics_request &1,(&3),(&4),&2,(&5),(&6) &end " see sc_subsystem_info_.incl.pl1 and mc_restriction_codes.incl.pl1 " for definition of the following bits. bool sc_flags.dont_parse_arguments,400000 bool sc_flags.obsolete,200000 bool sc_flags.dont_mask_calls,100000 bool sc_flags.requires_as,040000 bool sc_flags.requires_no_as,020000 bool sc_flags.complete_disks_first,010000 bool sc_flags.no_login_needed,004000 bool sc_flags.r_master_console,000001 bool sc_flags.r_as_control,000002 bool sc_flags.r_reset_sc,000003 bool sc_flags.r_reply,000004 bool sc_flags.r_edit_motd,000005 bool sc_flags.r_intercom,000006 bool sc_flags.r_mpx_control,000007 bool sc_flags.r_admin_mode,000010 bool sc_flags.r_rcp_control,000022 bool sc_flags.r_reconfig_system,000023 bool sc_flags.r_dump,000024 bool sc_flags.r_exec,000025 bool sc_flags.r_status,000026 bool sc_flags.r_daemon_control,000027 bool sc_flags.r_loginword,000030 bool sc_flags.r_mod_sysid,000031 bool sc_flags.r_down_ok,000032 bool sc_flags.r_warning,000033 bool sc_flags.r_set_maxu,000034 bool sc_flags.r_channel_control,000035 bool sc_flags.r_bump_user,000036 bool sc_flags.r_route_messages,000037 bool sc_flags.r_abs_control,000040 begin_table system_control_requests set_default_flags (flags.allow_command), (sc_flags.requires_as) set_default_multics_flags (flags.allow_command), (sc_flags.requires_as) admin_request abs,admin_$abs,(), (Control the absentee facility.), (default), (sc_flags.r_abs_control) admin_request accept,operator_mc_cmds_$accept,(), (Accept a channel as a message coordinator terminal.), (default), (default,sc_flags.r_route_messages) admin_request accept_vchn,operator_mc_cmds_$accept_vchn,(), (Accept a message coordinator virtual channel.), (default), (default,sc_flags.r_route_messages) multics_request add_lv,(alv), (Mount a logical volume for use.), disk_table_$mount_hvol, (default), (sc_flags.r_master_console) multics_request add_vol,(av), (Inform the system of the location of a physical volume.), disk_table_$accept, (default), (sc_flags.r_master_console) request admin,sc_admin_mode_$sc_admin_mode_,(), (Enter admin mode.), (default), (sc_flags.r_admin_mode,sc_flags.dont_mask_calls) admin_request attach,operator_com_channel_cmds_$attach,(), (Attach a communications channel for use.), (default), (default,sc_flags.r_channel_control) request bce,sc_requests_$bce,(), (Return to BCE.), (default), (sc_flags.r_master_console) admin_request bump,operator_process_cmds_$bump,(), (Bump an interactive user from the system.), (default), (default,sc_flags.r_as_control) request cripple,sc_requests_$cripple,(), (Stop the Answering Service in preparation for database reloads.), (default,flags.dont_summarize,flags.dont_list), (default,sc_flags.r_as_control) multics_request del_lv,(dlv), (Demount a logical volume.), disk_table_$demount_hvol, (default), (sc_flags.r_master_console) multics_request del_vol,(dv), (Demount a physical volume.), disk_table_$remove, (default), (sc_flags.r_master_console) admin_request define,operator_mc_cmds_$define,(), (Define a new virtual console, or add a disposition to an existing one.), (default), (default,sc_flags.r_route_messages) admin_request deroute,operator_mc_cmds_$deroute,(), (Remove a routine of a source stream.), (default), (default,sc_flags.r_route_messages) admin_request detach,operator_process_cmds_$detach,(), (Forcibly detach a communications channel from a user.), (default), (default,sc_flags.r_channel_control) admin_request down,admin_$down,(), (Sets, cancels, or prints the scheduled shutdown time.), (default), (default,sc_flags.r_down_ok) admin_request drop,operator_mc_cmds_$drop,(), (Drop a channel from use as a message coordinator terminal.), (default), (default,sc_flags.r_route_messages) request exec,sc_exec_request_$sc_exec_request_,(x), (Executes an extended command.), (default), (sc_flags.r_exec) request force_reset,sc_requests_$force_reset,(), (Force reset Answering Service locks and masks.), (default), (sc_flags.r_reset_sc,sc_flags.dont_mask_calls) request go,sc_requests_$go,(), (Start answering lines.), (default), (default,sc_flags.r_as_control) multics_request hmu,(), (Prints the number of users logged in.), as_who$hmu, (default), (default,sc_flags.r_status) multics_request init_vol,(), (Initialize a new physical volume.), disk_table_$initialize_disk, (default), (sc_flags.r_master_console) request intercom,sc_requests_$intercom,(ic), (Send a message to another message coordinator terminal.), (default), (default,sc_flags.dont_parse_arguments,sc_flags.r_intercom) multics_request list_disks,(ld), (Status of all disk drives.), disk_table_$list, (default), (sc_flags.r_status) multics_request list_lv_attachments,(llva), (Status of logical volume attachments.), lv_request_$attach_list, (default), (sc_flags.r_status) multics_request list_vols,(lsv), (Status of storage system volumes.), list_vols$list_vols, (default), (sc_flags.r_status) admin_request login,admin_$login,(logi), (Logs in a daemon process.), (default), (default,sc_flags.r_daemon_control) admin_request logout,admin_$logout,(logo), (Logs out a daemon process.), (default), (default,sc_flags.r_daemon_control) admin_request maxunits,admin_$maxunits,(maxu), (Set the maximum number of users who may login.), (default), (default,sc_flags.r_set_maxu) multics_request mc_list,(), (Lists message coordinator information.), mc_list$mc_list, (default), (default,sc_flags.r_status) request message,sc_requests_$message,(motd), (Edit the message of the day.), (default), (sc_flags.r_edit_motd) request multics,sc_requests_$multics,(mult), (Initialize the Answering Service for a special session.), (default), (sc_flags.requires_no_as,sc_flags.complete_disks_first,sc_flags.r_master_console) request no_start_up,sc_requests_$no_start_up,(ns), (Disables execution of the system_start_up exec_com.), (default), (sc_flags.requires_no_as,sc_flags.r_master_console) request quit,sc_requests_$quit,(), (Send a quit signal to a daemon process.), (default), (default,sc_flags.r_reply) admin_request rcp,admin_$rcp,(), (Control RCP.), (default), (default,sc_flags.r_rcp_control) request reply,sc_requests_$reply,(r), (Send input to a daemon process.), (default), (default,sc_flags.dont_parse_arguments+sc_flags.r_reply) admin_request reroute,operator_mc_cmds_$reroute,(), (Change the routing of a source stream.), (default), (default,sc_flags.r_route_messages) admin_request route,operator_mc_cmds_$route,(), (Route a source stream to a virtual console.), (default), (default,sc_flags.r_route_messages) request sign_off,sc_requests_$sign_off,(), (Sign out as operator.), (default), (default) request sign_on,sc_requests_$sign_on,(), (Sign in as operator.), (default), (default,sc_flags.no_login_needed,sc_flags.dont_mask_calls) admin_request redefine,operator_mc_cmds_$redefine,(), (Replace the disposition of a virtual console.), (default), (default,sc_flags.r_route_messages) admin_request remove,operator_com_channel_cmds_$remove,(), (Remove a channel from use.), (default), (default,sc_flags.r_channel_control) request reset,sc_requests_$reset,(), (Reset some Answering Service locks and masks.), (default), (default,sc_flags.r_reset_sc) multics_request salvage_vol,(), (Physical volume salvage a volume.), salv_caller$packsalv, (default), (sc_flags.r_master_console) request set_time_zone,sc_requests_$set_time_zone,(stz), (Set the system time zone.), (default), (sc_flags.r_master_console) request shutdown,sc_requests_$shutdown,(shut), (Shut down the system.), (default), (sc_flags.r_master_console,sc_flags.dont_mask_calls) request startup,sc_requests_$startup,(star), (Start the Answering Service and begin answering lines.), (default), (sc_flags.requires_no_as,sc_flags.complete_disks_first,sc_flags.r_master_console) admin_request stop,admin_$stop,(), (Bump users in preparation for system shutdown.), (default), (default,sc_flags.r_down_ok) admin_request substty,operator_mc_cmds_$substty,(), (Substitute one message coordinator terminal for another.), (default), (default,sc_flags.r_route_messages) admin_request sysid,admin_$sysid,(), (Changes the system ID.), (default), (default,sc_flags.r_mod_sysid) admin_request terminate,operator_process_cmds_$terminate,(), (Forcibly terminate a process.), (default), (default,sc_flags.r_as_control) admin_request unbump,operator_process_cmds_$unbump,(), (Cancel a bump of an interactive user.), (default), (default,sc_flags.r_as_control) admin_request undefine,operator_mc_cmds_$undefine,(), (Remove a disposition from a virtual console.), (default), (default,sc_flags.r_route_messages) obsolete_multics_request load_fnp,,admin_$load_fnp, (default,sc_flags.r_mpx_control) obsolete_multics_request fdump_fnp,,admin_$fdump_fnp, (default,sc_flags.r_mpx_control) obsolete_multics_request start_fnp,,admin_$start_fnp, (default,sc_flags.r_mpx_control) obsolete_multics_request stop_fnp,,admin_$stop_fnp, (default,sc_flags.r_mpx_control) multics_request set_drive_usage,(sdu), (Change a disk between user I/O and Storage System use.), disk_table_$io_ss_reconfig, (default), (sc_flags.r_master_console) multics_request preload,(), (Preload a disk or tape volume.), rcp_op_cmnd_$preload, (default), (sc_flags.r_rcp_control) multics_request unload,(), (Unload a disk or tape volume.), rcp_op_cmnd_$unload, (default), (sc_flags.r_rcp_control) obsolete_multics_request dump_fnp,,admin_$dump_fnp, (default,sc_flags.r_mpx_control) admin_request load_mpx,admin_$load_mpx,(), (Loads a multiplexer.), (default), (default,sc_flags.r_mpx_control) admin_request dump_mpx,admin_$dump_mpx,(), (Dumps a multiplexer.), (default), (default,sc_flags.r_mpx_control) admin_request start_mpx,admin_$start_mpx,(), (Starts a multiplexer.), (default), (default,sc_flags.r_mpx_control) admin_request stop_mpx,admin_$stop_mpx,(), (Stops a multiplexer from accepting new calls.), (default), (sc_flags.r_mpx_control) multics_request add_pdir_volume,(), (Adds a logical volume to the set of pdir volumes.), pdir_volume_manager_$add_pdv, (default), (sc_flags.r_master_console) multics_request del_pdir_volume,(), (Deletes a logical volume from the set of pdir volumes.), pdir_volume_manager_$del_pdv, (default), (sc_flags.r_master_console) multics_request set_pdir_volumes,(), (Specifies the set of pdir logical volumes.), pdir_volume_manager_$set_pdv, (default), (sc_flags.r_master_console) admin_request log,admin_$log,(), (Adds a message to the system log.), (default), (0) admin_request shift,admin_$shift,(), (Changes the shift.), (default), (default,sc_flags.r_as_control) admin_request disconnect,operator_process_cmds_$disconnect,(), (Forcibly disconnects a user from their terminal.), (default), (default,sc_flags.r_as_control) multics_request vacate_pdir_volume,(), (Moves all user process directories off of a logical volume.), pdir_volume_manager_$vac_pdv, (default), (default,sc_flags.r_master_console) admin_request shutdown_mpx,admin_$shutdown_mpx,(), (Shuts down a multiplexer without dumping it.), (default), (default,sc_flags.r_mpx_control) request reconfigure,reconfigure$sc_reconfigure_request,(rcf), (Reconfigures system hardware.), (default), (sc_flags.r_reconfig_system) request lock_mca,lock_mca$sc_lock_mca,(), (Disable input to the MCAs.), (default), (sc_flags.r_reconfig_system) request unlock_mca,lock_mca$sc_unlock_mca,(), (Enable input to a selected MCA.), (default), (sc_flags.r_reconfig_system) admin_request warn,admin_$warn,(w), (Sends a warning blast to a user.), (default), (default,sc_flags.r_as_control) multics_request who,(), (Lists logged in user.), as_who$long, (default), (default,sc_flags.r_status) admin_request word,admin_$word,(), (Changes the login word and banner message.), (default), (default,sc_flags.r_loginword) request .,sc_requests_$self_identify, (), (Identify the signed-on operator.), (default), (sc_flags.no_login_needed) request help,ssu_requests_$help, (), (Obtain information on the operator commands.), (default), (sc_flags.dont_mask_calls) obsolete_multics_request addmain,,obs_reconfigure$addmain, (sc_flags.r_master_console) obsolete_multics_request addcpu,,obs_reconfigure$addcpu, (sc_flags.r_master_console) obsolete_multics_request addmem,,obs_reconfigure$addmem, (sc_flags.r_master_console) obsolete_multics_request adddev,,reconfigure_rcp$add_device, (sc_flags.r_master_console) obsolete_multics_request delmain,,obs_reconfigure$delmain, (sc_flags.r_master_console) obsolete_multics_request delcpu,,obs_reconfigure$delcpu, (sc_flags.r_master_console) obsolete_multics_request delmem,,obs_reconfigure$delmem, (sc_flags.r_master_console) obsolete_multics_request deldev,,reconfigure_rcp$del_device, (sc_flags.r_master_console) unknown_request abbrev,(ab) unknown_request execute,(e) unknown_request exec_com,(ec) unknown_request if unknown_request ready,(rdy) unknown_request ready_on,(rdn) unknown_request ready_off,(rdf) unknown_request subsystem_name unknown_request subsystem_version unknown_request debug_mode end_table system_control_requests end  sc_requests_.pl1 11/11/89 1102.8rew 11/11/89 0809.2 187020 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* format: style2 */ sc_requests_: procedure; /**** SC_REQUESTS_ ssu requests for the the system control subsystem. This program used to be execute_sc_command_. The smarts about setting up environments went to sc_process_command_line_, and the commands landed here. WHEN this procedure is entered, all I/O switches are correctly set up to allow reading and writing (or, in the case of sac, to abort appropriately). ALL the commands in here can be written as if they were executing in a normal user environment, just like the ones in admin_. THIS procedure did not used to mask event calls, in spite of the clear requirement that anything that could conceivable block do so. Masking now takes place in sc_process_command_line_. */ /**** Modified 01/82 B. I. Margulies. answer yes sc_command shut. Modified 01/02/82 E. N. Kittlitz. added sc_stat_$Go. Modified 5/82 E. N. Kittlitz. New AS initialization. Modified 12/82 E. N. Kittlitz. Version 2 communications segment. encrypt admin password. Modified 1/83 E. N. Kittlitz. handle finish in admin mode. Modified 8/83 K. Loepere call_bce. Modified 1/84 K. Loepere make qedx_ the message editor. Rewritten for ssu_ 1984-10-26 BIM Modified 1985-01-08, BIM: mc access control, fix operator login for boot star. Modified 1985-01-28, E. Swenson: to call lg_ctl_ for login/logout messages. Modified 1985-01-29, E. Swenson: to fix operator login for boot star. Modified 1985-02-18, E. Swenson: to fix operator login for other problems. */ /****^ HISTORY COMMENTS: 1) change(86-08-01,Cox), approve(87-05-25,MCR7690), audit(87-03-16,GDixon), install(87-08-03,MR12.1-1055): Modified to support virtual MC terminals. 2) change(87-02-05,GDixon), approve(87-05-25,MCR7690), audit(87-05-06,Parisek), install(87-08-03,MR12.1-1055): Modified for a change to mc_anstbl.incl.pl1. Correct coding standard violations. 3) change(87-03-30,Lippard), approve(87-04-27,MCR7673), audit(87-05-15,Fawcett), install(87-05-26,MR12.1-1036): Added set_time_zone. 4) change(87-06-10,GDixon), approve(87-04-27,MCR7673), audit(87-06-10,Parisek), install(87-08-03,MR12.1-1055): A) Merge changes 2 & 3. B) Add operator message documentation for the new call to sys_log_ in set_time_zone. 5) change(87-06-23,Parisek), approve(87-06-23,MCR7690), audit(87-08-06,GDixon), install(87-08-11,MR12.1-1079): Correct an ioa_ control string error. 6) change(87-07-17,Parisek), approve(87-07-17,MCR7716), audit(87-08-07,Fawcett), install(87-08-11,MR12.1-1079): Call call_ec_ subroutine instead of exec_com for executing the ssu.ec so errors can be detected, displayed and ec will continue execution. END HISTORY COMMENTS */ declare SCI_ptr pointer; declare SCI_info_ptr pointer; dcl al fixed bin (21); dcl ap pointer; dcl arg_count fixed bin; dcl argument char (al) based (ap); dcl code fixed bin (35); dcl destination char (32) varying; dcl found_zone bit (1) aligned; dcl lang_index fixed bin; dcl message char (500); dcl message_length fixed bin (21); dcl operator_name char (32); dcl old_name char (32); dcl old_time_zone char (4) aligned; dcl password char (8); dcl reason char (100); dcl sci_ptr pointer; dcl temp_line char (500) varying; dcl time_zone char (4) aligned; dcl yea_shutdown bit (1) aligned; dcl zone_index fixed bin; dcl as_$as_init entry (fixed bin (35)); dcl as_$go entry (fixed bin (35)); dcl as_$reset entry (); dcl as_$shut_ok entry (fixed bin (35)); dcl as_$startup entry (fixed bin (35)); dcl command_query_ entry () options (variable); dcl command_query_$yes_no entry options (variable); dcl date_time_$set_zone entry (char (*), fixed bin (35)); dcl call_ec_ entry options (variable); dcl hphcs_$call_bce entry (); dcl hphcs_$set_system_time_zone entry (char (4) aligned, fixed bin (35)); dcl ioa_ entry () options (variable); dcl ioa_$rs entry () options (variable); dcl ipc_$mask_ev_calls entry (fixed bin (35)); dcl ipc_$unmask_ev_calls entry (fixed bin (35)); dcl lg_ctl_$login_operator entry (ptr, bit (1) aligned, char (*), char (*)); dcl lg_ctl_$logout_operator entry (ptr, char (*), char (*)); dcl mc_check_access_$quit entry (pointer, character (*), fixed binary (35)); dcl mc_check_access_$reply entry (pointer, character (*), fixed binary (35)); dcl mc_commands_$intercom entry (character (*) var, pointer, fixed bin (21), pointer, fixed binary (35)); dcl mc_commands_$quit_command entry (char (*), ptr, fixed bin (35)); dcl mc_commands_$reply_command entry (character (*) var, pointer, fixed bin (21), pointer, fixed binary (35)); dcl mc_commands_$sign_in entry (ptr, char (*), char (*)); dcl mc_commands_$sign_out entry (ptr, char (*), fixed bin (35)); dcl pnt_manager_$login_get_entry entry (char (*), char (*), ptr, fixed bin (35)); dcl read_password_ entry (character (*), character (*)); dcl restart_mc_ttys_ entry; dcl sc_abort_line_util_$real_abort_line entry () options (variable); dcl sc_admin_mode_ entry; dcl sc_edit_motd_ entry; dcl sc_ipc_mask_$remask entry (fixed binary); dcl sc_ipc_mask_$unmask entry (fixed binary); dcl scramble_ entry (char (8)) returns (char (8)); dcl ssu_$abort_line entry () options (variable); dcl ssu_$arg_count entry (ptr, fixed bin); dcl ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin (21)); dcl ssu_$print_message entry () options (variable); dcl sys_log_ entry options (variable); dcl sys_info$time_zone char (4) aligned ext static; dcl (error_table_$id_not_found, error_table_$noentry, error_table_$unknown_zone) fixed bin (35) ext static; dcl (after, addr, before, byte, length, ltrim, null, rtrim) builtin; dcl cleanup condition; dcl ( GRANTED initial ("1"b), DENIED initial ("0"b) ) bit (1) aligned internal static options (constant); no_start_up: entry (SCI_ptr, SCI_info_ptr); call setup; sc_stat_$did_part1, sc_stat_$did_part2, sc_stat_$did_part3 = "1"b; return; reply: entry (SCI_ptr, SCI_info_ptr); call setup; /**** THIS IS A SPECIAL COMMAND -- called with one un-parsed argument. */ if arg_count = 0 then call ssu_$abort_line (sci_ptr, 0, "Usage: reply SOURCE LINE"); call return_in_debug; call ssu_$arg_ptr (sci_ptr, 1, ap, al); temp_line = rtrim (ltrim (argument)); destination = before (temp_line, " "); if destination = temp_line /* no argument, all we have is a destination */ then do; destination = temp_line; message = byte (10); message_length = 1; end; else call ioa_$rs ("^a", message, message_length, after (temp_line, " ")); call mc_check_access_$reply (sc_subsystem_info_ptr, (destination), code); if code = error_table_$noentry then call ssu_$abort_line (sci_ptr, code, "No MC ACS segment exists for the source ^a.", destination); else if code ^= 0 then call ssu_$abort_line (sci_ptr, code, "Reply not permitted to message coordinator source ^a.", destination); call mc_commands_$reply_command (destination, addr (message), message_length, sc_subsystem_info.mc_atep, code); if code ^= 0 then call ssu_$abort_line (sci_ptr, code, "Reply not sent to ^a.", destination); return; admin: entry (SCI_ptr, SCI_info_ptr); call setup; if arg_count > 0 then call ssu_$abort_line (sci_ptr, 0, "Usage: admin"); call sc_admin_mode_; /* sc_stat_ carries all needed parameters */ return; bce: entry (SCI_ptr, SCI_info_ptr); call setup; if arg_count > 0 then call ssu_$abort_line (sci_ptr, 0, "Usage: bce"); call return_in_debug; if ^sc_stat_$test_mode then call hphcs_$call_bce; /* call bce. */ return; go: entry (SCI_ptr, SCI_info_ptr); call setup; if arg_count > 0 then call ssu_$abort_line (sci_ptr, 0, "Usage: go"); call return_in_debug; GO_COMMON: sc_stat_$Go_typed = "1"b; /* Indicate 'go' has been requested */ if ^sc_stat_$did_part2 then /* Execute system startup, second part. */ call call_system_start_up_ec ("part2"); sc_stat_$did_part2 = "1"b; call as_$go (code); /* Now make all lines answer. */ if code ^= 0 then call ssu_$abort_line (sci_ptr, code, "Answering Service startup failed."); sc_stat_$Go = "1"b; /* set the AS listening flag */ if ^sc_stat_$did_part3 then /* Execute system startup, third part */ call call_system_start_up_ec ("part3"); sc_stat_$did_part3 = "1"b; ip = as_data_$rs_ptrs (0); if installation_parms.require_operator_login then sc_stat_$no_operator_login = "0"b; /* Close the gate */ if installation_parms.vchn_requires_accept then sc_stat_$vchn_requires_accept = installation_parms.vchn_requires_accept; /* "login personid -op -vchn foo" must be accepted by operator if personid is not signed on system console */ return; message: entry (SCI_ptr, SCI_info_ptr); /* edit the MOTD */ call setup; if arg_count > 0 then call ssu_$abort_line (sci_ptr, 0, "Usage: message"); call return_in_debug; call sc_edit_motd_; return; multics: entry (SCI_ptr, SCI_info_ptr); call setup; if arg_count > 0 then call ssu_$abort_line (sci_ptr, 0, "Usage: multics"); call return_in_debug; sc_stat_$Multics_typed = "1"b; /* indicate 'multics' has been requested */ if ^sc_stat_$did_part1 then /* Execute initial part of system startup. */ call call_system_start_up_ec ("part1"); sc_stat_$did_part1 = "1"b; call as_$as_init (code); /* Initialize answering service (special session). */ if code ^= 0 then call ssu_$abort_line (sci_ptr, code, "Fix problem and retry."); sc_stat_$Multics = "1"b; /* set the Multics-session flag */ return; set_time_zone: entry (SCI_ptr, SCI_info_ptr); call setup; if arg_count ^= 1 then call ssu_$abort_line (sci_ptr, 0, "Usage: stz zone"); call ssu_$arg_ptr (sci_ptr, 1, ap, al); if al > length (time_zone) then call ssu_$abort_line (sci_ptr, error_table_$unknown_zone, "^a", argument); time_zone = argument; found_zone = "0"b; /* Validate zone.*/ do lang_index = 1 to ti_zone.number_lang while (^found_zone); do zone_index = 1 to ti_zone.number_zone while (^found_zone); if ti_zone.short (lang_index, zone_index) = time_zone then found_zone = "1"b; end; /* zones */ end; /* languages */ if ^found_zone then call ssu_$abort_line (sci_ptr, error_table_$unknown_zone, "^a", argument); call return_in_debug; old_time_zone = sys_info$time_zone; /* Save old zone */ call hphcs_$set_system_time_zone (time_zone, code); if code ^= 0 /* Set time zone */ then call ssu_$abort_line (sci_ptr, code, "^a", /* for the system*/ time_zone); call date_time_$set_zone ((time_zone), code); /* Set zone for */ if code ^= 0 /* Initializer */ then call ssu_$abort_line (sci_ptr, code, "^a", time_zone); call sys_log_ (SL_LOG, /* Log the change*/ "^a: Changed time zone from ^a to ^a.", "sc_requests_ (set_time_zone)", old_time_zone, time_zone); return; shutdown: entry (SCI_ptr, SCI_info_ptr); call setup; if arg_count > 0 then call ssu_$abort_line (sci_ptr, 0, "Usage: shutdown"); if sc_stat_$Multics then do; call as_$shut_ok (code); if code ^= 0 then do; yea_shutdown = "0"b; call command_query_$yes_no (yea_shutdown, (0), "shutdown", "These users will be logged off without any message. Use ""stop"" to warn and bump users", "^d users still on. Do you want to shut down? ", code); if ^yea_shutdown then return; end; end; go to sc_stat_$system_shutdown_label; startup: entry (SCI_ptr, SCI_info_ptr); call setup; if arg_count > 0 then call ssu_$abort_line (sci_ptr, 0, "Usage: startup"); call return_in_debug; sc_stat_$Star_typed = "1"b; /* indicate that someone typed 'startup'. */ sc_stat_$Multics_typed = "1"b; if ^sc_stat_$did_part1 then /* Execute first part of system startup */ call call_system_start_up_ec ("part1"); sc_stat_$did_part1 = "1"b; call as_$startup (code); /* Initialize answering service. (normal session) */ if code ^= 0 then return; sc_stat_$Multics = "1"b; /* Get here, and library is loaded... */ go to GO_COMMON; /* join common code */ force_reset: entry (SCI_ptr, SCI_info_ptr); call setup; if arg_count > 0 then call ssu_$abort_line (sci_ptr, 0, "Usage: force_reset"); call return_in_debug; if sc_stat_$Multics then call as_$reset; go to RESET_COMMON; reset: entry (SCI_ptr, SCI_info_ptr); call setup; if arg_count > 0 then call ssu_$abort_line (sci_ptr, 0, "Usage: reset"); call return_in_debug; RESET_COMMON: call iox_$control (sc_stat_$master_iocb, "start", null, code); if sc_stat_$mc_is_on then call restart_mc_ttys_ (); /* Kick all typers */ code = 0; /* Now get unmasked. */ do while (code = 0); /* .. by unmasking repeatedly. */ call ipc_$unmask_ev_calls (code); /* unmask event call channels */ end; return; cripple: entry (SCI_ptr, SCI_info_ptr); call setup; if arg_count > 0 then call ssu_$abort_line (sci_ptr, 0, "Usage: cripple"); call ipc_$mask_ev_calls (code); /* Stop all ipc signals, no dialups etc. */ call ssu_$print_message (sci_ptr, 0, "Answering service crippled."); return; intercom: /** This is a SPECIAL request, called with 1 argument, the message */ entry (SCI_ptr, SCI_info_ptr); call setup; if arg_count ^= 1 then call ssu_$abort_line (sci_ptr, 0, "Usage: intercom DEST TEXT"); call ssu_$arg_ptr (sci_ptr, 1, ap, al); temp_line = rtrim (ltrim (argument)); destination = before (temp_line, " "); if destination = "" then do; destination = temp_line; message = byte (10); message_length = 1; end; else call ioa_$rs ("^a", message, message_length, after (temp_line, " ")); call mc_commands_$intercom (destination, addr (message), message_length, sc_subsystem_info.mc_atep, code); if code ^= 0 then call ssu_$abort_line (sci_ptr, code, "Message not sent to ^a.", destination); return; quit: entry (SCI_ptr, SCI_info_ptr); call setup; if arg_count ^= 1 then call ssu_$abort_line (sci_ptr, 0, "Usage: quit SOURCE"); call ssu_$arg_ptr (sci_ptr, 1, ap, al); call mc_check_access_$quit (sc_subsystem_info_ptr, argument, code); if code ^= 0 then do; if code = error_table_$noentry then call ssu_$abort_line (sci_ptr, code, "No MC ACS segment for the message coodrinator source ^a.", argument); else call ssu_$abort_line (sci_ptr, code, "Quit not permitted to message coordinator source ^a.", argument); end; call mc_commands_$quit_command (argument, sc_subsystem_info.mc_atep, code); if code ^= 0 then call ssu_$abort_line (sci_ptr, code, "No quit signalled to ^a.", argument); return; sign_on: entry (SCI_ptr, SCI_info_ptr); call setup; if arg_count > 1 then call ssu_$abort_line (sci_ptr, 0, "Usage: sign_on OperatorName"); if sc_subsystem_info.mc_atep = null () then call sc_abort_line_util_$real_abort_line (sci_ptr, 0, "^a is not a terminal, so you cannot log in over it.", sc_subsystem_info.source_name); if arg_count = 0 then do; query_info.version = query_info_version_6; operator_name = ""; call command_query_ (addr (query_info), operator_name, "sign_on", "Operator name:"); if operator_name = "QUIT" | operator_name = "quit" then call sc_abort_line_util_$real_abort_line (sci_ptr, 0, "sign_on aborted by quit."); end; else do; call ssu_$arg_ptr (sci_ptr, 1, ap, al); operator_name = argument; end; call read_password_ ("Password", password); if password = "quit" | password = "QUIT" then call sc_abort_line_util_$real_abort_line (sci_ptr, 0, "sign_on aborted by quit."); password = scramble_ (password); PNTE.version = PNT_ENTRY_VERSION_2; reason = ""; call pnt_manager_$login_get_entry (operator_name, password, addr (PNTE), code); if code ^= 0 then do; if code = error_table_$id_not_found then reason = "Unregistered name"; else reason = "Bad password"; end; else if ^PNTE.flags.operator then reason = "Not operator"; if reason ^= "" then do; call lg_ctl_$login_operator (sc_subsystem_info_ptr, DENIED, operator_name, reason); call sc_abort_line_util_$real_abort_line (sci_ptr, 0, "Login incorrect"); end; operator_name = PNTE.user_id; call mc_commands_$sign_in (sc_subsystem_info.mc_atep, operator_name, old_name); if old_name ^= "" then do; call ssu_$print_message (sci_ptr, 0, "^a signed out as operator.", old_name); call lg_ctl_$logout_operator (sc_subsystem_info_ptr, old_name, "sign_on"); end; sc_subsystem_info.access_control_name = rtrim (operator_name) || ".Operator.o"; call ssu_$print_message (sci_ptr, 0, "^a signed on as operator on channel ^a.", operator_name, sc_subsystem_info.source_name); call lg_ctl_$login_operator (sc_subsystem_info_ptr, GRANTED, operator_name, "sign_on"); return; sign_off: entry (SCI_ptr, SCI_info_ptr); call setup; if arg_count ^= 0 then call ssu_$abort_line (sci_ptr, 0, "Usage: sign_off"); if sc_subsystem_info.mc_atep = null () then call ssu_$abort_line (sci_ptr, 0, "Not logged in."); call mc_commands_$sign_out (sc_subsystem_info.mc_atep, old_name, code); if code = 0 then do; call lg_ctl_$logout_operator (sc_subsystem_info_ptr, old_name, "sign_off"); call ssu_$print_message (sci_ptr, 0, "^a signed off.", old_name); sc_subsystem_info.access_control_name = sc_stat_$unidentified_access_name; end; else call ssu_$abort_line (sci_ptr, 0, "No one is signed on to ^a.", sc_subsystem_info.source_name); return; self_identify: entry (SCI_ptr, SCI_info_ptr); call setup; /*** Be nice and don't diagnose arguments */ mc_atep = sc_subsystem_info.mc_atep; if mc_atep = null () then call ioa_ ("system_control"); else do; call ioa_ ("system_control:^[ channel ^a^[ (vchannel ^a)^;^s^]^;^3s^] ^[^a^;No operator^s^] signed on.", ^mc_ate.the_system_console, mc_ate.real_tty_name, mc_ate.virtual, mc_ate.virtual_tty_name, mc_ate.signed_on, mc_ate.personid); end; return; setup: procedure; sci_ptr = SCI_ptr; sc_subsystem_info_ptr = SCI_info_ptr; call ssu_$arg_count (sci_ptr, arg_count); return; end setup; call_system_start_up_ec: procedure (P_arg1); declare P_arg1 char (*); declare remask_count fixed bin; declare saved_access_control_name char (32); remask_count = 0; saved_access_control_name = sc_subsystem_info.access_control_name; on cleanup begin; call sc_ipc_mask_$remask (remask_count); sc_subsystem_info.access_control_name = saved_access_control_name; end; call sc_ipc_mask_$unmask (remask_count); sc_subsystem_info.access_control_name = sc_stat_$exec_access_name; call call_ec_ ("system_start_up", P_arg1); call sc_ipc_mask_$remask (remask_count); return; end call_system_start_up_ec; return_in_debug: procedure; declare ssu_$get_debug_mode entry (ptr) returns (bit (1) aligned); if ssu_$get_debug_mode (sci_ptr) then go to RETURN; return; end return_in_debug; RETURN: return; %include as_data_; %include installation_parms; declare ip pointer; /* req for above */ %include iox_entries; %include mc_anstbl; %include pnt_entry; declare 1 PNTE aligned like pnt_entry; %include query_info; %include sc_stat_; %include sc_subsystem_info_; %include sys_log_constants; %include syserr_constants; %include time_names; /* BEGIN MESSAGE DOCUMENTATION Message: sc_requests_ (set_time_zone): Changed time zone from OLD_ZONE to NEW_ZONE. S: $sc T: $run M: This messages records that the set_time_zone operator request was given, and that the system default time zone was thereby changed from OLD_ZONE to NEW_ZONE. A: $ignore END MESSAGE DOCUMENTATION */ end sc_requests_;  sc_shutdown_.pl1 11/11/89 1102.8rew 11/11/89 0809.2 17892 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* sc_shutdown_: procedure to shut down AS, SC; called from system_control_ */ /* format: style2,idind30 */ /**** This is a separate procedure so that the admin environment can be completely unwound before it is called. */ /**** Written 1984-11-01 BIM */ /****^ HISTORY COMMENTS: 1) change(86-08-01,Swenson), approve(87-05-25,MCR7680), audit(87-02-07,GDixon), install(87-08-04,MR12.1-1055): Avoid calling hphcs_$shutdown when running in system control test mode. 2) change(87-02-07,GDixon), approve(87-05-25,MCR7680), audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055): Repair comments, clarify code. 3) change(87-02-07,GDixon), approve(87-05-25,MCR7678), audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055): Use timer_manager_constants include file. END HISTORY COMMENTS */ sc_shutdown_: procedure; declare as_$shutdown entry; declare hphcs_$shutdown entry; declare timer_manager_$sleep entry (fixed binary (71), bit (2)); if sc_stat_$Multics then do; sc_stat_$shutdown_typed = "1"b; /* publish our intention */ call as_$shutdown; /* turn off answering service. */ call timer_manager_$sleep (2, RELATIVE_SECONDS); /* Let messages get typed */ end; if ^sc_stat_$test_mode then call hphcs_$shutdown; /* Shut down file system and traffic control. */ return; %include sc_stat_; %include timer_manager_constants; end sc_shutdown_;  sc_signal_handler_.pl1 11/11/89 1102.8rew 11/11/89 0809.2 47691 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(87-02-05,GDixon), approve(87-05-25,MCR7680), audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055): Correct coding standard violations, and remove unnecessary statements. END HISTORY COMMENTS */ /**** The initializer's ring four base-of-stack handler. In admin mode proper, this is pre-empted by default_error_handler_$wall, and should never be called. That is, when sc_stat_$admin_listener_switch is "1"b. In the admin environment (sc_stat_$admin_sci_ptr ^= null) this is still the handler. This uses ssu_$abort_line to abort execution of a command, not the "abort" condition. */ /**** Written by the hidden Imam. */ /* Modified 1984-10-08 BIM for new admin mode */ /* format: style2,idind30,indcomtxt */ sc_signal_handler_: procedure; dcl error_switch ptr; /* Switch to write message on. */ dcl mp ptr; /* ptr to allocated message */ dcl ml fixed bin (21); /* lth of message */ dcl msg_area area (512); /* area in which condition_interpreter puts message */ dcl string char (64) aligned; /* Basic fault message. */ dcl (addr, empty, null) builtin; dcl as_$dump entry (char (*) aligned); dcl condition_interpreter_ entry (ptr, ptr, fixed bin (21), fixed bin, ptr, char (*), ptr, ptr); dcl find_condition_info_ entry (ptr, ptr, fixed bin (35)); dcl ioa_$ioa_switch entry () options (variable); dcl restart_mc_ttys_ entry; dcl ssu_$abort_line entry () options (variable); dcl ssu_$get_info_ptr entry (ptr) returns (ptr); dcl sys_log_ entry options (variable); /* First locate the condition frame which caused us to be invoked. */ CI.version = condition_info_version_1; call find_condition_info_ (null (), addr (CI), (0)); condition_info_header_ptr = CI.info_ptr; if condition_info_header_ptr ^= null () then if condition_info_header.quiet_restart then return; /* QUIT signals are handled specially. We don't quit out of anything we can't restart. */ if CI.condition_name = "quit" then return; if sc_stat_$admin_sci_ptr ^= null () then do; sc_subsystem_info_ptr = ssu_$get_info_ptr (sc_stat_$admin_sci_ptr); if sc_subsystem_info.no_real_tty then error_switch = sc_stat_$admin_log_iocb; else error_switch = sc_subsystem_info.real_iocb; end; else if sc_stat_$mc_is_on then error_switch = sc_stat_$mc_iocb; else error_switch = sc_stat_$master_iocb; if condition_info_header_ptr ^= null () then if condition_info_header.default_restart then do; call get_message_string; call iox_$put_chars (error_switch, mp, ml, (0)); return; end; /**** There is no need to muck with switches, since sc_process_command_line_ saves and restores. */ /* Make up error message. */ string = "error: " || CI.condition_name; if sc_stat_$mc_is_on then call sys_log_ (SL_LOG_BEEP, "sc_signal_handler_: ^a", string); else call ioa_$ioa_switch (error_switch, "^a", string); if sc_stat_$Multics then call as_$dump (string); /* Take nice dump. */ call get_message_string; call iox_$put_chars (error_switch, mp, ml, (0)); /* The message is printed. Now try to reset the system control environment and bust out of here */ call iox_$control (sc_stat_$master_iocb, "start", null, (0)); /* Make sure we aren't missing a wakeup. */ if sc_stat_$mc_is_on then call restart_mc_ttys_ (); /* .. or set of wakeups */ if sc_stat_$admin_sci_ptr ^= null () then call ssu_$abort_line (sc_stat_$admin_sci_ptr, 0, "Execution aborted by error signal."); else go to sc_stat_$master_abort_label; /* Return to console listener loop */ get_message_string: procedure; call condition_interpreter_ (addr (msg_area), mp, ml, 3, CI.mc_ptr, (CI.condition_name), CI.wc_ptr, CI.info_ptr) ; end get_message_string; %include condition_info_header; %include condition_info; declare 1 CI aligned like condition_info; %include iox_entries; %include sc_stat_; %include sc_subsystem_info_; %include sys_log_constants; /* BEGIN MESSAGE DOCUMENTATION Message: sc_signal_handler_: error: CONDITION_NAME S: as (severity2) T: $run M: A CONDITION_NAME condition occurred while running an operator command. An answering service dump has been taken to further describe the cause of the condition. A: $notify_sa END MESSAGE DOCUMENTATION */ end sc_signal_handler_;  sc_signal_io_handler_.pl1 11/11/89 1102.8rew 11/11/89 0809.2 48285 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* format: style2,idind30 */ /**** sc_signal_io_handler_ Handler for signal_io_ in the system control environment. This program performs and logs the I/O requested via the signal. */ /**** Written 1984-11-01 BIM */ /**** Modified 1985-04-01, E. Swenson: add NL to "(printer masked)" entries. */ /****^ HISTORY COMMENTS: 1) change(87-02-06,GDixon), approve(87-05-25,MCR7680), audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055): Correct coding standards violations. END HISTORY COMMENTS */ sc_signal_io_handler_: procedure; declare 1 CI aligned like condition_info; declare code fixed bin (35); declare real_iocb pointer; declare (addr, null) builtin; declare find_condition_info_ entry (pointer, pointer, fixed binary (35)); declare ioa_$ioa_switch entry () options (variable); declare ioa_$ioa_switch_nnl entry () options (variable); declare ssu_$get_info_ptr entry (ptr) returns (ptr); declare error_table_$io_no_permission fixed bin (35) ext static; CI.version = condition_info_version_1; call find_condition_info_ (null (), addr (CI), code); if code ^= 0 then return; if sc_stat_$admin_sci_ptr = null () then return; sc_subsystem_info_ptr = ssu_$get_info_ptr (sc_stat_$admin_sci_ptr); real_iocb = sc_subsystem_info.real_iocb; if real_iocb = null () then return; signal_io_info_ptr = CI.info_ptr; if signal_io_info.operation = SGI_OP_GET_LINE then call GET_LINE; else if signal_io_info.operation = SGI_OP_GET_CHARS then call GET_CHARS; else if signal_io_info.operation = SGI_OP_PUT_CHARS then call PUT_CHARS; else if signal_io_info.operation = SGI_OP_POSITION then call POSITION; else if signal_io_info.operation = SGI_OP_CONTROL then call CONTROL; else if signal_io_info.operation = SGI_OP_MODES then call MODES; return; /* If we get here, then we needn't unwind */ %page; GET_LINE: procedure; declare returned_string char (signal_io_info.returned_data_length) based (signal_io_info.data_ptr); call ioa_$ioa_switch_nnl (sc_stat_$admin_log_iocb, "^/"); /* in case of prompt */ call iox_$get_line (real_iocb, signal_io_info.data_ptr, signal_io_info.data_length, signal_io_info.returned_data_length, signal_io_info.returned_error_code); if signal_io_info.returned_error_code = 0 & signal_io_info.returned_data_length > 0 then if ^sc_subsystem_info.printer_offed then call ioa_$ioa_switch_nnl (sc_stat_$admin_log_iocb, "input: ^a", returned_string); else call ioa_$ioa_switch (sc_stat_$admin_log_iocb, "input: (printer masked)"); call check_hangup; return; end GET_LINE; GET_CHARS: procedure; declare returned_string char (signal_io_info.returned_data_length) based (signal_io_info.data_ptr); call iox_$get_chars (real_iocb, signal_io_info.data_ptr, signal_io_info.data_length, signal_io_info.returned_data_length, signal_io_info.returned_error_code); if signal_io_info.returned_error_code = 0 & signal_io_info.returned_data_length > 0 then if ^sc_subsystem_info.printer_offed then call ioa_$ioa_switch_nnl (sc_stat_$admin_log_iocb, "input: ^a", returned_string); else call ioa_$ioa_switch (sc_stat_$admin_log_iocb, "input: (printer masked)"); call check_hangup; return; end GET_CHARS; POSITION: procedure; call iox_$position (real_iocb, signal_io_info.position_type, (signal_io_info.position_amount), signal_io_info.returned_error_code); call check_hangup; return; end POSITION; MODES: procedure; call iox_$modes (real_iocb, signal_io_new_modes, signal_io_old_modes, signal_io_info.returned_error_code); call check_hangup; return; end MODES; PUT_CHARS: procedure; call iox_$put_chars (real_iocb, signal_io_info.data_ptr, signal_io_info.data_length, signal_io_info.returned_error_code); call ioa_$ioa_switch_nnl (sc_stat_$admin_log_iocb, "^a", signal_io_io_buffer); call check_hangup; return; end PUT_CHARS; CONTROL: procedure; if signal_io_order_name = "printer_off" then sc_subsystem_info.printer_offed = "1"b; if signal_io_order_name = "printer_on" then sc_subsystem_info.printer_offed = "0"b; call iox_$control (real_iocb, signal_io_order_name, signal_io_info.control_order_info_ptr, signal_io_info.returned_error_code); call check_hangup; return; end CONTROL; check_hangup: procedure; if signal_io_info.returned_error_code = error_table_$io_no_permission then call sc_subsystem_info.hangup_entry (sc_stat_$admin_sci_ptr); return; end check_hangup; %include condition_info; %include condition_info_header; %include iocb; %include iox_entries; %include signal_io_info; %include sc_subsystem_info_; %include sc_stat_; end sc_signal_io_handler_;  sc_stat_.alm 11/11/89 1102.8rew 11/11/89 0807.4 47448 " *********************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1987 * " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " These values are declared in sc_stat_.incl.pl1. " Changes herein should be reflected therein. " Written at an unknown time by the 12th Imam. " Modified 1984-10-08 BIM for more admin goodies. " Modified 1985-01-07 BIM for mc access control. " HISTORY COMMENTS: " 1) change(86-08-01,Cox), approve(87-05-28,MCR7690), audit(87-02-18,GDixon), " install(87-08-04,MR12.1-1055): " Added sc_stat_$vchn_requires_accept in support of virtual MC channels " for use by DSA. " 2) change(87-02-18,GDixon), approve(87-05-28,MCR7680), " audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055): " Reorganized by type of data to improve readability. " END HISTORY COMMENTS use statc join /link/statc segdef Go " segdefs are stored alphabetically segdef Go_typed segdef Multics segdef Multics_typed segdef Star_typed segdef admin_listener_exit_label segdef admin_listener_switch segdef admin_log_iocb segdef admin_log_write_ptr segdef admin_sci_ptr segdef as_log_write_ptr segdef did_part1 segdef did_part2 segdef did_part3 segdef exec_access_name segdef info_dir segdef initzer_ttyp segdef log_dir segdef master_abort_label segdef master_channel segdef master_iocb segdef master_sci_ptr segdef mc_acs_dir segdef mc_ansp segdef mc_iocb segdef mc_is_on segdef no_operator_login segdef shutdown_typed segdef sv1_iocb segdef sv2_iocb segdef sv3_iocb segdef sysdir segdef system_shutdown_label segdef test_mode segdef unidentified_access_name segdef vchn_requires_accept " Data is stored by type, with data types ordered with those needing " doubleword alignment appearing first: " LABELS " POINTERS " to DATA for calling log_write_ " to IOCBS " to SSU SUBSYSTEM CONTROL INFO " to TABLES " SWITCHES " CHARACTER STRINGS " ACCESS NAMES " PATHNAMES " OTHER TYPES even "LABELS admin_listener_exit_label: its -1,1 " go here to leave admin listener its -1,1 master_abort_label: its -1,1 " go here to return to system_control_ its -1,1 " request loop system_shutdown_label: its -1,1 " go here to make system shutdown. its -1,1 "POINTERS - DATA for calling log_write_ admin_log_write_ptr:its -1,1 " static for the admin log as_log_write_ptr: its -1,1 " ext static for the AS log "POINTERS - IOCBS admin_log_iocb: its -1,1 " IOCB for admin log master_iocb: its -1,1 " IOCB for "master_i/o" mc_iocb: its -1,1 " IOCB for "mc_i/o" sv1_iocb: its -1,1 " IOCB for "severity1" sv2_iocb: its -1,1 " IOCB for "severity2" sv3_iocb: its -1,1 " IOCB for "severity3" "POINTERS - SSU SUBSYSTEM CONTROL INFO admin_sci_ptr: its -1,1 " subsystem for current admin request master_sci_ptr: its -1,1 " permanent subsystem for otw_ "POINTERS - TABLES initzer_ttyp: its -1,1 "ptr to mc_ate for initializer terminal mc_ansp: its -1,1 "ptr to mc_anstbl, incl mc_ate array "SWITCHES " dcl XXX bit (1) aligned bool false,0 bool true,400000000000 Go: vfd 36o/false " TRUE if AS listening ('go' done) Go_typed: vfd 36o/false " TRUE immediately after 'go' typed Multics: vfd 36o/false " TRUE if AS started ('mult' done) Multics_typed: vfd 36o/false " TRUE immediately after 'mult' typed Star_typed: vfd 36o/false " TRUE if Go & Multics done as a result " of 'star' being typed admin_listener_switch: vfd 36o/false " TRUE if listening for admin commands did_part1: vfd 36o/false " TRUE if part 1 system_startup.ec done did_part2: vfd 36o/false " TRUE if part 2 system_startup.ec done did_part3: vfd 36o/false " TRUE if part 3 system_startup.ec done mc_is_on: vfd 36o/false " TRUE if message coordinator running no_operator_login: vfd 36o/true " TRUE if not requiring login shutdown_typed: vfd 36o/false " TRUE if shutdown command is executing test_mode: vfd 36o/false " TRUE if in test environment vchn_requires_accept: vfd 36o/true " TRUE if operator must accept all " 'login -op -vchn x' attempts "CHAR STRINGS - ACCESS NAMES " dcl XXX char(32) aligned exec_access_name: " Name used for executing x requests aci "_Exec_Command.Operator.o",32 unidentified_access_name: " Name used for executing requests from " unidentified operators. aci "_Unidentified.Operator.o",32 "CHAR STRINGS - PATHNAMES " dcl XXX char (168) aligned info_dir: aci ">documentation>subsystem>operator",168 log_dir: aci ">system_control_1>as_logs",168 mc_acs_dir: aci ">system_control_1>mc_acs",168 sysdir: aci ">system_control_1",168 "CHAR STRINGS - OTHER master_channel: aci "otw_ ",6 " dcl XXX char (6) aligned " Master TTY channel. end  sys_log_.pl1 11/11/89 1102.8rew 11/11/89 0809.2 187452 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style2,idind30,indcomtxt */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Name: sys_log_ */ /* This procedure is used by the Answering Service to report errors. */ /* */ /* There are two modes of operation: */ /* command-mode, in which errors are reported on behalf of an operator */ /* command, on the terminal which issued the command */ /* (sc_stat_$real_iocb), and/or logged in the admin log; */ /* as-mode, in which errors are reported on one of the answering service */ /* severity I/O switches (severity1, severity2 or severity3), and/or */ /* logged in the as log. */ /* */ /* The severity parameter determines which I/O switch is used (in as-mode) */ /* and how the error is presented, as follows: */ /* */ /* as-mode */ /* severity I/O switch logging/printing operation */ /* 0 log message, only */ /* 1 severity1 log & print message */ /* 2 severity2 log & print message with banner */ /* 3 severity3 log & print message with banner, */ /* kill the system by returning to bce */ /* */ /* Releases prior to MR11.0 allowed a negative severity value. Now, the */ /* absolute value of the severity parameter determines the action, as shown */ /* above. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* as-mode Entrypoints: */ /* */ /* call sys_log_ (severity, ioa_ctl, args); */ /* call sys_log_$binary (severity, data_ptr, data_lth, data_class, */ /* ioa_ctl, args); */ /* call sys_log_$error_log (severity, code, caller, ioa_ctl, args); */ /* Log caller's name, expanded error table code, ioa-formatted message */ /* and binary data, according to parameters supplied with the */ /* entrypoint. */ /* */ /* command-mode Entrypoints: */ /* */ /* call sys_log_$command (severity, ioa_ctl, args); */ /* call sys_log_$command_error (severity, code, caller, ioa_ctl, args); */ /* Log caller's name, expanded error table code, and ioa-formatted */ /* message, according to parameters supplied with the entrypoint. */ /* */ /* general Entrypoint: */ /* */ /* call sys_log_$general (info_ptr); */ /* Log caller's name, expanded error table code, message and optional */ /* binary data in either as-mode or command-mode. Options controlled */ /* by info structure pointed to by info_ptr. Message data can */ /* optionally come from a caller-supplied argument list. See comments */ /* for sl_info structure in sys_log_constants.incl.pl1. */ /* */ /* Entry: sys_log_$type_sv_zero */ /* */ /* call sys_log_$type_sv_zero (); */ /* Causes severity 0 messages to be logged and also printed on the */ /* console, even though messages of this severity calls only for */ /* logging of messages. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ sys_log_: proc (Severity); /**** THVV 11/70 Modified October 1977 by T. Casey to add type_sv_zero entry point for debugging. Modified May 1978 by T. Casey to lengthen message buffer to 256 chars to avoid truncating long messages. Modified August 1982 by E. N. Kittlitz, at the insistence of S. Harris and A. Haggett of Calgary, to not use MC streams before the MC is enabled. Modified August 1983 by K. Loepere for call_bce. Rewritten 1984-10-31 BIM Modified 1985-01-15 by E. Swenson for sys_log_$binary */ /****^ HISTORY COMMENTS: 1) change(86-08-01,Swenson), approve(87-05-25,MCR7680), audit(87-02-08,GDixon), install(87-08-04,MR12.1-1055): Modified to print messages on the terminal when running in system control test mode and no as log exists. 2) change(87-02-08,GDixon), approve(87-05-25,MCR7680), audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055): A) Fixed coding standard violations. B) Added back the facility to crash the system, if need be. 3) change(87-05-04,GDixon), approve(87-05-25,MCR7680), audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055): A) Fix sys_log_$error_code formatting problem. 4) change(87-05-06,GDixon), approve(87-06-10,MCR7708), audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055): A) Added sys_log_$general entrypoint. END HISTORY COMMENTS */ /* Parameters */ dcl Severity fixed bin (17) parameter; /* First arg. How bad things are. */ dcl Data_class char (10) varying parameter; /* Class of supplied data */ dcl Data_lth fixed bin (17) parameter; /* length of supplied data */ dcl Data_ptr ptr parameter; /* pointer to supplied data */ dcl Code fixed bin (35) parameter; /* Error code */ dcl Caller char (*) parameter; /* Caller name */ dcl Sl_info_ptr ptr parameter; /* pointer to sl_info structure for $general */ /* Automatic */ dcl arg_string char (500); dcl arg_string_lth fixed bin(21); dcl based_arg_ptr ptr; dcl based_arg_len fixed bin(21); dcl binary bit (1) aligned; dcl code fixed bin (35); dcl command bit (1) aligned; dcl count fixed bin; dcl data_ptr ptr; /* pointer to binary data supplied */ dcl data_lth fixed bin (17); /* length of binary data supplied */ dcl data_class char (10) varying; /* class of binary data */ dcl (fmtx, argx) fixed bin; /* general_rs args telling where format etc */ dcl ioa_ctl_string char (100) aligned; dcl long char (100) aligned; /* error message */ dcl (masked_ev_calls_code, unmasked_ev_calls_code) fixed bin (35); dcl severity fixed bin; dcl temp_line char (500) varying; /* Based */ dcl based_caller char (based_arg_len) based (based_arg_ptr); dcl based_class char (based_arg_len) based (based_arg_ptr); dcl based_code fixed bin(35) based (based_arg_ptr); dcl based_data_lth fixed bin(21) based (based_arg_ptr); dcl based_data_ptr ptr based (based_arg_ptr); dcl based_fixed_bin fixed bin based (based_arg_ptr); /* Entries */ dcl convert_status_code_ entry (fixed binary (35), character (8) aligned, character (100) aligned); dcl cu_$arg_list_ptr entry returns (ptr); dcl cu_$arg_count_rel entry (fixed bin, ptr, fixed bin(35)); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin(21), fixed bin(35), ptr); dcl date_time_$format entry (character (*), fixed binary (71), character (*), character (*)) returns (character (250) var); dcl hcs_$block entry (); dcl hphcs_$call_bce entry (); dcl ioa_ entry () options (variable); dcl ioa_$general_rs entry (ptr, fixed bin, fixed bin, char (*), fixed bin(21), bit (1) aligned, bit (1) aligned); dcl ioa_$general_rs_control_string entry (ptr, char(*), fixed bin, char(*), fixed bin(21), bit(1) aligned, bit(1) aligned); dcl ioa_$ioa_switch entry () options (variable); dcl ioa_$rsnnl entry options (variable); dcl iox_$control entry (ptr, char (*), ptr, fixed bin (35)); dcl ipc_$mask_ev_calls entry (fixed bin (35)); dcl ipc_$unmask_ev_calls entry (fixed bin (35)); dcl log_write_$data entry (ptr, fixed bin, char (*), ptr, fixed bin, char (10) var, ptr, fixed bin (35)); dcl log_write_$message entry (pointer, fixed binary, character (*), pointer, fixed binary (35)); dcl phcs_$ring_0_message entry (char(*)); dcl signal_ entry (char(*), ptr, ptr, ptr); dcl ssu_$get_info_ptr entry (ptr) returns (ptr); /* Conditions */ dcl cleanup condition; /* Builtin */ dcl (abs, addr, clock, length, max, null, rtrim, size, substr) builtin; /* External */ dcl (error_table_$bad_arg, error_table_$null_info_ptr, error_table_$unimplemented_version, error_table_$wrong_no_of_args) fixed bin(35) ext static; /* Static */ dcl type_sv0 bit (1) aligned int static init (""b); /* print Severity zero messages for debugging */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* sys_log_: entry (Severity); */ command = "0"b; binary = "0"b; go to no_error_common; command: entry (Severity); command = "1"b; binary = "0"b; no_error_common: argx = 3; /* set indices for loc of args */ fmtx = 2; /* and format */ call ioa_$general_rs (cu_$arg_list_ptr (), fmtx, argx, arg_string, arg_string_lth, "0"b, "0"b); temp_line = substr (arg_string, 1, arg_string_lth); go to join; /* * * * * * * * * * * * * * * * * * * * * * * * * */ binary: entry (Severity, Data_ptr, Data_lth, Data_class); data_ptr = Data_ptr; /* copy args */ data_lth = Data_lth; /* copy args */ data_class = Data_class; /* copy args */ argx = 6; /* location of the ioa args */ fmtx = 5; /* location of the ioa format string */ command = "0"b; /* regular non-command entrypoint */ binary = "1"b; /* we have binary data supplied */ call ioa_$general_rs (cu_$arg_list_ptr (), fmtx, argx, arg_string, arg_string_lth, "0"b, "0"b); temp_line = substr(arg_string, 1, arg_string_lth); goto join; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ error_log: entry (Severity, Code, Caller); /* like com_err_ for initializer */ command = "0"b; binary = "0"b; go to error_common; command_error: entry (Severity, Code, Caller); command = "1"b; binary = "0"b; go to error_common; error_common: argx = 5; fmtx = 4; long = ""; /* blank reason */ if Code ^= 0 then /* convert user error code to string */ call convert_status_code_ (Code, "", long); /* find explanation of errcode */ call ioa_$general_rs (cu_$arg_list_ptr (), fmtx, argx, arg_string, arg_string_lth, "0"b, "0"b); call ioa_$rsnnl ("^a: ^a ^a", temp_line, (0), Caller, long, substr(arg_string,1,arg_string_lth)); go to join; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ general: entry (Sl_info_ptr); sli_ptr = Sl_info_ptr; if sli_ptr = null then do; sys_log_error_info.info_string = "Null pointer passed to sys_log_$general."; sys_log_error_info.status_code = error_table_$null_info_ptr; GEN_BAD_IN: sys_log_error_info.length = size(sys_log_error_info); sys_log_error_info.version = SYS_LOG_ERROR_INFO_version_1; sys_log_error_info.action_flags = "0"b; sys_log_error_info.action_flags.cant_restart = "1"b; sys_log_error_info.sl_info_ptr = sli_ptr; call signal_ (SYS_LOG_ERROR_name, null, addr(sys_log_error_info), null); return; end; if sli.version ^= SL_INFO_version_1 then do; sys_log_error_info.info_string = "Structure passed to sys_log_$general has version " || sli.version || ", expected version " || SL_INFO_version_1 || "."; sys_log_error_info.status_code = error_table_$unimplemented_version; go to GEN_BAD_IN; end; if sli.arg_list_ptr ^= null then do; call cu_$arg_count_rel (count, sli.arg_list_ptr, 0); if max (sli.loc.mode, sli.loc.severity, sli.loc.code, sli.loc.caller, sli.loc.data+1, sli.loc.class, sli.loc.ioa_msg) > count then do; sys_log_error_info.info_string = "Structure input to sys_log_$general references args not in arg list."; sys_log_error_info.status_code = error_table_$wrong_no_of_args; go to GEN_BAD_IN; end; end; else if max (sli.loc.mode, sli.loc.severity, sli.loc.code, sli.loc.caller, sli.loc.data, sli.loc.class, sli.loc.ioa_msg) > 0 then do; sys_log_error_info.info_string = "Structure input to sys_log_$general references args, but arg_list_ptr is null."; sys_log_error_info.status_code = error_table_$bad_arg; go to GEN_BAD_IN; end; if sli.loc.code > 0 then do; call cu_$arg_ptr_rel (sli.loc.code, based_arg_ptr, 0, code, sli.arg_list_ptr); if code = 0 then sli.code = based_code; else sli.code = -1; end; else if sli.loc.code = SL_INFO_arg_not_given then sli.code = 0; if sli.loc.code ^= SL_INFO_arg_not_given then if sli.code = 0 then return; /* 0 -> no err */ if sli.code = 0 | sli.code = -1 then /* -1 -> err, no */ long = ""; /* code */ else call convert_status_code_ (sli.code, "", long); if sli.loc.mode > 0 then do; call cu_$arg_ptr_rel (sli.loc.mode, based_arg_ptr, 0, 0, sli.arg_list_ptr); sli.mode = based_fixed_bin; end; else if sli.loc.mode = SL_INFO_arg_not_given then sli.mode = SL_INFO_as_mode; command = sli.mode=SL_INFO_command_mode; if sli.loc.severity > 0 then do; call cu_$arg_ptr_rel (sli.loc.severity, based_arg_ptr, 0, 0, sli.arg_list_ptr); sli.severity = based_fixed_bin; end; else if sli.loc.severity = SL_INFO_arg_not_given then sli.severity = SL_LOG; severity = abs(sli.severity); if sli.loc.caller > 0 then do; call cu_$arg_ptr_rel (sli.loc.caller, based_arg_ptr, based_arg_len, 0, sli.arg_list_ptr); sli.caller = based_caller; end; else if sli.loc.caller = SL_INFO_arg_not_given then sli.caller = ""; if sli.loc.data > 0 then do; call cu_$arg_ptr_rel (sli.loc.data, based_arg_ptr, 0, 0, sli.arg_list_ptr); sli.data_ptr = based_data_ptr; call cu_$arg_ptr_rel (sli.loc.data+1, based_arg_ptr, 0, 0, sli.arg_list_ptr); sli.data_lth = based_data_lth; end; if sli.loc.data = SL_INFO_arg_not_given then binary = "0"b; else do; data_ptr = sli.data_ptr; data_lth = sli.data_lth; binary = "1"b; end; if sli.loc.class > 0 then do; call cu_$arg_ptr_rel (sli.loc.class, based_arg_ptr, based_arg_len, 0, sli.arg_list_ptr); sli.class = based_class; end; else if sli.loc.class = SL_INFO_arg_not_given then sli.class = ""; if binary then data_class = sli.class; if sli.loc.ioa_msg > 0 then do; if sli.flags.ioa_msg_is_error_code then do; call cu_$arg_ptr_rel (sli.loc.ioa_msg, based_arg_ptr, 0, 0, sli.arg_list_ptr); call convert_status_code_ (based_code, "", ioa_ctl_string); if length(rtrim(ioa_ctl_string)) > 0 then call ioa_$general_rs_control_string (sli.arg_list_ptr, rtrim(ioa_ctl_string), sli.loc.ioa_msg+1, arg_string, arg_string_lth, "0"b, "0"b); else arg_string_lth = 0; end; else call ioa_$general_rs (sli.arg_list_ptr, sli.loc.ioa_msg, sli.loc.ioa_msg+1, arg_string, arg_string_lth, "0"b, "0"b); sli.ioa_msg = substr(arg_string, 1, arg_string_lth); end; else if sli.loc.ioa_msg = SL_INFO_arg_not_given then sli.ioa_msg = ""; temp_line = ""; if sli.loc.caller ^= SL_INFO_arg_not_given then do; temp_line = temp_line || rtrim(sli.caller); temp_line = temp_line || ": "; end; if long ^= "" then do; temp_line = temp_line || rtrim(long); temp_line = temp_line || " "; end; if sli.loc.ioa_msg ^= SL_INFO_arg_not_given then temp_line = temp_line || sli.ioa_msg; go to join_general; /* * * * * * * * * * * * * * * * * * * * * * * * * */ join: severity = Severity; /* copy Severity */ severity = abs (severity); join_general: masked_ev_calls_code, unmasked_ev_calls_code = -1; on cleanup begin; if masked_ev_calls_code = 0 & unmasked_ev_calls_code ^= 0 then call ipc_$unmask_ev_calls ((0)); end; call ipc_$mask_ev_calls (masked_ev_calls_code); if sc_stat_$test_mode & (sc_stat_$as_log_write_ptr = null ()) then do; call ioa_ ("LOG: ^a", temp_line); goto RETURN; end; /**** First deposit in appropriate logs */ if ^command then do; if ^binary then call log_write_$message (sc_stat_$as_log_write_ptr, severity, (temp_line), (null ()), code); else call log_write_$data (sc_stat_$as_log_write_ptr, severity, (temp_line), data_ptr, data_lth, data_class, (null ()), code); if severity > 3 then severity = 3; if severity = 1 | type_sv0 then call ioa_$ioa_switch (sc_stat_$sv1_iocb, "^[ ^4a as ^;^s^]^a", ^sc_stat_$mc_is_on, as_time (), temp_line); else if severity = 2 then call ioa_$ioa_switch (sc_stat_$sv2_iocb, "^[^/********************^/ ^4a as ^;^s^]^a", ^sc_stat_$mc_is_on, as_time (), temp_line); else if severity = 3 then call ioa_$ioa_switch (sc_stat_$sv3_iocb, "^[^/********************^/ ^4a as ^]^a", ^sc_stat_$mc_is_on, as_time (), temp_line); end; else do; /* treat as command output */ call iox_$control (sc_stat_$admin_log_iocb, "flush_pending_output", null (), (0)); call log_write_$message (sc_stat_$admin_log_write_ptr, severity, (temp_line), (null ()), code); sc_subsystem_info_ptr = ssu_$get_info_ptr (sc_stat_$admin_sci_ptr); if (severity > 0 | type_sv0) & sc_subsystem_info.real_iocb ^= null () /* if null, logging will suffice */ then call ioa_$ioa_switch (sc_subsystem_info.real_iocb, "^a", temp_line); end; if severity > 2 then do; /* should we kill system? */ if sc_stat_$mc_is_on then call ioa_$ioa_switch (sc_stat_$sv3_iocb, "^/sys_log_: KILLING ANSWERING SERVICE. DUMP INITIALIZER & REBOOT."); if sc_stat_$test_mode then go to RETURN; call phcs_$ring_0_message ((temp_line)); call phcs_$ring_0_message ("sys_log_: Returning to BCE. Dump Initializer and reboot."); call hphcs_$call_bce; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* If we return here, it is because the operator has warned users to cleanup */ /* & logout. The initializer is non-operational, so no logins, logouts, or */ /* accounting updates will work. The initializer should block and stay */ /* blocked, so users can run. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ do while ("1"b); call hcs_$block; /* just as if we had logged out */ end; end; RETURN: call ipc_$unmask_ev_calls (unmasked_ev_calls_code); return; /* * * * * * * * * * * * * * * * * * * * * * * * * */ type_sv_zero: entry; /* to set switch to type sv zero messages for debugging */ type_sv0 = ^type_sv0; /* flip the switch, turning it off or on */ call ioa_ ("sys_log_: sv zero typing turned ^[on^;off^].", type_sv0); return; /* * * * * * * * * * * * * * * * * * * * * * * * * */ as_time: procedure returns (char (4)); return (date_time_$format ("^Hd^MH", clock (), "", "")); end as_time; %include condition_info_header; %include sc_subsystem_info_; %include sc_stat_; %include sys_log_error_info; %include sys_log_constants; dcl 1 sli aligned like sl_info based (sli_ptr); dcl sli_ptr ptr; end sys_log_;  system_control_.pl1 11/11/89 1102.8rew 11/11/89 0809.2 57951 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style2,idind30 */ system_control_: procedure; /* System Control is the procedure called by the initializer process after system initialization has been completed in ring 1. It runs in ring 4, and is outwardly called by system_startup_ */ /* Initially coded by M. J. Spier on April 25, 1969 Revised for mini_shell by R. C. Daley on June 29, 1969 Recoded for efficiency by J.M. Grochow on December 22, 1969 Recoded for the new User/System Control by Michael J. Spier, March 27, 1970 Completely recoded by Michael J. Spier on Saturday June 27, 1970 Revised for operator communications by Dennis Capps Sept. 1972 Intercom, input logging, elimination of bugs 5/74 THVV Split into seventeen little programs THVV 4/75 Modified 750318 by PG to get test mode to work Modified for IOX April 1981 by Benson I. Margulies. Modified for call_bce August 1983 by Keith Loepere. Modified 1984-10-08 BIM for demise of communications Modified 1984-10-26 BIM for ssu_ */ /****^ HISTORY COMMENTS: 1) change(86-05-13,GJohnson), approve(86-05-13,MCR7387), audit(86-05-13,Martinson), install(86-05-14,MR12.0-1056): Correct error message documentation. 2) change(86-08-01,Cox), approve(87-05-25,MCR7690), audit(87-03-13,GDixon), install(87-08-04,MR12.1-1055): Modified for change to mc_anstbl.incl.pl1. 3) change(87-02-03,GDixon), approve(87-05-25,MCR7680), audit(87-05-06,Parisek), install(87-08-04,MR12.1-1055): Modified to meet coding standards by deleting unreferenced variables, declaring used builtins, etc. END HISTORY COMMENTS */ /* DECLARATION OF BUILTIN FUNCTIONS */ dcl (addr, length, null, rtrim) builtin; /* CONDITIONS */ dcl any_other condition; dcl signal_io_ condition; /* DECLARATION OF EXTERNAL ENTRIES */ dcl hphcs_$syserr entry options (variable); dcl hphcs_$call_bce entry (); dcl ioa_$ioa_switch entry () options (variable); dcl sc_init_ entry (); dcl sc_process_command_line_ entry (pointer, pointer, fixed binary (21)); dcl sc_shutdown_ entry; dcl sc_signal_handler_ entry (); dcl sc_signal_io_handler_ entry; /* DECLARATION OF AUTOMATIC STORAGE VARIABLES */ dcl buffer char (500); dcl command_line_length fixed bin (21); dcl initial_command char (30); dcl ip ptr automatic; /* This section of the code initializes the system control environment. */ initial_command = ""; go to common; /* if entered as result of "standard" */ startup_entry: entry; /* entry to execute startup command upon entry */ initial_command = "startup"; go to common; multics_entry: entry; /* entry to execute multics cmd immediately upon entry */ initial_command = "multics"; go to common; common: if ^sc_stat_$test_mode then on any_other begin; call hphcs_$syserr (1, "system_control_: fault during init."); call hphcs_$call_bce (); end; call sc_init_ (); on any_other call sc_signal_handler_; on signal_io_ call sc_signal_io_handler_; sc_stat_$system_shutdown_label = SHUTDOWN_COMES_HERE; if initial_command ^= "" then call sc_process_command_line_ (sc_stat_$master_sci_ptr, addr (initial_command), length (rtrim (initial_command))); /* Here is the main loop of system control. All this program does is act like a regular listener: It reads a line from the master console, parses it to find out what the command is, and executes the command. The trick is that in the initializer process, there are a large number of static event call channels, in the process's event channel table, which can have events arrive on them. When such an event is signalled, the ipc_$block module appears (on a stack trace) to have called out instead of returning to the DIM for the console. The rule in the initializer is that any module which might encounter a block condition (such as an output dim) must mask event calls so that the only place where event calls can be activated is while the read call just below is blocked. */ sc_stat_$master_abort_label = SYSTEM_CONTROL_LISTENER; SYSTEM_CONTROL_LISTENER: do while ("1"b); mc_atep = sc_stat_$initzer_ttyp; /* it may get set at any time */ if ^sc_stat_$Multics | (mc_atep = null ()) then call ioa_$ioa_switch (sc_stat_$master_iocb, "Ready"); else call ioa_$ioa_switch (sc_stat_$master_iocb, "Ready^[ (^a)^;^s^]^[ (Not signed on.)^]", mc_ate.signed_on, mc_ate.personid, as_data_$rs_ptrs (0) -> installation_parms.require_operator_login & ^mc_ate.signed_on); command_line_length = 0; call iox_$get_line (sc_stat_$master_iocb, addr (buffer), length (buffer), command_line_length, (0)); if command_line_length > 0 then call sc_process_command_line_ (sc_stat_$master_sci_ptr, addr (buffer), command_line_length); end; SHUTDOWN_COMES_HERE: call sc_shutdown_; %include as_data_; %include installation_parms; %include iox_entries; %include mc_anstbl; %include sc_stat_; /* BEGIN MESSAGE DOCUMENTATION Message: Ready S: $info T: In response to an operator command. M: The Initializer types Ready whenever it is ready to accept an Initializer command in ring 4. A: Type the desired command. Message: system_control_: fault during init S: ring 4 system control. T: $init M: Some error condition has occurred unexpectedly while starting up the ring 4 initializer environment. The system will return to bce. A: $contact $recover END MESSAGE DOCUMENTATION */ end 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