uc_cleanup_network_dials_.pl1 07/13/88 1113.4r w 07/13/88 0938.1 99216 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-08-01,Swenson), approve(87-07-13,MCR7737), audit(87-05-18,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-03-26,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Use correct calling sequence when calling the force_disconnect entrypoint found in the connection list entry. 3) change(87-05-18,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Changed for new uc_send_ls_response_ calling sequence. 4) change(87-06-01,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Checked to get Login_Server handle out of ute. The connection list entry contains only the Initializer handle. 5) change(87-06-01,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Changed to get Login_Server's handle for a dialed connection out of the connection's user table entry (UTE). The handle in the connection list is the Initializer's handle. B) Changed to logout/free the UTE if uc_send_ls_response_ cannot send the response to the Login_Server. 6) change(87-06-09,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Include correct user process_group_id in login_server_termination_response. 7) change(87-06-19,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Avoid reference through unset pointer by declaring ute_index automatic. END HISTORY COMMENTS */ /* format: style4,indattr,insnl */ uc_cleanup_network_dials_: procedure (P_process_id, P_logout_flag, P_code); /* This procedure is called by the answering service when either 1) the process is destroyed (to cleanup any outstanding dialed connections), or 2) when the process (or the answering service) requests that all dialed connections be dropped. The "owner" (usually the login server) of the connection is notified so that it can perform the necessary processing (such as write an appropriate message on the user's terminal). This program searches the active_connection_list finding connections of which the specified proces is the user, and for each one that is a "dialed" connection, attempts to send a termination_response to the owner. If this fails, it attempts to force_disconnect the connection. */ /* Parameters */ dcl P_process_id bit (36) aligned parameter; dcl P_logout_flag bit (1) aligned parameter; dcl P_code fixed bin (35) parameter; /* Automatic */ dcl 1 auto_active_connection_info aligned like active_connection_info automatic; dcl 1 auto_ls_termination_response aligned like login_server_termination_response automatic; dcl 1 auto_ls_reply aligned like ls_reply_message automatic; dcl code fixed bin (35) automatic; dcl connection_handle fixed bin (35) automatic; dcl connection_name char (32) automatic; dcl connection_offset bit (18) automatic; dcl force_disconnect_name char (64) automatic; dcl initializer_handle bit (72) aligned automatic; dcl logout_flag bit (1) aligned automatic; dcl more bit (1) aligned automatic; dcl owner_process_id bit (36) aligned automatic; dcl owner_handle bit (72) aligned automatic; dcl owner_event_channel fixed bin (71) automatic; dcl send_terminate bit (1) aligned automatic; dcl user_group_id char (32) automatic; dcl user_process_id bit (36) aligned automatic; dcl ute_index fixed bin automatic; /* Entries */ dcl hpriv_connection_list_$get_next_user entry (bit (36) aligned, bit (18), ptr, fixed bin (35)); dcl uc_logout_ entry (ptr, char(*)); dcl uc_send_ls_response_ entry (ptr, fixed bin(18), bit(36) aligned, bit(72) aligned, fixed bin(71), ptr, char(32) aligned, fixed bin(35), fixed bin(35)); dcl user_table_mgr_$free entry (ptr); /* External */ dcl error_table_$noentry fixed bin (35) external static; /* Builtins */ dcl (addr, null, rtrim, size, unspec) builtin; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* Program */ user_process_id = P_process_id; logout_flag = P_logout_flag; /* Set up termination response -- we're going to send the same one to everybody */ ls_response_ptr = addr (auto_ls_termination_response); unspec (login_server_termination_response) = ""b; login_server_response_header.message_type = LS_TERMINATION_RESPONSE; login_server_response_header.header_pad = ""b; login_server_response_header.version = LOGIN_SERVER_TERMINATION_RESPONSE_VERSION_1; login_server_termination_response.process_id = user_process_id; login_server_termination_response.status_code = 0; login_server_termination_response.logout = logout_flag; /* ? */ /* Now start searching the connection list. Each time we find a connection, we will get the next one before processing the current one, so that the current one doesn't get deleted before we can find the next. */ active_connection_info_ptr = addr (auto_active_connection_info); unspec (active_connection_info) = ""b; active_connection_info.version = ACT_INFO_VERSION_1; connection_offset = ""b; /* for finding the first one */ more = Get_next (connection_offset); do while (more); connection_offset = active_connection_info.offset; if active_connection_info.usage_type = LS_DIAL_USAGE /* this is one we're interested in */ then do; /* copy out info for later use */ owner_process_id = active_connection_info.owner_process_id; owner_event_channel = active_connection_info.terminate_event_channel; initializer_handle = active_connection_info.owner_initializer_handle; connection_name = active_connection_info.connection_name; connection_handle = active_connection_info.connection_handle; force_disconnect_name = active_connection_info.force_disconnect_entry; ansp = as_data_$ansp; send_terminate = "0"b; do ute_index = 1 to anstbl.current_size; utep = addr (anstbl.entry(ute_index)); if ute.active = NOW_LOGGED_IN & ute.tty_name = connection_name & ute.login_server_info.our_handle = initializer_handle & ute.login_server_info.process_id = owner_process_id then do; owner_handle = ute.login_server_info.his_handle; user_group_id = Get_Group_ID(); send_terminate = "1"b; end; end; if ^send_terminate then do; /* connection not in ute. */ owner_process_id = ""b; /* Make terminator do force_disconnect */ owner_handle = ""b; user_group_id = ""; utep = null; send_terminate = "1"b; end; end; else send_terminate = "0"b; more = Get_next (connection_offset); if send_terminate then do; /* now process the previous one */ unspec(auto_ls_reply) = ""b; login_server_termination_response.process_group_id = user_group_id; call uc_send_ls_response_ (ls_response_ptr, size (login_server_termination_response), owner_process_id, owner_handle, owner_event_channel, addr (auto_ls_reply), active_connection_info.connection_name, 0, code); if code ^= 0 & utep ^= null then do; call uc_logout_ (utep, "logout, dialed terminal"); call user_table_mgr_$free (utep); end; end; end; EXIT: P_code = code; return; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ Get_Group_ID: procedure () returns (char(32) varying); dcl group char (32) varying; group = ""; if ute.person ^= "" then do; group = rtrim(ute.person); group = group || "."; group = group || rtrim(ute.project); group = group || "."; group = group || ute.tag; end; return (group); end Get_Group_ID; /* * * * * * * * * * * * * * * * * * * * * * * * * */ Get_next: procedure (P_connection_offset) returns (bit (1) aligned); dcl P_connection_offset bit (18) parameter; dcl connection_offset bit (18); dcl code fixed bin (35); connection_offset = P_connection_offset; call hpriv_connection_list_$get_next_user (user_process_id, connection_offset, active_connection_info_ptr, code) ; if code = error_table_$noentry /* there are no more */ then return ("0"b); else if code ^= 0 then call Error (code); /* nothing else should go wrong */ else return ("1"b); end Get_next; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ Error: procedure (P_code); dcl P_code fixed bin (35) parameter; go to EXIT; end Error; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* format: off */ %include active_connection_info; %include answer_table; %include as_data_; %include dialup_values; %include login_server_messages; %include ls_usage_types; %include user_attributes; %include user_table_entry; %include user_table_header; end uc_cleanup_network_dials_;  uc_create_process_.pl1 07/13/88 1113.4rew 07/13/88 0906.6 157491 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-27,Swenson), approve(87-07-13,MCR7737), audit(87-05-16,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-04-27,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1 3) change(87-05-04,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Avoid referencing ute.ln_args if ute.arg_count = 0. 4) change(87-05-09,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Set number_of_arguments to 0 when ute.arg_count = 0 to avoid unset variable. 5) change(87-05-13,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Move act_ctl_$open_account call from uc_ls_create_request_ into here. B) Set pit.line_type from ute.line_type. C) Add code to undo steps of process creation when a fatal error occurs. 6) change(87-05-31,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Assign ute.n_processes+1 to pit.n_processes when filling in the pit, since ute.n_processes hasn't been incremented for the new process at the point of that assignment. (dsa 227 228) 7) change(88-02-02,Parisek), approve(88-02-11,MCR7849), audit(88-02-23,Lippard), install(88-07-13,MR12.2-1047): Added setting of new PIT elements min_ring & max_ring. Eliminated PIT ringpad element. SCP6367 END HISTORY COMMENTS */ /* format: style4,indattr */ uc_create_process_: procedure (P_utep, P_code); /* Parameters */ dcl P_utep ptr parameter; dcl P_code fixed bin (35) parameter; /* Automatic */ dcl aip ptr automatic; dcl argp ptr automatic; dcl 1 auto_create_info structure aligned like create_info automatic; dcl code fixed bin (35) automatic; dcl ip ptr automatic; dcl length_of_arguments fixed bin automatic; dcl length_of_pit fixed bin automatic; /* size of fixed portion */ dcl number_of_arguments fixed bin automatic; dcl pdtep ptr automatic; dcl pit_size fixed bin automatic; /* actual size */ dcl reason char (8) aligned automatic; dcl satep ptr automatic; dcl whoptr ptr automatic; /* Based */ dcl based_arg_string char (length_of_arguments) based aligned; dcl lengths (number_of_arguments) fixed bin based aligned; /* Entries */ dcl act_ctl_$close_account entry (ptr); dcl act_ctl_$cp entry (ptr); dcl act_ctl_$open_account entry (ptr); dcl as_access_audit_$process entry (ptr, fixed bin, char (*)); dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned); dcl hcs_$truncate_seg entry (ptr, fixed bin (19), fixed bin (35)); dcl hphcs_$create_proc entry (ptr, fixed bin (35)); dcl ioa_$rsnnl entry () options (variable); dcl pdir_volume_manager_$select_pdir_volume entry (ptr, fixed bin (35)); /* External */ dcl error_table_$out_of_sequence fixed bin (35) ext static; /* Constant */ dcl DEFAULT_CLS_SIZE fixed bin (35) initial (65536) internal static options (constant); dcl DEFAULT_KST_SIZE fixed bin initial (0) internal static options (constant); dcl DEFAULT_LOT_SIZE fixed bin initial (512) internal static options (constant); dcl (FALSE initial ("0"b), TRUE initial ("1"b)) bit (1) aligned internal static options (constant); dcl ME char (18) initial ("uc_create_process_") internal static options (constant); /* Builtins */ dcl (addr, binary, bit, clock, divide, fixed, length, null, rel, rtrim, string, substr, unspec) builtin; %page; /* Program */ call Setup (); if ^ute.uflags.proc_create_ok then call Abort (SL_LOG_SILENT, error_table_$out_of_sequence, "Called before process creation variables set for ^a.^a.^a.", ute.person, ute.project, ute.tag); call Setup_PIT (); call Setup_Create_Info (); call Select_Process_Directory_Volume (); call Create_Process (); call Update_Whotab (); RETURN: P_code = code; return; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: Report errors via sys_log_$general and stop execution. */ /* */ /* Syntax: call Abort (severity, code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_sev_code_msg; sl_info.caller = ME; sl_info.arg_list_ptr = cu_$arg_list_ptr (); call sys_log_$general (addr (sl_info)); code = sl_info.code; if code ^= 0 then go to RETURN; end Abort; %page; Setup: procedure (); utep = P_utep; code = 0; ansp = as_data_$ansp; ip = as_data_$rs_ptrs (0); satep = ute.uprojp; pdtep = ute.pdtep; anstbl.current_time = clock (); return; end Setup; %page; Setup_PIT: procedure (); dcl i fixed bin automatic; pit_ptr = as_data_$pit_ptr; call hcs_$truncate_seg (pit_ptr, 0, code); if code ^= 0 then call Abort (SL_LOG_BEEP, code, ME, "Truncate pit template failed; creating process for ^a.^a.^a.", ute.person, ute.project, ute.tag); pit.version = PIT_version_3; pit.process_type = ute.process_type; pit.login_responder = substr (ute.init_proc, 1, ute.ip_len); pit.homedir = ute.home_dir; pit.project = ute.project; pit.account = ""; /* unused */ pit.n_processes = ute.n_processes + 1; /* ute.n_processes hasn't been incremented yet. */ pit.login_time = ute.login_time; pit.proc_creation_time = clock (); pit.old_proc_cpu = ute.cpu_usage; /* will be zero for first process */ pit.user_weight = ute.user_weight; pit.anonymous = ute.anonymous; pit.login_name = ute.person; pit.logout_pid = anstbl.as_procid; pit.logout_channel = ute.event; pit.group = ute.group; pit.min_ring = ute.lowest_ring; /* minimum ring */ pit.max_ring = ute.highest_ring; /* maximum ring */ string (pit.at) = string (ute.at); pit.whox = ute.whotabx; pit.outer_module = ute.outer_module; pit.dont_call_init_admin = ute.uflags.dont_call_init_admin; pit.terminal_access_class = ""b; /* not used */ pit.dollar_charge = user.dollar_charge; pit.dollar_limit = user.dollar_limit; pit.shift_limit (*) = user.shift_limit (*); pit.logins = user.logins; pit.crashes = user.crashes; pit.interactive (*) = user.interactive (*); pit.absentee (*) = user.absentee (*); pit.iod (*) = user.iod (*); pit.devices (*) = user.devices (*); pit.time_last_reset = user.time_last_reset; pit.absolute_limit = user.absolute_limit; pit.absolute_spent = user.absolute_spent; pit.absolute_cutoff = user.absolute_cutoff; pit.absolute_increm = user.absolute_increm; pit.rs_number = ute.rs_number; pit.request_id = ute.request_id; pit.authorization_range = ute.process_authorization_range; /**** TBS: The charge_type is available in the cdte for MCS channels. If this module ever supports MCS, it should be extracted from here. */ pit.charge_type = 0; pit.term_type_name = ute.terminal_type; pit.line_type = ute.line_type; /**** TBS: The tty_type is an obsolete field which is present in the cdte. If this module ever supports MCS, it should be extracted from here. */ pit.tty_type = 0; /**** TBS: If the value of pit.service is type is used, it will have to be conjured up from somewhere. The cdte, of course, has this value for MCS channels. It was probably only used for the old NCP/FTP. */ pit.service_type = 0; pit.tty_answerback = ute.tty_id_code; pit.old_tty = ""; pit.standby = ute.standby_line; pit.login_line = ""; /* unused */ pit.cant_bump_until = ute.cant_bump_until; /* 0 for abs & dmn */ pit.input_seg = ute.input_seg; /* only valid for absentees */ pit.output_seg = ute.output_seg; /* ditto */ pit.max_cpu_time = ute.max_cpu_time; /* ditto */ if ute.process_type = PT_ABSENTEE then pit.abs_queue = ute.queue; else pit.abs_queue = -1; string (pit.abs_attributes) = "0"b; /* copy ute abs_attributes bits */ pit.restartable = ute.restartable; pit.user_deferred_until_time = ute.user_deferred_until_time; pit.proxy = ute.proxy; pit.set_bit_cnt = ute.set_bit_cnt; pit.truncate_absout = ute.truncate_absout; pit.restarted = ute.restarted; aip = addr (pit.start_arg_info); pit.arg_info_ptr = fixed (rel (aip)); pit.old_proc_core = ute.mem_usage; pit.old_proc_io_ops = 0; pit.tty = ute.tty_name; if length (rtrim (pit.tty)) <= length (pit.old_tty) then pit.old_tty = substr (pit.tty, 1, length (pit.old_tty)); number_of_arguments = ute.arg_count; aip -> arg_info.arg_count = number_of_arguments; if number_of_arguments > 0 then do; length_of_arguments = ute.ln_args; aip -> arg_info.ln_args = length_of_arguments; argp = ute.arg_lengths_ptr; do i = 1 to number_of_arguments; aip -> arg_info.arg_lengths (i) = argp -> lengths (i); end; if length_of_arguments > 0 then do; argp = ute.args_ptr; aip -> arg_info.args = argp -> based_arg_string; end; end; else length_of_arguments, aip -> arg_info.ln_args = 0; length_of_pit = binary (rel (addr (pit.start_arg_info)), 18); pit_size = length_of_pit + number_of_arguments + divide (length_of_arguments + 3, 4, 35, 0) + 2; return; end Setup_PIT; %page; Setup_Create_Info: procedure (); if anstbl.processid_index > 262140 | anstbl.processid_index < 0 then anstbl.processid_index = 0; anstbl.processid_index = anstbl.processid_index + 1; auto_create_info.processid.rel_apte = ""b; /* returned from hardcore */ auto_create_info.processid.unique_index = bit (fixed (anstbl.processid_index, 18), 18); auto_create_info.version = version_of_create_info; auto_create_info.term_channel = pit.logout_channel; auto_create_info.term_processid = pit.logout_pid; auto_create_info.words_of_pit = pit_size; if ute.pdir_quota > 0 then /* nonzero value in PDT of SAT */ auto_create_info.record_quota = ute.pdir_quota; else do; ute.pdir_quota = installation_parms.default_pdir_seg_quota; auto_create_info.record_quota = ute.pdir_quota; end; auto_create_info.ppml = 0; /* obsolete */ auto_create_info.initial_ring = ute.initial_ring; auto_create_info.highest_ring = ute.highest_ring; auto_create_info.timax = -1; /* but see below */ if ute.process_type = PT_ABSENTEE then if ute.queue > 0 then auto_create_info.timax = installation_parms.abs_timax (ute.queue); auto_create_info.account_ptr = null (); /* unused */ auto_create_info.pit_ptr = pit_ptr; call ioa_$rsnnl ("^[anonymous^s^;^a^].^a.^a", auto_create_info.process_group_id, (0), (ute.anonymous = 1), ute.person, ute.project, ute.tag); auto_create_info.user_processid = ""; /* unused */ auto_create_info.account_id = ""; /* unused */ auto_create_info.homedir = rel (addr (pit.homedir)); auto_create_info.lot_in_stack = TRUE; if ute.lot_size = 0 then auto_create_info.lot_size = DEFAULT_LOT_SIZE; else if ute.lot_size > 0 then auto_create_info.lot_size = ute.lot_size; else do; auto_create_info.lot_size = -(ute.lot_size); auto_create_info.lot_in_stack = FALSE; end; auto_create_info.cls_in_stack = FALSE; if ute.cls_size = 0 then auto_create_info.cls_size = DEFAULT_CLS_SIZE; else if ute.cls_size > 0 then auto_create_info.cls_size = ute.cls_size; else do; auto_create_info.cls_size = -(ute.cls_size); auto_create_info.cls_in_stack = TRUE; end; if ute.kst_size = 0 then auto_create_info.kst_size = DEFAULT_KST_SIZE; else auto_create_info.kst_size = ute.kst_size; auto_create_info.dont_call_init_admin = ute.uflags.dont_call_init_admin; auto_create_info.audit = ute.audit; auto_create_info.process_authorization = ute.process_authorization; auto_create_info.max_process_authorization = ute.process_authorization_range (2); auto_create_info.work_class = ute.work_class; auto_create_info.subsystem = substr (ute.init_proc, ute.ip_len + 1, ute.ss_len); ute.pdir_dir_quota = installation_parms.default_pdir_dir_quota; auto_create_info.dir_quota = ute.pdir_dir_quota; return; end Setup_Create_Info; %page; Select_Process_Directory_Volume: procedure (); /**** Chose a process directory logical volume for this process */ if ^as_data_$debug_flag then do; call pdir_volume_manager_$select_pdir_volume (utep, code); if code ^= 0 then call Log_Error_with_Code (SL_LOG_BEEP, code, ME, "Assigning pdir volume for ^a.^a.^a", ute.person, ute.project, ute.tag); end; return; end Select_Process_Directory_Volume; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Log_Error_with_Code: log an error via sys_log_$general and continue */ /* execution. */ /* */ /* Syntax: call Log_Error_with_Code (severity, code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Log_Error_with_Code: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_sev_code_msg; sl_info.caller = ME; sl_info.arg_list_ptr = cu_$arg_list_ptr (); call sys_log_$general (addr (sl_info)); end Log_Error_with_Code; %page; Create_Process: procedure (); ute.n_processes = ute.n_processes + 1; if ute.n_processes = 1 then /* not new proc? */ call act_ctl_$open_account (utep); call hphcs_$create_proc (addr (auto_create_info), code); if code ^= 0 then do; ute.active = NOW_LOGGED_IN; ute.uflags.proc_create_ok = FALSE; call convert_status_code_ (code, reason, ""); call as_access_audit_$process (utep, -AS_AUDIT_PROCESS_CREATE, (reason)); call act_ctl_$close_account (utep); call Abort (SL_LOG, code, ME, "Could not create process for ^a.^a.^a.", ute.person, ute.project, ute.tag); end; ute.proc_id = unspec (auto_create_info.processid); ute.active = NOW_HAS_PROCESS; ute.destroy_flag = WAIT_LOGOUT_SIG; call as_access_audit_$process (utep, AS_AUDIT_PROCESS_CREATE, ""); call act_ctl_$cp (utep); return; end Create_Process; %page; Update_Whotab: procedure (); /**** Various items in the whotab entry for the user were not filled in at login time because the values were not known. They are updated now. */ dcl whotab_idx fixed bin automatic; whoptr = as_data_$whoptr; /**** Update the number of load control units in the whotab header */ whotab.n_units = whotab.n_units + ute.user_weight; /**** Update the per-user whotab values if the user has a whotab entry */ if ute.whotabx ^= 0 then do; /* user has a whotab entry */ whotab_idx = ute.whotabx; whotab.e (whotab_idx).units = ute.user_weight; whotab.e (whotab_idx).stby = ute.standby_line; whotab.e (whotab_idx).group = ute.group; whotab.e (whotab_idx).cant_bump_until = ute.cant_bump_until; end; return; end Update_Whotab; /* format: off */ %page; %include answer_table; %page; %include as_data_; %page; %include access_audit_bin_header; /* needed by PL/I */ %page; %include as_audit_structures; %page; %include create_info; %page; %include dialup_values; %page; %include installation_parms; %page; %include pdt; dcl pdtp ptr automatic init (null); /* pdt needs it */ %page; %include pit; %page; %include sys_log_constants; %page; %include user_attributes; %page; %include user_table_entry; %page; %include user_table_header; %page; %include whotab; end uc_create_process_;  uc_create_process_check_.pl1 07/13/88 1113.4rew 07/13/88 0904.2 151443 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-27,Swenson), approve(87-07-13,MCR7737), audit(87-05-16,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-04-27,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1. B) Move notification of other processes into uc_login_, now that the login operation is distinguished from process creation. C) Add support for minimum MNA terminal manager ring check. Data comes from login_server_process_request.minimum_ring. 3) change(87-05-09,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Corrected to reference login_server_process_request.default_io_module, rather than .outer_module. login_server_process_request.outer_module was assign to ute.outer_mode in uc_ls_create_request_. 4) change(88-02-02,Parisek), approve(88-02-11,MCR7849), audit(88-03-22,Lippard), install(88-07-13,MR12.2-1047): Added setting of new UTE element lowest_ring. SCP6367 END HISTORY COMMENTS */ /* format: style4,indattr */ uc_create_process_check_: procedure (P_utep, P_ls_process_request_ptr, P_code); /* Parameters */ dcl P_ls_process_request_ptr ptr parameter; /* ptr to process request data structure */ dcl P_utep ptr parameter; dcl P_code fixed bin (35) parameter; /* Automatic */ dcl code fixed bin (35) automatic; dcl pdtep ptr automatic; dcl satp ptr automatic; dcl satep ptr automatic; /* Entries */ dcl act_ctl_$check_for_process_creation entry (ptr, char (8) aligned, char (168) var, fixed bin (35)); dcl load_ctl_$check_for_process_creation entry (ptr, fixed bin (35)); /* External */ dcl as_error_table_$illegal_om_arg fixed bin (35) external static; dcl as_error_table_$already_logged_in fixed bin (35) external static; dcl as_error_table_$illegal_hd_arg fixed bin (35) external static; dcl as_error_table_$illegal_ip_arg fixed bin (35) external static; dcl as_error_table_$illegal_ss_arg fixed bin (35) external static; dcl as_error_table_$long_ip_arg fixed bin (35) external static; dcl as_error_table_$long_ss_arg fixed bin (35) external static; dcl as_error_table_$no_primary fixed bin (35) ext static; dcl as_error_table_$ring_too_high fixed bin (35) external static; dcl as_error_table_$ring_too_low fixed bin (35) external static; dcl as_error_table_$user_fg_cpu_limit fixed bin (35) ext static; dcl as_error_table_$user_max_bg fixed bin (35) ext static; dcl as_error_table_$user_max_fg fixed bin (35) ext static; dcl error_table_$bad_arg fixed bin (35) ext static; dcl error_table_$out_of_sequence fixed bin (35) ext static; /* Constant */ dcl ME char (24) int static options (constant) init ("uc_create_process_check_"); dcl (TRUE initial ("1"b), FALSE initial ("0"b)) bit (1) aligned internal static options (constant); /* Builtin */ dcl (addr, clock, index, length, max, min, null, rtrim, substr) builtin; %page; /* Program */ call Setup (); if ute.active ^= NOW_LOGGED_IN then call Abort_Create (error_table_$out_of_sequence); call Check_Process_Limits (); call Check_For_Multiple_Logins (); call Check_With_Accounting (); call Setup_Initial_Procedure_And_Subsystem (); call Setup_Login_Ring (); call Setup_Outer_Module (); call Setup_Miscellaneous_Variables (); call Check_With_Load_Control (); ute.uflags.proc_create_ok = TRUE; RETURN: P_code = code; return; %page; Setup: procedure (); utep = P_utep; ls_request_ptr = P_ls_process_request_ptr; code = 0; ansp = as_data_$ansp; satp = as_data_$satp; satep = ute.uprojp; pdtep = ute.pdtep; anstbl.current_time = clock (); return; end Setup; %page; Abort_Create: procedure (P_code); dcl P_code fixed bin (35) parameter; code = P_code; goto RETURN; end Abort_Create; %page; Check_Process_Limits: procedure (); dcl limit fixed bin automatic; if ute.queue <= 0 then do; /* foreground process */ if ute.process_type = PT_ABSENTEE then do; /**** Check foreground absentee CPU limits */ limit = project.abs_foreground_cpu_limit; if limit = 0 then /* no SAT limit */ limit = user.abs_foreground_cpu_limit; else if user.abs_foreground_cpu_limit > 0 then /* PDT limit */ limit = min (limit, user.abs_foreground_cpu_limit); if limit > 0 then /* there is a SAT or PDT limit */ if ute.max_cpu_time > limit then call Abort_Create (as_error_table_$user_fg_cpu_limit); if ^ute.at.pm_ok & /* primary not allowed */ ^ute.uflags.foreground_secondary_ok/* secondary not ok */ then call Abort_Create (as_error_table_$no_primary); end; /**** Check foreground absentee process limits */ limit = project.max_foreground; if limit = 0 then /* no SAT limit */ limit = user.max_foreground; /* use PDT limit */ else if user.max_foreground > 0 then /* there is a PDT limit */ limit = min (limit, user.max_foreground); if limit > 0 then /* there is a limit */ if user.n_foreground ^< limit then do; /* user at limit */ if ute.process_type = PT_INTERACTIVE then do; if user.n_interactive > 0 & /* already has one */ ^ute.at.multip then do; /* no multip */ call Abort_Create (as_error_table_$already_logged_in); end; /* end already has one */ end; /* end interactive */ else /* foreground absentee */ call Abort_Create (as_error_table_$user_max_fg); end; /* user at limit */ end; /* foreground process */ else do; /* background process */ if ^ute.abs_run then do; /* not force-run by operator */ limit = project.max_background; if limit = 0 then /* no SAT limit */ limit = user.max_background; /* pick up PDT limit */ else if user.max_background > 0 then /* there is a PDT limit */ limit = min (limit, user.max_background); /* get smaller */ if limit > 0 then /* if there is a limit */ if user.n_background ^< limit then /* user at limit */ call Abort_Create (as_error_table_$user_max_bg); end; /* end not force-run by operator */ end; /* end background process */ return; %page; end Check_Process_Limits; %page; Check_For_Multiple_Logins: procedure (); if ute.process_type ^= PT_INTERACTIVE | ute.anonymous = 1 then return; if user.n_interactive > 0 then do; if ^ute.at.multip then /* no multip */ call Abort_Create (as_error_table_$already_logged_in); end; return; end Check_For_Multiple_Logins; %page; Check_With_Accounting: procedure (); dcl short_info char (8) aligned automatic; dcl long_info char (168) varying automatic; call act_ctl_$check_for_process_creation (utep, short_info, long_info, code); if code ^= 0 then call Abort_Create (code); return; end Check_With_Accounting; %page; Setup_Initial_Procedure_And_Subsystem: procedure (); dcl ip_len fixed bin automatic; dcl ss_len fixed bin automatic; dcl subsystem char (64) automatic; /**** Check if login is restricted to using a special process overseer. If it is, use this correct overseer_. */ if ute.network_connection_type ^= 0 & ute.network_connection_type ^= NETWORK_CONNECTION_LOGIN then do; if ute.network_connection_type ^= NETWORK_CONNECTION_DSA_FILE_TRANSFER then call Abort_Create (error_table_$bad_arg); else do; /* DSA file transfer connection */ ute.init_proc = "dsa_uft_server_overseer_"; ute.ip_len = length (rtrim (ute.init_proc)); ute.ss_len = 0; /* no subsystem */ ute.uflags.dont_call_init_admin = FALSE; end; end; else do; /* Normal LOGIN */ /**** Save the subsystem so that we don't clobber it below */ if ute.uflags.ss_given then subsystem = substr (ute.init_proc, ute.ip_len + 1, ute.ss_len); if ute.uflags.ip_given then do; if ^ute.at.vinitproc then call Abort_Create (as_error_table_$illegal_ip_arg); end; else do; /* not supplied on command line, use PDT */ if user.uflags.ip_given then /* length stored in PDT */ ip_len = user.ip_len; else do; /* must scan and figure it out */ ip_len = -1 + index (user.initial_procedure, " "); if ip_len = -1 then /* if no blanks, then */ ip_len = length (user.initial_procedure); end; /* it is 64 characters long */ substr (ute.init_proc, 1, ip_len) = substr (user.initial_procedure, 1, ip_len); ute.ip_len = ip_len; ute.uflags.dont_call_init_admin = user.uflags.dont_call_init_admin; end; if ute.ip_len > length (",direct") then if substr (ute.init_proc, ute.ip_len - length (",direct") + 1, length (",direct")) = ",direct" then do; ute.uflags.dont_call_init_admin = TRUE; ute.ip_len = ute.ip_len - length (",direct"); end; /**** Now process the subsystem. We may have it already from above */ if ute.uflags.ss_given then do; if ^ute.at.vinitproc then call Abort_Create (as_error_table_$illegal_ss_arg); ss_len = ute.ss_len; end; else if user.uflags.ss_given then do; /* is it supplied in PDT? */ ss_len = user.ss_len; subsystem = substr (user.initial_procedure, user.ip_len + 1, user.ss_len); end; else ss_len = -1; /* not supplied at all */ if ss_len ^= -1 then do; /* we have a subsystem */ if ss_len + ute.ip_len > length (ute.init_proc) then do; /* no room */ if ute.uflags.ip_given then call Abort_Create (as_error_table_$long_ip_arg); else call Abort_Create (as_error_table_$long_ss_arg); end; else do; substr (ute.init_proc, ute.ip_len + 1, ss_len) = substr (subsystem, 1, ss_len); ute.ss_len = ss_len; ute.uflags.ss_given = TRUE; end; end; end; return; end Setup_Initial_Procedure_And_Subsystem; %page; Setup_Login_Ring: procedure (); dcl ring fixed bin (3) automatic; if user.low_ring < project.min_ring then call Log ("Raised min ring for ^a.^a from ^d (in PDTE) to ^d (in SATE).", ute.person, ute.project, user.low_ring, project.min_ring); if ute.initial_ring ^= -1 then /* user specified it */ ring = ute.initial_ring; else ring = user.default_ring; /* otherwise use PDT default */ ring = max (project.min_ring, user.low_ring, ring); if ring <= 0 then ring = as_data_$dft_user_ring; if login_server_process_request.minimum_ring_given then do; if ring < login_server_process_request.minimum_ring then do; call Log ("Raised min ring for ^a.^a from ^d (in SATE/PDTE) to ^d (of Login Server)", ute.person, ute.project, ring, login_server_process_request.minimum_ring); ring = login_server_process_request.minimum_ring; end; end; if ute.initial_ring ^= -1 then if ute.initial_ring < ring then call Abort_Create (as_error_table_$ring_too_low); if ring > as_data_$max_user_ring then ring = as_data_$max_user_ring; ute.lowest_ring = max (project.min_ring, user.low_ring); ute.initial_ring = ring; /**** Determine max user ring */ if user.high_ring > project.max_ring then call Log ("Lowered max ring for ^a.^a from ^d (in PDTE) to ^d (in SATE).", ute.person, ute.project, user.high_ring, project.max_ring); if project.max_ring <= 0 then ring = as_data_$dft_user_ring + 1; else ring = project.max_ring; ring = min (ring, user.high_ring, as_data_$max_user_ring); if ring < ute.initial_ring then call Abort_Create (as_error_table_$ring_too_high); ute.highest_ring = ring; return; end Setup_Login_Ring; %page; Setup_Outer_Module: procedure (); if ute.outer_module ^= "" then if ^ute.at.vinitproc then call Abort_Create (as_error_table_$illegal_om_arg); if ute.outer_module = "" then do; ute.outer_module = user.outer_module; if ute.outer_module = "" | ute.outer_module = as_data_$tty_dim then do; if login_server_process_request.default_io_module ^= "" then ute.outer_module = login_server_process_request.default_io_module; else ute.outer_module = as_data_$tty_dim; end; end; return; end Setup_Outer_Module; %page; Setup_Miscellaneous_Variables: procedure (); dcl i fixed bin automatic; /**** Constraint process directory quota */ if project.pdir_quota > 0 then do; /* there is a SAT limit */ if user.pdir_quota > project.pdir_quota then call Log ("Reduced pdir quota for ^a.^a from ^d (in PDTE) to ^d (in SATE).", ute.person, ute.project, user.pdir_quota, project.pdir_quota); ute.pdir_quota = min (project.pdir_quota, user.pdir_quota); end; else /* no SAT limit */ ute.pdir_quota = user.pdir_quota; /**** Copy various tables sizes from the PDT */ ute.lot_size = user.lot_size; ute.kst_size = user.kst_size; ute.cls_size = user.cls_size; /**** Determine user's load control weight */ ute.user_weight = -1; /* not yet set */ do i = 1 to sat.uwt_size while (ute.user_weight = -1); if ute.init_proc = sat.uwt (i).initproc then ute.user_weight = sat.uwt (i).units; end; if ute.user_weight = -1 then ute.user_weight = as_data_$default_weight; /**** Locate user's home directory */ if ute.home_dir ^= "" then /* user supplied home directory? */ if ^ute.at.vhomedir then /* allowed */ call Abort_Create (as_error_table_$illegal_hd_arg); else ; else ute.home_dir = user.home_dir; /* use PDT default */ /**** Process disconnection/saving checks. */ if ute.process_type = PT_INTERACTIVE then do; /* only for interactive processes */ if ute.at.save_on_disconnect & ute.at.disconnect_ok then ute.uflags.save_if_disconnected = TRUE; else ute.uflags.save_if_disconnected = FALSE; end; return; end Setup_Miscellaneous_Variables; %page; Check_With_Load_Control: procedure (); call load_ctl_$check_for_process_creation (utep, code); if code ^= 0 then call Abort_Create (code); return; end Check_With_Load_Control; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Log: log information about process creation restrictions in AS log. */ /* */ /* Syntax: call Log (ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Log: procedure () options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_msg; sl_info.caller = ME; sl_info.arg_list_ptr = cu_$arg_list_ptr (); call sys_log_$general (addr (sl_info)); end Log; /* format: off */ %page; %include answer_table; %page; %include as_data_; %page; %include dialup_values; %page; %include login_server_messages; %page; %include pdt; dcl pdtp ptr automatic init (null); /* pdt needs it */ %page; %include sat; %page; %include sys_log_constants; %page; %include user_attributes; %page; %include user_table_entry; %page; %include user_table_header; end uc_create_process_check_;  uc_dial_.pl1 07/13/88 1113.4r w 07/13/88 0938.1 107631 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-27,Swenson), approve(87-07-13,MCR7737), audit(87-05-18,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-04-27,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1 3) change(87-05-18,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Correct coding standard violations. B) Standardize format of audit messages. 4) change(87-06-01,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Expand aliases in "dial DIAL_ID person.project". 5) change(87-06-11,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Change to call as_access_audit_$channel to audit dialins. END HISTORY COMMENTS */ /* format: style4,indattr,insnl */ uc_dial_: procedure (P_utep, P_dial_qualifier, P_person_id, P_project_id, P_connection_name, P_connection_access_class_range, P_target_utep, P_code); /* Parameters */ dcl P_utep ptr parameter; dcl P_dial_qualifier char (*) parameter; dcl P_person_id char (*) parameter; dcl P_project_id char (*) parameter; dcl P_connection_name char (*) parameter; dcl P_connection_access_class_range (2) bit (72) aligned parameter; dcl P_target_utep ptr parameter; dcl P_code fixed bin (35) parameter; /* Automatic */ dcl 1 auto_channel_audit_info aligned like channel_audit_info automatic; dcl code fixed bin (35) automatic; dcl dial_qualifier char (32) automatic; dcl find_person_project bit (1) aligned automatic; dcl target_person_id char (32) automatic; dcl target_project_id char (32) automatic; dcl target_utep ptr automatic; dcl user_validated bit (1) aligned automatic; /* Based */ dcl 1 target_ute aligned like ute based (target_utep); /* Entries */ dcl aim_check_$in_range entry (bit (72) aligned, (2) bit (72) aligned) returns (bit (1) aligned); dcl as_access_audit_$channel entry (ptr, ptr, ptr, fixed bin, ptr, char(*)); dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned); dcl hash_$search entry (ptr, char (*), fixed bin (35), fixed bin (35)); dcl pnt_manager_$admin_get_entry entry (char (*), ptr, fixed bin (35)); /* External */ dcl ( as_error_table_$dialnoline, as_error_table_$dialnotup, error_table_$action_not_performed, error_table_$ai_restricted, error_table_$id_not_found ) fixed bin (35) ext static; /* Constant */ dcl DENIED bit (1) aligned initial ("0"b) internal static options (constant); dcl FALSE bit (1) aligned initial ("0"b) internal static options (constant); dcl GRANTED bit (1) aligned initial ("1"b) internal static options (constant); dcl ME char (8) initial ("uc_dial_") int static options (constant); dcl TRUE bit (1) aligned initial ("1"b) internal static options (constant); /* Builtin */ dcl (addr, length, null, rtrim, substr) builtin; %page; /* Program */ code = 0; utep = P_utep; if utep = null () then user_validated = FALSE; else user_validated = TRUE; ansp = as_data_$ansp; dutp = as_data_$dutp; autp = as_data_$autp; dial_qualifier = P_dial_qualifier; if dial_qualifier = "" then call Abort (as_error_table_$dialnoline); if dial_qualifier = "system" then call Abort (error_table_$action_not_performed); target_person_id = P_person_id; target_project_id = P_project_id; if target_person_id = "" then find_person_project = FALSE; else do; find_person_project = TRUE; if ^convert_aliases (target_person_id, target_project_id) then call Abort (as_error_table_$dialnotup); end; target_utep = find_dialable_process (); if target_utep = null () then call Abort (as_error_table_$dialnotup); /**** Mark the UTE has having a client */ target_ute.ndialed_consoles = target_ute.ndialed_consoles + 1; /**** Audit the DIALIN */ call Audit_dialin (target_utep, GRANTED, ""); code = 0; RETURN: if code = 0 then P_target_utep = target_utep; else P_target_utep = null (); P_code = code; return; %page; convert_aliases: procedure (rq_person, rq_project) returns (bit (1)); dcl rq_person char (32); dcl rq_project char (32); dcl code fixed bin (35); dcl satx fixed bin (35); call pnt_manager_$admin_get_entry (rq_person, addr (pnte), code); if code = error_table_$id_not_found then return (FALSE); else if code ^= 0 then do; call Log_Error (code, "Can't find PNT entry: ^a", rq_person); return (FALSE); end; else rq_person = substr (pnte.user_id, 1, length (rq_person)); if rq_project = "" then rq_project = pnte.default_project; else do; call hash_$search (as_data_$sat_htp, rq_project, satx, code); if code ^= 0 then return (FALSE); satp = as_data_$satp; satep = addr (sat.project (satx)); if rq_project ^= project.project_id then if rq_project ^= project.alias then do; call Log_Error (-1, "^a: sat.ht has ""^a"", sat has ""^a"" at ^p", rq_project, project.project_id, satep); return (FALSE); end; rq_project = project.project_id; end; return (TRUE); end convert_aliases; %page; find_dialable_process: procedure () returns (ptr); dcl i fixed bin automatic; dcl temp_utep ptr automatic; do i = 1 to anstbl.current_size; temp_utep = addr (anstbl.entry (i)); if ok_for_dial (temp_utep) then return (temp_utep); end; do i = 1 to dutbl.current_size; temp_utep = addr (dutbl.entry (i)); if ok_for_dial (temp_utep) then return (temp_utep); end; do i = 1 to autbl.current_size; temp_utep = addr (autbl.entry (i)); if ok_for_dial (temp_utep) then return (temp_utep); end; return (null ()); /* couldn't find any dialable process */ %page; ok_for_dial: procedure (P_utep) returns (bit (1) aligned); dcl P_utep ptr parameter; if P_utep -> ute.active ^= NOW_HAS_PROCESS then return (FALSE); if find_person_project then do; if P_utep -> ute.person ^= target_person_id then return (FALSE); if P_utep -> ute.project ^= target_project_id then return (FALSE); end; else do; /* we want a registered dial server */ if ^P_utep -> ute.registered_dial_server then return (FALSE); end; if P_utep -> ute.dial_qualifier ^= dial_qualifier then return (FALSE); if ^P_utep -> ute.at.dialok then return (FALSE); if P_utep -> ute.dial_ev_chn = 0 then return (FALSE); /**** Now perform access checks (these should be done first) */ if ^aim_check_$in_range (P_utep -> ute.process_authorization, P_connection_access_class_range) then do; code = error_table_$ai_restricted; call Audit_denied_dialin (P_utep, code); return (FALSE); end; /**** TBS: We should perform discretionary access control checks too. */ return (TRUE); end ok_for_dial; end find_dialable_process; %page; Abort: procedure (P_code); dcl P_code fixed bin (35) parameter; code = P_code; goto RETURN; end Abort; %page; Audit_denied_dialin: procedure (P_utep, P_code); dcl P_utep pointer parameter; dcl P_code fixed bin (35) parameter; dcl reason char (100) aligned automatic; if P_code = 0 then reason = ""; else call convert_status_code_ (P_code, (""), reason); call Audit_dialin (P_utep, DENIED, rtrim(reason)); return; end Audit_denied_dialin; %page; Audit_dialin: procedure (P_target_utep, grant_sw, reason); dcl P_target_utep ptr parameter; dcl grant_sw bit(1) aligned parameter; dcl reason char(*) parameter; dcl action fixed bin(17) automatic; dcl target_utep ptr automatic; dcl 1 target_ute aligned like ute based (target_utep); target_utep = P_target_utep; channel_audit_info_ptr = addr(auto_channel_audit_info); channel_audit_info.channel_name = P_connection_name; channel_audit_info.valid = FALSE; channel_audit_info.valid.service_info = TRUE; channel_audit_info.valid.user_validation_level = TRUE; channel_audit_info.valid.access_class = TRUE; channel_audit_info.valid.access_class_range = TRUE; channel_audit_info.service_info = dial_qualifier; channel_audit_info.user_validation_level = target_ute.initial_ring; channel_audit_info.access_class = target_ute.process_authorization; channel_audit_info.access_class_range = P_connection_access_class_range; action = AS_AUDIT_CHANNEL_DIALIN; if ^grant_sw then action = -action; call as_access_audit_$channel (null, utep, target_utep, action, addr(channel_audit_info), reason); end Audit_dialin; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Log_Error: Report errors via sys_log_$general. */ /* */ /* Syntax: call Log_Error (code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Log_Error: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_code_msg; sl_info.arg_list_ptr = cu_$arg_list_ptr (); sl_info.severity = SL_LOG_BEEP; sl_info.caller = ME; call sys_log_$general (addr (sl_info)); return; end Log_Error; /* format: off */ %page; %include absentee_user_table; %page; %include access_audit_bin_header; %page; %include answer_table; %page; %include as_data_; %page; %include as_audit_structures; %page; %include daemon_user_table; %page; %include dialup_values; %page; %include pnt_entry; dcl 1 pnte structure aligned like pnt_entry; %page; %include sat; dcl satep ptr; dcl satp ptr; %page; %include sys_log_constants; %page; %include user_attributes; %page; %include user_table_entry; %page; %include user_table_header; end uc_dial_;  uc_list_disconnected_procs_.pl1 07/13/88 1113.4r w 07/13/88 0938.2 73593 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-27,Swenson), approve(87-07-13,MCR7737), audit(87-05-16,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-04-27,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1 3) change(87-05-16,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Add cleanup handler. B) Convert to sys_log_$general. 4) change(87-05-20,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Correct problem which damaged ute.ute_index. 5) change(87-07-29,GDixon), approve(87-07-29,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Correctly handle case where number of disconnected processes exceeds user.n_disconnected. END HISTORY COMMENTS */ /* format: style4,indattr */ uc_list_disconnected_procs_: procedure (P_utep, P_area_ptr, P_uc_disconnected_process_list_ptr); /* Parameters */ dcl P_utep ptr parameter; dcl P_area_ptr ptr parameter; dcl P_uc_disconnected_process_list_ptr ptr parameter; /* Automatic */ dcl area_ptr ptr automatic; dcl code fixed bin (35) automatic; dcl processes_found fixed bin automatic; dcl temp_list ptr automatic; dcl temp_utep ptr automatic; dcl ute_index fixed bin; /* Based */ dcl system_area area based (area_ptr); /* Entries */ dcl get_system_free_area_ entry () returns (ptr); /* External */ dcl error_table_$null_info_ptr fixed bin (35) ext static; /* Constant */ dcl ME char (27) initial ("uc_list_disconnected_procs_") internal static options (constant); /* Builtins */ dcl (addr, null) builtin; /* Conditions */ dcl cleanup condition; %page; /* Program */ utep = P_utep; area_ptr = P_area_ptr; uc_disconnected_process_list_ptr = null (); code = 0; if utep = null () then call Abort (error_table_$null_info_ptr, "Pointer to UTE is null."); pdtep = ute.pdtep; if pdtep = null () then call Abort (-1, "Null PDT entry pointer for ^a.^a ^a.", ute.person, ute.project, ute.tty_name); /**** If the user has no disconnected processes, save ourselves a lot of work and time by just returning a null pointer to the disconnected process list information. */ if user.n_disconnected = 0 then goto RETURN; if area_ptr = null () then area_ptr = get_system_free_area_ (); temp_list = null; on cleanup begin; if temp_list ^= null & temp_list ^= uc_disconnected_process_list_ptr then free temp_list -> uc_disconnected_process_list in (system_area); if uc_disconnected_process_list_ptr ^= null then free uc_disconnected_process_list in (system_area); end; uc_n_disconnected_processes = user.n_disconnected; allocate uc_disconnected_process_list in (system_area); uc_disconnected_process_list.version = UC_DISCONNECTED_PROCESS_LIST_VERSION_1; uc_disconnected_process_list.n_disconnected_processes = uc_n_disconnected_processes; ansp = as_data_$ansp; processes_found = 0; do ute_index = 1 to anstbl.current_size; temp_utep = addr (anstbl.entry (ute_index)); if temp_utep -> ute.active > NOW_LOGGED_IN & temp_utep ^= utep & temp_utep -> ute.anonymous = 0 & temp_utep -> ute.person = ute.person & temp_utep -> ute.project = ute.project & temp_utep -> ute.disconnected then do; processes_found = processes_found + 1; /* count */ if processes_found > uc_disconnected_process_list.n_disconnected_processes then do; uc_n_disconnected_processes = processes_found; allocate uc_disconnected_process_list in (system_area) set (temp_list); temp_list -> uc_disconnected_process_list.n_disconnected_processes = uc_disconnected_process_list.n_disconnected_processes; temp_list -> uc_disconnected_process_list = uc_disconnected_process_list; free uc_disconnected_process_list in (system_area); uc_disconnected_process_list_ptr = temp_list; temp_list = null; uc_disconnected_process_list.n_disconnected_processes = processes_found; end; uc_disconnected_process_list.process (processes_found).utep = temp_utep; end; end; if processes_found ^= user.n_disconnected then do; call Error_No_Abort ( "Disconnected process count = ^d; PDT entry = ^d.", processes_found, user.n_disconnected); end; RETURN: P_uc_disconnected_process_list_ptr = uc_disconnected_process_list_ptr; return; ABORT_RETURN: if uc_disconnected_process_list_ptr ^= null () then do; free uc_disconnected_process_list in (system_area); uc_disconnected_process_list_ptr = null (); end; goto RETURN; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: Stop disconnected process list operation by emitting an */ /* explanatory as log message, and returning nonzero code to our caller. */ /* */ /* Syntax: call Abort (code, ioa_ctl, args); */ /* */ /* */ /* Error_No_Abort: Add error message to as log, but do not stop */ /* the list operation. */ /* */ /* Syntax: call Error_No_Abort (ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_code_msg; sl_info.arg_list_ptr = cu_$arg_list_ptr (); sl_info.severity = SL_LOG_SILENT; sl_info.caller = ME; call sys_log_$general (addr (sl_info)); code = sl_info.code; go to ABORT_RETURN; Error_No_Abort: entry options (variable); sl_info = sl_info_msg; sl_info.arg_list_ptr = cu_$arg_list_ptr (); sl_info.severity = SL_LOG_SILENT; sl_info.caller = ME; call sys_log_$general (addr (sl_info)); return; end Abort; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* format: off */ %page; %include answer_table; %page; %include as_data_; %page; %include dialup_values; %page; %include pdt; dcl pdtp ptr automatic init (null); /* pdt needs it. */ %page; %include sys_log_constants; %page; %include uc_disc_proc_list; %page; %include user_attributes; %page; %include user_table_entry; %page; %include user_table_header; end uc_list_disconnected_procs_;  uc_login_.pl1 07/13/88 1113.4r w 07/13/88 0938.2 384714 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-19,Swenson), approve(87-07-13,MCR7737), audit(87-04-24,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-04-21,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) For notification of other processes for this personid, require that a process exist, not just that user be logged in. B) Changed DETERMINE_AUTHORIZATIONS to use convert_access_class_$(minimum and maximum) instead of aim_check_$greater to find the minimum range of authorizations between the SAT, PDT and PNT. C) Corrected to properly enforce password expiration interval. D) Removed references to ute.uflags.logged_in. E) Make all decisions on which internal procs to run in Setup, rather than making some there and some in the main procedure. F) Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1 3) change(87-05-12,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Don't send login notifications to disconnected or UFT processes. Neither can receive the message or act upon an invalid login. (dsa 119) B) Don't send bad password information to UFT processes, since they cannot pass it along to the user (there is no user at the terminal). 4) change(87-05-14,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Replace use of uc_validate_info.channel_info.line_type with ute.line_type. B) Correct person_id (= anonymous) in group_id of anonymous users. END HISTORY COMMENTS */ /* format: style4,indattr */ uc_login_: procedure (P_uc_validate_info_ptr, P_utep, P_code); /* Parameters */ dcl P_uc_validate_info_ptr ptr parameter; dcl P_utep ptr parameter; dcl P_code fixed bin (35) parameter; /* Automatic */ dcl authorization (3) bit (72) aligned; dcl auth_string char (200); dcl auth_string_octal char (32); dcl code fixed bin (35) automatic; dcl 1 flags structure aligned automatic, 2 anonymous bit (1) unaligned, 2 check_password bit (1) unaligned, 2 check_physical_security_breach bit (1) unaligned, 2 check_change_arguments bit (1) unaligned, 2 check_authorization_argument bit (1) unaligned, 2 check_daemon_access bit (1) unaligned, 2 check_channel_access bit (1) unaligned, 2 check_channel_access_class bit (1) unaligned, 2 check_anonymous_password bit (1) unaligned, 2 pad1 bit (27) unaligned; dcl htp ptr; dcl ip ptr automatic; dcl maybe_update_pnte bit (1) aligned automatic; dcl pdtep ptr automatic; dcl pdtp ptr automatic; dcl 1 pnte structure aligned like pnt_entry; dcl 1 old_pnte structure aligned like pnt_entry; dcl satep ptr automatic; dcl satp ptr automatic; dcl whoptr ptr automatic; /* Entries */ dcl aim_check_$greater_or_equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl aim_check_$in_range entry (bit (72) aligned, (2) bit (72) aligned) returns (bit (1) aligned); dcl as_access_audit_$login entry (ptr, char (*)); dcl asu_$blast_user entry (ptr, char (*), char (*), fixed bin (35)); dcl convert_access_class_$maximum entry ((*) bit (72) aligned, fixed bin, bit (72) aligned); dcl convert_access_class_$minimum entry ((*) bit (72) aligned, fixed bin, bit (72) aligned); dcl convert_access_class_$to_string_short entry (bit (72) aligned, char (*), fixed bin (35)); dcl convert_access_class_$to_string_range_short entry ((2) bit (72) aligned, char (*), fixed bin (35)); dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned); dcl display_access_class_ entry (bit (72) aligned) returns (char (32) aligned); dcl display_access_class_$range entry ((2) bit (72) aligned) returns (char (32) aligned); dcl hash_$search entry (ptr, char (*), fixed bin (35), fixed bin (35)); dcl hcs_$get_user_access_modes entry (char (*), char (*), char (*), fixed bin, bit (36) aligned, bit (36) aligned, fixed bin (35)); dcl initiate_file_ entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35)); dcl ioa_$rs entry () options (variable); dcl ioa_$rsnnl entry () options (variable); dcl mail_table_initializer_$set_dft_proj entry (char (*), char (*), fixed bin (35)); dcl mc_check_access_$log_in_as_daemon entry (char (*), char (*), fixed bin (35)); dcl merge_access_audit_flags_ entry (bit (36) aligned, bit (36) aligned) returns (bit (36) aligned); dcl pnt_manager_$admin_get_entry entry (char (*), ptr, fixed bin (35)); dcl pnt_manager_$login_get_entry entry (char (*), char (*), ptr, fixed bin (35)); dcl pnt_manager_$update_entry entry (ptr, bit (1) aligned, bit (1) aligned, fixed bin (35)); dcl scramble_ entry (char (8)) returns (char (8)); dcl ttt_info_$decode_type entry (fixed bin, char (*), fixed bin (35)); dcl ttt_info_$encode_type entry (char (*), fixed bin, fixed bin (35)); dcl up_sat_$make_sat_hash entry (ptr, fixed bin, ptr, char (*), fixed bin (35)); /* External */ dcl (as_error_table_$already_in_notify_msg, as_error_table_$bad_anon_pw, as_error_table_$bad_password, as_error_table_$bad_personid, as_error_table_$bad_project, as_error_table_$breach, as_error_table_$breach_msg, as_error_table_$cant_give_dft_auth, as_error_table_$cant_give_that_authorization, as_error_table_$dialup_error, as_error_table_$must_change, as_error_table_$must_use_generate_pw, as_error_table_$no_change, as_error_table_$no_line_permission, as_error_table_$not_in_pdt, as_error_table_$operator_not_allowed, as_error_table_$password_expired, as_error_table_$password_locked, as_error_table_$password_probe_mail_msg, as_error_table_$password_probe1_mail_msg, as_error_table_$password_trap, as_error_table_$pdt_missing, as_error_table_$person_auth_msg, as_error_table_$terminal_auth_msg, as_error_table_$too_many_bad_pw) fixed bin (35) ext static; dcl (error_table_$bad_arg, error_table_$bad_password, error_table_$id_not_found, error_table_$messages_off, error_table_$smallarg, error_table_$wakeup_denied) fixed bin (35) ext static; /* Constant */ dcl ALLOW_RETRY bit (1) aligned initial ("1"b) internal static options (constant); dcl FALSE bit (1) aligned initial ("0"b) internal static options (constant); dcl ME char (9) initial ("uc_login_") internal static options (constant); dcl SYSTEM_LOW bit (72) aligned initial (""b) internal static options (constant); dcl TRUE bit (1) aligned initial ("1"b) internal static options (constant); dcl USECS_PER_DAY fixed bin (71) initial (86400000000) internal static options (constant); /* Builtin */ dcl (addr, addrel, clock, length, mod, null, rtrim, string, substr, unspec) builtin; /* Conditions */ dcl seg_fault_error condition; %page; /* Program */ /**** TBS: Fault Handler */ call Setup (); call Validate_Personid (); if flags.check_password then call Check_Password_Flags (); if flags.check_physical_security_breach then call Check_Physical_Security_Breach (); if flags.check_change_arguments then call Process_Change_Arguments (); if flags.check_authorization_argument then call Check_Authorization_Argument (); call Validate_Projectid (); if flags.check_anonymous_password then call Check_Anonymous_Password (); if flags.check_daemon_access then call Check_Daemon_Access (); if flags.check_channel_access then call Check_Channel_Access (); call Process_Attributes (); call Check_Access_Authorization (); if flags.check_channel_access_class then call Check_Channel_Access_Class (); call Login (); RETURN: P_code = code; if maybe_update_pnte then if unspec (old_pnte) ^= unspec (pnte) then call Update_Pnte (); return; %page; Setup: procedure (); uc_validate_info_ptr = P_uc_validate_info_ptr; utep = P_utep; code = 0; ansp = as_data_$ansp; ip = as_data_$rs_ptrs (0); satp = as_data_$satp; whoptr = as_data_$whoptr; anstbl.current_time = clock (); unspec (flags) = ""b; if ute.process_type = PT_INTERACTIVE then do; flags.check_password = TRUE; flags.check_physical_security_breach = TRUE; flags.check_change_arguments = TRUE; flags.check_authorization_argument = TRUE; flags.check_daemon_access = FALSE; flags.check_channel_access = TRUE; flags.check_channel_access_class = TRUE; end; else if ute.process_type = PT_ABSENTEE then do; flags.check_password = FALSE; flags.check_physical_security_breach = FALSE; flags.check_change_arguments = FALSE; flags.check_authorization_argument = FALSE; flags.check_daemon_access = FALSE; flags.check_channel_access = FALSE; flags.check_channel_access_class = FALSE; end; else if ute.process_type = PT_DAEMON then do; flags.check_password = FALSE; flags.check_physical_security_breach = FALSE; flags.check_change_arguments = TRUE; flags.check_authorization_argument = TRUE; flags.check_daemon_access = TRUE; flags.check_channel_access = FALSE; flags.check_channel_access_class = FALSE; end; else call Abort (error_table_$bad_arg, ^ALLOW_RETRY); if ^uc_validate_info.flags.check_channel_access then flags.check_channel_access = FALSE; if ute.anonymous = 1 then do; flags.anonymous = TRUE; flags.check_password = FALSE; flags.check_anonymous_password = uc_validate_info.flags.check_anonymous_password; flags.check_change_arguments = FALSE; end; else flags.anonymous = FALSE; anstbl.session_uid_counter = anstbl.session_uid_counter + 1; ute.session_uid = anstbl.session_uid_counter; maybe_update_pnte = FALSE; return; end Setup; %page; Validate_Personid: procedure (); dcl password char (32) automatic; if ute.person = "" then call Abort (as_error_table_$bad_personid, ALLOW_RETRY); if flags.anonymous then if ute.project = "" then do; ute.project = ute.person; return; end; if flags.check_password then do; if ute.login_flags.cpw then password = ute.old_password; else password = uc_validate_info.password; unspec (pnte) = ""b; call pnt_manager_$login_get_entry (ute.person, password, addr (pnte), code); end; else call pnt_manager_$admin_get_entry (ute.person, addr (pnte), code); if code = error_table_$id_not_found then call Abort (as_error_table_$bad_personid, ALLOW_RETRY); else if code ^= error_table_$bad_password & code ^= 0 then do; call Log_Error_with_Code (SL_LOG_BEEP, code, "Reading PNT entry for ^a.", ute.person); call Abort (as_error_table_$dialup_error, ^ALLOW_RETRY); end; /* If we get here, we were able to read the PNT entry. The password, however, may still have been incorrect. */ old_pnte = pnte; maybe_update_pnte = TRUE; ute.person = substr (pnte.user_id, 1, length (ute.person)); if ute.project = "" then ute.project = pnte.default_project; if code = error_table_$bad_password then do; call Bad_Password (); call Abort (as_error_table_$bad_password, ALLOW_RETRY); end; /**** Check to see if user is login in as an operator. Validate his authorization to do so. */ if ute.login_flags.operator then if ^pnte.flags.operator then call Abort (as_error_table_$operator_not_allowed, ALLOW_RETRY); /**** Personid is validated */ return; %page; Bad_Password: procedure (); dcl mail_for_user char (128) automatic; dcl message char (256) automatic; pnte.n_bad_pw = pnte.n_bad_pw + 1; pnte.n_bad_pw_since_good = pnte.n_bad_pw_since_good + 1; pnte.time_last_bad_pw = anstbl.current_time; pnte.last_bad_pw_reported = FALSE; pnte.bad_pw_term_id = ute.tty_id_code; pnte.bad_pw_term_type = ute.terminal_type; pnte.bad_pw_line_type = ute.line_type; if pnte.n_bad_pw_since_good = 1 then message = Convert_Message (as_error_table_$password_probe1_mail_msg); else message = Convert_Message (as_error_table_$password_probe_mail_msg); if message ^= "" then do; if pnte.n_bad_pw_since_good = 1 then call ioa_$rs (message, mail_for_user, (0), ute.person, ute.terminal_type, ute.tty_id_code); else call ioa_$rs (message, mail_for_user, (0), ute.person, pnte.n_bad_pw_since_good, ute.terminal_type, ute.tty_id_code); call Send_User_Mail (ute.person, ute.project, mail_for_user, pnte.default_person_authorization, code); if (code ^= 0) & (code ^= error_table_$wakeup_denied) & (code ^= error_table_$messages_off) then do; call Send_User_Mail (ute.person, (pnte.default_project), mail_for_user, pnte.default_person_authorization, code); if code = 0 then pnte.flags.last_bad_pw_reported = "1"b; end; else pnte.flags.last_bad_pw_reported = "1"b; end; if mod (pnte.n_bad_pw_since_good, installation_parms.login_tries) = 0 then do; call Log_Coded_Error (SL_LOG_BEEP, as_error_table_$too_many_bad_pw, ute.person, ute.project, ute.tty_name, ute.terminal_type, ute.tty_id_code); end; return; end Bad_Password; end Validate_Personid; %page; Check_Password_Flags: procedure (); if ute.login_flags.cpw & ^ute.login_flags.generate_pw & pnte.flags.generate_pw then call Abort (as_error_table_$must_use_generate_pw, ALLOW_RETRY); if installation_parms.password_expiration_interval ^= 0 then if ((anstbl.current_time - pnte.time_last_good_pw) > (installation_parms.password_expiration_interval * USECS_PER_DAY)) & ((anstbl.current_time - pnte.user_validated_time) > (installation_parms.password_expiration_interval * USECS_PER_DAY)) then do; uc_validate_info.password_unused_too_long = TRUE; uc_validate_info.password_interval = installation_parms.password_expiration_interval; call Abort (as_error_table_$password_expired, ^ALLOW_RETRY); end; if ^ute.login_flags.cpw then do; if pnte.flags.must_change then do; if ^pnte.flags.generate_pw then call Abort (as_error_table_$must_change, ALLOW_RETRY); else call Abort (as_error_table_$must_use_generate_pw, ALLOW_RETRY); end; if installation_parms.password_change_interval ^= 0 then if (anstbl.current_time - pnte.time_pw_changed) > (installation_parms.password_change_interval * USECS_PER_DAY) then do; uc_validate_info.password_expired = TRUE; uc_validate_info.password_interval = installation_parms.password_change_interval; if ^pnte.flags.generate_pw then call Abort (as_error_table_$must_change, ALLOW_RETRY); else call Abort (as_error_table_$must_use_generate_pw, ALLOW_RETRY); end; end; pnte.n_good_pw = pnte.n_good_pw + 1; pnte.time_last_good_pw = anstbl.current_time; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* We used to check pnte.flags.last_bad_pw_reported here to decide whether */ /* to print the message "Your password was ..." on the terminal upon login. */ /* Since it is possible (and likely) that the user logging in will have */ /* never seen the mail sent telling him that his password was used */ /* incorrectly, we remove that check and force the message on his terminal. */ /* The theory is that if there really is someone trying to guess a password, */ /* and he does manage to succeed and get in, he will most likely delete any */ /* mail telling the REAL user that someone was hacking. */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ if pnte.n_bad_pw_since_good > 0 & ute.tag ^= TAG_UFT then /* UFT processes cannot send msgs to user */ do; uc_validate_info.last_bad_pw_info.time = pnte.time_last_bad_pw; uc_validate_info.last_bad_pw_info.number = pnte.n_bad_pw_since_good; uc_validate_info.last_bad_pw_info.terminal_type = pnte.bad_pw_term_type; uc_validate_info.last_bad_pw_info.terminal_id = pnte.bad_pw_term_id; uc_validate_info.last_bad_pw_info.line_type = pnte.bad_pw_line_type; pnte.last_bad_pw_reported = "1"b; end; else do; /* better than returning garbage */ uc_validate_info.last_bad_pw_info.time = 0; uc_validate_info.last_bad_pw_info.number = 0; uc_validate_info.last_bad_pw_info.terminal_type = ""; uc_validate_info.last_bad_pw_info.terminal_id = ""; uc_validate_info.last_bad_pw_info.line_type = 0; end; if pnte.last_bad_pw_reported then pnte.n_bad_pw_since_good = 0; if pnte.flags.trap then do; call Log_Coded_Error (SL_LOG_BEEP, as_error_table_$password_trap, ute.person, ute.project, ute.tty_name, ute.terminal_type, ute.tty_id_code); end; if (pnte.flags.pw_time_lock & anstbl.current_time < pnte.password_timelock) | pnte.flags.lock then call Abort (as_error_table_$password_locked, ^ALLOW_RETRY); if ute.login_flags.cpw then if pnte.flags.nochange then call Abort (as_error_table_$no_change, ALLOW_RETRY); else do; pnte.password = uc_validate_info.password; pnte.time_pw_changed = anstbl.current_time; pnte.flags.must_change = FALSE; uc_validate_info.changed_password = TRUE; end; return; end Check_Password_Flags; %page; Check_Physical_Security_Breach: procedure (); dcl maximum_authorization bit (72) aligned automatic; if flags.anonymous then maximum_authorization = SYSTEM_LOW; else maximum_authorization = pnte.person_authorization (2); if ^aim_check_$greater_or_equal (maximum_authorization, uc_validate_info.channel_info.access_class_range (1)) then do; call Log_Coded_Error (SL_LOG_BEEP, as_error_table_$breach_msg, ute.person, ute.project, ute.tty_name, ute.terminal_type, ute.tty_id_code); auth_string_octal = display_access_class_ (maximum_authorization); call convert_access_class_$to_string_short ( maximum_authorization, auth_string, code); if code ^= 0 then if code = error_table_$smallarg then code = 0; else auth_string = ""; call Log_Coded_Error (SL_LOG, as_error_table_$person_auth_msg, auth_string_octal, auth_string); auth_string_octal = display_access_class_$range ( uc_validate_info.channel_info.access_class_range); call convert_access_class_$to_string_range_short ( uc_validate_info.channel_info.access_class_range, auth_string, code); if code ^= 0 then if code = error_table_$smallarg then code = 0; else auth_string = ""; call Log_Coded_Error (SL_LOG, as_error_table_$terminal_auth_msg, auth_string_octal, auth_string); call Abort (as_error_table_$breach, ^ALLOW_RETRY); end; return; end Check_Physical_Security_Breach; %page; Process_Change_Arguments: procedure (); if ute.login_flags.cdp then if ^pnte.flags.nochange then do; pnte.default_project = substr (ute.project, 1, length (pnte.default_project)); uc_validate_info.changed_default_project = TRUE; end; else call Abort (as_error_table_$no_change, ALLOW_RETRY); if ute.login_flags.cda then if ^pnte.flags.nochange then do; pnte.default_person_authorization = ute.process_authorization; uc_validate_info.default_authorization_changed = TRUE; end; else call Abort (as_error_table_$no_change, ALLOW_RETRY); if uc_validate_info.changed_default_project then do; call mail_table_initializer_$set_dft_proj (rtrim (pnte.user_id), rtrim (pnte.default_project), code); if code ^= 0 then call Log_Error_with_Code (SL_LOG_BEEP, code, "Changing Mail Table default project for ^a to ^a", pnte.user_id, pnte.default_project); end; return; end Process_Change_Arguments; %page; Check_Authorization_Argument: procedure (); if ^ute.login_flags.auth_given then if flags.anonymous then ute.process_authorization = SYSTEM_LOW; else ute.process_authorization = pnte.default_person_authorization; return; end Check_Authorization_Argument; %page; Validate_Projectid: procedure (); dcl ans char (64) automatic; dcl i fixed bin (35) automatic; dcl pdt_entryname char (32) automatic; dcl pdt_htp ptr automatic; dcl temp_person_name char (32) automatic; lookup_loop: call hash_$search (as_data_$sat_htp, ute.project, i, code); if code ^= 0 then call Abort (as_error_table_$bad_project, ALLOW_RETRY); satep = addr (sat.project (i)); if ute.project ^= project.project_id then if ute.project ^= project.alias then do; call Log_Error_with_Code (SL_LOG_SILENT, -1, "sat.ht has ""^a"", SAT has ""^a"" at ^p", ute.project, project.project_id, satep); call up_sat_$make_sat_hash (satp, sat.n_projects, as_data_$sat_htp, ans, code); if code ^= 0 then do; call Log_Error_with_Code (SL_LOG, code, "Unable to rehash sat.ht: ^a", ans); call Abort (as_error_table_$dialup_error, ^ALLOW_RETRY); end; else goto lookup_loop; /* go try the lookup again */ end; if project.state ^= 1 then do; call Log_Error_with_Code (SL_LOG_SILENT, -1, "Project ^a, state ^d, still in sat.ht", project.project_id, project.state); call Abort (as_error_table_$bad_project, ALLOW_RETRY); end; ute.project = project.project_id; /* in case alias */ /* was used. */ if project.pdt_ptr ^= null () then pdtp = project.pdt_ptr; else do; pdt_entryname = rtrim (project.project_id) || ".pdt"; call initiate_file_ (as_data_$pdtdir, pdt_entryname, RW_ACCESS, pdtp, (0), code); if code ^= 0 then do; call Log_Error_with_Code (SL_LOG_SILENT, code, "^a>^a", as_data_$pdtdir, project.project_id); call Abort (as_error_table_$pdt_missing, ALLOW_RETRY); end; project.pdt_ptr = pdtp; end; if project.rs_number < 0 | project.rs_number > whotab.n_rate_structures then do; call Log_Error_with_Code (SL_LOG_BEEP, -1, "Project ^a has invalid rate_structure number ^d. Using rate_structure 0.", project.project_id, project.rs_number); ute.rs_number = 0; end; else ute.rs_number = project.rs_number; temp_person_name = ute.person; if flags.anonymous then if ^project.at.anonymous then call Abort (as_error_table_$not_in_pdt, ALLOW_RETRY); else temp_person_name = "*"; pdtep = null (); on seg_fault_error begin; call Log_Error_with_Code (SL_LOG_BEEP, -1, "PDT for project ^a has its damage switch set. Login for user ^a refused.", ute.project, ute.person); call Abort (as_error_table_$dialup_error, ^ALLOW_RETRY); end; i = pdt.ht_relp; revert seg_fault_error; if pdt.ht_relp > 0 then do; pdt_htp = addrel (pdtp, pdt.ht_relp); if pdt_htp -> htable.id ^= "ht01" & pdt_htp -> htable.id ^= "ht02" then do; call Log_Error_with_Code (SL_LOG_BEEP, -1, "No hash table at ^o of ^a.pdt", pdt.ht_relp, project.project_id); end; else do; call hash_$search (pdt_htp, temp_person_name, i, code); if code ^= 0 then call Abort (as_error_table_$not_in_pdt, ALLOW_RETRY); pdtep = addr (pdt.user (i)); if user.state ^= 1 then do; call Log_Error_with_Code (SL_LOG_BEEP, -1, "User ^a, state ^d, still in hash table of ^a.pdt", temp_person_name, user.state, project.project_id); call Abort (as_error_table_$not_in_pdt, ALLOW_RETRY); end; if user.person_id ^= temp_person_name then do; call Log_Error_with_Code (SL_LOG_BEEP, -1, "Hash table of ^a.pdt has ^a, pdt has ^a, at ^p", project.project_id, temp_person_name, user.person_id, pdtep); pdtep = null (); end; end; end; if pdtep = null then do i = 1 to pdt.current_size while (pdtep = null ()); pdtep = addr (pdt.user (i)); if user.state = 1 then do; if user.person_id ^= temp_person_name then pdtep = null (); end; else pdtep = null (); end; if pdtep = null () then call Abort (as_error_table_$not_in_pdt, ALLOW_RETRY); ute.pdtep = pdtep; ute.uprojp = satep; return; end Validate_Projectid; %page; Check_Anonymous_Password: procedure (); if user.password ^= "" then if scramble_ ((user.password)) ^= uc_validate_info.password then call Abort (as_error_table_$bad_anon_pw, ALLOW_RETRY); return; end Check_Anonymous_Password; %page; Check_Daemon_Access: procedure (); dcl group_id char (32) automatic; call ioa_$rsnnl ("^a.^a.z", group_id, (0), ute.person, ute.project); call mc_check_access_$log_in_as_daemon (group_id, ute.tty_name, code); if code ^= 0 then call Abort (code, ^ALLOW_RETRY); return; end Check_Daemon_Access; %page; Check_Channel_Access: procedure (); dcl group_id char (32) automatic; dcl mode bit (36) aligned automatic; dcl type char (8) automatic; if ute.login_flags.dial_pw then type = "dial"; else if ute.login_flags.slave_pw then type = "slave"; else type = "login"; call ioa_$rsnnl ("^[anonymous^s^;^a^].^a.^a", group_id, (0), (ute.anonymous = 1), ute.person, ute.project, ute.tag); call hcs_$get_user_access_modes (as_data_$rcpdir, rtrim (ute.tty_name) || ".acs", group_id, 0, mode, (""b), code); if code ^= 0 then do; call Log_Error_with_Code (SL_LOG, code, "Unable to check access for channel ^a.", ute.tty_name); mode = ""b; end; if (mode & RW_ACCESS) ^= RW_ACCESS then call Abort (as_error_table_$no_line_permission, ^ALLOW_RETRY); return; end Check_Channel_Access; %page; Process_Attributes: procedure (); dcl bstemp bit (36) aligned automatic; /**** Don't let user set attributes disallowed by SAT or PDT */ string (ute.ur_at) = string (ute.ur_at) & ((string (user.at) & string (project.at)) | USER_ATTRIBUTES_always_allowed); /**** Turn on attributes which user cannot set. */ string (ute.at) = string (ute.at) | ^USER_ATTRIBUTES_settable_by_user; /**** Turn on defaults for attributes user didn't specify. */ string (ute.at) = string (ute.at) | (string (user.at) & USER_ATTRIBUTES_default_in_pdt & ^string (ute.ur_at)); /**** Turn off attributes denied by SAT or PDT */ string (ute.at) = string (ute.at) & ((string (user.at) & string (project.at)) | USER_ATTRIBUTES_always_allowed); /**** Remember attributes set by user. */ bstemp = string (ute.at) & (string (ute.ur_at) | USER_ATTRIBUTES_settable_by_user); /**** Turn off attributes user is allowed to set. */ string (ute.at) = string (ute.at) & ^USER_ATTRIBUTES_settable_by_user; /**** Set user-settable attributes according to user wishes. */ string (ute.at) = string (ute.at) | bstemp; if ute.at.guaranteed_login then ute.at.nobump = "1"b; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* The process-saving attributes, disconnect_ok and save_on_disconnect, need */ /* special handling. After the above logic, each is on in ute.at only if it */ /* was on in both SAT and PDT. */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /**** First we force both on if both were on in SAT. */ if project.at.save_on_disconnect & project.at.disconnect_ok then ute.at.save_on_disconnect, ute.at.disconnect_ok = "1"b; /**** Then turn on save_on_disconnect if on in PDT, even if off in SAT */ if user.at.save_on_disconnect then ute.at.save_on_disconnect = "1"b; /**** Process saving is impossible for anonymous users. */ if flags.anonymous then ute.at.save_on_disconnect, ute.at.disconnect_ok = ""b; end Process_Attributes; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Here we determine the user process authorization and maximum */ /* authorization. We also set the audit flags. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Check_Access_Authorization: procedure (); /**** Currently, we only allow anonymous users to log in at system_low authorization. To lift this restriction, all that is necessary is to delete the following statement. */ if flags.anonymous then ute.process_authorization = SYSTEM_LOW; ute.process_authorization_range (*) = ""b; /**** Set the process minimum authorization to the maximum of the following */ authorization (1) = user.user_authorization (1); authorization (2) = project.project_authorization (1); if ute.anonymous = 1 then /* anonymous have no pnte */ authorization (3) = project.project_authorization (1); else authorization (3) = pnte.person_authorization (1); call convert_access_class_$maximum (authorization, 3, ute.process_authorization_range (1)); /**** Set the process maximum authorization to the minimum of the following */ authorization (1) = user.user_authorization (2); authorization (2) = project.project_authorization (2); if ute.anonymous = 1 then /* anonymous have no pnte */ authorization (3) = project.project_authorization (2); else authorization (3) = pnte.person_authorization (2); call convert_access_class_$minimum (authorization, 3, ute.process_authorization_range (2)); /**** Merge the audit flags from the SAT and the PNT. If the user is anonymous, there is no PNT entry se we set the ute.audit to the SAT value. */ if flags.anonymous then ute.audit = project.audit; else ute.audit = merge_access_audit_flags_ (project.audit, pnte.audit); /**** Compare the requested or default authorization with the computed authorization range and reject the login if this authorization is outside the allowed range. */ if ^aim_check_$in_range (ute.process_authorization, ute.process_authorization_range) then do; if ute.login_flags.auth_given | ute.process_type = PT_ABSENTEE then call Abort (as_error_table_$cant_give_that_authorization, ALLOW_RETRY); else call Abort (as_error_table_$cant_give_dft_auth, ALLOW_RETRY); end; end Check_Access_Authorization; %page; Check_Channel_Access_Class: procedure (); if ^aim_check_$in_range (ute.process_authorization, uc_validate_info.channel_info.access_class_range) then do; if ute.login_flags.auth_given | ute.process_type = PT_ABSENTEE then call Abort (as_error_table_$cant_give_that_authorization, ALLOW_RETRY); else call Abort (as_error_table_$cant_give_dft_auth, ALLOW_RETRY); end; end Check_Channel_Access_Class; %page; Login: procedure (); dcl temp_code fixed bin (35) automatic; dcl temp_coded_type fixed bin automatic; dcl temp_terminal_type char (32) automatic; ute.login_result = 0; ute.active = NOW_LOGGED_IN; ute.login_time = anstbl.current_time; call as_access_audit_$login (utep, ""); if ^flags.anonymous then do; /**** Tell caller about last login info */ uc_validate_info.last_login_info.time = user.last_login_time; if user.last_login_type = 0 then /* no such thing, old type */ temp_coded_type = user.last_login_line_type; else temp_coded_type = user.last_login_type; call ttt_info_$decode_type (temp_coded_type, temp_terminal_type, code) ; if code ^= 0 then temp_terminal_type = "UNKNOWN"; uc_validate_info.last_login_info.terminal_type = temp_terminal_type; uc_validate_info.last_login_info.terminal_id = user.last_login_unit; uc_validate_info.last_login_info.line_type = user.last_login_line_type; /**** Update last login info for next time */ user.last_login_time = anstbl.current_time; user.last_login_unit = ute.tty_id_code; call ttt_info_$encode_type (ute.terminal_type, temp_coded_type, temp_code); user.last_login_type = temp_coded_type; if temp_code ^= 0 then user.last_login_type = 0; user.last_login_line_type = ute.line_type; /**** Tell caller about number of disconnected processes. */ uc_validate_info.number_disconnected_processes = user.n_disconnected; end; /**** Update the who table */ call Update_Whotable (); /**** Notify other login instances of this login */ call Notify_Other_Instances (); code = 0; return; %page; Notify_Other_Instances: procedure (); dcl code fixed bin (35) automatic; dcl i fixed bin automatic; dcl mail_for_user char (256); dcl notified_instance bit (1) aligned automatic; dcl temp_lth fixed bin (21) automatic; dcl temp_string char (100) automatic; dcl temp_utep ptr automatic; notified_instance = FALSE; do i = 1 to anstbl.current_size while (^notified_instance); temp_utep = addr (anstbl.entry (i)); if temp_utep ^= utep & temp_utep -> ute.active >= NOW_HAS_PROCESS & temp_utep -> ute.anonymous = 0 & temp_utep -> ute.person = ute.person & ^temp_utep -> ute.disconnected & temp_utep -> ute.tag ^= TAG_UFT then do; temp_string = Convert_Message (as_error_table_$already_in_notify_msg); call ioa_$rsnnl (temp_string, mail_for_user, temp_lth, ute.person, ute.person, ute.project, ute.terminal_type, ute.tty_id_code); call Send_User_Mail (temp_utep -> ute.person, temp_utep -> ute.project, substr (mail_for_user, 1, temp_lth), ute.process_authorization, code); if code = 0 then notified_instance = TRUE; else do; call asu_$blast_user (temp_utep, mail_for_user, (""), code); if code = 0 then notified_instance = TRUE; end; end; end; return; end Notify_Other_Instances; end Login; %page; Abort: procedure (P_code, P_allow_retry); dcl P_code fixed bin (35) parameter; dcl P_allow_retry bit (1) aligned parameter; dcl status_code_string char (8) aligned automatic; code = P_code; if code ^= 0 then call convert_status_code_ (code, status_code_string, ("")); else status_code_string = ""; if P_allow_retry then ute.login_result = 2; /* allow retry */ else ute.login_result = 1; /* don't allow retry */ ute.failure_reason = 1; /* 1 = "lg_ctl_" said no */ call as_access_audit_$login (utep, (status_code_string)); goto RETURN; end Abort; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Log_Error_with_Code: log an error via sys_log_$general and continue */ /* execution. */ /* */ /* Syntax: call Log_Error_with_Code (severity, code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Log_Error_with_Code: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_sev_code_msg; sl_info.caller = ME; sl_info.arg_list_ptr = cu_$arg_list_ptr (); call sys_log_$general (addr (sl_info)); end Log_Error_with_Code; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Log_Coded_Error: log an error via sys_log_$general and continue */ /* execution. */ /* */ /* Syntax: call Log_Error_with_Code (severity, ioa_ctl_in_error_code, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Log_Coded_Error: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_sev_coded_msg; sl_info.caller = ME; sl_info.arg_list_ptr = cu_$arg_list_ptr (); call sys_log_$general (addr (sl_info)); end Log_Coded_Error; /* * * * * * * * * * * * * * * * * * * * * * * * * */ %page; Convert_Message: procedure (P_code) returns (char (100) varying); dcl P_code fixed bin (35) parameter; dcl message char (100) aligned automatic; call convert_status_code_ (P_code, (""), message); return (rtrim (message)); end Convert_Message; %page; Update_Pnte: procedure (); call pnt_manager_$update_entry (addr (pnte), (uc_validate_info.changed_password), FALSE, code); maybe_update_pnte = FALSE; if code ^= 0 then do; call Log_Error_with_Code (SL_LOG_BEEP, code, "Error updating PNT entry for ^a.", ute.person); call Abort (as_error_table_$dialup_error, ALLOW_RETRY); end; return; end Update_Pnte; %page; %page; Send_User_Mail: procedure (P_personid, P_projectid, P_message, P_access_class, P_code); dcl P_personid char (*) parameter; dcl P_projectid char (*) parameter; dcl P_message char (*) parameter; dcl P_access_class bit (72) aligned parameter; dcl P_code fixed bin (35) parameter; dcl pdt_name char (32) automatic; dcl send_mail_$access_class entry (char (*), char (*), ptr, bit (72) aligned, fixed bin (35)); unspec (send_mail_info) = ""b; send_mail_info.version = send_mail_info_version_2; send_mail_info.sent_from = "login"; send_mail_info.switches.wakeup = TRUE; send_mail_info.always_add = TRUE; call ioa_$rsnnl ("^a.^a", pdt_name, (0), P_personid, P_projectid); call send_mail_$access_class (pdt_name, rtrim (P_message), addr (send_mail_info), P_access_class, code); if (code = 0) | (code = error_table_$wakeup_denied) | (code = error_table_$messages_off) then P_code = 0; else P_code = code; return; %page; %include send_mail_info; end Send_User_Mail; %page; Update_Whotable: procedure (); /**** Publish the login in the whotab */ dcl whotab_idx fixed bin automatic; whoptr = as_data_$whoptr; whotab.n_users = whotab.n_users + 1; if ute.at.nolist then do; whotab_idx = 0; ute.whotabx = 0; end; else do; if whotab.freep = 0 then do; /* no free slots up to max */ whotab.laste = whotab.laste + 1; whotab_idx = whotab.laste - whotab.laste_adjust; end; else do; /* have a free slot */ whotab_idx = whotab.freep; whotab.freep = whotab.e (whotab_idx).chain; end; ute.whotabx = whotab_idx; if ute.anonymous = 1 then whotab.e (whotab_idx).person = "anonymous"; else whotab.e (whotab_idx).person = ute.person; whotab.e (whotab_idx).project = ute.project; whotab.e (whotab_idx).units = 0; /* filled in later */ whotab.e (whotab_idx).timeon = anstbl.current_time; whotab.e (whotab_idx).anon = ute.anonymous; whotab.e (whotab_idx).stby = 0; /* later */ whotab.e (whotab_idx).active = NOW_LOGGED_IN; whotab.e (whotab_idx).idcode = ute.tty_id_code; whotab.e (whotab_idx).group = ""; /* later */ whotab.e (whotab_idx).cant_bump_until = 0; /* later */ whotab.e (whotab_idx).proc_type = ute.process_type; whotab.e (whotab_idx).process_authorization = ute.process_authorization; whotab.e (whotab_idx).fg_abs, whotab.e (whotab_idx).disconnected, whotab.e (whotab_idx).suspended = FALSE; end; if ute.process_type = PT_DAEMON then /* daemon process */ whotab.n_daemons = whotab.n_daemons + 1; else if ute.process_type = PT_ABSENTEE then do; /* absentee process */ if ute.queue > 0 then do; /* background absentee */ whotab.abs_users = whotab.abs_users + 1; if whotab_idx > 0 then whotab.e (whotab_idx).fg_abs = FALSE; end; else do; /* foreground absentee */ whotab.fg_abs_users = whotab.fg_abs_users + 1; if whotab_idx > 0 then whotab.e (whotab_idx).fg_abs = TRUE; end; end; return; end Update_Whotable; /* format: off */ %page; %include access_mode_values; %page; %include as_data_; %page; %include answer_table; %page; %include dialup_values; %page; %include hashst; %page; %include installation_parms; %page; %include line_types; %page; %include pdt; %page; %include pnt_entry; %page; %include sat; %page; %include sys_log_constants; %page; %include uc_validate_info; %page; %include user_attributes; %page; %include user_table_entry; %page; %include user_table_header; %page; %include whotab; end uc_login_;  uc_logout_.pl1 07/13/88 1113.4r w 07/13/88 0938.2 60489 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-27,Swenson), approve(87-07-13,MCR7737), audit(87-05-18,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-04-27,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1 3) change(87-05-18,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Use sys_log_$general to report errors. B) Correct error in maintenance of whotab. 4) change(87-05-20,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): When an MNA user logs in, a UTE is created. When this user connects to an existing process, that proc's UTE is retained and the login UTE is freed; but the whotab is never updated to reflect freeing of the login UTE. A) Add uc_logout_$reconnect to do all aspects of logging out the login UTE except for auditing the LOGOUT. Instead, uc_setup_process_connect_ audits a CONNECT operation. END HISTORY COMMENTS */ /* format: style4,indattr */ uc_logout_: procedure (P_utep, P_added_info); /* Parameters */ dcl P_added_info char (*) parameter; dcl P_utep ptr parameter; /* Automatic */ dcl added_info char (32) automatic; dcl reconnect_sw bit (1); dcl satep ptr automatic; dcl whoptr ptr automatic; /* Entries */ dcl as_access_audit_$logout entry (ptr, char (*)); dcl load_ctl_$unload entry (ptr, fixed bin); dcl terminate_file_ entry (ptr, fixed bin (24), bit (*), fixed bin (35)); /* External */ dcl error_table_$action_not_performed fixed bin(35) ext static; /* Constants */ dcl (FALSE init("0"b), TRUE init("1"b)) bit(1) int static options(constant); dcl ME char(10) int static options(constant) init("uc_logout_"); /* Builtins */ dcl (addr, null) builtin; %page; /* Program */ reconnect_sw = FALSE; go to COMMON; reconnect: entry (P_utep, P_added_info); reconnect_sw = TRUE; go to COMMON; COMMON: utep = P_utep; added_info = P_added_info; call Setup (); if ute.active ^= NOW_LOGGED_IN then call Abort (error_table_$action_not_performed, "UTE (^d, ^p in ^a) not logged in (active= ^a, ^d).", ute.ute_index, utep, TABLE_NAMES(ute.process_type), ACTIVE_VALUES(ute.active), ute.active); call Update_Whotab (); /* Make sure whotab gets updated. Do it first. */ if ute.uflags.proc_create_ok then call load_ctl_$unload (utep, ute.process_type); if ute.uprojp ^= null () then do; satep = ute.uprojp; if project.n_users <= 0 then if project.project_id ^= "SysDaemon" then do; call terminate_file_ (project.pdt_ptr, 0, TERM_FILE_TERM, (0)); ute.pdtep = null (); end; end; ute.active = NOW_DIALED; if ^reconnect_sw then /* reconnect audited in uc_setup_process_connect_ */ call as_access_audit_$logout (utep, added_info); RETURN: return; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: Report errors via sys_log_$general and stop execution. */ /* */ /* Syntax: call Abort (code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_code_msg; sl_info.arg_list_ptr = cu_$arg_list_ptr (); sl_info.severity = SL_LOG_BEEP; sl_info.caller = ME; call sys_log_$general (addr (sl_info)); goto RETURN; end Abort; %page; Setup: procedure (); ansp = as_data_$ansp; return; end Setup; %page; Update_Whotab: procedure (); dcl whotab_idx fixed bin automatic; whoptr = as_data_$whoptr; whotab.n_users = whotab.n_users - 1; whotab.n_units = whotab.n_units - ute.user_weight; whotab_idx = ute.whotabx; if whotab_idx ^= 0 then do; whotab.e (whotab_idx).active = NOW_FREE; whotab.e (whotab_idx).person = ""; whotab.e (whotab_idx).project = ""; whotab.e (whotab_idx).chain = whotab.freep; /* chain free entries together */ whotab.freep = whotab_idx; /* on top of free queue */ ute.whotabx = 0; end; if ute.process_type = PT_ABSENTEE then do; if ute.queue > 0 then /* background absentee */ whotab.abs_users = whotab.abs_users - 1; else whotab.fg_abs_users = whotab.fg_abs_users - 1; end; else if ute.process_type = PT_DAEMON then whotab.n_daemons = whotab.n_daemons - 1; return; end Update_Whotab; /* format: off */ %page; %include answer_table; %page; %include as_data_; %page; %include dialup_values; %page; %include sat; dcl satp ptr automatic init (null); /* sat needs it */ %page; %include sys_log_constants; %page; %include terminate_file; %page; %include user_attributes; %page; %include user_table_entry; %page; %include user_table_header; %page; %include whotab; end uc_logout_;  uc_ls_connect_request_.pl1 08/04/87 1510.9rew 08/04/87 1510.9 29520 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-04,Swenson), approve(87-07-13,MCR7737), audit(87-05-16,GDixon), install(87-08-04,MR12.1-1055): Initially coded. 2) change(87-05-16,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Simplified code. B) Removed unreferenced declarations. C) Added pnotice. END HISTORY COMMENTS */ /* format: style4,indattr */ uc_ls_connect_request_: procedure (P_ls_request_server_info_ptr, P_ls_request_ptr, P_ls_request_lth, P_ls_response_ptr, P_ls_response_lth, P_ls_ipc_reply_ptr, P_code); /* Parameters */ dcl P_ls_request_server_info_ptr ptr parameter; dcl P_ls_request_ptr ptr parameter; dcl P_ls_request_lth fixed bin (18) parameter; dcl P_ls_response_ptr ptr parameter; dcl P_ls_response_lth fixed bin (18) parameter; dcl P_ls_ipc_reply_ptr ptr parameter; dcl P_code fixed bin (35) parameter; /* Automatic */ dcl code fixed bin (35) automatic; /* Entries */ dcl uc_setup_process_connect_ entry (ptr, ptr, fixed bin (18), ptr, fixed bin (18), ptr, ptr, fixed bin (35)); /* Constants */ dcl TRUE bit(1) int static options(constant) init("1"b); /* Builtins */ dcl null builtin; %page; /* Program */ code = 0; call uc_setup_process_connect_ (P_ls_request_server_info_ptr, P_ls_request_ptr, P_ls_request_lth, P_ls_response_ptr, P_ls_response_lth, P_ls_ipc_reply_ptr, null (), code); if code = 0 then do; ls_response_ptr = P_ls_response_ptr; login_server_process_response.flags.connected = TRUE; end; RETURN: P_code = code; return; %page; %include login_server_messages; end uc_ls_connect_request_;  uc_ls_create_request_.pl1 07/13/88 1113.4r w 07/13/88 0938.2 133677 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-04,Swenson), approve(87-07-13,MCR7737), audit(87-04-24,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-04-24,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Upgrade to use sys_log_$general for reporting errors. B) Correct setting of attributes. C) Updated for change to user_table_entry.incl.pl1. D) Correct coding standard violations. E) Updated to pass login_server_process_request.minimum_ring to uc_create_process_check_ for testing. 3) change(87-05-04,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Avoid reference to login_server_process_request.login_arguments if login_server_process_request.n_args = 0. 4) change(87-05-13,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Move act_ctl_$open_account call from here into uc_create_process_. B) Set login_server_process_response.status_code to code returned by uc_create_process_ if error occurs. Also turn of ute.uflags.proc_create_ok in such case. C) Set login_server_process_response.brief from ute.at.brief. END HISTORY COMMENTS */ /* format: style4,indattr */ uc_ls_create_request_: procedure (P_ls_request_server_info_ptr, P_ls_request_ptr, P_ls_request_lth, P_ls_response_ptr, P_ls_response_lth, P_ls_ipc_reply_ptr, P_code); /* Parameters */ dcl P_ls_request_server_info_ptr ptr parameter; dcl P_ls_request_ptr ptr parameter; dcl P_ls_request_lth fixed bin (18) parameter; dcl P_ls_response_ptr ptr parameter; dcl P_ls_response_lth fixed bin (18) parameter; dcl P_ls_ipc_reply_ptr ptr parameter; dcl P_code fixed bin (35) parameter; /* Automatic */ dcl check_code fixed bin (35) automatic; dcl code fixed bin (35) automatic; dcl reason char (8) aligned automatic; dcl temp fixed bin (17) automatic; /* Based */ dcl argstring char (ute.ln_args) based (ute.args_ptr); dcl lengths (ute.arg_count) based (ute.arg_lengths_ptr) fixed bin; dcl system_area area based (system_area_ptr); /* Entries */ dcl as_access_audit_$process entry (ptr, fixed bin, char (*)); dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned); dcl get_system_free_area_ entry () returns (ptr); dcl ioa_$rsnnl entry () options (variable); dcl uc_create_process_ entry (ptr, fixed bin (35)); dcl uc_create_process_check_ entry (ptr, ptr, fixed bin (35)); dcl user_table_mgr_$utep_from_handle entry (bit (72) aligned) returns (ptr); /* Internal */ dcl system_area_ptr ptr int static init (null); /* External */ dcl as_error_table_$already_logged_in fixed bin (35) ext static; dcl error_table_$bad_arg fixed bin (35) ext static; dcl error_table_$id_not_found fixed bin (35) ext static; /* Constant */ dcl ME char (21) initial ("uc_ls_create_request_") internal static options (constant); dcl NL char (1) int static options (constant) init (" "); dcl FALSE bit (1) aligned initial ("0"b) internal static options (constant); dcl TRUE bit (1) aligned initial ("1"b) internal static options (constant); /* Builtins */ dcl (addr, currentsize, length, null, rtrim, substr, unspec) builtin; %page; /* Program */ ls_request_server_info_ptr = P_ls_request_server_info_ptr; ls_request_ptr = P_ls_request_ptr; ls_reply_message_ptr = P_ls_ipc_reply_ptr; code = 0; utep = user_table_mgr_$utep_from_handle ( login_server_process_request.handle); if utep = null () then call Abort (SL_LOG_SILENT, error_table_$id_not_found, "Could not locate user table entry for handle ^24.3b.", login_server_process_request.handle); if ute.person ^= login_server_process_request.person_id | ute.project ^= login_server_process_request.project_id then call Abort (SL_LOG_SILENT, error_table_$bad_arg, "Person.Project in request (^a.^a) don't match ute (^a.^a).", login_server_process_request.person_id, login_server_process_request.project_id, ute.person, ute.project); if login_server_process_request.switch_flags.warn_given then do; ute.ur_at.no_warning = TRUE; ute.at.no_warning = ^login_server_process_request.switch_values.warn; end; if login_server_process_request.switch_flags.force_given then do; ute.ur_at.guaranteed_login = TRUE; ute.at.guaranteed_login = login_server_process_request.switch_values.force; end; if login_server_process_request.switch_flags.save_given then do; ute.ur_at.save_on_disconnect = TRUE; ute.at.save_on_disconnect = login_server_process_request.switch_values.save_on_disconnect; end; if login_server_process_request.switch_flags.preempt_given then do; ute.ur_at.bumping = TRUE; ute.at.bumping = login_server_process_request.switch_values.preempt; end; else ute.at.bumping = TRUE; if login_server_process_request.switch_flags.brief_given then do; ute.ur_at.brief = TRUE; ute.at.brief = login_server_process_request.switch_values.brief; end; if login_server_process_request.other_flags.init_ring_given then ute.initial_ring = login_server_process_request.initial_ring; else ute.initial_ring = -1; if login_server_process_request.other_flags.immediate then ute.uflags.user_specified_immediate = TRUE; if login_server_process_request.other_flags.no_start_up then do; ute.ur_at.nostartup = TRUE; ute.at.nostartup = TRUE; end; if login_server_process_request.home_dir ^= "" then do; temp = length (rtrim (login_server_process_request.home_dir)); if temp > length (ute.home_dir) then call Abort (SL_LOG_SILENT, error_table_$bad_arg, "Home_dir (^a) too long (>d chars).", login_server_process_request.home_dir, length (ute.home_dir)); ute.home_dir = substr (login_server_process_request.home_dir, 1, length (ute.home_dir)); end; if login_server_process_request.outer_module ^= "" then ute.outer_module = login_server_process_request.outer_module; if login_server_process_request.process_overseer ^= "" then do; temp = length (rtrim (login_server_process_request.process_overseer)); if temp > length (ute.init_proc) then call Abort (SL_LOG_SILENT, error_table_$bad_arg, "Process overseer (^a) too long (>^d chars).", login_server_process_request.process_overseer, length (ute.init_proc)); ute.init_proc = substr (login_server_process_request.process_overseer, 1, length (ute.init_proc)); ute.uflags.ip_given = TRUE; ute.ip_len = temp; end; if login_server_process_request.subsystem ^= "" then do; temp = length (rtrim (login_server_process_request.subsystem)); if temp > length (ute.init_proc) - ute.ip_len then call Abort (SL_LOG_SILENT, error_table_$bad_arg, "Subsystem (^a) too long (>d chars).", login_server_process_request.subsystem, length (ute.init_proc) - ute.ip_len); ute.uflags.ss_given = TRUE; substr (ute.init_proc, ute.ip_len + 1, temp) = login_server_process_request.subsystem; ute.ss_len = temp; end; ute.arg_count = login_server_process_request.n_args; if ute.arg_count > 0 then do; ls_process_request_n_args = login_server_process_request.n_args; ls_process_request_arg_string_length = login_server_process_request.arg_string_length; ute.ln_args = login_server_process_request.arg_string_length; if system_area_ptr = null then system_area_ptr = get_system_free_area_ (); allocate lengths in (system_area); allocate argstring in (system_area); if ute.ln_args <= 0 then lengths (*) = 0; else do; lengths (*) = login_server_process_request.args (*).arg_length; argstring = login_server_process_request.arg_string; end; end; else ute.ln_args = 0; call uc_create_process_check_ (utep, ls_request_ptr, check_code); call Setup_Create_Response (); if check_code ^= 0 then do; call convert_status_code_ (check_code, reason, ("")); call as_access_audit_$process (utep, -AS_AUDIT_PROCESS_CREATE, (reason)); if check_code = as_error_table_$already_logged_in then login_server_process_response.flags.already_logged_in = TRUE; end; else do; call uc_create_process_ (utep, code); if code ^= 0 then do; login_server_process_response.status_code = code; call Abort (SL_LOG, code, "Creating process for ^a.^a.", login_server_process_request.person_id, login_server_process_request.project_id); end; login_server_process_response.login_instance = user.n_interactive; login_server_process_response.process_id = ute.proc_id; login_server_process_response.flags.created = TRUE; login_server_process_response.flags.brief = ute.at.brief; call Set_Start_Event_Channel (); end; RETURN: P_code = code; return; %page; Setup_Create_Response: procedure (); dcl message_buffer char (as_data_$ls_message_buffer_cur_lth) based (as_data_$ls_message_buffer_ptr); ls_response_ptr = P_ls_response_ptr; ls_process_response_accounting_message_length = 0;/* initially */ unspec (login_server_process_response) = ""b; login_server_process_response.header.message_type = LS_PROCESS_RESPONSE; login_server_process_response.header.header_pad = ""b; login_server_process_response.header.version = LOGIN_SERVER_PROCESS_RESPONSE_VERSION_1; login_server_process_response.status_code = check_code; login_server_process_response.authorization = ute.process_authorization; call ioa_$rsnnl ("^[anonymous^s^;^a^].^a.^a", login_server_process_response.process_group_id, (0), (ute.anonymous = 1), ute.person, ute.project, ute.tag); login_server_process_response.process_number = 0; /* for create */ pdtep = ute.pdtep; /* used below */ login_server_process_response.n_disconnected_processes = user.n_disconnected; if ute.login_result = 1 then login_server_process_response.flags.disconnect = TRUE; else login_server_process_response.flags.disconnect = FALSE; login_server_process_response.flags.anonymous = (ute.anonymous = 1); login_server_process_response.initial_ring = ute.initial_ring; ls_process_response_accounting_message_length = as_data_$ls_message_buffer_cur_lth; login_server_process_response.accounting_message_length = ls_process_response_accounting_message_length; login_server_process_response.accounting_message = rtrim (message_buffer, NL); as_data_$ls_message_buffer_cur_lth = 0; /* reset to nothing */ P_ls_response_lth = currentsize (login_server_process_response); return; end Setup_Create_Response; %page; Set_Start_Event_Channel: procedure (); dcl code fixed bin (35) automatic; dcl r_factor fixed bin (35) automatic; dcl r_offset fixed bin (18) automatic; dcl hphcs_$get_ipc_operands entry (bit (36) aligned, fixed bin (18), fixed bin (35), fixed bin (35)); dcl ipc_validate_$encode_event_channel_name entry (fixed bin (18), fixed bin (35), bit (3) aligned, fixed bin (15), fixed bin (3), bit (1) aligned, fixed bin (18), fixed bin (71)); /**** We must construct an event channel which will pass the IPC event channel validation tests. To do this, we must learn the values of R-Offset and R-Factor for the process. */ call hphcs_$get_ipc_operands (ute.proc_id, r_offset, r_factor, code); if code = 0 then do; call ipc_validate_$encode_event_channel_name (r_offset, r_factor, "000"b /* flags */, 1 /* index */, 4 /* ring */, "1"b /* regular */, 1 /* unique id */, login_server_process_response.start_event_channel); end; else do; login_server_process_response.start_event_channel = 0; call Abort (SL_LOG_BEEP, code, "Retrieving the values of R-Offset and R-Factor for ^w (^a.^a)", ute.proc_id, ute.person, ute.project); end; end Set_Start_Event_Channel; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: Report errors via sys_log_$general and stop execution. */ /* */ /* Syntax: call Abort (severity, code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_sev_code_msg; sl_info.caller = ME; sl_info.arg_list_ptr = cu_$arg_list_ptr (); call sys_log_$general (addr (sl_info)); code = sl_info.code; if code ^= 0 then go to RETURN; end Abort; /* format: off */ %page; %include access_audit_bin_header; %page; %include as_audit_structures; %page; %include as_data_; %page; %include login_server_messages; %page; %include ls_request_server_info; %page; %include pdt; dcl pdtp ptr automatic init (null); /* pdt needs it */ %page; %include sys_log_constants; %page; %include user_attributes; %page; %include user_table_entry; end uc_ls_create_request_;  uc_ls_destroy_request_.pl1 07/13/88 1113.4r w 07/13/88 0938.2 45936 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-04,Swenson), approve(87-07-13,MCR7737), audit(87-05-16,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-04-28,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Updated for change to user_table_entry.incl.pl1. END HISTORY COMMENTS */ /* format: style4,indattr */ uc_ls_destroy_request_: procedure (P_ls_request_server_info_ptr, P_ls_request_ptr, P_ls_request_lth, P_ls_response_ptr, P_ls_response_lth, P_ls_ipc_reply_ptr, P_code); /* Parameters */ dcl P_ls_request_server_info_ptr ptr parameter; dcl P_ls_request_ptr ptr parameter; dcl P_ls_request_lth fixed bin (18) parameter; dcl P_ls_response_ptr ptr parameter; dcl P_ls_response_lth fixed bin (18) parameter; dcl P_ls_ipc_reply_ptr ptr parameter; dcl P_code fixed bin (35) parameter; /* Automatic */ dcl code fixed bin (35) automatic; /* Entries */ dcl asu_$send_term_signal entry (ptr, fixed bin) returns (bit (1) aligned); dcl dpg_ entry (ptr, char (*)); dcl uc_setup_process_connect_ entry (ptr, ptr, fixed bin (18), ptr, fixed bin (18), ptr, ptr, fixed bin (35)); /* Constant */ dcl ME char (22) initial ("uc_ls_destroy_request_") internal static options (constant); dcl TRUE bit (1) aligned initial ("1"b) internal static options (constant); /* Builtins */ dcl (addr, null) builtin; %page; /* Program */ ls_request_server_info_ptr = P_ls_request_server_info_ptr; ls_request_ptr = P_ls_request_ptr; ls_reply_message_ptr = P_ls_ipc_reply_ptr; code = 0; call uc_setup_process_connect_ (ls_request_server_info_ptr, ls_request_ptr, P_ls_request_lth, P_ls_response_ptr, P_ls_response_lth, ls_reply_message_ptr, utep, code); if code ^= 0 then call Abort (code, "Destroying process for ^a.^a failed.", login_server_process_request.person_id, login_server_process_request.project_id); /**** Tell the request server not to send a reply for this request, yet. */ P_ls_ipc_reply_ptr -> ls_reply_message.flags.do_not_reply = TRUE; P_ls_response_lth = 0; ute.logout_type = "dest"; ute.destroy_flag = WAIT_DESTROY_REQUEST; if login_server_process_request.other_flags.immediate then call dpg_ (utep, "destroy immediate"); else if ^asu_$send_term_signal (utep, PT_DESTROY_REQUEST) then call dpg_ (utep, "destroy"); else ; /* sent trm_ signal; go away until response comes in */ RETURN: P_code = code; return; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: Report errors via sys_log_$general and stop execution. */ /* */ /* Syntax: call Abort (code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_code_msg; sl_info.arg_list_ptr = cu_$arg_list_ptr (); sl_info.severity = SL_LOG_SILENT; sl_info.caller = ME; call sys_log_$general (addr (sl_info)); code = sl_info.code; if code ^= 0 then go to RETURN; end Abort; /* format: off */ %page; %include dialup_values; %page; %include login_server_messages; %page; %include ls_request_server_info; %page; %include sys_log_constants; %page; %include user_attributes; %page; %include user_table_entry; end uc_ls_destroy_request_;  uc_ls_dial_request_.pl1 07/13/88 1113.4r w 07/13/88 0938.2 69777 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-27,Swenson), approve(87-07-13,MCR7737), audit(87-05-18,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-04-28,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Updated for change to user_table_entry.incl.pl1. 3) change(87-05-18,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Use sys_log_$general to report errors. 4) change(87-06-09,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Save process ID of target process in ute for dialed terminal. uc_proc_term_handler_, when invoked to bump the dialed terminal, can then include proper process id in the terminate response message. END HISTORY COMMENTS */ /* format: style4,indattr,insnl */ uc_ls_dial_request_: procedure (P_ls_request_server_info_ptr, P_ls_request_ptr, P_ls_request_lth, P_ls_response_ptr, P_ls_response_lth, P_ls_ipc_reply_ptr, P_code); /* Parameters */ dcl P_ls_request_server_info_ptr ptr parameter; dcl P_ls_request_ptr ptr parameter; dcl P_ls_request_lth fixed bin (18) parameter; dcl P_ls_response_ptr ptr parameter; dcl P_ls_response_lth fixed bin (18) parameter; dcl P_ls_ipc_reply_ptr ptr parameter; dcl P_code fixed bin (35) parameter; /* Automatic */ dcl code fixed bin (35) automatic; dcl target_utep ptr automatic; /* Entries */ dcl ioa_$rsnnl entry () options (variable); dcl uc_dial_ entry (ptr, char (*), char (*), char (*), char (*), (2) bit (72) aligned, ptr, fixed bin (35)) ; dcl uc_logout_ entry (ptr, char (*)); dcl user_table_mgr_$utep_from_handle entry (bit (72) aligned) returns (ptr); /* External */ dcl error_table_$id_not_found fixed bin (35) ext static; dcl error_table_$unimplemented_version fixed bin (35) ext static; /* Constant */ dcl ME char (32) initial ("uc_ls_dial_request_") internal static options (constant); dcl TRUE bit (1) aligned initial ("1"b) internal static options (constant); /* Builtins */ dcl (addr, currentsize, null, unspec) builtin; %page; /* Program */ ls_request_server_info_ptr = P_ls_request_server_info_ptr; ls_request_ptr = P_ls_request_ptr; ls_reply_message_ptr = P_ls_ipc_reply_ptr; code = 0; if login_server_dial_request.request_version ^= LS_DIAL_REQUEST_VERSION_1 then call Abort (error_table_$unimplemented_version, "login_server_dial_request version is ^a, ^a expected.", login_server_dial_request.request_version, LS_DIAL_REQUEST_VERSION_1); /**** The dial request can be sent to us either with or without user identification and authentication. That is, there may not be any user table entry associated with this request when we receive it. We can tell this from the handle supplied by the login server. If it is 0, then no validation has been performed and there is no UTE associated with the request. */ if login_server_dial_request.initializer_handle = ""b then utep = null (); /* user has not been validated */ else do; /* already have a UTE. Let's check */ utep = user_table_mgr_$utep_from_handle ( login_server_dial_request.initializer_handle); if utep = null () then call Abort (error_table_$id_not_found, "Could not locate user table entry for handle ^24.3b.", login_server_dial_request.initializer_handle); end; target_utep = null (); call uc_dial_ (utep, (login_server_dial_request.dial_qualifier), (login_server_dial_request.person_id), (login_server_dial_request.project_id), (login_server_dial_request.connection_info.connection_name), login_server_dial_request.connection_info.access_class_range, target_utep, code); %page; if code ^= 0 then do; if utep ^= null () then call uc_logout_ (utep, "dial failed"); end; else do; /* dial worked. */ if utep ^= null then /* save owner pid*/ ute.proc_id = target_utep->ute.proc_id; /* in dial ute. */ ls_response_ptr = P_ls_response_ptr; /* respond to */ unspec (login_server_dial_response) = ""b; /* login server */ login_server_dial_response.header.message_type = LS_DIAL_RESPONSE; login_server_dial_response.header.version = LOGIN_SERVER_DIAL_RESPONSE_VERSION_1; login_server_dial_response.status_code = code; login_server_dial_response.process_id = target_utep -> ute.proc_id; call ioa_$rsnnl ("^a.^a.^a", login_server_dial_response.process_group_id, (0), target_utep -> ute.person, target_utep -> ute.project, target_utep -> ute.tag); login_server_dial_response.authorization = target_utep -> ute.process_authorization; login_server_dial_response.start_event_channel = target_utep -> ute.dial_ev_chn; login_server_dial_response.process_ring = target_utep -> ute.initial_ring; P_ls_response_lth = currentsize (login_server_dial_response); end; RETURN: P_code = code; return; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: Report an error via sys_log_$general and stop execution if a */ /* nonzero code was given. */ /* */ /* Syntax: call Abort (code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_code_msg; sl_info.severity = SL_LOG_SILENT; sl_info.caller = ME; sl_info.arg_list_ptr = cu_$arg_list_ptr (); call sys_log_$general (addr (sl_info)); code = sl_info.code; if code ^= 0 then go to RETURN; end Abort; /* format: off */ %page; %include login_server_messages; %page; %include ls_request_server_info; %page; %include sys_log_constants; %page; %include user_attributes; %page; %include user_table_entry; end uc_ls_dial_request_;  uc_ls_disconnect_request_.pl1 07/13/88 1113.4r w 07/13/88 0938.2 53478 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-27,Swenson), approve(87-07-13,MCR7737), audit(87-05-18,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-04-27,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1 3) change(87-05-18,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Use sys_log_$general for error reporting. B) Correct coding standard violations. C) Complete sys_log_ error messages. END HISTORY COMMENTS */ /* format: style4,indattr */ uc_ls_disconnect_request_: procedure (P_ls_request_server_info_ptr, P_ls_request_ptr, P_ls_request_lth, P_ls_response_ptr, P_ls_response_lth, P_ls_ipc_reply_ptr, P_code); /* Parameters */ dcl P_ls_request_server_info_ptr ptr parameter; dcl P_ls_request_ptr ptr parameter; dcl P_ls_request_lth fixed bin (18) parameter; dcl P_ls_response_ptr ptr parameter; dcl P_ls_response_lth fixed bin (18) parameter; dcl P_ls_ipc_reply_ptr ptr parameter; dcl P_code fixed bin (35) parameter; /* Automatic */ dcl code fixed bin (35) automatic; dcl hangup_ev_message fixed bin (71) automatic; /* Entries */ dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl uc_logout_ entry (ptr, char (*)); dcl user_table_mgr_$free entry (ptr); dcl user_table_mgr_$utep_from_handle entry (bit (72) aligned) returns (ptr); /* External */ dcl error_table_$action_not_performed fixed bin (35) ext static; dcl error_table_$id_not_found fixed bin (35) ext static; /* Constant */ dcl HANGUP_EV_MESSAGE char (8) initial ("hangup") internal static options (constant); dcl ME char (32) initial ("uc_ls_disconnect_request_") internal static options (constant); /* Builtin */ dcl (addr, null, unspec) builtin; %page; /* Program */ ls_request_server_info_ptr = P_ls_request_server_info_ptr; ls_request_ptr = P_ls_request_ptr; ls_reply_message_ptr = P_ls_ipc_reply_ptr; code = 0; utep = user_table_mgr_$utep_from_handle ( login_server_disconnect_request.handle); if utep = null () then call Abort (SL_LOG_SILENT, error_table_$id_not_found, "Could not locate user table entry for handle ^24.3b.", login_server_disconnect_request.handle); if ute.active = NOW_LOGGED_IN then do; /* no process yet */ call uc_logout_ (utep, "hangup, no process"); call user_table_mgr_$free (utep); P_ls_response_lth = 0; end; else if ute.active = NOW_HAS_PROCESS then do; unspec (hangup_ev_message) = unspec (HANGUP_EV_MESSAGE); ansp = as_data_$ansp; call hcs_$wakeup (anstbl.as_procid, ute.event, hangup_ev_message, code); if code ^= 0 then call Abort (SL_LOG_BEEP, code, "Sending hangup wakeup for ^[*^]^a.^a ^a ^12.3b.", (ute.anonymous=1), ute.person, ute.project, ute.tty_name, ute.proc_id); end; else do; call Abort (SL_LOG_BEEP, error_table_$action_not_performed, "UTE (^d, ^p in ^a) not logged in (active= ^a, ^d).", ute.ute_index, utep, TABLE_NAMES(ute.process_type), ACTIVE_VALUES(ute.active), ute.active); end; RETURN: P_code = 0; return; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: Report errors via sys_log_$general and stop execution. */ /* */ /* Syntax: call Abort (severity, code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_sev_code_msg; sl_info.arg_list_ptr = cu_$arg_list_ptr (); sl_info.caller = ME; call sys_log_$general (addr (sl_info)); code = sl_info.code; if code ^= 0 then go to RETURN; end Abort; /* format: off */ %page; %include answer_table; %page; %include as_data_; %page; %include dialup_values; %page; %include login_server_messages; %page; %include ls_request_server_info; %page; %include sys_log_constants; %page; %include user_attributes; %page; %include user_table_entry; %page; %include user_table_header; end uc_ls_disconnect_request_;  uc_ls_list_request_.pl1 07/13/88 1113.4r w 07/13/88 0938.3 63612 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-04,Swenson), approve(87-07-13,MCR7737), audit(87-05-15,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-04-28,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Updated for change to user_table_entry.incl.pl1. 3) change(87-05-16,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Put connection_info.line_type into return structure. B) Put ute.initial_ring into the return structure. C) Convert to sys_log_$general. END HISTORY COMMENTS */ /* format: style4,indattr,insnl */ uc_ls_list_request_: procedure (P_ls_request_server_info_ptr, P_ls_request_ptr, P_ls_request_lth, P_ls_response_ptr, P_ls_response_lth, P_ls_ipc_reply_ptr, P_code); /* Parameters */ dcl P_ls_request_server_info_ptr ptr parameter; dcl P_ls_request_ptr ptr parameter; dcl P_ls_request_lth fixed bin (18) parameter; dcl P_ls_response_ptr ptr parameter; dcl P_ls_response_lth fixed bin (18) parameter; dcl P_ls_ipc_reply_ptr ptr parameter; dcl P_code fixed bin (35) parameter; /* Automatic */ dcl code fixed bin (35) automatic; dcl i fixed bin automatic; /* Entries */ dcl get_system_free_area_ entry () returns (ptr); dcl uc_list_disconnected_procs_ entry (ptr, ptr, ptr); dcl user_table_mgr_$utep_from_handle entry (bit (72) aligned) returns (ptr); /* External */ dcl error_table_$id_not_found fixed bin (35) ext static; /* Based */ dcl system_area area based (system_area_ptr); /* Internal */ dcl system_area_ptr ptr int static init (null); /* Constant */ dcl ME char (19) initial ("uc_ls_list_request_") internal static options (constant); /* Builtins */ dcl (addr, currentsize, null, unspec) builtin; /* Conditions */ dcl cleanup condition; %page; /* Program */ ls_request_ptr = P_ls_request_ptr; ls_response_ptr = P_ls_response_ptr; code = 0; if system_area_ptr = null then system_area_ptr = get_system_free_area_ (); uc_disconnected_process_list_ptr = null; on cleanup begin; if uc_disconnected_process_list_ptr ^= null then free uc_disconnected_process_list in (system_area); end; utep = user_table_mgr_$utep_from_handle ( login_server_list_request.handle); if utep = null () then call Abort (error_table_$id_not_found, "Could not locate user table entry for handle ^24.3b.", login_server_list_request.handle); call uc_list_disconnected_procs_ (utep, system_area_ptr, uc_disconnected_process_list_ptr); if uc_disconnected_process_list_ptr = null () then login_server_list_response_n_processes = 0; else login_server_list_response_n_processes = uc_disconnected_process_list.n_disconnected_processes; unspec (login_server_list_response) = ""b; login_server_list_response.header.message_type = LS_LIST_RESPONSE; login_server_list_response.header.version = LOGIN_SERVER_LIST_RESPONSE_VERSION_1; login_server_list_response.n_processes = login_server_list_response_n_processes; do i = 1 to login_server_list_response_n_processes; utep = uc_disconnected_process_list.process (i).utep; login_server_list_response.creation_time(i) = ute.login_time; login_server_list_response.authorization(i) = ute.process_authorization; if ute.initial_ring ^= ute.pdtep->user.default_ring then login_server_list_response.initial_ring(i) = ute.initial_ring; else login_server_list_response.initial_ring(i) = 0; login_server_list_response.connection_name(i) = ute.tty_name; /**** NOTE: We do not maintain the access class range for communication channels in the UTE and therefore cannot return this information. */ login_server_list_response.access_class_range(i,*) = ""b; login_server_list_response.terminal_type(i) = ute.terminal_type; login_server_list_response.terminal_id(i) = ute.tty_id_code; login_server_list_response.line_type(i) = ute.line_type; end; if uc_disconnected_process_list_ptr ^= null then do; free uc_disconnected_process_list in (system_area); uc_disconnected_process_list_ptr = null (); end; P_ls_response_lth = currentsize (login_server_list_response); RETURN: P_code = code; return; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: Report error in as log and stop the list operation, returning an */ /* error code. */ /* */ /* Syntax: call Abort (code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_code_msg; sl_info.arg_list_ptr = cu_$arg_list_ptr (); sl_info.severity = SL_LOG_SILENT; sl_info.caller = ME; call sys_log_$general (addr (sl_info)); code = sl_info.code; go to RETURN; end Abort; /* format: off */ %page; %include login_server_messages; %page; %include pdt; dcl pdtp ptr automatic init (null); /* pdt needs it */ %page; %include sys_log_constants; %page; %include uc_disc_proc_list; %page; %include user_attributes; /* not used, but needed by PL/I */ %page; %include user_table_entry; end uc_ls_list_request_;  uc_ls_logout_request_.pl1 08/04/87 1511.0rew 08/04/87 1511.0 44721 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-27,Swenson), approve(87-07-13,MCR7737), audit(87-05-18,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-04-29,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Change references from uc_user_table_mgr_ to user_table_mgr_. 3) change(87-05-18,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Use sys_log_$general for error reporting. B) Correct coding standard violations. C) Complete sys_log_ error messages. END HISTORY COMMENTS */ /* format: style4,indattr */ uc_ls_logout_request_: procedure (P_ls_request_server_info_ptr, P_ls_request_ptr, P_ls_request_lth, P_ls_response_ptr, P_ls_response_lth, P_ls_ipc_reply_ptr, P_code); /**** This login server request is issued only when a user is in the middle of a login dialogue and types "logout". It is used to notify the AS to clean up the ute entry for the user. */ /* Parameters */ dcl P_ls_request_server_info_ptr ptr parameter; dcl P_ls_request_ptr ptr parameter; dcl P_ls_request_lth fixed bin (18) parameter; dcl P_ls_response_ptr ptr parameter; dcl P_ls_response_lth fixed bin (18) parameter; dcl P_ls_ipc_reply_ptr ptr parameter; dcl P_code fixed bin (35) parameter; /* Automatic */ dcl code fixed bin (35) automatic; dcl utep ptr automatic; /* Entries */ dcl user_table_mgr_$free entry (ptr); dcl user_table_mgr_$utep_from_handle entry (bit (72) aligned) returns (ptr); dcl uc_logout_ entry (ptr, char (*)); /* External */ dcl error_table_$id_not_found fixed bin (35) ext static; /* Constant */ dcl ME char (21) initial ("uc_ls_logout_request_") internal static options (constant); /* Builtins */ dcl (addr, null) builtin; %page; /* Program */ ls_request_ptr = P_ls_request_ptr; code = 0; utep = user_table_mgr_$utep_from_handle ( login_server_logout_request.handle); if utep = null () then call Abort (error_table_$id_not_found, "Could not locate user table entry for handle ^24.3b.", login_server_logout_request.handle); /**** Log the user out, if he is logged in. */ call uc_logout_ (utep, "logout, no process"); /**** Free the user table entry. */ call user_table_mgr_$free (utep); /**** The login server will not expect any response */ P_ls_response_lth = 0; RETURN: P_code = code; return; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: Report errors via sys_log_$general and stop execution. */ /* */ /* Syntax: call Abort (code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_code_msg; sl_info.arg_list_ptr = cu_$arg_list_ptr (); sl_info.severity = SL_LOG_SILENT; sl_info.caller = ME; call sys_log_$general (addr (sl_info)); code = sl_info.code; if code ^= 0 then go to RETURN; end Abort; /* format: off */ %page; %include ls_request_server_info; %page; %include login_server_messages; %page; %include sys_log_constants; end uc_ls_logout_request_;  uc_ls_new_proc_request_.pl1 07/13/88 1113.4r w 07/13/88 0938.3 48393 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-04,Swenson), approve(87-07-13,MCR7737), audit(87-05-16,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-04-28,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Updated for change to user_table_entry.incl.pl1. 3) change(87-05-18,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Use sys_log_$general to report errors. B) Correct coding standard violations. END HISTORY COMMENTS */ /* format: style4,indattr */ uc_ls_new_proc_request_: procedure (P_ls_request_server_info_ptr, P_ls_request_ptr, P_ls_request_lth, P_ls_response_ptr, P_ls_response_lth, P_ls_ipc_reply_ptr, P_code); /* Parameters */ dcl P_ls_request_server_info_ptr ptr parameter; dcl P_ls_request_ptr ptr parameter; dcl P_ls_request_lth fixed bin (18) parameter; dcl P_ls_response_ptr ptr parameter; dcl P_ls_response_lth fixed bin (18) parameter; dcl P_ls_ipc_reply_ptr ptr parameter; dcl P_code fixed bin (35) parameter; /* Automatic */ dcl code fixed bin (35) automatic; /* Entries */ dcl asu_$send_term_signal entry (ptr, fixed bin) returns (bit (1) aligned); dcl dpg_ entry (ptr, char (*)); dcl uc_setup_process_connect_ entry (ptr, ptr, fixed bin (18), ptr, fixed bin (18), ptr, ptr, fixed bin (35)); /* Constant */ dcl ME char (23) initial ("uc_ls_new_proc_request_") internal static options (constant); dcl TRUE bit (1) aligned initial ("1"b) internal static options (constant); /* Builtins */ dcl (addr, null) builtin; %page; /* Program */ ls_request_server_info_ptr = P_ls_request_server_info_ptr; ls_request_ptr = P_ls_request_ptr; ls_reply_message_ptr = P_ls_ipc_reply_ptr; code = 0; call uc_setup_process_connect_ (P_ls_request_server_info_ptr, P_ls_request_ptr, P_ls_request_lth, P_ls_response_ptr, P_ls_response_lth, P_ls_ipc_reply_ptr, utep, code); if code ^= 0 then call Abort (code, "Issuing new_proc for ^a.^a ^a", login_server_process_request.person_id, login_server_process_request.project_id, login_server_process_request.connection_name); /**** Tell the request server not to send a reply for this request, yet. */ P_ls_ipc_reply_ptr -> ls_reply_message.flags.do_not_reply = TRUE; P_ls_response_lth = 0; ute.logout_type = "newp"; ute.destroy_flag = WAIT_NEW_PROC_REQUEST; if login_server_process_request.other_flags.immediate then call dpg_ (utep, "new_proc immediate"); else if ^asu_$send_term_signal (utep, PT_NEW_PROC_REQUEST) then call dpg_ (utep, "new_proc"); else ; /* sent trm_ signal; go away until response comes in */ RETURN: P_code = code; return; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: Report errors via sys_log_$general and stop execution. */ /* */ /* Syntax: call Abort (code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_code_msg; sl_info.arg_list_ptr = cu_$arg_list_ptr (); sl_info.severity = SL_LOG_SILENT; sl_info.caller = ME; call sys_log_$general (addr (sl_info)); code = sl_info.code; if code ^= 0 then go to RETURN; end Abort; /* format: off */ %page; %include dialup_values; %page; %include login_server_messages; %page; %include ls_request_server_info; %page; %include sys_log_constants; %page; %include user_attributes; %page; %include user_table_entry; end uc_ls_new_proc_request_;  uc_ls_operator_request_.pl1 07/13/88 1113.4r w 07/13/88 0938.3 88497 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-08,Swenson), approve(87-07-13,MCR7737), audit(87-04-08,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-04-08,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Logout user (updating who_tab as well) if operator login denied by mc_commands_$mc_login. Also, destroy the user table entry. B) Null login_server_operator_response.process_group_id when operator login fails. C) Use sys_log_$general to report errors. D) Null login_server_operator_request.person_id, project_id, virtual_channel for non-I&A logins, rather than depending upon the login server to do this. E) Updated for change to user_table_entry.incl.pl1. 3) change(87-06-11,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Change calling sequence of mc_commands_$mc_login to pass utep, so Initializer process_id can be filled in after the channel has been added to mc_anstbl. This allows operator to drop the channel rather than accepting it. 4) change(87-06-26,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Pass connection_info.access_class_range to mc_commands_$mc_login for use in the operator login audit message. END HISTORY COMMENTS */ /* format: style4,indattr,insnl */ uc_ls_operator_request_: procedure (P_ls_request_server_info_ptr, P_ls_request_ptr, P_ls_request_lth, P_ls_response_ptr, P_ls_response_lth, P_ls_ipc_reply_ptr, P_code); /* Parameters */ dcl P_ls_request_server_info_ptr ptr parameter; dcl P_ls_request_ptr ptr parameter; dcl P_ls_request_lth fixed bin (18) parameter; dcl P_ls_response_ptr ptr parameter; dcl P_ls_response_lth fixed bin (18) parameter; dcl P_ls_ipc_reply_ptr ptr parameter; dcl P_code fixed bin (35) parameter; /* Automatic */ dcl code fixed bin (35) automatic; dcl ls_termination_event_channel fixed bin (71) automatic; /* Entries */ dcl mc_commands_$mc_login entry (char (*), char (*), ptr, char (*), (2) bit (72) aligned, bit (36) aligned, fixed bin (71), fixed bin (71), bit (72) aligned, fixed bin (35)); dcl uc_logout_ entry (ptr, char (*)); dcl user_table_mgr_$free entry (ptr); dcl user_table_mgr_$utep_from_handle entry (bit (72) aligned) returns (ptr); /* External */ dcl error_table_$bad_arg fixed bin (35) ext static; dcl error_table_$id_not_found fixed bin (35) ext static; dcl error_table_$unimplemented_version fixed bin (35) ext static; /* Constant */ dcl ME char (23) initial ("uc_ls_operator_request_") internal static options (constant); dcl TRUE bit (1) aligned initial ("1"b) internal static options (constant); /* Builtin */ dcl (addr, currentsize, null, unspec) builtin; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* Program */ ls_request_ptr = P_ls_request_ptr; ls_response_ptr = P_ls_response_ptr; ls_reply_message_ptr = P_ls_ipc_reply_ptr; ls_request_server_info_ptr = P_ls_request_server_info_ptr; code = 0; if login_server_operator_request.request_version ^= LOGIN_SERVER_OPERATOR_REQUEST_VERSION_1 then call Abort (error_table_$unimplemented_version, "Version of login_server_operator_request is ^a, ^a expected.", login_server_operator_request.request_version, LOGIN_SERVER_OPERATOR_REQUEST_VERSION_1); /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* The operator request can be sent to us either with or without user */ /* identification and authentication. This occurs when when the user types */ /* "d system" without specifying "-user Personid.Projectid". In this case, */ /* there will not be any user table entry associated with this request. We */ /* can tell this from the handle supplied by the login server. If it is 0, */ /* then no validation has been performed and there is no UTE associated with */ /* the request. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ if login_server_operator_request.initializer_handle = ""b then do; utep = null (); /* no I&A */ login_server_operator_request.person_id, login_server_operator_request.project_id, login_server_operator_request.virtual_channel = ""; end; else do; utep = user_table_mgr_$utep_from_handle (login_server_operator_request.initializer_handle); if utep = null () then call Abort (error_table_$id_not_found, "Could not locate user table entry for handle ^24.3b.", login_server_operator_request.initializer_handle); end; if utep ^= null () then if login_server_operator_request.person_id ^= ute.person | login_server_operator_request.project_id ^= ute.project then call Abort (error_table_$bad_arg, "Person.project in operator request (^a.^a) do not match UTE (^a.^a)", login_server_operator_request.person_id, login_server_operator_request.project_id, ute.person, ute.project); if utep ^= null () then ls_termination_event_channel = ute.login_server_info.termination_event_channel; else ls_termination_event_channel = login_server_operator_request.terminate_event_channel; call mc_commands_$mc_login ( (login_server_operator_request.connection_info.connection_name), (login_server_operator_request.person_id), utep, (login_server_operator_request.virtual_channel), login_server_operator_request.connection_info.access_class_range, ls_request_server_info.request_info.sender_process_id, ls_termination_event_channel, login_server_operator_request.header.reply_event_channel, login_server_operator_request.header.reply_handle, code); /**** If the message coordinator said this was ok, then we don't send the response. We let the MC do it. */ if code = 0 then ls_reply_message.flags.do_not_reply = TRUE; else do; call Fill_response_structure (); code = 0; if utep ^= null then do; call uc_logout_ (utep, "DENIED: login -operator"); call user_table_mgr_$free (utep); end; end; RETURN: P_code = code; return; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: Report an error via sys_log_$general and stop execution if a */ /* nonzero code was given. */ /* */ /* Syntax: call Abort (code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_code_msg; sl_info.severity = SL_LOG_SILENT; sl_info.caller = ME; sl_info.arg_list_ptr = cu_$arg_list_ptr (); call sys_log_$general (addr (sl_info)); code = sl_info.code; if code ^= 0 then go to RETURN; end Abort; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ Fill_response_structure: procedure; unspec (login_server_operator_response) = ""b; login_server_operator_response.header.message_type = LS_OPERATOR_RESPONSE; login_server_operator_response.header.version = LOGIN_SERVER_OPERATOR_RESPONSE_VERSION_1; login_server_operator_response.status_code = code; login_server_operator_response.process_group_id = ""; P_ls_response_lth = currentsize (login_server_operator_response); end Fill_response_structure; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* format: off */ %include login_server_messages; %include ls_request_server_info; %include sys_log_constants; %include user_attributes; /* not used, but needed by PL/I */ %include user_table_entry; end uc_ls_operator_request_;  uc_ls_process_request_.pl1 08/04/87 1511.0rew 08/04/87 1511.0 53919 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-24,Swenson), approve(87-07-13,MCR7737), audit(87-04-23,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-04-24,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Upgrade to use sys_log_$general to report errors. B) Handle enter and enterp preaccess commands. END HISTORY COMMENTS */ /* format: style4,indattr */ uc_ls_process_request_: procedure (P_ls_request_server_info_ptr, P_ls_request_ptr, P_ls_request_lth, P_ls_response_ptr, P_ls_response_lth, P_ls_ipc_reply_ptr, P_code); /* Parameters */ dcl P_ls_request_server_info_ptr ptr parameter; dcl P_ls_request_ptr ptr parameter; dcl P_ls_request_lth fixed bin (18) parameter; dcl P_ls_response_ptr ptr parameter; dcl P_ls_response_lth fixed bin (18) parameter; dcl P_ls_ipc_reply_ptr ptr parameter; dcl P_code fixed bin (35) parameter; /* Automatic */ dcl abort_label label automatic; dcl code fixed bin (35) automatic; dcl entry_to_call entry (ptr, ptr, fixed bin (18), ptr, fixed bin (18), ptr, fixed bin (35)) variable; /* Entries */ dcl uc_ls_create_request_ entry (ptr, ptr, fixed bin (18), ptr, fixed bin (18), ptr, fixed bin (35)); dcl uc_ls_destroy_request_ entry (ptr, ptr, fixed bin (18), ptr, fixed bin (18), ptr, fixed bin (35)); dcl uc_ls_connect_request_ entry (ptr, ptr, fixed bin (18), ptr, fixed bin (18), ptr, fixed bin (35)); dcl uc_ls_new_proc_request_ entry (ptr, ptr, fixed bin (18), ptr, fixed bin (18), ptr, fixed bin (35)); /* External */ dcl error_table_$bad_arg fixed bin (35) ext static; /* Constant */ dcl ME char (22) initial ("uc_ls_process_request_") internal static options (constant); /* Builtins */ dcl addr builtin; %page; /* Program */ ls_request_server_info_ptr = P_ls_request_server_info_ptr; ls_request_ptr = P_ls_request_ptr; ls_reply_message_ptr = P_ls_ipc_reply_ptr; code = 0; abort_label = RETURN; if login_server_process_request.header.request_version ^= LS_PROCESS_REQUEST_VERSION_1 then call Abort (SL_LOG_SILENT, code, "login_server_process_request version is ^a, should be ^a.", login_server_process_request.header.request_version, LS_PROCESS_REQUEST_VERSION_1); if login_server_process_request.command_type = LOGIN_REQ then entry_to_call = uc_ls_create_request_; else if login_server_process_request.command_type = CREATE_REQ then entry_to_call = uc_ls_create_request_; else if login_server_process_request.command_type = DESTROY_REQ then entry_to_call = uc_ls_destroy_request_; else if login_server_process_request.command_type = CONNECT_REQ then entry_to_call = uc_ls_connect_request_; else if login_server_process_request.command_type = NEW_PROC_REQ then entry_to_call = uc_ls_new_proc_request_; else if login_server_process_request.command_type = ENTER_REQ then entry_to_call = uc_ls_create_request_; else if login_server_process_request.command_type = ENTERP_REQ then entry_to_call = uc_ls_create_request_; else call Abort (SL_LOG_SILENT, error_table_$bad_arg, "command_type is invalid (^d).", login_server_process_request.command_type); /**** Dispatch on subrequest */ call entry_to_call (P_ls_request_server_info_ptr, P_ls_request_ptr, P_ls_request_lth, P_ls_response_ptr, P_ls_response_lth, P_ls_ipc_reply_ptr, code); RETURN: P_code = code; return; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: Report an error via sys_log_$general and stop execution if a */ /* nonzero code was given. */ /* */ /* Syntax: call Abort (severity, code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_sev_code_msg; sl_info.caller = ME; sl_info.arg_list_ptr = cu_$arg_list_ptr (); call sys_log_$general (addr (sl_info)); code = sl_info.code; if code ^= 0 then go to abort_label; end Abort; /* format: off */ %page; %include login_server_messages; %page; %include ls_request_server_info; %page; %include sys_log_constants; end uc_ls_process_request_;  uc_ls_rq_server_wakeup_.pl1 08/04/87 1511.0rew 08/04/87 1511.0 133182 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-08-05,Swenson), approve(87-07-13,MCR7737), audit(87-04-16,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-04-16,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Correct coding standard violations. B) Integrate Swenson's later changes into the module. C) Use LS_REQUEST_TYPES and LS_RESPONSE_TYPES arrays to improve trace messages. D) Convert to sys_log_$general for error and trace messages. E) Upgraded for change to answer_table.incl.pl1. 3) change(87-05-18,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Remove procedures for sending a login server response from this program. Centralize this function in uc_send_ls_response_. END HISTORY COMMENTS */ /* format: style4,indattr */ uc_ls_rq_server_wakeup_: procedure (P_event_call_info_ptr); /* Parameters */ dcl P_event_call_info_ptr ptr parameter; /* Automatic */ dcl code fixed bin (35) automatic; dcl ls_data_reply_lth fixed bin (18) automatic; dcl ls_data_reply_ptr ptr automatic; dcl ls_request_lth fixed bin (18) automatic; dcl 1 mmi aligned like mseg_message_info automatic; dcl ms_index fixed bin automatic; dcl request_type fixed bin automatic; dcl response_type fixed bin automatic; /* External */ dcl as_error_table_$dialup_error fixed bin (35) ext static; dcl error_table_$bad_arg fixed bin (35) external; dcl error_table_$no_message fixed bin (35) external; dcl error_table_$out_of_sequence fixed bin (35) external; dcl error_table_$unexpected_condition fixed bin (35) external; dcl error_table_$unimplemented_version fixed bin (35) external; /* Entries */ dcl as_any_other_handler_$no_cleanup entry (char (*), label); dcl get_system_free_area_ entry returns (pointer); dcl message_segment_$delete_index entry (fixed bin, bit (72) aligned, fixed bin (35)); dcl message_segment_$read_message_index entry (fixed bin, pointer, pointer, fixed bin (35)); dcl message_segment_$get_message_count_index entry (fixed bin, fixed bin, fixed bin (35)); dcl pathname_ entry (char (*), char (*)) returns (char (168)); dcl (uc_ls_validate_request_, uc_ls_process_request_, uc_ls_list_request_, uc_ls_dial_request_, uc_ls_disconnect_request_, uc_ls_logout_request_, uc_ls_operator_request_) entry (ptr, ptr, fixed bin (18), ptr, fixed bin (18), bit (72) aligned, fixed bin (35)); dcl uc_send_ls_response_ entry (ptr, fixed bin(18), bit(36) aligned, bit(72) aligned, fixed bin(71), ptr, char(32) aligned, fixed bin(35), fixed bin(35)); /* Builtin */ dcl (addr, currentsize, divide, hbound, lbound, null, rtrim, unspec) builtin; /* Internal Static */ dcl system_area_ptr ptr int static init (null); dcl trace_flag bit (1) aligned initial ("0"b) internal static; /* Constant */ dcl FALSE bit (1) initial ("0"b) internal static options (constant); dcl ME char (23) initial ("uc_ls_rq_server_wakeup_") internal static options (constant); dcl TRUE bit (1) initial ("1"b) internal static options (constant); /* Based */ dcl system_area area based (system_area_ptr); /* Conditions */ dcl any_other condition; dcl cleanup condition; %page; /* Program */ event_call_info_ptr = P_event_call_info_ptr; ls_request_server_info_ptr = event_call_info.data_ptr; if ls_request_server_info_ptr = null () then call Abort (SL_LOG_BEEP, error_table_$out_of_sequence, MAIN_RETURN, "Wakeup with null ptr to sectest_server_info."); if ^ls_request_server_info.flags.initialized then call Abort (SL_LOG_BEEP, error_table_$out_of_sequence, MAIN_RETURN, "Wakeup with ls_request_server_info not initialized."); /**** Leave a record that a login server request has been received. This flag is used by dial_ctl_ to decide whether to call uc_cleanup_network_dials_. */ ansp = as_data_$ansp; if anstbl.login_server_present = FALSE then anstbl.login_server_present = TRUE; ms_index = ls_request_server_info.request_ms.index; if ms_index = 0 then call Abort (SL_LOG_BEEP, error_table_$out_of_sequence, MAIN_RETURN, "Request message segment not initialized yet."); unspec (mmi) = ""b; mmi.version = MSEG_MESSAGE_INFO_V1; mmi.message_code = MSEG_READ_FIRST; mmi.ms_ptr = null (); if system_area_ptr = null then system_area_ptr = get_system_free_area_ (); on cleanup call Clean_Up (); call Process_Messages (); MAIN_RETURN: return; %page; trace_on: entry (); trace_flag = TRUE; return; trace_off: entry (); trace_flag = FALSE; return; %page; Process_Messages: procedure (); dcl action fixed bin; dcl message_count fixed bin; dcl (PROCESS initial (1), REJECT initial (2)) fixed bin internal static options (constant); do while ("1"b); call message_segment_$read_message_index (ms_index, addr (system_area), addr (mmi), code); if code = error_table_$no_message then return; if code ^= 0 then call Abort (SL_LOG_BEEP, code, MAIN_RETURN, "Error reading message from message segment."); action = Examine_Message (); if action = PROCESS then call Process_The_Message (); call Delete_The_Message (); if mmi.ms_ptr ^= null () then begin; declare msg bit (mmi.ms_len) aligned based (mmi.ms_ptr); free msg in (system_area); mmi.ms_ptr = null (); end; call message_segment_$get_message_count_index (ms_index, message_count, code); if code ^= 0 then call Abort (SL_LOG_BEEP, code, MAIN_RETURN, "Could not get message count from message segment ^a.", pathname_ (ls_request_server_info.request_ms.dirname, ls_request_server_info.request_ms.entryname)); if message_count = 0 then return; end; %page; Examine_Message: procedure () returns (fixed bin); ls_request_ptr = mmi.ms_ptr; ls_request_lth = divide (mmi.ms_len, 36, 18); if ls_request_lth < (currentsize (ls_request_header)) then call Abort (SL_LOG_SILENT, error_table_$bad_arg, REJECT_MESSAGE, "Size of request from ^a too small. Got ^d; expected at least ^d.", mmi.sender_id, ls_request_lth, currentsize (ls_request_header)); else if ls_request_header.header_version ^= LS_REQUEST_HEADER_VERSION_1 then call Abort (SL_LOG_SILENT, error_table_$unimplemented_version, REJECT_MESSAGE, "Invalid version (^a) in request from ^a.", ls_request_header.header_version, mmi.sender_id); else do; request_type = ls_request_header.request_type; if lbound (LS_REQUEST_TYPES, 1) <= request_type & request_type <= hbound (LS_REQUEST_TYPES, 1) then code = 0; else call Abort (SL_LOG_SILENT, error_table_$bad_arg, REJECT_MESSAGE, "Invalid request type ^d from ^a.", request_type, mmi.sender_id); end; return (PROCESS); REJECT_MESSAGE: return (REJECT); end Examine_Message; %page; Process_The_Message: procedure (); dcl 1 auto_ls_reply_message aligned like ls_reply_message automatic; dcl code fixed bin (35) automatic; dcl entry_to_call entry (ptr, ptr, fixed bin (18), ptr, fixed bin (18), ptr, fixed bin (35)) variable; if trace_flag then call Trace ("Received ^a request from ^a.", LS_REQUEST_TYPES (request_type), mmi.sender_id); if request_type = LS_VALIDATE_REQUEST then entry_to_call = uc_ls_validate_request_; else if request_type = LS_PROCESS_REQUEST then entry_to_call = uc_ls_process_request_; else if request_type = LS_LIST_REQUEST then entry_to_call = uc_ls_list_request_; else if request_type = LS_DIAL_REQUEST then entry_to_call = uc_ls_dial_request_; else if request_type = LS_DISCONNECT_REQUEST then entry_to_call = uc_ls_disconnect_request_; else if request_type = LS_LOGOUT_REQUEST then entry_to_call = uc_ls_logout_request_; else if request_type = LS_OPERATOR_REQUEST then entry_to_call = uc_ls_operator_request_; else call Abort (SL_LOG_SILENT, error_table_$bad_arg, ABORT_REQUEST_NO_REPLY, "Invalid request type ^d specified.", request_type); ls_reply_message_ptr = addr (auto_ls_reply_message); unspec (ls_reply_message) = ""b; ls_data_reply_ptr = ls_request_server_info.reply_ptr; ls_data_reply_lth = 0; ls_request_server_info.request_info.sender_process_id = mmi.sender_process_id; on any_other begin; revert any_other; code = as_error_table_$dialup_error; unspec (ls_reply_message) = ""b; ls_reply_message.code = code; ls_reply_message.flags.do_not_reply = FALSE; call Abort (SL_LOG_BEEP, error_table_$unexpected_condition, TAKE_AS_DUMP, "Processing login server ""^a"" request from ^a.", LS_REQUEST_TYPES (request_type), mmi.sender_id); TAKE_AS_DUMP: call as_any_other_handler_$no_cleanup (ME, ABORT_REQUEST); end; call entry_to_call (ls_request_server_info_ptr, ls_request_ptr, ls_request_lth, ls_data_reply_ptr, ls_data_reply_lth, ls_reply_message_ptr, code); revert any_other; ABORT_REQUEST: if ls_data_reply_lth > 0 then call Test_Data_Reply (); if trace_flag then call Trace ( "Processed ^a request from ^a. ^[No reply.^;Reply^[ with ^a response.^]^]", LS_REQUEST_TYPES (request_type), mmi.sender_id, ls_reply_message.do_not_reply, ls_data_reply_lth > 0, LS_RESPONSE_TYPES (response_type)); if ^ls_reply_message.do_not_reply then call uc_send_ls_response_ (ls_data_reply_ptr, ls_data_reply_lth, mmi.sender_process_id, ls_request_header.reply_handle, ls_request_header.reply_event_channel, addr(ls_reply_message), ls_request_header.connection_name, code, code); else ; /* we don't want to send anything to LS (yet). */ ABORT_REQUEST_NO_REPLY: return; %page; Test_Data_Reply: procedure (); ls_response_ptr = ls_data_reply_ptr; response_type = login_server_response_header.message_type; if lbound (LS_RESPONSE_TYPES, 1) <= response_type & response_type <= hbound (LS_RESPONSE_TYPES, 1) then ; else response_type = LS_UNKNOWN_RESPONSE; end Test_Data_Reply; end Process_The_Message; end Process_Messages; %page; Clean_Up: procedure (); declare msg bit (mmi.ms_len) aligned based (mmi.ms_ptr); if mmi.ms_ptr ^= null () then free msg in (system_area); end Clean_Up; %page; Delete_The_Message: procedure (); call message_segment_$delete_index (ms_index, mmi.ms_id, code); if code ^= 0 then call Abort (SL_LOG_SILENT, code, DELETE_FAILED, "Could not delete message ^.3b for ^a.", mmi.ms_id, mmi.sender_id); else mmi.ms_id = ""b; /* clear out since no longer valid */ DELETE_FAILED: end Delete_The_Message; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: report errors via sys_log_$general. */ /* */ /* Syntax: call Abort (severity, code, error_return_label, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl sys_log_$general entry (ptr); dcl abort_label_ptr pointer automatic; dcl abort_label label based (abort_label_ptr); sl_info = sl_info_sev_code_label_msg; sl_info.caller = ME; sl_info.arg_list_ptr = cu_$arg_list_ptr (); call sys_log_$general (addr (sl_info)); code = sl_info.code; if code ^= 0 then do; call cu_$arg_ptr_rel (3, abort_label_ptr, 0, 0, sl_info.arg_list_ptr); go to abort_label; end; end Abort; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Trace: trace events via sys_log_$general. */ /* */ /* Syntax: call Trace (ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Trace: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_msg; sl_info.caller = rtrim (ME) || " (trace)"; sl_info.arg_list_ptr = cu_$arg_list_ptr (); call sys_log_$general (addr (sl_info)); end Trace; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* format: off */ %page; %include answer_table; %page; %include as_data_; %page; %include condition_info; %page; %include condition_info_header; %page; %include event_call_info; %page; %include login_server_messages; %page; %include ls_request_server_info; %page; %include mseg_message_info; %page; %include sys_log_constants; %page; %include user_table_header; end uc_ls_rq_server_wakeup_;  uc_ls_validate_request_.pl1 07/13/88 1113.4r w 07/13/88 0938.3 126099 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-07,Swenson), approve(87-07-13,MCR7737), audit(87-04-24,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-04-07,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Correct problem with enter (anonymous no password) logins. B) Change wakeup priority for ute.event to coincide with that used by dialup_. C) Reordered statements to reflect changes to user_table_entry.incl.pl1 and user_table_entry.incl.pl1 and login_server_validate_response structure. D) Improved sys_log_ messages. E) Added login_server_validate_response.last_incorrect_password.time. F) Use login_server_validate_request.connection_info.line_type. (dsa 123) 3) change(87-05-11,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Use named constants from dialup_values.incl.pl1 for ute.tag values. 4) change(87-05-13,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Set ute.line_type from login_server_validate_request.line_type. B) Remove use of uc_validate_info.line_type. END HISTORY COMMENTS */ /* format: style4,indattr */ uc_ls_validate_request_: procedure (P_ls_request_server_info_ptr, P_ls_request_ptr, P_ls_request_lth, P_ls_reply_data_ptr, P_ls_reply_data_lth, P_ls_ipc_reply_ptr, P_code); /**** TBS: Add auditing of errors. */ /* Parameters */ dcl P_ls_request_server_info_ptr ptr parameter; dcl P_ls_request_ptr ptr parameter; dcl P_ls_request_lth fixed bin (18) parameter; dcl P_ls_reply_data_ptr ptr parameter; dcl P_ls_reply_data_lth fixed bin (18) parameter; dcl P_ls_ipc_reply_ptr ptr parameter; dcl P_code fixed bin (35) parameter; /* Automatic */ dcl abort_label label automatic; dcl 1 auto_uc_validate_info aligned like uc_validate_info automatic; dcl code fixed bin (35) automatic; dcl ip ptr automatic; dcl validate_code fixed bin (35) automatic; /* Entries */ dcl as_any_other_handler_$no_cleanup entry (char (*), label); dcl asu_$setup_login_server_handle entry (ptr); dcl ipc_$decl_event_call_chn entry (fixed bin (71), entry, ptr, fixed bin, fixed bin (35)); dcl uc_login_ entry (ptr, ptr, fixed bin (35)); dcl uc_proc_term_handler_ entry (ptr); dcl user_table_mgr_$allocate entry (fixed bin) returns (ptr); dcl user_table_mgr_$free entry (ptr); /* External */ dcl as_error_table_$dialup_error fixed bin (35) ext static; dcl as_error_table_$tty_no_room fixed bin (35) ext static; dcl error_table_$unimplemented_version fixed bin (35) ext static; /* Constant */ dcl ME char (23) initial ("uc_ls_validate_request_") internal static options (constant); dcl (ANONYMOUS initial (1), NOT_ANONYMOUS initial (0)) fixed bin internal static options (constant); dcl (TRUE initial ("1"b), FALSE initial ("0"b)) bit (1) aligned internal static options (constant); /* Conditions */ dcl any_other condition; /* Builtin */ dcl (addr, currentsize, null, substr, unspec) builtin; %page; /* Program */ utep = null (); ls_request_server_info_ptr = P_ls_request_server_info_ptr; ls_request_ptr = P_ls_request_ptr; ls_reply_message_ptr = P_ls_ipc_reply_ptr; abort_label = ERROR_RETURN; code = 0; on any_other call as_any_other_handler_$no_cleanup (ME, FAULT_LABEL); if login_server_validate_request.header.request_version ^= LS_VALIDATE_REQUEST_VERSION_1 then call Abort (SL_LOG_SILENT, error_table_$unimplemented_version, "Expected login_server_validate_request version ^a, received ^a.", LS_VALIDATE_REQUEST_VERSION_1, login_server_validate_request.header.request_version); utep = user_table_mgr_$allocate (PT_INTERACTIVE); if utep = null then call Abort (SL_LOG, as_error_table_$tty_no_room, "The answer table is full."); call ipc_$decl_event_call_chn (ute.event, uc_proc_term_handler_, utep, INT_LOGIN_PRIO, code); if code ^= 0 then call Abort (SL_LOG, code, "Setting event call handler for user table entry (^p).", utep); /**** Initialize validate_info and reply_message structures */ unspec (ls_reply_message) = ""b; uc_validate_info_ptr = addr (auto_uc_validate_info); unspec (uc_validate_info) = ""b; /**** Fill in ute from validate request info */ ute.person = login_server_validate_request.person_id; ute.project = login_server_validate_request.project_id; if login_server_validate_request.network_connection_type = NETWORK_CONNECTION_DSA_FILE_TRANSFER then ute.tag = TAG_UFT; else ute.tag = TAG_INTERACTIVE; if login_server_validate_request.flags.anonymous then do; ute.anonymous = ANONYMOUS; uc_validate_info.flags.check_anonymous_password = TRUE; end; else if login_server_validate_request.flags.anon_no_password then do; ute.anonymous = ANONYMOUS; uc_validate_info.flags.check_anonymous_password = FALSE; end; else ute.anonymous = NOT_ANONYMOUS; ute.network_connection_type = login_server_validate_request.network_connection_type; ute.tty_name = login_server_validate_request.connection_info.connection_name; ute.tty_id_code = login_server_validate_request.connection_info.terminal_id; ute.terminal_type = login_server_validate_request.connection_info.terminal_type; ute.line_type = login_server_validate_request.connection_info.line_type; if login_server_validate_request.flags.auth_given then do; ute.login_flags.auth_given = TRUE; ute.process_authorization = login_server_validate_request.authorization; end; ute.login_flags.cpw = login_server_validate_request.flags.change_password; ute.login_flags.generate_pw = login_server_validate_request.flags.gpw; ute.login_flags.cdp = login_server_validate_request.flags.change_default_proj; ute.login_flags.cda = login_server_validate_request.flags.change_default_auth; if ute.login_flags.cpw then do; uc_validate_info.password = login_server_validate_request.new_password; ute.old_password = login_server_validate_request.current_password; end; else uc_validate_info.password = login_server_validate_request.current_password; /**** The operator flag indicates that the user wants to log in as an operator. This is the functional replacement of "dial system.". */ ute.login_flags.operator = login_server_validate_request.flags.operator; ute.login_server_info.his_handle = login_server_validate_request.header.reply_handle; ute.login_server_info.process_id = ls_request_server_info.request_info.sender_process_id; ute.login_server_info.response_event_channel = login_server_validate_request.header.reply_event_channel; ute.login_server_info.termination_event_channel = login_server_validate_request.terminate_event_channel; /**** Finish filling in uc_validate_info */ uc_validate_info.channel_info.access_class_range (*) = login_server_validate_request.connection_info.access_class_range; /**** TBS: At present, there is no check to see if a user, undergoing I&A, has access to use the particular channel on which he is attempting to log in. This really should be done by the AS since we can reject the login as we do for MCS channels if the user lacks appropriate access. For the time being, however, we perform no discretionary access checking on the login channel name. */ uc_validate_info.flags.check_channel_access = FALSE; /**** Clear out message buffer used to hold login messages for the user */ as_data_$ls_message_buffer_cur_lth = 0; call uc_login_ (uc_validate_info_ptr, utep, validate_code); /**** Validate_code gets placed in the response record. */ if validate_code = 0 then call asu_$setup_login_server_handle (utep); call Setup_Response (); if validate_code ^= 0 then goto ERROR_RETURN; else goto RETURN; FAULT_LABEL: code = as_error_table_$dialup_error; ERROR_RETURN: if utep ^= null () then call user_table_mgr_$free (utep); RETURN: P_code = code; return; %page; Setup_Response: procedure (); ls_response_ptr = P_ls_reply_data_ptr; unspec (login_server_validate_response) = ""b; login_server_validate_response.header.message_type = LS_VALIDATE_RESPONSE; login_server_validate_response.header.header_pad = ""b; login_server_validate_response.header.version = LS_VALIDATE_RESPONSE_VERSION_1; login_server_validate_response.handle = ute.login_server_info.our_handle; login_server_validate_response.authorization = ute.process_authorization; login_server_validate_response.authorization_range = ute.process_authorization_range; login_server_validate_response.status_code = validate_code; login_server_validate_response.person_id = substr (ute.person, 1, 22); login_server_validate_response.project_id = substr (ute.project, 1, 9); login_server_validate_response.n_disconnected_processes = uc_validate_info.number_disconnected_processes; login_server_validate_response.previous_login_info.time = uc_validate_info.last_login_info.time; login_server_validate_response.previous_login_info.terminal_type = uc_validate_info.last_login_info.terminal_type; login_server_validate_response.previous_login_info.terminal_id = uc_validate_info.last_login_info.terminal_id; login_server_validate_response.incorrect_passwords = uc_validate_info.last_bad_pw_info.number; login_server_validate_response.last_incorrect_password.terminal_type = uc_validate_info.last_bad_pw_info.terminal_type; login_server_validate_response.last_incorrect_password.terminal_id = uc_validate_info.last_bad_pw_info.terminal_id; if ute.login_result = 1 /* do not allow retry */ then login_server_validate_response.flags.disconnect = TRUE; else login_server_validate_response.flags.disconnect = FALSE; login_server_validate_response.flags.password_changed = uc_validate_info.output_info.flags.changed_password; login_server_validate_response.flags.default_auth_changed = uc_validate_info.output_info.flags.default_authorization_changed; login_server_validate_response.flags.default_proj_changed = uc_validate_info.output_info.flags.changed_default_project; login_server_validate_response.flags.password_expired = uc_validate_info.output_info.flags.password_expired; login_server_validate_response.flags.password_unused_too_long = uc_validate_info.output_info.flags.password_unused_too_long; ip = as_data_$rs_ptrs (0); if login_server_validate_response.flags.password_unused_too_long then login_server_validate_response.password_interval = installation_parms.password_expiration_interval; else if login_server_validate_response.flags.password_expired then login_server_validate_response.password_interval = installation_parms.password_change_interval; login_server_validate_response.flags.pad = ""b; P_ls_reply_data_lth = currentsize (login_server_validate_response); return; end Setup_Response; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: Report an error via sys_log_$general and stop execution if a */ /* nonzero code was given. */ /* */ /* Syntax: call Abort (severity, code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_sev_code_msg; sl_info.caller = ME; sl_info.arg_list_ptr = cu_$arg_list_ptr (); call sys_log_$general (addr (sl_info)); code = sl_info.code; if code ^= 0 then go to abort_label; end Abort; /* format: off */ %page; %include as_data_; %page; %include as_wakeup_priorities; %page; %include dialup_values; %page; %include installation_parms; %page; %include line_types; %page; %include login_server_messages; %page; %include ls_request_server_info; %page; %include sys_log_constants; %page; %include uc_ls_handle; %page; %include uc_validate_info; %page; %include user_attributes; %page; %include user_table_entry; end uc_ls_validate_request_;  uc_proc_term_handler_.pl1 07/13/88 1113.4r w 07/13/88 0938.3 453870 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(85-08-01,Swenson), approve(87-07-14,MCR7737), audit(87-05-18,GDixon), install(87-08-04,MR12.1-1055): Initially coded. 2) change(86-04-09,Herbst), approve(87-07-14,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Changed Disconnect_Process proc to set ute.disconnection_rel_minutes. 3) change(87-03-03,Brunelle), approve(87-07-14,MCR7737), audit(87-07-30,GDixon), install(87-08-04,MR12.1-1055): Added code to handle inacrcvd (inactivity msg received and processed) signal (signal type 12). This reschedules the bump timer scheduled for the user to installation_parms.warning_time from the receipt of the signal by calling asu_$reschedule_bump_timer. 4) change(87-04-27,GDixon), approve(87-07-14,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1 5) change(87-05-17,GDixon), approve(87-07-14,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Use automatic response structures rather than based storage. B) Use constants to set/test ute.preempted. C) Use sys_log_$general to report errors. D) Allow operator requests to bump/detach a logged in user with no process. E) Use new uc_send_ls_response_ calling sequence. 6) change(87-05-18,Parisek), approve(87-07-14,MCR7690), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Added call to remove MC tty when bumping a logged in user with no process (User logged in as operator). 7) change(87-05-18,Brunelle), approve(87-07-14,MCR7737), audit(87-07-30,GDixon), install(87-08-04,MR12.1-1055): Added call to set anstbl.current_time which was forgotten. 8) change(87-05-29,GDixon), approve(87-07-14,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) When bumping a logged-in, no-process UTE, hold the user connection rather than dropping it. 9) change(87-06-02,GDixon), approve(87-07-14,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Correct error in ioa_ control string. 10) change(87-06-09,GDixon), approve(87-07-14,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Include process ID and group ID in login_server_termination_response. For dialed terminals having a UTE, the process ID of the target process has been placed in their UTE by uc_ls_dial_request_ or mc_commands_$mc_login. 11) change(87-07-14,Parisek), approve(87-07-14,MCR7644), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Added code for handling a user "disconnect" command. 12) change(87-07-15,GDixon), approve(87-07-15,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Audit process terminations via as_access_audit_$process. 13) change(87-07-30,GDixon), approve(87-07-30,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Correct arguments in several error messages. B) When user unbumped too late, give him a new process just as dialup_ does. END HISTORY COMMENTS */ /* format: style4,indattr,insnl */ uc_proc_term_handler_: procedure (P_event_call_info_ptr); /* Parameters */ dcl P_event_call_info_ptr ptr parameter; /* Automatic */ dcl code fixed bin (35) automatic; dcl destroy_index fixed bin (17) automatic; dcl ip ptr automatic; dcl metering_enabled bit (1) aligned automatic; dcl pdtep ptr automatic; dcl saved_destroy_flag fixed bin automatic; dcl signal_left_half char (4) automatic; dcl signal_string char (8) automatic; dcl wakeup_from fixed bin automatic; dcl whoptr ptr automatic; /* Automatic Structures */ dcl 1 auto_new_proc_response aligned automatic like login_server_new_proc_response; dcl 1 auto_process_response aligned automatic like login_server_process_response.fixed_part; dcl 1 auto_termination_response aligned automatic like login_server_termination_response; dcl 1 new_proc_auth structure aligned automatic, 2 pad char (2) unaligned, 2 authorization bit (54) unaligned; dcl 1 signal_term_code structure aligned automatic, 2 pad char (4) unaligned, 2 code fixed bin (35) unaligned; /* Based */ dcl stopstop_msg fixed bin (71) based (addr (stopstop)); dcl termstop_msg fixed bin (71) based (addr (termstop)); /* Entries */ dcl act_ctl_$activity_unbump entry (ptr, fixed bin (35)); dcl act_ctl_$close_account entry (ptr); dcl act_ctl_$dp entry (ptr); dcl aim_check_$equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl aim_check_$in_range entry (bit (72) aligned, (2) bit (72) aligned) returns (bit (1) aligned); dcl as_access_audit_$logout entry (ptr, char (*)); dcl as_access_audit_$process entry (ptr, fixed bin, char (*)); dcl as_any_other_handler_$no_cleanup entry (char (*), label); dcl as_meter_$enter entry (fixed bin); dcl as_meter_$exit entry (fixed bin); dcl asu_$reschedule_bump_timer entry (ptr, fixed bin); dcl asu_$send_term_signal entry (ptr, fixed bin) returns (bit (1) aligned); dcl asu_$suspend_process entry (ptr); dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned); dcl dpg_ entry (ptr, char (*)); dcl dpg_$finish entry (ptr); dcl get_process_id_ entry () returns (bit (36)); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl mc_commands_$remove_tty entry (char (*), bit (1) aligned, fixed bin (35)); dcl send_mail_$access_class entry (char (*), char (*), ptr, bit (72) aligned, fixed bin (35)); dcl timer_manager_$reset_alarm_wakeup entry (fixed bin (71)); dcl uc_create_process_ entry (ptr, fixed bin (35)); dcl uc_logout_ entry (ptr, char (*)); dcl uc_send_ls_response_ entry (ptr, fixed bin (18), bit (36) aligned, bit (72) aligned, fixed bin (71), ptr, char (32) aligned, fixed bin (35), fixed bin (35)); dcl user_table_mgr_$free entry (ptr); /* External */ dcl ( as_error_table_$activity_unbump, as_error_table_$automatic_logout, as_error_table_$bump_cancelled, as_error_table_$disc_hd_msg, as_error_table_$illegal_new_proc, as_error_table_$illegal_signal, as_error_table_$init_err, as_error_table_$no_disc_hd, as_error_table_$no_init_proc, as_error_table_$no_io_attach, as_error_table_$no_logout_hold, as_error_table_$no_perm_disc, as_error_table_$no_signal, as_error_table_$shutdown, as_error_table_$term_by_operator ) fixed bin (35) external static; dcl ( error_table_$fatal_error, error_table_$messages_deferred, error_table_$messages_off, error_table_$null_info_ptr ) fixed bin (35) ext static; /* Constant */ dcl ( FALSE initial ("0"b), TRUE initial ("1"b) ) bit (1) aligned internal static options (constant); dcl MAX_USER_SIGNALS fixed bin int static options (constant) init (19); dcl ME char (21) initial ("uc_proc_term_handler_") internal static options (constant); dcl ( UNKNOWN_SOURCE init (0), RING_0 init (1), USER init (2), USER_CONTROL init (3) ) fixed bin int static options (constant); dcl USEC_PER_MINUTE fixed bin (35) int static options (constant) init (60000000); dcl USEC_PER_SECOND fixed bin (35) int static options (constant) init (1000000); dcl WAKEUP_SOURCE (0:3) char (16) varying int static options (constant) init ( "unknown source", "ring 0", "UTE user", "user control"); dcl ( stopstop initial ("stopstop"), termstop initial ("termstop") ) char (8) internal static options (constant); /* Conditions */ dcl any_other condition; dcl cleanup condition; /* Builtin */ dcl (addr, baseno, clock, currentsize, divide, hbound, lbound, length, max, null, rtrim, substr, unspec) builtin; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* Program */ code = 0; event_call_info_ptr = P_event_call_info_ptr; ansp = as_data_$ansp; ip = as_data_$rs_ptrs (0); whoptr = as_data_$whoptr; anstbl.current_time = clock (); /* Read Clock */ metering_enabled = FALSE; on cleanup call Clean_Up (); on any_other call as_any_other_handler_$no_cleanup (ME, RETURN); if event_call_info_ptr = null () then call Abort (error_table_$null_info_ptr, "Null event_call_info pointer."); /**** TBS: This is not strictly correct, since we're not dialup */ metering_enabled = TRUE; call as_meter_$enter (DIALUP_METER); unspec (signal_string) = unspec (event_call_info.message); destroy_index = PT_FPE; /* fatal process error is default */ utep = event_call_info.data_ptr; /* Ensure ute points to one of our user tables. */ call Validate_UTEp (); wakeup_from = UNKNOWN_SOURCE; if event_call_info.ring = 0 then wakeup_from = RING_0; else if event_call_info.sender = get_process_id_ () then wakeup_from = USER_CONTROL; else if ute.active = NOW_HAS_PROCESS & ute.proc_id = event_call_info.sender then wakeup_from = USER; else call Abort (-1, "UTE (^d, ^p in ^a) received wakeup (^a, ^24.3b) from invalid process (^12.3b).", ute.ute_index, utep, TABLE_NAMES (ute.process_type), signal_string, unspec (signal_string), event_call_info.sender); if ute.active = NOW_FREE then call Abort (-1, "Free UTE (^d, ^p in ^a) received wakeup (^a, ^24.3b) from ^a.", ute.ute_index, utep, TABLE_NAMES (ute.process_type), signal_string, unspec (signal_string), WAKEUP_SOURCE (wakeup_from)); call Setup_LS_Termination_Response (); /**** In the event that the operator tried to bump a user who was logged in with no process, handle this case. Assume that any wakeup sent to the UTE is a "bump" request, since no others make a whole lot of sense, anyway. */ if ute.destroy_flag < WAIT_LOGOUT_SIG then if ute.active = NOW_LOGGED_IN then do; call Kill_Login_and_Notify_LS (); end; else call Abort (-1, "UTE (^d, ^p in ^a) wakeup (^a, ^24.3b) from ^a with unexpected destroy_flag (^a, ^d).", ute.ute_index, utep, TABLE_NAMES (ute.process_type), signal_string, unspec(signal_string), WAKEUP_SOURCE (wakeup_from), TRA_VEC_VALUES (ute.destroy_flag), ute.destroy_flag); if wakeup_from = USER then call Process_User_Wakeup (); else call Process_System_Wakeup (); if destroy_index < lbound (term_handler, 1) | destroy_index > hbound (term_handler, 1) then call Abort (-1, "UTE (^d, ^p in ^a) wakeup (^a, ^24.3b) from ^a with unexpected destroy_index (^d).", ute.ute_index, utep, TABLE_NAMES (ute.process_type), signal_string, unspec(signal_string), WAKEUP_SOURCE (wakeup_from), destroy_index); signal_left_half = substr (signal_string, 1, length (signal_left_half)); if signal_string ^= "stopstop" & signal_string ^= "termsgnl" then ute.logout_type = signal_left_half; goto term_handler (destroy_index); /* PT_FPE */ term_handler (1): if signal_left_half = "init" | signal_left_half = "term" then do; unspec (signal_term_code) = unspec (signal_string); login_server_termination_response.status_code = signal_term_code.code; end; else /* We should have SOME error code */ login_server_termination_response.status_code = error_table_$fatal_error; login_server_termination_response.flags.fatal_error = TRUE; call Prepare_To_Terminate_Process (); goto TERMINATE; /**** PT_NEW_PROC */ term_handler (2): ute.destroy_flag = WAIT_NEW_PROC; goto TERMINATE; /**** PT_LOGOUT_HOLD */ term_handler (3): if installation_parms.trusted_path_login then do; ute.destroy_flag = WAIT_LOGOUT; login_server_termination_response.status_code = as_error_table_$no_logout_hold; end; else /* ^trusted_path_login */ ute.destroy_flag = WAIT_LOGOUT_HOLD; goto TERMINATE; /**** PT_LOGOUT */ term_handler (4): ute.destroy_flag = WAIT_LOGOUT; goto TERMINATE; /**** PT_LOGOUT_BRIEF */ term_handler (5): login_server_termination_response.flags.brief = TRUE; ute.destroy_flag = WAIT_LOGOUT; goto TERMINATE; /**** PT_LOGOUT_HOLD_BRIEF */ term_handler (6): if installation_parms.trusted_path_login then do; login_server_termination_response.status_code = as_error_table_$no_logout_hold; ute.destroy_flag = WAIT_LOGOUT; end; else do; /* ^trusted_path_login */ login_server_termination_response.flags.brief = TRUE; ute.destroy_flag = WAIT_LOGOUT_HOLD; end; goto TERMINATE; /**** PT_INITIALIZATION_ERROR, init_err */ term_handler (7): login_server_termination_response.flags.offer_help = TRUE; login_server_termination_response.flags.fpe_during_init = TRUE; login_server_termination_response.status_code = as_error_table_$init_err; ute.destroy_flag = WAIT_LOGOUT_HOLD; goto TERMINATE; /**** PT_IO_ATTACHMENT_ERROR, no_ioatt */ term_handler (8): login_server_termination_response.flags.offer_help = TRUE; login_server_termination_response.status_code = as_error_table_$no_io_attach; ute.destroy_flag = WAIT_LOGOUT_HOLD; goto TERMINATE; /**** PT_BAD_INITIAL_PROCEDURE, no_initp */ term_handler (9): login_server_termination_response.status_code = as_error_table_$no_init_proc; login_server_termination_response.flags.fpe_during_init = TRUE; login_server_termination_response.flags.offer_help = TRUE; ute.destroy_flag = WAIT_LOGOUT_HOLD; goto TERMINATE; /**** PT_DISCONNECT_COMMAND */ term_handler (10): /* User typed disconnect */ if ^ute.at.disconnect_ok then do; login_server_termination_response.status_code = as_error_table_$no_perm_disc; login_server_termination_response.fatal_error = TRUE; call Prepare_To_Terminate_Process(); goto TERMINATE; end; if installation_parms.trusted_path_login then do; login_server_termination_response.status_code = as_error_table_$no_disc_hd; end; else login_server_termination_response.status_code = as_error_table_$disc_hd_msg; goto term_handler (20); /**** PT_OBSOLETE_1 */ term_handler (11): goto term_handler (PT_LOGOUT); /**** PT_INACTIVITY_RECEIVED */ term_handler (12): if (ute.preempted = PREEMPT_BUMPED & ute.activity_can_unbump) then do; /* user waiting on bump timer */ call asu_$reschedule_bump_timer (utep, installation_parms.warning_time); end; go to RETURN; /**** PT_NEW_PROC_AUTH */ term_handler (13): ute.destroy_flag = WAIT_NEW_PROC; if ute.disconnected then do; login_server_termination_response.status_code = as_error_table_$illegal_new_proc; ute.destroy_flag = WAIT_LOGOUT; end; else do; /* not a disconnected process */ unspec (new_proc_auth) = unspec (signal_string); if ^aim_check_$in_range ((new_proc_auth.authorization), ute.process_authorization_range) then do; login_server_termination_response.status_code = as_error_table_$illegal_new_proc; end; /**** TBS: Check channel authorization */ else if installation_parms.trusted_path_login then do; if ^aim_check_$equal ((new_proc_auth.authorization), ute.process_authorization) then login_server_termination_response.status_code = as_error_table_$illegal_new_proc; end; else do; /* everything ok */ ute.process_authorization = new_proc_auth.authorization; if ute.whotabx > 0 then whotab.e (ute.whotabx).process_authorization = ute.process_authorization; end; end; goto TERMINATE; /**** PT_TERM_SIGNAL */ term_handler (14): /**** ute.preempted says what to do here: -1 user unbumped after term signal sent 0 user unbumped; ignore alarm___ 1 value internally used in load_ctl_ 2 user bumped; when alarm___ comes in, send term signal 3 term signal sent; destroy process if termsgnl, alarm___, or cpulimit signals come in 4 user bumped; process sick, so destroy without sending term signal 5 trm_ signal sent, termsgnl received; (if still 3, we never got the termsgnl). */ call timer_manager_$reset_alarm_wakeup (ute.event); if ute.preempted = PREEMPT_UNBUMP then do; /* unbumped too late */ login_server_termination_response.status_code = as_error_table_$bump_cancelled; ute.destroy_flag = WAIT_NEW_PROC; /* give user a new process. Best we can do. */ call Prepare_To_Terminate_Process (); end; else if ute.preempted = PREEMPT_TERM_SENT then do;/* sent trm_ signal, expecting this */ ute.preempted = PREEMPT_TERMSGNL_RECEIVED; /* no longer expected termsgnl */ goto term_handler (ute.logout_index); /* continue doing it */ end; else do; /* unexpected termsgnl */ login_server_termination_response.status_code = as_error_table_$illegal_signal; login_server_termination_response.fatal_error = TRUE; ute.logout_type = "term"; call Prepare_To_Terminate_Process (); end; goto TERMINATE; /**** PT_UNUSED_1 */ term_handler (15): goto term_handler (PT_LOGOUT); /**** PT_UNUSED_2 */ term_handler (16): goto term_handler (PT_LOGOUT); /**** PT_UNUSED_3 */ term_handler (17): goto term_handler (PT_LOGOUT); /**** PT_UNUSED_4 */ term_handler (18): goto term_handler (PT_LOGOUT); /**** PT_UNUSED_5 */ term_handler (19): goto term_handler (PT_LOGOUT); /**** PT_HANGUP */ term_handler (20): if ute.active = NOW_HAS_PROCESS & ute.preempted <= PREEMPT_UNBUMP_IGNORE_ALARM then if ute.save_if_disconnected then do; call Disconnect_Process (); goto RETURN; end; else if signal_string = "disconn" then do; call Disconnect_Process (); call Notify_LS_After_Disconnect; goto RETURN; end; if asu_$send_term_signal (utep, PT_HANGUP) then goto RETURN; /* come back later */ else do; ute.destroy_flag = WAIT_LOGOUT; ute.logout_type = "hngp"; /* "hang" would be misleading */ end; goto TERMINATE; /**** PT_SHUTDOWN */ term_handler (21): if asu_$send_term_signal (utep, PT_SHUTDOWN) then goto RETURN; else do; ute.destroy_flag = WAIT_LOGOUT; login_server_termination_response.status_code = as_error_table_$shutdown; end; goto TERMINATE; /**** PT_BUMP */ term_handler (22): if asu_$send_term_signal (utep, PT_BUMP) then goto RETURN; else do; ute.destroy_flag = WAIT_LOGOUT; login_server_termination_response.status_code = as_error_table_$automatic_logout; end; goto TERMINATE; /**** PT_ALARM */ term_handler (23): if ute.sus_sent & ^ute.suspended then /* timeout on sus response */ call Process_Ignored_Sus_Signal (); else if ute.preempted <= PREEMPT_UNBUMP_IGNORE_ALARM then /* unbumped */ goto RETURN; else do; if (ute.preempted = PREEMPT_BUMPED & ute.activity_can_unbump) then do; call Process_Bump_Timer (code); /* bump timer went off, see if user woke up */ if code = 0 then go to term_handler (PT_UNBUMP); /* unbump */ end; if asu_$send_term_signal (utep, PT_ALARM) then goto RETURN; else if ute.preempted = PREEMPT_TERM_SENT then do; /* already send trm_ signal */ call Process_Ignored_Trm_Signal (); end; else do; ute.destroy_flag = WAIT_LOGOUT; if anstbl.session = AT_SHUTDOWN then login_server_termination_response.status_code = as_error_table_$shutdown; else login_server_termination_response.status_code = as_error_table_$automatic_logout; end; end; goto TERMINATE; /**** PT_DETACH, detach */ term_handler (24): if ute.active < NOW_HAS_PROCESS then do; /* never get here */ goto RETURN; /* handled at top */ end; /* of program. */ else if asu_$send_term_signal (utep, PT_DETACH) then goto RETURN; else do; ute.destroy_flag = WAIT_LOGOUT; login_server_termination_response.status_code = as_error_table_$automatic_logout; end; goto TERMINATE; /**** PT_UNBUMP */ term_handler (25): ute.activity_can_unbump = FALSE; if ute.preempted = PREEMPT_TERM_SENT then /* already sent trm_ */ ute.preempted = PREEMPT_UNBUMP; /* remember this */ else ute.preempted = PREEMPT_UNBUMP_IGNORE_ALARM; /* no longer preempted */ goto RETURN; /**** PT_STOPSTOP */ term_handler (26): if ute.destroy_flag <= WAIT_LOGOUT_SIG then do; call Log ("Premature stopstop for ^[*^]^a.^a ^a ^12.3b.", (ute.anonymous = 1), ute.person, ute.project, ute.tty_name, ute.proc_id); call hcs_$wakeup (anstbl.as_procid, ute.event, termstop_msg, (0)); call hcs_$wakeup (anstbl.as_procid, ute.event, stopstop_msg, (0)); end; else do; call dpg_$finish (utep); call act_ctl_$dp (utep); ute.active = NOW_LOGGED_IN; /**** If the user has been bumped (by the operator or for a shutdown), don't let him get out of the bump by getting a new process. Otherwise, indicate that the user is no longer in the state of process destruction. */ if ute.destroy_flag ^= WAIT_NEW_PROC & ute.destroy_flag ^= WAIT_NEW_PROC_REQUEST then do; call Close_Account_And_Logout (); if ute.destroy_flag = WAIT_DESTROY_REQUEST then call Notify_LS_With_Process_Response (WAIT_DESTROY_REQUEST, 0); end; else do; /* user is getting a new process */ saved_destroy_flag = ute.destroy_flag; /* uc_create_process_ will clobber ute.destroy_flag */ if ute.preempted >= PREEMPT_TERM_SENT then ute.preempted = PREEMPT_UNBUMP_IGNORE_ALARM; call uc_create_process_ (utep, code); if code ^= 0 then call Close_Account_And_Logout (); if saved_destroy_flag = WAIT_NEW_PROC then call Send_New_Process_Response (code); else call Notify_LS_With_Process_Response (saved_destroy_flag, code); if code = 0 then goto RETURN; /* i.e. do not free UTE */ end; call user_table_mgr_$free (utep); end; goto RETURN; /**** PT_OPERATOR_TERMINATE, terminat */ term_handler (27): if asu_$send_term_signal (utep, PT_OPERATOR_TERMINATE) then goto RETURN; else do; login_server_termination_response.status_code = as_error_table_$term_by_operator; login_server_termination_response.flags.fatal_error = TRUE; call Prepare_To_Terminate_Process (); end; goto TERMINATE; /**** PT_TERMSTOP */ term_handler (28): ute.destroy_flag = WAIT_LOGOUT_HOLD; login_server_termination_response.status_code = as_error_table_$no_signal; goto TERMINATE; /**** PT_CPU_LIMIT */ term_handler (29): if ute.ignore_cpulimit then do; ute.ignore_cpulimit = FALSE; goto RETURN; end; if ute.preempted = PREEMPT_TERM_SENT then do; call timer_manager_$reset_alarm_wakeup (ute.event); call Process_Ignored_Trm_Signal (); end; else if ute.sus_sent then do; call timer_manager_$reset_alarm_wakeup (ute.event); call Process_Ignored_Sus_Signal (); goto TERMINATE; end; else call Abort (-1, "Unexpected cpulimit wakeup for ^[*^]^a.^a ^a ^12.3b.", (ute.anonymous = 1), ute.person, ute.project, ute.tty_name, ute.proc_id); goto RETURN; /**** PT_DESTROY_REQUEST */ term_handler (30): /**** We get here when the user has used the -destroy control argument to the login command, or the "destroy" login server request. The user process has been sent the trm_ signal, and has either responded properly with the "termsgnl", or our real or cpu timer has gone off. In any case, we must now destroy the process. When the process has destroyed itself, we receive the "stopstop" wakeup from ring-0 and the handler for this wakeup, above, will notify the login server for user. */ ute.destroy_flag = WAIT_DESTROY_REQUEST; call Kill_Process (); goto RETURN; /**** PT_NEW_PROC_REQUEST */ term_handler (31): /**** We get here when the user has used the -new_proc control argument to the login command, or the "new_proc" login server request. The user process has been sent the trm_ signal, and has responded (or timed out). Now we must destroy the process. */ ute.destroy_flag = WAIT_NEW_PROC_REQUEST; call Kill_Process (); goto RETURN; TERMINATE: call Kill_Process_And_Notify_LS (); RETURN: call Clean_Up (); return; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* I N T E R N A L P R O C E D U R E S */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: Report errors via sys_log_$general and stop execution. */ /* */ /* Syntax: call Abort (code, ioa_ctl, args); */ /* */ /* */ /* Log, Log_Error: Report errors via sys_log_$general. */ /* */ /* Syntax: call Log (ioa_ctl, args); */ /* call Log_Error (code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_code_msg; sl_info.arg_list_ptr = cu_$arg_list_ptr (); sl_info.severity = SL_LOG_SILENT; sl_info.caller = ME; call sys_log_$general (addr (sl_info)); code = sl_info.code; if code ^= 0 then go to RETURN; return; Log: entry options (variable); sl_info = sl_info_msg; sl_info.arg_list_ptr = cu_$arg_list_ptr (); sl_info.severity = SL_LOG_SILENT; sl_info.caller = ME; call sys_log_$general (addr (sl_info)); return; Log_Error: entry options (variable); sl_info = sl_info_code_msg; sl_info.arg_list_ptr = cu_$arg_list_ptr (); sl_info.severity = SL_LOG_SILENT; sl_info.caller = ME; call sys_log_$general (addr (sl_info)); return; end Abort; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ Clean_Up: procedure (); /**** Stop metering time in this procedure. */ if metering_enabled then call as_meter_$exit (DIALUP_METER); return; end Clean_Up; /* * * * * * * * * * * * * * * * * * * * * * * * * */ Close_Account_And_Logout: procedure (); call act_ctl_$close_account (utep); call uc_logout_ (utep, ute.logout_type); return; end Close_Account_And_Logout; /* * * * * * * * * * * * * * * * * * * * * * * * * */ Convert_Status_Code: procedure (P_code) returns (char (100) aligned); dcl P_code fixed bin (35) parameter; dcl status_code_short char (8) aligned automatic; dcl status_code_string char (100) aligned automatic; call convert_status_code_ (P_code, status_code_short, status_code_string); return (status_code_string); Convert_Status_Code_Short: entry (P_code) returns (char (8) aligned); call convert_status_code_ (P_code, status_code_short, status_code_string); return (status_code_short); end Convert_Status_Code; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ Disconnect_Process: procedure (); call asu_$suspend_process (utep); ute.disconnected = TRUE; ute.disconnection_rel_minutes = divide (clock () - ute.login_time, USEC_PER_MINUTE, 17, 0); if ute.whotabx > 0 then whotab.e (ute.whotabx).disconnected = TRUE; ute.pdtep -> user.n_disconnected = max (0, ute.pdtep -> user.n_disconnected + 1); call as_access_audit_$process (utep, AS_AUDIT_PROCESS_DISCONNECT, "hangup"); call as_access_audit_$logout (utep, "disconnect"); return; end Disconnect_Process; /* * * * * * * * * * * * * * * * * * * * * * * * * */ Get_Group_ID: procedure () returns (char (32) varying); dcl group char (32) varying; group = ""; if ute.person ^= "" then do; group = rtrim (ute.person); group = group || "."; group = group || rtrim (ute.project); group = group || "."; group = group || ute.tag; end; return (group); end Get_Group_ID; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ Get_Start_Event_Channel: procedure () returns (fixed bin (71)); dcl local_code fixed bin (35) automatic; dcl r_factor fixed bin (35) automatic; dcl r_offset fixed bin (18) automatic; dcl start_event_channel fixed bin (71) automatic; dcl hphcs_$get_ipc_operands entry (bit (36) aligned, fixed bin (18), fixed bin (35), fixed bin (35)); dcl ipc_validate_$encode_event_channel_name entry (fixed bin (18), fixed bin (35), bit (3) aligned, fixed bin (15), fixed bin (3), bit (1) aligned, fixed bin (18), fixed bin (71)); /**** We must construct an event channel which will pass the IPC event channel validation tests. To do this, we must learn the values of R-Offset and R-Factor for the process. */ call hphcs_$get_ipc_operands (ute.proc_id, r_offset, r_factor, local_code); if local_code = 0 then do; call ipc_validate_$encode_event_channel_name (r_offset, r_factor, "000"b /* flags */, 1 /* index */, 4 /* ring */, "1"b /* regular */, 1 /* unique id */, start_event_channel); end; else do; call Log_Error (local_code, "Retrieving R-Offset and R-Factor for ^[*^]^a.^a ^a ^12.3b", (ute.anonymous = 1), ute.person, ute.project, ute.tty_name, ute.proc_id); start_event_channel = 0; end; return (start_event_channel); end Get_Start_Event_Channel; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ Kill_Login_and_Notify_LS: procedure; dcl 1 local_ls_reply_message aligned like ls_reply_message automatic; ls_response_ptr = addr (auto_termination_response); login_server_termination_response.process_id = /* dialed terms */ ute.proc_id; /* have target */ /* proc's ID. */ login_server_termination_response.process_group_id = Get_Group_ID (); login_server_termination_response.status_code = as_error_table_$term_by_operator; login_server_termination_response.flags.fatal_error = TRUE; login_server_termination_response.flags.logout = TRUE; login_server_termination_response.flags.hold = TRUE; unspec (local_ls_reply_message) = ""b; call uc_send_ls_response_ (ls_response_ptr, currentsize (login_server_termination_response), ute.login_server_info.process_id, ute.login_server_info.his_handle, ute.login_server_info.response_event_channel, addr (local_ls_reply_message), (ute.tty_name), 0, code); if code ^= 0 then call Log_Error (code, "Sending termination response for ^[*^]^a.^a ^a ^12.3b to login server.", (ute.anonymous = 1), ute.person, ute.project, ute.tty_name, ute.proc_id); call uc_logout_ (utep, "bump"); if ute.login_flags.operator | ute.login_flags.special_pw.dial_pw then do; /* MC terminal */ call mc_commands_$remove_tty (ute.tty_name, "1"b, code); if code ^= 0 then call Log_Error (code, "Removing ^a from the MC answer table.", ute.tty_name); end; call user_table_mgr_$free (utep); goto RETURN; end Kill_Login_and_Notify_LS; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ Kill_Process: procedure (); if ute.active = NOW_HAS_PROCESS then call dpg_ (utep, (signal_string)); return; end Kill_Process; /* * * * * * * * * * * * * * * * * * * * * * * * * */ Kill_Process_And_Notify_LS: procedure (); call Kill_Process (); ls_response_ptr = addr (auto_termination_response); login_server_termination_response.process_id = ute.proc_id; login_server_termination_response.process_group_id = Get_Group_ID (); if ute.destroy_flag = WAIT_LOGOUT then do; login_server_termination_response.flags.logout = TRUE; login_server_termination_response.flags.hold = FALSE; end; else if ute.destroy_flag = WAIT_LOGOUT_HOLD then do; login_server_termination_response.flags.logout = TRUE; login_server_termination_response.flags.hold = TRUE; end; else if ute.destroy_flag = WAIT_NEW_PROC then login_server_termination_response.flags.new_proc = TRUE; else call Abort (-1, "ute.destroy_flag = ^d at after process destruction.", ute.destroy_flag); call Notify_LS (); return; end Kill_Process_And_Notify_LS; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ Notify_LS: procedure; dcl 1 local_ls_reply_message aligned like ls_reply_message automatic; login_server_termination_response.accounting_info.cpu_usage = ute.cpu_usage; login_server_termination_response.accounting_info.cost = ute.session_cost; unspec (local_ls_reply_message) = ""b; call uc_send_ls_response_ (ls_response_ptr, currentsize (login_server_termination_response), ute.login_server_info.process_id, ute.login_server_info.his_handle, ute.login_server_info.termination_event_channel, addr (local_ls_reply_message), (ute.tty_name), 0, code); if code ^= 0 then call Log_Error (code, "Could not send process termination response for ^a.^a.^a to login server.", ute.person, ute.project, ute.tag); end Notify_LS; /* * * * * * * * * * * * * * * * * * * * * * * * * */ Notify_LS_After_Disconnect: /* Called for */ procedure (); /* user-typed */ /* disconnect */ /* command. */ login_server_termination_response.flags.logout = TRUE; if login_server_termination_response.status_code = as_error_table_$disc_hd_msg then login_server_termination_response.flags.hold = TRUE; else login_server_termination_response.flags.hold = FALSE; call Notify_LS (); return; end Notify_LS_After_Disconnect; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ Notify_LS_With_Process_Response: procedure (P_reason, P_code); /**** This procedure is called to notify the Login Server for a user of the successful execution of the "destroy" or "new_proc" login server requests. */ dcl P_reason fixed bin parameter; dcl P_code fixed bin (35) parameter; dcl 1 local_ls_reply_message aligned like ls_reply_message automatic; unspec (local_ls_reply_message) = ""b; local_ls_reply_message.code = P_code; ls_process_response_accounting_message_length = 0; ls_response_ptr = addr (auto_process_response); unspec (login_server_process_response) = ""b; login_server_process_response.header.message_type = LS_PROCESS_RESPONSE; login_server_process_response.header.version = LOGIN_SERVER_PROCESS_RESPONSE_VERSION_1; login_server_process_response.status_code = P_code; login_server_process_response.process_id = ute.proc_id; /**** Since we've switched UTEs on the loging server, we need to apprise it of the new handle associated with this connection. */ login_server_process_response.new_handle = ute.login_server_info.our_handle; login_server_process_response.authorization = ute.process_authorization; login_server_process_response.process_group_id = Get_Group_ID (); login_server_process_response.process_number = 0; if ute.pdtep ^= null then login_server_process_response.n_disconnected_processes = ute.pdtep -> user.n_disconnected; else login_server_process_response.n_disconnected_processes = 0; if P_reason = WAIT_NEW_PROC_REQUEST then login_server_process_response.start_event_channel = Get_Start_Event_Channel (); login_server_process_response.login_instance = 0; login_server_process_response.accounting_info.cpu_usage = ute.cpu_usage; login_server_process_response.accounting_info.cost = ute.session_cost; if P_reason = WAIT_DESTROY_REQUEST then do; login_server_process_response.flags.destroyed = TRUE; /**** This could be based on an installation parameter */ login_server_process_response.flags.logout = TRUE; end; else if P_reason = WAIT_NEW_PROC_REQUEST then login_server_process_response.flags.new_proc = TRUE; login_server_process_response.initial_ring = ute.initial_ring; login_server_process_response.already_logged_in_info.connection_name = ""; login_server_process_response.already_logged_in_info.terminal_type = ""; login_server_process_response.already_logged_in_info.terminal_id = ""; login_server_process_response.accounting_message_length = 0; call uc_send_ls_response_ (ls_response_ptr, currentsize (login_server_process_response), ute.login_server_info.process_id, ute.login_server_info.his_handle, ute.login_server_info.response_event_channel, addr (local_ls_reply_message), (ute.tty_name), 0, code); if code ^= 0 then call Log_Error (code, "Sending login server response for process destruction of ^a.^a.^a.", ute.person, ute.project, ute.tag); return; end Notify_LS_With_Process_Response; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ Prepare_To_Terminate_Process: procedure (); call as_access_audit_$process (utep, AS_AUDIT_PROCESS_TERMINATE, Convert_Status_Code_Short( login_server_termination_response.status_code)); if ute.disconnected then ute.destroy_flag = WAIT_LOGOUT; else if substr (signal_string, 1, 4) = "init" then do; /* during init */ ute.destroy_flag = WAIT_LOGOUT_HOLD; login_server_termination_response.flags.fpe_during_init = TRUE; login_server_termination_response.flags.offer_help = TRUE; end; else do; /* not during init */ if ute.recent_fatal_error_time + installation_parms.fatal_error_loop_seconds * USEC_PER_SECOND < anstbl.current_time then do; if ute.uflags.fpe_causes_logout then do; login_server_termination_response.flags.fpe_caused_logout = TRUE; ute.destroy_flag = WAIT_LOGOUT_HOLD; end; else do; /* ^fpe_causes_logout */ ute.recent_fatal_error_time = anstbl.current_time; ute.recent_fatal_error_count = 1; ute.destroy_flag = WAIT_NEW_PROC; end; end; else do; /* recent fatal process error */ ute.recent_fatal_error_count = ute.recent_fatal_error_count + 1; if ute.recent_fatal_error_count < installation_parms.fatal_error_loop_count then ute.destroy_flag = WAIT_NEW_PROC; else /* exceeded fatal_error_loop_count */ do; ute.destroy_flag = WAIT_LOGOUT_HOLD; login_server_termination_response.flags.fpe_loop = TRUE; login_server_termination_response.flags.offer_help = TRUE; end; end; end; return; end Prepare_To_Terminate_Process; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ Process_Bump_Timer: procedure (P_code); dcl P_code fixed bin (35); dcl code fixed bin (35); dcl user_id char (32); call act_ctl_$activity_unbump (utep, P_code); if P_code = 0 then do; /* acceptably active */ call Log ("Cancelling inactivity bump of ^a.^a", ute.person, ute.project); /* notify user of unbump */ user_id = rtrim (ute.person) || "." || /* build Person.Project */ rtrim (ute.project); unspec (send_mail_info) = "0"b; send_mail_info.version = send_mail_info_version_2; send_mail_info.wakeup = "1"b; send_mail_info.always_add = "1"b; send_mail_info.sent_from = "answering service"; call send_mail_$access_class (user_id, Convert_Status_Code (as_error_table_$activity_unbump), addr (send_mail_info), ute.process_authorization, code); if code ^= 0 & code ^= error_table_$messages_deferred & code ^= error_table_$messages_off then call Log_Error (code, "When attempting to notify user ^a of dialup event", user_id); end; end Process_Bump_Timer; /* * * * * * * * * * * * * * * * * * * * * * * * * */ Process_Ignored_Sus_Signal: procedure (); call Log ("sus_ signal ignored by ^[*^]^a.^a ^a ^12.3b.", (ute.anonymous = 1), ute.person, ute.project, ute.tty_name, ute.proc_id); if asu_$send_term_signal (utep, PT_HANGUP) then goto RETURN; else ute.destroy_flag = WAIT_LOGOUT; return; end Process_Ignored_Sus_Signal; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ Process_Ignored_Trm_Signal: procedure (); ute.preempted = PREEMPT_TERMSGNL_RECEIVED; /* no longer waiting termsgnl */ call Log ("process ignored trm_ signal ^a.^a.^a on channel ^a.", ute.person, ute.project, ute.tag, ute.tty_name); if ute.logout_index = PT_ALARM then do; /* bump */ ute.destroy_flag = WAIT_LOGOUT; if anstbl.session = AT_SHUTDOWN then login_server_termination_response.status_code = as_error_table_$shutdown; else login_server_termination_response.status_code = as_error_table_$automatic_logout; call Kill_Process_And_Notify_LS (); end; else goto term_handler (ute.logout_index); /* not bump */ end Process_Ignored_Trm_Signal; /* * * * * * * * * * * * * * * * * * * * * * * * * */ Process_Sus_Response: procedure (); ute.sus_channel = event_call_info.message; if ^ute.ignore_cpulimit then do; /* not released before responded */ ute.suspended = TRUE; if ute.whotabx > 0 then whotab.e (ute.whotabx).suspended = TRUE; /**** Turn off realtime timer we set for responded to sus_ signal. */ call timer_manager_$reset_alarm_wakeup (ute.event); end; else do; /* released before responded */ ute.sus_sent = FALSE; if ute.whotabx > 0 then whotab.e (ute.whotabx).suspended = FALSE; /**** Tell process it may run again. */ call hcs_$wakeup (ute.proc_id, ute.sus_channel, 0, (0)); end; return; end Process_Sus_Response; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ Process_System_Wakeup: procedure (); do destroy_index = 1 to as_data_$system_signal_types.n_system_signals while (signal_string ^= as_data_$system_signal_types.system_signals (destroy_index)); end; if destroy_index <= as_data_$system_signal_types.n_system_signals then destroy_index = destroy_index + MAX_USER_SIGNALS; else call Abort (-1, "Invalid system signal ^a.", signal_string); return; end Process_System_Wakeup; /* * * * * * * * * * * * * * * * * * * * * * * * * */ Process_User_Wakeup: procedure (); do destroy_index = 1 to as_data_$signal_types.n_signals while (signal_string ^= as_data_$signal_types.signals (destroy_index)); end; if destroy_index <= as_data_$signal_types.n_signals then ; else if substr (signal_string, 1, 4) = "term" | substr (signal_string, 1, 4) = "init" then destroy_index = PT_FPE; else if substr (signal_string, 1, 2) = "np" then destroy_index = PT_NEW_PROC_AUTH; else if ute.sus_sent & ^ute.suspended then do; call Process_Sus_Response (); goto RETURN; end; else do; login_server_termination_response.status_code = as_error_table_$illegal_signal; login_server_termination_response.flags.fatal_error = TRUE; call Prepare_To_Terminate_Process (); goto TERMINATE; end; return; end Process_User_Wakeup; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ Setup_LS_Termination_Response: procedure (); ls_response_ptr = addr (auto_termination_response); unspec (login_server_termination_response) = ""b; login_server_termination_response.header.message_type = LS_TERMINATION_RESPONSE; login_server_termination_response.header.version = LOGIN_SERVER_TERMINATION_RESPONSE_VERSION_1; login_server_termination_response.process_id = ute.proc_id; login_server_termination_response.process_group_id = Get_Group_ID (); return; end Setup_LS_Termination_Response; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ Send_New_Process_Response: procedure (P_code); dcl P_code fixed bin (35) parameter; dcl 1 local_ls_reply_message aligned like ls_reply_message automatic; if P_code ^= 0 then do; call Log_Error (P_code, "Could not create new process for ^a.^a.^a.", ute.person, ute.project, ute.tag); return; end; ls_response_ptr = addr (auto_new_proc_response); unspec (login_server_new_proc_response) = ""b; login_server_new_proc_response.header.message_type = LS_NEW_PROC_RESPONSE; login_server_new_proc_response.header.version = LOGIN_SERVER_NEW_PROC_RESPONSE_VERSION_1; login_server_new_proc_response.new_authorization = ute.process_authorization; login_server_new_proc_response.new_start_event_channel = Get_Start_Event_Channel (); login_server_new_proc_response.new_process_id = ute.proc_id; unspec (local_ls_reply_message) = ""b; call uc_send_ls_response_ (ls_response_ptr, currentsize (login_server_new_proc_response), ute.login_server_info.process_id, ute.login_server_info.his_handle, ute.login_server_info.termination_event_channel, addr (local_ls_reply_message), (ute.tty_name), 0, code); if code ^= 0 then call Log_Error (code, "Sending new process login server response for ^[*^]^a.^a ^a ^12.3b.", (ute.anonymous = 1), ute.person, ute.project, ute.tty_name, ute.proc_id); return; end Send_New_Process_Response; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ Validate_UTEp: procedure (); /**** Ensure the utep supplied as the event call data pointer points into either the answer_table, the absentee_user_table, or the daemon_user_table. Otherwise, reject the wakeup. */ if utep = null () then call Abort (error_table_$null_info_ptr, "Null UTE pointer with wakeup (^a, ^24.3b) from process ^12.3b.", signal_string, unspec (signal_string), event_call_info.sender); if baseno (utep) ^= baseno (as_data_$ansp) & baseno (utep) ^= baseno (as_data_$autp) & baseno (utep) ^= baseno (as_data_$dutp) then call Abort (-1, "Invalid UTE pointer (^p) with wakeup (^a, ^24.3b) from process ^12.3b.", utep, signal_string, unspec (signal_string), event_call_info.sender); return; end Validate_UTEp; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* format: off */ %include access_audit_bin_header; /* not used, but needed by PL/I */ %include answer_table; %include as_audit_structures; %include as_data_; %include as_meter_numbers; %include dialup_values; %include event_call_info; %include installation_parms; %include login_server_messages; %include pdt; dcl pdtp pointer automatic init(null); /* required by pdt.incl.pl1 */ %include send_mail_info; %include sys_log_constants; %include user_attributes; %include user_table_entry; %include user_table_header; %include whotab; end uc_proc_term_handler_;  uc_send_ls_response_.pl1 08/04/87 1511.0rew 08/04/87 1511.0 89973 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-04,Swenson), approve(87-07-13,MCR7737), audit(87-05-16,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-05-16,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Correct coding standard violations. B) Allow caller to control whether a response message is sent. C) If reply wakeup cannot be sent, force_disconnect the MNA connection. 3) change(87-05-21,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Add sys_log_ error message to diagnose failure to add user_message or failure to send wakeup to login server. 4) change(87-05-22,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Copy event channel from parameter for use in hcs_$wakeup call. B) Log error message for failure to add user message. C) Centralize call to Force_Disconnect in an Abort procedure. 5) change(87-07-28,GDixon), approve(87-07-28,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Move call to sys_log_$general to correct place within the Abort proc. END HISTORY COMMENTS */ /* format: style4,indattr */ uc_send_ls_response_: procedure (P_data_ptr, P_data_lth, P_ls_process_id, P_ls_handle, P_ls_event_channel, P_ls_reply_message_ptr, P_connection_name, P_reply_code, P_code); /* Parameters */ dcl P_data_ptr ptr parameter; dcl P_data_lth fixed bin (18) parameter; dcl P_ls_process_id bit (36) aligned parameter; dcl P_ls_handle bit (72) aligned parameter; dcl P_ls_event_channel fixed bin (71) parameter; dcl P_ls_reply_message_ptr ptr parameter; dcl P_connection_name char (32) aligned parameter; dcl P_reply_code fixed bin (35) parameter; dcl P_code fixed bin (35) parameter; /* Automatic */ dcl 1 asum_ai aligned like as_user_message_add_info automatic; dcl connection_name char (32) aligned automatic; dcl code fixed bin (35) automatic; dcl data_ptr ptr automatic; dcl data_lth fixed bin (18) automatic; dcl ls_process_id bit (36) aligned automatic; dcl ls_handle bit (72) aligned automatic; dcl ls_event_channel fixed bin (71) automatic; dcl reply_code fixed bin (35) automatic; /* Based */ dcl based_event_message fixed bin (71) based; /* Entries */ dcl as_user_message_$priv_add_message entry (ptr, fixed bin (35)); dcl hcs_$make_entry entry (ptr, char (*), char (*), entry, fixed bin (35)); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl hpriv_connection_list_$get_name entry (char (*), ptr, fixed bin (35)); /* Constant */ dcl FALSE bit (1) aligned initial ("0"b) internal static options (constant); dcl LOGIN_SERVER_RING fixed bin int static options (constant) init (4); dcl ME char (20) int static options (constant) init ("uc_send_ls_response_"); dcl TRUE bit (1) aligned initial ("1"b) internal static options (constant); /* Builtins */ dcl (addr, after, before, null, unspec) builtin; /* Program */ data_ptr = P_data_ptr; data_lth = P_data_lth; ls_process_id = P_ls_process_id; ls_handle = P_ls_handle; ls_event_channel = P_ls_event_channel; ls_reply_message_ptr = P_ls_reply_message_ptr; connection_name = P_connection_name; reply_code = P_reply_code; code = 0; if ls_reply_message.do_not_reply then goto RETURN; if ls_event_channel = 0 then goto RETURN; if unspec (ls_reply_message) = ""b then do; ls_reply_message.code = reply_code; ls_reply_message.flags = FALSE; end; if data_lth > 0 then do; unspec (asum_ai) = ""b; asum_ai.version = AS_USER_MESSAGE_ADD_INFO_VERSION_1; asum_ai.message_ptr = data_ptr; asum_ai.message_length = data_lth; asum_ai.message_access_class = ""b; asum_ai.destination_info.group_id = ""; asum_ai.destination_info.process_id = ls_process_id; asum_ai.destination_info.handle = ls_handle; asum_ai.destination_info.ring = LOGIN_SERVER_RING; asum_ai.reader_deletes = "1"b; call as_user_message_$priv_add_message (addr (asum_ai), code); if code ^= 0 then call Abort (SL_LOG_BEEP, code, "Sending response via as_user_message_$priv_add_message."); ls_reply_message.response_sent = TRUE; end; call hcs_$wakeup (ls_process_id, ls_event_channel, ls_reply_message_ptr -> based_event_message, code); if code ^= 0 then call Abort (SL_LOG, code, "Sending wakeup for ^a to Login_Server ^12.3b event channel ^24.3b.", connection_name, ls_process_id, unspec(ls_event_channel)); RETURN: P_code = code; return; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: log an error via sys_log_$general, force_disconnect the terminal */ /* and abort execution. */ /* */ /* Syntax: call Abort (severity, code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_sev_code_msg; sl_info.caller = ME; sl_info.arg_list_ptr = cu_$arg_list_ptr (); call sys_log_$general (addr (sl_info)); code = sl_info.code; if code ^= 0 then do; call Force_Disconnect (connection_name); go to RETURN; end; end Abort; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* if couldn't notify owner, then try to disconnect the connection ourselves */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Force_Disconnect: procedure (P_connection_name); dcl P_connection_name char (32) aligned; dcl code fixed bin (35); dcl connection_name char (32); dcl entry_point_name char (60); dcl ref_name char (32); dcl entry_to_call entry (char (*), fixed bin (35)) variable; connection_name = P_connection_name; if connection_name ^= "" then do; aci.version = ACT_INFO_VERSION_1; call hpriv_connection_list_$get_name (connection_name, addr (aci), code); if code = 0 then do; if aci.force_disconnect_entry ^= "" then do; ref_name = before ( aci.force_disconnect_entry, "$"); entry_point_name = after ( aci.force_disconnect_entry, "$"); if entry_point_name = "" then entry_point_name = ref_name; call hcs_$make_entry (null (), ref_name, entry_point_name, entry_to_call, code); if code = 0 then call entry_to_call (connection_name, code); if code ^= 0 then call Log_Error_With_Code (code, "Calling Force_Disconnect procedure ^a$^a.", ref_name, entry_point_name); end; end; end; return; end Force_Disconnect; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Log_Error_With_Code: log an error via sys_log_$general and continue */ /* execution. */ /* */ /* Syntax: call Log_Error_With_Code (code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Log_Error_With_Code: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_code_msg; sl_info.severity = SL_LOG_SILENT; sl_info.caller = ME; sl_info.arg_list_ptr = cu_$arg_list_ptr (); call sys_log_$general (addr (sl_info)); end Log_Error_With_Code; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* format: off */ %include active_connection_info; dcl 1 aci aligned like active_connection_info; %include as_user_message_add; %include login_server_messages; %include sys_log_constants; end uc_send_ls_response_;  uc_set_pit_tty_info_.pl1 07/13/88 1113.4r w 07/13/88 0936.4 56619 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-04,Swenson), approve(87-07-13,MCR7737), audit(87-05-15,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-04-28,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Updated for change to user_table_entry.incl.pl1. 3) change(87-05-14,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Replace error logging with calls to sys_log_$general. b) Set pit.line_type from ute.line_type. END HISTORY COMMENTS */ /* format: style4,indattr */ uc_set_pit_tty_info_: procedure (P_utep, P_code); /* Parameters */ dcl P_code fixed bin (35) parameter; dcl P_utep ptr parameter; /* Automatic */ dcl code fixed bin (35) automatic; /* Entries */ dcl hcs_$truncate_seg entry (ptr, fixed bin (19), fixed bin (35)); dcl hphcs_$set_pit_tty_info entry (bit (36) aligned, ptr, fixed bin (35)); /* External */ dcl error_table_$out_of_sequence fixed bin (35) ext static; /* Constant */ dcl ME char (20) initial ("uc_set_pit_tty_info_") internal static options (constant); /* Builtins */ dcl (addr, null, length, rtrim, substr) builtin; %page; /* Program */ utep = P_utep; code = 0; if ^ute.uflags.proc_create_ok then call Abort (error_table_$out_of_sequence); call Setup_PIT (); call hphcs_$set_pit_tty_info (ute.proc_id, pit_ptr, code); if code ^= 0 then call Log_Error_with_Code (code, "Could not set tty info in PIT for ^a.^a.^a on channel ^a.", ute.person, ute.project, ute.tag, ute.tty_name); RETURN: P_code = code; return; %page; Setup_PIT: procedure (); pit_ptr = as_data_$pit_ptr; call hcs_$truncate_seg (pit_ptr, 0, code); if code ^= 0 then call Abort (code, "Could not truncate the pit template."); pit.version = PIT_version_3; pit.tty = ute.tty_name; if length (rtrim (pit.tty)) <= length (pit.old_tty) then pit.old_tty = substr (pit.tty, 1, length (pit.old_tty)); pit.terminal_access_class = ""b; /* not used */ pit.line_type = ute.line_type; pit.term_type_name = ute.terminal_type; /**** TBS: If the value of pit.service is type is used, it will have to be conjured up from somewhere. The cdte, of course, has this value for MCS channels. It was probably only used for the old NCP/FTP. */ pit.service_type = 0; /**** TBS: The charge_type is available in the cdte for MCS channels. If this module ever supports MCS, it should be extracted from here. */ pit.charge_type = 0; pit.tty_answerback = ute.tty_id_code; /**** TBS: The tty_type is an obsolete field which is present in the cdte. If this module ever supports MCS, it should be extracted from here. */ pit.tty_type = 0; pit.outer_module = ute.outer_module; return; end Setup_PIT; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: Report an error via sys_log_$general and stop execution if a */ /* nonzero code was given. */ /* */ /* Syntax: call Abort (code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_code_msg; sl_info.severity = SL_LOG_SILENT; sl_info.caller = ME; sl_info.arg_list_ptr = cu_$arg_list_ptr (); call sys_log_$general (addr (sl_info)); code = sl_info.code; if code ^= 0 then go to RETURN; end Abort; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Log_Error_with_Code: log an error via sys_log_$general and continue */ /* execution. */ /* */ /* Syntax: call Log_Error_with_Code (code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Log_Error_with_Code: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_code_msg; sl_info.severity = SL_LOG_SILENT; sl_info.caller = ME; sl_info.arg_list_ptr = cu_$arg_list_ptr (); call sys_log_$general (addr (sl_info)); end Log_Error_with_Code; /* format: off */ %page; %include as_data_; %page; %include access_audit_bin_header; /* needed by PL/I */ %page; %include as_audit_structures; %page; %include dialup_values; %page; %include pit; %page; %include sys_log_constants; %page; %include user_attributes; %page; %include user_table_entry; end uc_set_pit_tty_info_;  uc_setup_process_connect_.pl1 07/13/88 1113.4r w 07/13/88 0938.3 151479 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This module is part of the Multics Network Architecture (MNA) version of */ /* user control. MNA user control serves users coming into Multics via */ /* separate networks (eg, the Distributed Systems Architecture (DSA) */ /* network. MNA user control is not used for logins through the Multics */ /* Communications System (MCS). A separate MCS user control system serves */ /* MCS users. */ /* */ /* To Be Supplied: */ /* 1) Brief module description. See MDD010 or MTBs 751 and 752 for details */ /* about this module, and its relationship to modules in the MCS user */ /* control system. */ /* 2) Operator error message documentation. This program calls */ /* sys_log_$general but does not contain the required descriptions of */ /* these messages. This omission was waived for initial installation */ /* of the subsystem by the auditor, security coordinator, and by MDC */ /* management. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /****^ HISTORY COMMENTS: 1) change(86-04-04,Swenson), approve(87-07-13,MCR7737), audit(87-05-16,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-04-28,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Updated for change to user_table_entry.incl.pl1. 3) change(87-05-15,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Add cleanup handler; convert to sys_log_$general. B) Add check for process ring below minimum login server ring. C) Set ute.line_type. D) Allow reconnecting user to respecify ute.outer_module. 4) change(87-05-20,GDixon), approve(87-07-13,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): When an MNA user logs in, a UTE is created. When this user connects to an existing process, that proc's UTE is retained and the login UTE is freed; but the whotab is never updated to reflect freeing of the login UTE. A) Call uc_logout_$reconnect to do all aspects of logging out the login UTE except for auditing the LOGOUT. Instead, we audit a CONNECT operation. 5) change(87-07-28,GDixon), approve(87-07-28,MCR7737), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Remove redundant statement in Set_Outer_Module proc. END HISTORY COMMENTS */ /* format: style4,indattr */ uc_setup_process_connect_: procedure (P_ls_request_server_info_ptr, P_ls_request_ptr, P_ls_request_lth, P_ls_response_ptr, P_ls_response_lth, P_ls_ipc_reply_ptr, P_utep, P_code); /* Parameters */ dcl P_ls_request_server_info_ptr ptr parameter; dcl P_ls_request_ptr ptr parameter; dcl P_ls_request_lth fixed bin (18) parameter; dcl P_ls_response_ptr ptr parameter; dcl P_ls_response_lth fixed bin (18) parameter; dcl P_ls_ipc_reply_ptr ptr parameter; dcl P_utep ptr parameter; dcl P_code fixed bin (35) parameter; /* Automatic */ dcl added_info char(128); dcl code fixed bin (35) automatic; dcl process_number fixed bin automatic; dcl saved_utep ptr automatic; dcl temp_utep ptr automatic; dcl whoptr ptr automatic; /* Entries */ dcl aim_check_$equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl as_access_audit_$process entry (ptr, fixed bin, char (*)); dcl as_access_audit_$process_connect_denied entry (ptr, ptr, char (*)); dcl as_any_other_handler_$no_cleanup entry (char (*), label); dcl asu_$release_suspended_process entry (ptr); dcl asu_$setup_login_server_handle entry (ptr); dcl display_access_class_ entry (bit(72) aligned) returns(char(32) aligned); dcl get_system_free_area_ entry() returns(ptr); dcl ioa_$rsnnl entry () options (variable); dcl ipc_$decl_event_call_chn entry (fixed bin (71), entry, ptr, fixed bin, fixed bin (35)); dcl uc_list_disconnected_procs_ entry (ptr, ptr, ptr); dcl uc_logout_$reconnect entry (ptr, char(*)); dcl uc_proc_term_handler_ entry (ptr); dcl uc_set_pit_tty_info_ entry (ptr, fixed bin (35)); dcl user_table_mgr_$free entry (ptr); dcl user_table_mgr_$utep_from_handle entry (bit (72) aligned) returns (ptr); /* External */ dcl as_error_table_$dialup_error fixed bin (35) ext static; dcl as_error_table_$illegal_om_arg fixed bin(35) ext static; dcl as_error_table_$no_connect_aclass fixed bin (35) ext static; dcl as_error_table_$no_disconnected_procs fixed bin (35) ext static; dcl as_error_table_$no_such_process_msg fixed bin (35) ext static; dcl as_error_table_$ring_too_low fixed bin(35) ext static; dcl error_table_$bad_arg fixed bin (35) ext static; dcl error_table_$id_not_found fixed bin (35) ext static; /* Based */ dcl system_area area based (system_area_ptr); /* Internal */ dcl system_area_ptr ptr int static init(null); /* Constant */ dcl FALSE bit (1) aligned initial ("0"b) internal static options (constant); dcl ME char (25) initial ("uc_setup_process_connect_") internal static options (constant); dcl TRUE bit (1) aligned initial ("1"b) internal static options (constant); /* Conditions */ dcl (any_other, cleanup) condition; /* Builtins */ dcl (addr, currentsize, max, null, unspec) builtin; /* Program */ ls_request_server_info_ptr = P_ls_request_server_info_ptr; ls_request_ptr = P_ls_request_ptr; ls_reply_message_ptr = P_ls_ipc_reply_ptr; P_utep = null; code = 0; if system_area_ptr = null then system_area_ptr = get_system_free_area_(); uc_disconnected_process_list_ptr = null (); on cleanup begin; if uc_disconnected_process_list_ptr ^= null then free uc_disconnected_process_list in (system_area); end; on any_other call as_any_other_handler_$no_cleanup (ME, FAULT_LABEL); utep = user_table_mgr_$utep_from_handle ( login_server_process_request.handle); if utep = null () then call Abort_With_Error (SL_LOG_SILENT, error_table_$id_not_found, "Could not locate user table entry for handle ^24.3b.", login_server_process_request.handle); if ute.person ^= login_server_process_request.person_id | ute.project ^= login_server_process_request.project_id then call Abort_With_Error (SL_LOG_SILENT, error_table_$bad_arg, "Person.Project in connect request (^a.^a) do not match UTE (^a.^a).", login_server_process_request.person_id, login_server_process_request.project_id, ute.person, ute.project); call uc_list_disconnected_procs_ (utep, addr(system_area), uc_disconnected_process_list_ptr); if uc_disconnected_process_list_ptr = null () then call Abort (as_error_table_$no_disconnected_procs); if uc_disconnected_process_list.n_disconnected_processes = 0 then call Abort (as_error_table_$no_disconnected_procs); process_number = login_server_process_request.process_number; if process_number = 0 & uc_disconnected_process_list.n_disconnected_processes = 1 then process_number = 1; if process_number < 1 | process_number > uc_disconnected_process_list.n_disconnected_processes then call Abort (as_error_table_$no_such_process_msg); temp_utep = uc_disconnected_process_list.process (process_number).utep; if ^aim_check_$equal (ute.process_authorization, temp_utep -> ute.process_authorization) then do; call ioa_$rsnnl ("User authorization = ^a, Process authorization = ^a", added_info, (0), display_access_class_ (ute.process_authorization), display_access_class_ ( temp_utep -> ute.process_authorization)); call as_access_audit_$process_connect_denied (utep, temp_utep, added_info); call Abort (as_error_table_$no_connect_aclass); end; if login_server_process_request.other_flags.minimum_ring_given then if temp_utep -> ute.initial_ring < login_server_process_request.minimum_ring then do; call ioa_$rsnnl ("Connection minimum ring = ^d, Process initial ring = ^d", added_info, (0), login_server_process_request.minimum_ring, temp_utep -> ute.initial_ring); call as_access_audit_$process_connect_denied (utep, temp_utep, added_info); call Abort (as_error_table_$ring_too_low); end; /**** Make UTE for disconnected process ute associated with this connection. This includes copying ute lock state into the disconnected UTE. */ temp_utep -> ute.lock_value = temp_utep -> ute.lock_value + ute.lock_value; saved_utep = utep; /* save old UTE pointer */ utep = temp_utep; /* switch UTEs */ P_utep = utep; /* tell caller where we are */ /**** Update the connection information into the new UTE. */ ute.tty_name = login_server_process_request.connection_info.connection_name; ute.tty_id_code = login_server_process_request.connection_info.terminal_id; ute.terminal_type = login_server_process_request.connection_info.terminal_type; ute.line_type = login_server_process_request.connection_info.line_type; /**** We should allow the user to specify a new outer module. We must, however, validate the user's ability to select one. */ call Setup_Outer_Module(); if login_server_process_request.switch_flags.brief_given then do; ute.at.brief = login_server_process_request.switch_values.brief; ute.ur_at.brief = TRUE; end; /**** Copy the login_server process_id, event_channel, and handle from the new UTE into the old UTE. Keep the handle which encodes the old UTE, however. */ ute.login_server_info.his_handle = saved_utep -> ute.login_server_info.his_handle; ute.login_server_info.response_event_channel = saved_utep -> ute.login_server_info.response_event_channel; ute.login_server_info.termination_event_channel = saved_utep -> ute.login_server_info.termination_event_channel; ute.login_server_info.process_id = saved_utep -> ute.login_server_info.process_id; /**** If, however, login_server_info.our_handle equals 0, then this UTE was created via MCS (not MNA). We must create a handle. */ if ute.login_server_info.our_handle = ""b then call asu_$setup_login_server_handle (utep); /**** Here, we re-declare the event channel associated with this UTE to be associated with our event call handler, uc_proc_term_handler_. This UTE might have been associated with an MCS channel before, and hence used another event call handler (presumably dialup_). */ call ipc_$decl_event_call_chn (ute.event, uc_proc_term_handler_, utep, 1 /* priority */, code); if code ^= 0 then /* let user reconnect, but they'll be problems later */ call Error_No_Abort (SL_LOG_BEEP, code, "Setting event call handler at reconnection for ^a.^a ^a ^w.", ute.person, ute.project, ute.tty_name, ute.proc_id); call as_access_audit_$process (utep, AS_AUDIT_PROCESS_CONNECT, ""); call uc_logout_$reconnect (saved_utep, ""); /* Remove login UTE from whotab */ call user_table_mgr_$free (saved_utep); call uc_set_pit_tty_info_ (utep, code); if code ^= 0 then call Error_No_Abort (SL_LOG_SILENT, code, "Setting pit tty info at reconnection for ^a.^a ^a ^w.", ute.person, ute.project, ute.tty_name, ute.proc_id); call asu_$release_suspended_process (utep); ute.pdtep -> user.n_disconnected = max (0, ute.pdtep -> user.n_disconnected - 1); ute.disconnected = FALSE; if ute.whotabx > 0 then do; whoptr = as_data_$whoptr; whotab.e (ute.whotabx).disconnected = FALSE; whotab.e (ute.whotabx).idcode = ute.tty_id_code; end; ute.destroy_flag = WAIT_LOGOUT_SIG; /**** Setup login_server_process_response */ ls_response_ptr = P_ls_response_ptr; ls_process_response_accounting_message_length = 0; unspec (login_server_process_response) = ""b; login_server_process_response.header.message_type = LS_PROCESS_RESPONSE; login_server_process_response.header.version = LOGIN_SERVER_PROCESS_RESPONSE_VERSION_1; login_server_process_response.status_code = 0; login_server_process_response.process_id = ute.proc_id; login_server_process_response.new_handle = ute.login_server_info.our_handle; login_server_process_response.authorization = ute.process_authorization; call ioa_$rsnnl ("^a.^a.^a", login_server_process_response.process_group_id, (0), ute.person, ute.project, ute.tag); login_server_process_response.process_number = process_number; login_server_process_response.n_disconnected_processes = ute.pdtep -> user.n_disconnected; login_server_process_response.start_event_channel = ute.sus_channel; login_server_process_response.initial_ring = ute.initial_ring; /**** login_server_process_response.flags must be set by our caller since we don't know the caller's true intention. He may be reconnecting to do a new_proc, to destroy the process, or to continue operation in the suspended process. This corresponds to different flag settings. */ P_ls_response_lth = currentsize (login_server_process_response); RETURN: if uc_disconnected_process_list_ptr ^= null () then free uc_disconnected_process_list in (system_area); P_code = code; return; FAULT_LABEL: code = as_error_table_$dialup_error; goto RETURN; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: Stop reconnection by returning nonzero code to our caller. No */ /* log message is produced. */ /* */ /* Syntax: call Abort (code); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure (P_code); dcl P_code fixed bin (35) parameter; code = P_code; goto RETURN; end Abort; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort_With_Error: Stop reconnection by emitting an explanatory as log */ /* message, and returning nonzero code to our caller. */ /* */ /* Syntax: call Abort_With_Error (severity, code, ioa_ctl, args); */ /* */ /* */ /* Error_No_Abort: Add error message to as log, but do not stop */ /* reconnection. */ /* */ /* Syntax: call Error_No_Abort (severity, code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort_With_Error: procedure options (variable); dcl cu_$arg_list_ptr entry returns(ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_sev_code_msg; sl_info.arg_list_ptr = cu_$arg_list_ptr(); sl_info.caller = ME; call sys_log_$general (addr(sl_info)); code = sl_info.code; go to RETURN; Error_No_Abort: entry options (variable); sl_info = sl_info_sev_code_msg; sl_info.arg_list_ptr = cu_$arg_list_ptr(); sl_info.caller = ME; call sys_log_$general (addr(sl_info)); end Abort_With_Error; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ Setup_Outer_Module: procedure (); if login_server_process_request.outer_module ^= "" then if ^ute.at.vinitproc then call Abort (as_error_table_$illegal_om_arg); else ute.outer_module = login_server_process_request.outer_module; else if ute.outer_module = ute.pdtep -> user.outer_module then; else if ute.outer_module = as_data_$tty_dim then do; if login_server_process_request.default_io_module ^= "" then ute.outer_module = login_server_process_request.default_io_module; end; return; end Setup_Outer_Module; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* format: off */ %include as_data_; %include access_audit_bin_header; /* not used by needed by PL/I */ %include as_audit_structures; %include dialup_values; %include login_server_messages; %include ls_request_server_info; %include pdt; dcl pdtp ptr automatic init (null); /* pdt needs it. */ %include sys_log_constants; %include uc_disc_proc_list; %include user_attributes; %include user_table_entry; %include whotab; end uc_setup_process_connect_; 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