absentee_user_manager_.pl1 08/29/88 0943.8rew 08/29/88 0858.8 518211 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4 */ absentee_user_manager_: proc (ev_msg_ptr); /* main answering service procedure of absentee facility */ /* coded by E. Stone and modified 9/71 */ /* Modified many times since 1971. */ /* Modified April 1976 by T. Casey to check for "initxxxx" process termination event message */ /* Modified 7/76 by THVV to send mail and get rid of gotos and little arrows */ /* Modified September 1977 by T. Casey to log all ignored wakeups and make error message buffer longer. */ /* Modified May 1978 by T. Casey for resource reservations, per-queue reserved slots, and check for lost stopstop wakeup */ /* Modified November 1978 by T. Casey for MR7.0 absentee control parameters */ /* Modified March 1979 by T. Casey for MR7.0a absentee process suspension and trm_ signalling. */ /* Modified March 1980 by Tom Casey to add metering. */ /* Modified December 1980 by E. N. Kittlitz for bugfixes */ /* Modified June 1981 by T. Casey for MR9.0 for absentee load control perf. improvements, and do only one login per wakeup */ /* Modified September 22, 1981 by T. Casey for MR9.0 to fix bug in handling of termstop wakeup. */ /* Modified November 1981, E. N. Kittlitz. user_table_entry conversion. */ /* Modified December 1981, E. N. Kittlitz. copy abs control values to whotab. */ /* Modified April 1982, E. N. Kittlitz. New AS initialization. bugfixes. */ /* Modified October 1982, E. N. Kittlitz. Fix cancellation validation, check cancellation by person only */ /* Modified November 1982, E. N. Kittlitz. Fix validate_user_cancellation null pointer on notify_ca_sender */ /* Modified 1984-07-20 BIM for version 2 UTE */ /* Modified 1984-11-27 by E. Swenson for IPC event channel validation. Modified 1985-01-16 by E. Swenson to set ute.tag before calling lg_ctl_. Modified 1985-04-19 by E. Swenson to fix any other handler. */ /****^ HISTORY COMMENTS: 1) change(86-05-13,GJohnson), approve(86-05-13,MCR7387), audit(86-05-13,Martinson), install(86-05-14,MR12.0-1055): Correct error message documentation. 2) change(86-05-19,Gilcrease), approve(86-05-20,MCR7370), audit(86-06-25,Lippard), install(86-06-30,MR12.0-1082): Change UTE version, for -truncate absout, SCP6297. 3) change(86-05-19,Lippard), approve(85-12-30,MCR7326), audit(86-10-27,GDixon), install(86-10-28,MR12.0-1200): Modified 07 November 1985 (above date to satisfy picky hcom) by Jim Lippard to add entry points login_any_absentee and cancel_absentee, and remove code for user IPC messages. 4) change(87-04-26,GDixon), approve(87-07-12,MCR7741), audit(87-07-23,Brunelle), install(87-08-04,MR12.1-1055): A) Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1. B) Note new user-signalled event for the disconnect command (disconn). Although the command cannot be used in absentee processes, if the user attempts to call terminate_process_ for a disconnection, we will instead destroy the process. C) Replace calls to lg_ctl_$reset with user_table_mgr_$reset. (dsa 214) 5) change(87-05-04,GDixon), approve(87-07-12,MCR7741), audit(87-07-23,Brunelle), install(87-08-04,MR12.1-1055): A) Remove one more call to lg_ctl_$reset. B) Avoid setting ute.ute_index; let user_table_mgr_ do this. C) Avoid setting ute.active = NOW_FREE; let user_table_mgr_$free do this. 6) change(87-05-10,GDixon), approve(87-07-12,MCR7741), audit(87-07-23,Brunelle), install(87-08-04,MR12.1-1055): A) Correct absN field in LOGIN/LOGOUT messages. It should reference the ute_index. 7) change(87-05-11,GDixon), approve(87-07-12,MCR7741), audit(87-07-23,Brunelle), install(87-08-04,MR12.1-1055): Changes to more properly maintain anstbl.n_abs_run: A) Don't set autbl.n_abs_run, since user_table_mgr_ is doing that. B) Change any_other strategy to ensure that user_table_mgr_$free always gets called when error occurs after user_table_mgr_$allocate. 8) change(87-05-14,GDixon), approve(87-07-12,MCR7741), audit(87-07-23,Brunelle), install(87-08-04,MR12.1-1055): Use constants to set ute.tag. 9) change(87-05-20,Lippard), approve(87-07-12,MCR7709), audit(87-07-23,Brunelle), install(87-08-04,MR12.1-1055): A) Modified to not attempt to process absentee logins when absentee has been stopped. B) Don't create ute.event channel, since user_table_mgr_$allocate does this. 10) change(87-07-12,GDixon), approve(87-07-12,MCR7741), audit(87-07-23,Brunelle), install(87-08-04,MR12.1-1055): A) Remove windows in cleanup handling. B) Change cleanup handler to call user_table_mgr_$free to release the UTE if an error occurs. C) Establish cleanup and any_other handlers at $cancel_absentee, $login_any_absentee and $aum_abs_run entrypoints. D) Remove call to dial_ctl_$dial_broom, since dpg_ now calls this routine. 11) change(87-08-18,GDixon), approve(87-08-18,MCR7741), audit(87-08-19,Brunelle), install(87-08-20,MR12.1-1092): A) Changed handler for rlse signal (sent by abs release command) to send a wakeup to the suspended absentee process after calling asu_$release_suspended_process. asu_ used to send this wakeup, but no longer does due to a change for MNA. 12) change(87-12-08,GDixon), approve(88-08-15,MCR7969), audit(88-08-03,Lippard), install(88-08-29,MR12.2-1093): A) Change alarm___ code to handle alarm sent by asu_$bump_user to bump an absentee process. Absentee jobs can be bumped for many reasons (eg, locking of the user's password). asu_$bump_user should work for absentee jobs, whatever the reason. The real reason for bumping is in the as log, put there by the caller of asu_$bump_user. END HISTORY COMMENTS */ dcl absentee_rq_chn fixed bin (71) int static, /* channel used to signal new requests. */ termstop char (8) aligned int static options (constant) init ("termstop"), termstop_msg fixed bin (71) based (addr (termstop)), STOPstop char (8) aligned int static options (constant) init ("STOPstop"), STOPstop_msg fixed bin (71) based (addr (STOPstop)), slack fixed bin int static options (constant) init (2),/* slack to allow 2 interactive processes to get in */ absentee_procid bit (36) aligned int static, /* process id of absentee user manager */ static_label label int static, /* error transfer */ trace bit (1) aligned int static init ("0"b); dcl unlock_msg int static fixed bin (71); /* message sent by unlock procedure */ dcl unlock_string char (8) int static options (constant) init ("unlock"); /* contents of that message */ dcl abs_stop_before_startup bit (1) aligned int static init (""b); dcl job_term_reasons (13) char (64) int static options (constant) init ("Job terminated.", "Job executed new_proc command.", "", "", "", "", "Process initialization error.", "Process could not attach I/O streams.", "Process could not locate initial procedure.", "Process requested disconnect, which is not allowed.", "error.", "error.", "Job executed new_proc command."); dcl common_channel_signals (8) char (4) int static options (constant) init ( "alar", /* 1 */ "inac", /* 2 */ "bump", /* 3 */ "term", /* 4 */ "canc", /* 5 */ "caxx", /* 6 */ "susp", /* 7 */ "rlse"); /* 8 */ dcl bump_reasons (9) char (64) int static options (constant) init ( "Job exceeded cpu limit.", "Process inactive too long.", "Operator bumped job.", "Operator terminated process.", "Operator canceled job.", "Job bumped at user's request.", "Process ignored sus_ signal.", "Process used too much cpu time while suspended.", "System bumped job."); dcl (i, j) fixed bin, /* temp & useful counter */ code fixed bin (35), /* error code */ ignore_code fixed bin (35), /* cross ref. will show where we deliberately ignore error code */ ix fixed bin, cpu fixed bin (71), old_cpu fixed bin (71), pp fixed bin, pf fixed bin, secs float bin, aborting bit (1) aligned init ("0"b); /* set TRUE by ucs handler. */ dcl cpu_time_limit fixed bin (71); dcl absentee_tty_name char (32); dcl wakeup_over_common_channel bit (1) aligned init (""b); dcl wakeup_from_as bit (1) aligned init (""b); dcl wakeup_from_user bit (1) aligned init (""b); dcl wakeup_from_ring_zero bit (1) aligned init (""b); dcl abs_run_sw bit (1) aligned init (""b); dcl abs_arg_ptr ptr init (null); dcl (code_mask_ev_calls, code_unmask_ev_calls) fixed bin (35); dcl status char (100) aligned, /* reason for failure to login absentee user */ reason char (256) varying init ("ERROR"), hisid char (32), abort_message char (256), shxx char (8) aligned, /* short version of error code. */ loxx char (100) aligned, /* long ditto */ id char (24) int static init ("absentee_user_manager_") options (constant), initid char (32) int static init ("absentee_user_manager_$init") options (constant), error_message_2 char (36) aligned int static init ("Don't bring up absentee facility."), error_message_3 char (32) aligned int static init ("Error in initializing absentee."); dcl ev_msg_ptr ptr; /* parameter - pointer to entire event message */ dcl 1 ev_msg aligned based (ev_msg_ptr), 2 ev_chan fixed bin (71), 2 ev_message bit (72), 2 from_proc bit (36) aligned, 2 origin aligned, 3 dev_signal bit (18) unaligned, 3 sender_ring bit (18) unaligned, 2 datap ptr; /* ptr to AUT entry. */ dcl 1 ev_msg1 aligned based (ev_msg_ptr), 2 ev_chan fixed bin (71), 2 signal char (8), 2 origin, 3 dev_signal bit (18) unal, 3 sender_ring bit (18) unal, 2 datap ptr; dcl 1 ev_msg2 aligned based (ev_msg_ptr), 2 ev_chan fixed bin (71), 2 what char (4), 2 ix fixed bin (35), 2 origin, 3 dev_signal bit (18) unal, 3 sender_ring bit (18) unal, 2 datap ptr; dcl absentee_user_manager_$absentee_user_manager_ entry; dcl absentee_utility_ entry (ptr, ptr, fixed bin (35)); dcl absentee_utility_$au_send_ctl_wakeup entry; dcl absentee_utility_$clear_lc_list entry; dcl absentee_utility_$delete_message entry (ptr); dcl absentee_utility_$init_au entry (fixed bin (35)); dcl absentee_utility_$mark_request_running entry (ptr); dcl absentee_utility_$set_resource_timer entry; dcl absentee_utility_$term_au entry; dcl act_ctl_$close_account entry (ptr); dcl act_ctl_$cp entry (ptr); dcl act_ctl_$dp entry (ptr); dcl act_ctl_$open_account entry (ptr); dcl as_dump_ entry (char (*) aligned); dcl (as_meter_$enter, as_meter_$exit) entry (fixed bin); dcl asu_$check_for_stopped_process entry (ptr, char (*)) returns (bit (1) aligned); dcl asu_$find_process entry (bit (*) aligned, fixed bin, ptr); dcl asu_$release_suspended_process entry (ptr); dcl asu_$send_term_signal entry (ptr, fixed bin) returns (bit (1) aligned); dcl asu_$start_process entry (ptr); /* used to start a process running */ dcl asu_$suspend_process entry (ptr); dcl available_slots_ entry (fixed bin, fixed bin, (4) fixed bin, (4) fixed bin) returns (fixed bin); dcl clock_ entry returns (fixed bin (71)); dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned); dcl cpg_$cpg_abs entry (ptr, fixed bin (35)); dcl dpg_ entry (ptr, char (*)); dcl dpg_$finish entry (ptr); dcl condition_ entry (char (*), entry); dcl freen_ entry (ptr); dcl get_process_id_ entry (bit (36) aligned); dcl hcs_$get_usage_values entry (fixed bin, fixed bin (71), fixed bin); dcl hcs_$truncate_seg entry (ptr, fixed bin, fixed bin (35)); dcl hphcs_$set_cpu_monitor entry (bit (36) aligned, fixed bin (71), fixed bin (35)); dcl hcs_$wakeup entry (bit (*) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl ioa_$rsnnl entry options (variable); dcl ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)); dcl ipc_$decl_ev_call_chn entry (fixed bin (71), entry, ptr, fixed bin, fixed bin (35)); dcl ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35)); dcl ipc_$mask_ev_calls entry (fixed bin (35)); dcl ipc_$unmask_ev_calls entry (fixed bin (35)); dcl lg_ctl_$abs_in entry (ptr, char (*) aligned, fixed bin (35)); dcl lg_ctl_$abs_out entry (ptr); dcl lv_request_$cleanup_process entry (bit (36) aligned); dcl rcp_sys_$cancel_id entry (fixed bin (71), char (*), fixed bin (35)); dcl rcp_sys_$pre_claim entry (fixed bin (71), char (*), bit (36) aligned, fixed bin (35)); dcl rcp_sys_$unassign_process entry (bit (36) aligned, fixed bin (35)); dcl request_id_ entry (fixed bin (71)) returns (char (19)); dcl send_mail_$access_class entry (char (*), char (*), ptr, bit (72) aligned, fixed bin (35)); dcl sub_err_ entry () options (variable); dcl sys_log_ entry options (variable); dcl sys_log_$error_log entry options (variable); dcl timer_manager_$reset_alarm_wakeup entry (fixed bin (71)); dcl user_table_mgr_$allocate entry (fixed bin) returns(ptr); dcl user_table_mgr_$free entry (ptr); dcl as_error_table_$illegal_signal ext fixed bin (35); dcl error_table_$messages_deferred ext fixed bin (35); dcl error_table_$messages_off ext fixed bin (35); dcl error_table_$noentry ext fixed bin (35); dcl error_table_$out_of_sequence fixed bin (35) ext; dcl sys_info$max_seg_size fixed bin (35) ext static; dcl (addr, baseno, divide, fixed, hbound, max, null, rel, rtrim, size, string, substr, unspec) builtin; %page; /* MAIN ENTRY POINT absentee_user_manager_: proc (ev_msg_ptr); MAIN ENTRY POINT */ /* Initialize */ autp = as_data_$autp; ansp = as_data_$ansp; code_mask_ev_calls, code_unmask_ev_calls = -1; utep = null; /* Cause fault if bug. */ call condition_ ("cleanup", cleaner_up); anstbl.current_time = clock_ (); absentee_tty_name = "unknown absentee"; /* never did find the absentee job... */ if trace then do; call hcs_$get_usage_values (pf, old_cpu, pp); end; static_label = retr; /* Set up error exit label. */ call condition_ ("any_other", ucs); /* Set up a handler in case of fault. */ call as_meter_$enter (AUM_METER); /* Decode the ipc message. The interprocess message which invoked absentee_user_manager_ (via event call) may come from any of several sources. a) login from admin, in answering service, if abs maxu has changed b) aum_ctl, which we send ourselves before returning after a login c) FUNCxxxx from admin or answering service, requesting action on slot xxxx d) others from absentee process, reporting problems logging in, or reporting finish */ if ev_msg.from_proc = absentee_procid then /* remember if message is from answering service * */ wakeup_from_as = "1"b; if ev_msg.origin.sender_ring = ""b then /* and whether from ring zero or outer ring */ wakeup_from_ring_zero = "1"b; /* See if message was sent over common absentee request channel */ if ev_msg.ev_chan = absentee_rq_chn then do; /* If message sent over common absentee request channel */ wakeup_over_common_channel = "1"b; /* remember what channel the wakeup came over */ if ev_msg1.signal = "login " then /* Someone suggests that we check queues for a job to log in */ goto lg; /* do so */ /* not "login" */ if ev_msg1.signal = "aum_ctl" then do; /* we sent ourselves this one */ if ^wakeup_from_as then goto evil; /* or did we? If not, complain and exit */ if ^autbl.aum_ctl then /* if we did but we don't need it any more */ goto retr; /* exit quickly */ goto lg; /* we wanted to see if we could log in any more absentees, but we went blocked to give higher priority work a chance to get done ahead of absentee logins. */ end; if ^wakeup_from_as then /* if wakeup is not from answering service */ goto evil; /* then it is illegal */ /* Second word of message is index of aute. Check its validity before using it. */ if (ev_msg2.ix <= 0 | ev_msg2.ix > autbl.current_size) then /* if index is garbage, decide what complaint to make */ if wakeup_from_as then goto inval_mess; /* we sent ourselves a bad one. log it for debugging */ else goto evil; /* user sent bad one. log to detect playful or malicious users */ ix = ev_msg2.ix; /* Get index of entry */ utep = addr (autbl.entry (ix)); /* get address of entry in absentee user table */ absentee_tty_name = ute.tty_name; /* for errors, which absentee channel */ /* First word of message is reason for bumping the job. Check its validity and then take the appropriate action */ do i = 1 to hbound (common_channel_signals, 1) while (ev_msg2.what ^= common_channel_signals (i)); end; if i > hbound (common_channel_signals, 1) then do; /* if signal unrecognized */ if wakeup_from_as then goto inval_mess; /* report that we sent ourselves a bad one */ else goto evil; /* unknown message from unknown source */ end; /* end message not recognized */ /* Signals from abs suspend and abs release commands get special processing, here. */ if i = 7 then do; /* susp */ call asu_$suspend_process (utep); goto retr; end; if i = 8 then do; /* rlse */ call asu_$release_suspended_process (utep); /**** Now send the process a wakeup over the event channel setup by the sus_ signal handler, to kick the process into action again. */ call hcs_$wakeup (ute.proc_id, ute.sus_channel, (0), code); if code ^= 0 then call sys_log_$error_log (SL_LOG_SILENT, code, id, "Trying to wakeup ^a.^a.^a process after abs release.", ute.person, ute.project, ute.tag); goto retr; end; /* The rest of the signals are various kinds of bumps. They all end up destroying the absentee process */ ute.logout_type = ev_msg2.what; /* brief reason for bumping is first 4 chars of signal */ if asu_$send_term_signal (utep, i) then /* if we send trm_, to give process a chance to clean up */ goto retr; /* wait for it to do so. It will send termsgnl when it's done */ reason = bump_reasons (i); /* if we don't send trm_, continue logging it out */ end; /* end message sent over common channel */ /* If not common channel, message must have been sent over a running job's event channel */ else do; /* message over running job's channel */ utep = ev_msg.datap; /* Extract ptr to AUT entry. */ if baseno (utep) ^= baseno (autp) then go to evil; /* WOOPS */ if ev_msg.from_proc = ute.proc_id then /* remember whether wakeup is from absentee user */ wakeup_from_user = "1"b; ix = ute.ute_index; /* Will need this for queue threading. */ /* See what the message is. Then either take some special action, or set reason and logout type and destroy the process. */ reason = ev_msg1.signal; /* Default reason */ if ute.destroy_flag = WAIT_LOGOUT_SIG & ute.preempted ^= PREEMPT_TERM_SENT then /* if brief reason not already set */ ute.logout_type = ev_msg2.what; /* do it now */ /* Scan table of user signals for match with this message. */ do i = 1 to n_signals while (ev_msg1.signal ^= signals (i)); end; /* But before checking for a match, see if it was one of the few system signals, such as alarm___, cpulimit, and termstop, that absentee jobs can generate */ if ev_msg1.signal = "alarm___" then do; /* alarm timer - process ignored sus_ or trm_ signal */ if ^wakeup_from_as then goto evil; /* alarm___ not valid unless from a.s. */ if ute.preempted = PREEMPT_TERM_SENT then do; /* it was trm_ */ ignored_term: call wakeup_error ("Process ignored trm_ signal."); reason = rtrim (bump_reasons (ute.logout_index)); reason = reason || " Process ignored trm_ signal."; goto destroy; end; else if ute.sus_sent then do; /* it was sus_ */ ignored_sus: ute.logout_type = "isus"; /* brief reason for bump */ reason = bump_reasons (7); /* long reason */ call wakeup_error (reason); /* tell operator why we're bumping it */ if asu_$send_term_signal (utep, 7) then goto retr; /* maybe let it signal finish first */ else goto destroy; /* but if not, bump it now */ end; else if ute.preempted = PREEMPT_BUMPED /* asu_$bump_user was called for this proc */ then do; ute.logout_type = "sbmp"; reason = bump_reasons (9); if asu_$send_term_signal (utep, 9) then goto retr; else goto destroy; end; else do; /* we were not expecting an alarm___ */ call wakeup_error ("Ignoring unexpected alarm___ for"); /* log it */ goto retr; /* and ignore it */ end; end; /* end alarm___ */ else if ev_msg1.signal = "cpulimit" then do; /* process used too much cpu time after sus_ or trm_, or while running */ if ^wakeup_from_ring_zero then goto evil; /* cpulimit can only come from ring zero */ if ute.ignore_cpulimit then do; /* cpulimit timer can't be turned off */ ute.ignore_cpulimit = ""b; /* so we turn on this switch when we want to turn it off */ goto retr; /* and if it goes off with the switch on, we ignore it */ end; call reset_alarm; /* turn off the alarm timer */ if ute.preempted = PREEMPT_TERM_SENT then /* it was trm_ that the process ignored */ goto ignored_term; /* code to handle that condition already exists above */ else if ute.sus_sent then do; /* it was sus_ */ if ^ute.suspended then /* if process ignored it completely */ goto ignored_sus; /* code to handle that is also found above */ ute.logout_type = "csus"; /* brief reason for bump */ reason = bump_reasons (8); /* explain exactly what happened */ call wakeup_error (reason); /* tell operator why we're bumping it */ if asu_$send_term_signal (utep, 8) then goto retr; /* maybe let it signal finish */ else goto destroy; /* but if not, bump it now */ end; else do; /* user-specified cpu time limit ran out */ ute.logout_type = "cpul"; /* brief reason for bumping job */ if asu_$send_term_signal (utep, 1) /* maybe send trm_ signal and give job a chance to clean up */ /* 1 is index of "too much cpu time" in reason lists */ then goto retr; /* if signal sent, wait for job to log out */ /* if signal not sent */ reason = bump_reasons (1); /* set reason */ goto destroy; /* and go destroy the process immediately */ end; end; /* end cpulimit */ /* Check for termstop wakeup. That wakeup means that the original wakeup, giving the reason for the process termination, never arrived; a stopstop wakeup arrived out of sequence, and we sent ourselves a termstop and a STOPstop to get back in sequence. We have no way of knowing what the original reason was. */ else if ev_msg1.signal = "termstop" then do; ute.logout_type = "tstp"; /* try to say termstop in 4 letters */ reason = "termstop"; goto destroy; end; /* it was not one of the system signals. See if it's one of the user signals from the table we scanned above. */ else if i <= n_signals then do; /* if it was */ if ^wakeup_from_user then goto evil; /* reject it if it's not from the owner of the aute */ if i = 14 then do; /* termsgnl gets special processing */ if ute.preempted = PREEMPT_TERM_SENT then do; /* if we were expecting it */ call reset_alarm; /* turn off alarm timer */ reason = bump_reasons (ute.logout_index); /* get original reason for bump */ goto destroy; /* Sorry Edsger, but I'm in a hurry */ end; else do; /* we weren't expecting it */ call wakeup_error ("Unexpected termsgnl from"); /* log it */ ev_msg2.ix = as_error_table_$illegal_signal; goto convert_term_code; /* report error and terminate process */ end; end; /* end termsgnl */ else if i <= hbound (job_term_reasons, 1) then reason = job_term_reasons (i); else reason = "error."; end; /* Signal not in table. See if it is fatal process error, with code in second word */ else if ev_msg2.what = "term" | ev_msg2.what = "init" then do; /* User process got fatal error. */ if ^wakeup_from_user then goto evil; /* reject it if it's not from this user */ convert_term_code: call convert_status_code_ (ev_msg2.ix, shxx, loxx); reason = loxx; call sys_log_ (0, "^a: process terminated ^a.^a abs^d ^a", id, ute.person, ute.project, ix, shxx); end; /* No. Maybe it is stopstop */ else if ev_msg1.signal = "stopstop" then reason = ""; /* Process finished dying */ else if ev_msg1.signal = "STOPstop" then reason = ""; /* Re-synch wakeup. */ /* It is none of the known ASCII messages. It might be the event channel that a suspended process has gone blocked on. */ else if ute.sus_sent & ^ute.suspended then do; /* if waiting for response to sus_ signal, this must be it */ if ^wakeup_from_user then goto evil; /* reject it if it's from some other user */ unspec (ute.sus_channel) = ev_msg.ev_message; /* save the event channel that the process is blocked on */ if ute.ignore_cpulimit then do; /* if process was released before it responded to sus_ */ ute.sus_sent = ""b; /* clear the suspended flag */ call hcs_$wakeup (ute.proc_id, ute.sus_channel, (0), (0)); /* tell process it may run */ end; /* leave the ignore_cpulimit switch on */ else do; /* if not released already */ ute.suspended = "1"b; /* remember that it's suspended */ call reset_alarm; /* turn off the alarm timer */ goto retr; /* that's all. get out immediately */ end; end; /* None of the above. Log it and reject it. */ else go to evil; /* a hacker */ /* See if we were expecting termsgnl but got something else from the user process. (If we had gotten termsgnl, we would have gone directly to destroy, and not ended up here.) */ if ute.preempted = PREEMPT_TERM_SENT then do;/* if waiting for termsgnl */ call reset_alarm; /* turn off alarm so it won't go off at an awkward time */ if reason ^= "" then do; /* reason says why termsgnl didn't come - f.p.e. maybe */ reason = rtrim (reason); /* add some further explanation of what happened */ reason = reason || " while handling trm_ signal after: "; reason = reason || rtrim (bump_reasons (ute.logout_index)); end; else do; /* reason is blank, so construct an explanation */ reason = rtrim (bump_reasons (ute.logout_index)); reason = reason || " Process did not respond properly to trm_ signal."; end; end; end; /* end message over running job's channel */ /* This section destroys an absentee process. Pointer "autp" points to the absentee_user_table entry. */ destroy: if ev_msg1.signal ^= "stopstop" then do; /* First or second pass? */ if ev_msg1.signal = "STOPstop" then do; /* STOPstop is a.s.'s simulation of stopstop */ if ^wakeup_from_as then goto evil; /* reject it if not from a.s. */ else if ute.destroy_flag ^= WAIT_LOGOUT then goto log_ignored_msg; else go to kill; /* STOPstop used to re-synchronize */ end; if ev_msg1.signal = "termstop" then if ute.destroy_flag ^= WAIT_LOGOUT_SIG then goto log_ignored_msg; if ute.active < NOW_LOGGED_IN then go to evil; /* Validate origin of wakeup before destroying process */ if ^wakeup_from_user then /* if wakeup not from the absentee process itself */ if ^wakeup_from_as then /* and not from answering service */ if ^wakeup_from_ring_zero then /* and not from ring zero */ goto evil; /* log and reject the wakeup */ if ute.destroy_flag >= WAIT_LOGOUT then /* if apparently waiting for stopstop */ if asu_$check_for_stopped_process (utep, id) then /* and process is, in fact, stopped */ goto kill; /* go finish its destruction */ destroy1: /* come here if fault between creating and starting process */ ute.active = NOW_LOGGED_IN; /* Indicate there is no process. */ ute.destroy_flag = WAIT_LOGOUT; /* .. and set up to finish destroying. */ call rcp_sys_$unassign_process (ute.proc_id, ignore_code); if ute.lvs_attached then call lv_request_$cleanup_process (ute.proc_id); call dpg_ (utep, (ev_msg2.what)); /* First pass. Request destruction. */ if reason ^= "" then do; call ioa_$rsnnl ("Absentee job ^a ^a terminated. ^a", abort_message, j, ute.input_seg, request_id_ (ute.request_id), reason); call notify_request_owner (abort_message); end; else if ute.notify then /* if user requested notification */ call notify ("logged out"); /* tell him the job logged out */ go to retr; /* And that's all for now. We'll wait for the stopstop. */ end; /* The process must run a bit to destroy itself. it will send a "stopstop" when it is really dead. */ if substr (anstbl.sysdir, 1, 4) = ">sys" then /* Unless testing, ... */ if ev_msg.origin.sender_ring then go to evil;/* stopstop must come from ring 0 */ if ute.destroy_flag = WAIT_LOGOUT_SIG then do; /* oops. */ call sys_log_ (0, "^a: premature stopstop for ^a", id, ute.tty_name); call hcs_$wakeup (whotab.abs_procid, ute.event, termstop_msg, code); call hcs_$wakeup (whotab.abs_procid, ute.event, STOPstop_msg, code); return; end; /* Here we really finish killing the process */ kill: static_label = no_go; /* In case of fault. */ call dpg_$finish (utep); /* Now finish the process destruct. */ call act_ctl_$dp (utep); /* Sign process off accounting. */ if ute.queue > 0 then /* track background jobs */ autbl.n_abs (ute.queue) = autbl.n_abs (ute.queue) - 1; cleanup: ute.active = NOW_LOGGED_IN; /* Make sure it says "no process" */ anstbl.lock_count = anstbl.lock_count + 1; /* lock answer table */ call act_ctl_$close_account (utep); /* Close out account */ call lg_ctl_$abs_out (utep); /* tell system that absentee user not logged in */ no_go: static_label = free; /* If fault here just get out fast */ if ute.reservation_id ^= 0 then do; /* if job had a reservation */ call rcp_sys_$cancel_id (ute.reservation_id, rtrim (ute.person) || "." || rtrim (ute.project) || ".*", code); if code ^= 0 then /* badcall = reservation doesn't belong to this user */ if code ^= error_table_$noentry then /* noentry = no such reservation, i.e., it was canceled already */ call sys_log_$error_log (1, code, id, "attempting to cancel reservation ^a for ^a.^a ^a", request_id_ (ute.reservation_id), ute.person, ute.project, ute.tty_name); end; call unlock; /* unlock answer table */ if ^(ute.abs_attributes.restartable & ute.logout_type = "bump") then do; /* if not bump of restartable request */ call ipc_$mask_ev_calls (code_mask_ev_calls); call absentee_utility_$delete_message (utep);/* delete the request from the queue */ if code_mask_ev_calls = 0 & code_unmask_ev_calls ^= 0 then do; call ipc_$unmask_ev_calls (code_unmask_ev_calls); code_mask_ev_calls, code_unmask_ev_calls = -1; end; end; free: static_label = retr; call user_table_mgr_$free (utep); /* clear out abs user table entry */ if aborting then go to retr; /* If unclaimed signal in progress give up. */ /* Fall through and try to log in another process */ /* But before we do ... We just did a logout. So maybe a request on the load control list could log in now. So clear the list and give them all a chance to try loging in. */ if autbl.lc_list then /* if there is a non-empty list */ call absentee_utility_$clear_lc_list; %page; /* ------------------------------------------------------- */ /* This section is entered if a user has just queued a job or if admin has signalled that it has increased max absentees. We will try to log in an absentee job if possible. */ lg: if ^autbl.abs_up | autbl.abs_stopped then /* don't allow absentee logins if */ goto retr; /* absentee facility is stopped. */ if anstbl.n_users > 0 then /* absentee not to take last APT entry */ if (anstbl.n_users + slack) >= anstbl.max_users then do; if abs_run_sw then call sys_log_ (-1, "^a (abs run): System too full; no absentee jobs can be started now.", id); goto retr; end; static_label = lgfail; /* in case blow in message seg stuff */ utep = user_table_mgr_$allocate (PT_ABSENTEE); if utep = null then go to retr; ix = ute.ute_index; code = 0; /* clear error code */ ute.logout_type = "logi"; /* logout reason, in case of fault while logging in */ call_au: /* come here when load control says no, to defer request and get another */ /* NOTE that code contains load control deferral reason */ if abs_run_sw then /* if called by abs run command */ ute.abs_run = "1"b; /* tell AU to find and run a particular job */ call ipc_$mask_ev_calls (code_mask_ev_calls); /* if a job is being deferred, code contains the deferral reason - THUS code MIGHT BE AN INPUT VARIABLE HERE - BE CAREFUL */ call absentee_utility_ (utep, abs_arg_ptr, code); /* get next candidate for absentee process */ if code_mask_ev_calls = 0 & code_unmask_ev_calls ^= 0 then do; call ipc_$unmask_ev_calls (code_unmask_ev_calls); code_mask_ev_calls, code_unmask_ev_calls = -1; end; if code ^= 0 then do; /* if no job can log in now, we'll eventually go blocked */ lgfail: static_label = retr; call user_table_mgr_$free (utep); /* clear abs user table entry */ autbl.aum_ctl = ""b; /* tell everyone that we quit 'cause there's nothing to do */ if autbl.lc_list then /* if there's an lc list */ call absentee_utility_$clear_lc_list; /* clear it, so we'll start fresh at next login wakeup */ /* NOTE: if we only clear it when there's an absentee logout, then foreground jobs waiting for slots to be vacated by interactive logouts could be delayed unnecessarily. */ go to retr; end; /* Call user control */ ute.tty_id_code = "none"; ute.tag = TAG_ABSENTEE; call ioa_$rsnnl ("abs^d", ute.tty_name, i, ix); anstbl.lock_count = anstbl.lock_count + 1; /* lock answer table */ static_label = cleanup; /* In case of fault. */ call as_meter_$enter (ABS_TRYLOG_METER); /* meter number and cost of login attempts */ call lg_ctl_$abs_in (utep, status, code); /* try to login absentee user */ /* if code is nonzero, it says why job couldn't log in */ call as_meter_$exit (ABS_TRYLOG_METER); if ute.login_result ^= 0 then do; /* if job cannot be logged in */ if ute.args_ptr ^= null then call freen_ (ute.args_ptr); /* first, free its argument storage */ if ute.arg_lengths_ptr ^= null then call freen_ (ute.arg_lengths_ptr); if ute.login_result = 2 then do; /* if it could log in later */ call unlock; /* unlock answer table before we forget we had it locked */ goto call_au; /* go defer it and get another request */ /* NOTE that deferral reason is being passed to AU in code */ end; /* else send user a message and then dispose of the request */ call ioa_$rsnnl ("Unable to login job ^a. ^a", abort_message, j, ute.input_seg, status); call notify_request_owner (abort_message); go to no_go; end; /* Fill in absentee user table entry. lg_ctl_ and act_ctl_ will fill in standard part */ ute.n_processes = 1; /* constants */ call ipc_$decl_ev_call_chn (ute.event, absentee_user_manager_$absentee_user_manager_, utep, ABS_LOGIN_PRIO, ignore_code); ute.active = NOW_LOGGED_IN; /* Indicate that slot is in use. */ call act_ctl_$open_account (utep); /* open account for absentee user session */ call cpg_$cpg_abs (utep, code); /* create absentee process */ if code ^= 0 then do; /* Oh, ick */ call sys_log_$error_log (1, code, id, "Creating proc for ^a.^a", ute.person, ute.project); call convert_status_code_ (code, shxx, loxx); call ioa_$rsnnl ("Unable to create process for job ^a. ^a", abort_message, j, ute.input_seg, loxx); call notify_request_owner (abort_message); go to cleanup; end; static_label = destroy1; /* In case of fault, kill process. */ if ute.queue > 0 then /* count background jobs */ autbl.n_abs (ute.queue) = autbl.n_abs (ute.queue) + 1; call act_ctl_$cp (utep); /* start process accounting */ ute.active = NOW_HAS_PROCESS; /* Indicate that there is now a process. */ ute.destroy_flag = WAIT_LOGOUT_SIG; /* And that the next thing to happen is logout. */ call unlock; /* unlock answer table */ if ute.args_ptr ^= null then call freen_ (ute.args_ptr); /* Free args .. copied into PIT */ if ute.arg_lengths_ptr ^= null then call freen_ (ute.arg_lengths_ptr); if ute.reservation_id ^= 0 then do; /* if this job has a reservation */ call rcp_sys_$pre_claim (ute.reservation_id, /* tell RCP the process id to which it belongs */ rtrim (ute.person) || "." || rtrim (ute.project) || ".*", ute.proc_id, code); if code ^= 0 then /* noentry = no such reservation; badcall = reservation doesn't belong to this user */ call sys_log_$error_log (1, code, id, "attempting to pre-claim reservation ^a for ^a.^a ^a", request_id_ (ute.reservation_id), ute.person, ute.project, ute.tty_name); end; /* Set cpu monitor to limit the cpu time this process can use. */ cpu_time_limit = ute.max_cpu_time * 1000000; /* convert seconds to usec. */ call hphcs_$set_cpu_monitor (ute.proc_id, cpu_time_limit, ignore_code); /**** Now kick the process out of its initially blocked state */ call asu_$start_process (utep); /* Notify user, if requested, and rewrite job in queue to show that it's running. */ if ute.notify then /* if user asked for notification */ call notify ("logged in"); /* tell him it logged in */ call absentee_utility_$mark_request_running (utep); /* do what the name implies */ /* We're all finished logging in one absentee request. There might be others that could log in. Instead of trying to log more in now, we'll go blocked and give other answering service work, of higher priority (e.g., interactive logins) a chance to get done. But we'll send ourselves a wakeup ("aum_ctl") over the login event channel, so that we'll get a chance to run again when there's nothing of higher priority to be done. (If we're here because of an operator "abs run" command, we don't bother sending the wakeup.) */ if ^abs_run_sw then /* if not abs run command */ call absentee_utility_$au_send_ctl_wakeup; /* then go send the wakeup */ retr: static_label = retr1; do i = -1 to 4; /* see if we need to set a resource timer */ if autbl.rsc_waiting (i) > 0 then /* if there are jobs waiting for resources */ if available_slots_ (max (1, i), autbl.max_abs_users, (autbl.qres), (autbl.n_abs)) > 0 then do; /* and there are slots available to them */ call absentee_utility_$set_resource_timer; /* check for resource availability periodically */ i = 4; /* get out of the loop */ end; end; if code_mask_ev_calls = 0 & code_unmask_ev_calls ^= 0 then call ipc_$unmask_ev_calls (code_unmask_ev_calls); /* event calls should not be masked now; we have no reason to believe they are, but we're just being cautious */ if trace & ^abs_run_sw then do; static_label = retr1; call hcs_$get_usage_values (pf, cpu, pp); secs = (cpu - old_cpu) * 1e-6; call sys_log_ (1, "^a: Trace ^.3f ^a ^w ^w", id, secs, ev_msg2.what, ev_msg2.ix, ev_msg.from_proc); end; retr1: static_label = return_immediately; call as_meter_$exit (AUM_METER); return_immediately: return; inval_mess: call sys_log_ (1, "^a: Strange event message ^w^w from Initializer", id, ev_msg2.what, ev_msg2.ix); go to retr; evil: call asu_$find_process (ev_msg.from_proc, i, utep); if utep = null then call sys_log_ (1, "^a: Strange event message ^24.3b from user proc ^w", id, ev_msg.ev_message, ev_msg.from_proc); else call sys_log_ (1, "^a: Strange event message ^24.3b from ^a.^a ^a", id, ev_msg.ev_message, ute.person, ute.project, ute.tty_name); go to retr; log_ignored_msg: call sys_log_ (0, "^a: ignored wakeup ^24.3b from ^w for ^a", id, ev_msg.ev_message, ev_msg.from_proc, absentee_tty_name); goto retr; %page; /* ENTRY: cancel_absentee This entry point cancels a specified job. It is called by asr_abs_command_server_ after the canceller has already been validated. This entry hacks up the information aum_ requires. In the future, when all the IPC garbage has been removed from this module, this can be made much cleaner. */ cancel_absentee: entry (P_job_ptr); dcl (P_job_ptr) ptr; dcl 1 hack_event_message aligned like ev_msg; autp = as_data_$autp; ansp = as_data_$ansp; call as_meter_$enter (AUM_METER); /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Do NOT establish a cleanup on unit here. Since UTEp is input, we may not */ /* free it if an error occurs. Also, since what failed is the cancellation */ /* attempt and the job is still running, we shouldn't free its UTE. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ code_mask_ev_calls, code_unmask_ev_calls = -1; utep = P_job_ptr; call condition_ ("any_other", ucs); static_label = retr; /* bump_reasons (6) = User bump. This code will have to change if admin_$abs is modified to call this entry point to bump or cancel a specific absentee. */ reason = bump_reasons (6); /* This is needed solely for the call to dpg_. */ ev_msg_ptr = addr (hack_event_message); ev_msg2.what, ute.logout_type = "canc"; goto destroy1; %page; /* ENTRY POINT to log in any absentee. It is called by asr_abs_command_server_ to wakeup AUM to see if a newly-entered job can be run. It just branches to lg. */ login_any_absentee: entry; autp = as_data_$autp; ansp = as_data_$ansp; call as_meter_$enter (AUM_METER); utep = null; code_mask_ev_calls, code_unmask_ev_calls = -1; call condition_ ("cleanup", cleaner_up); call condition_ ("any_other", ucs); static_label = retr; go to lg; %page; /* ENTRY POINT to log in a specified job. Called by admin when abs run command is given. */ aum_abs_run: entry (a_arg_ptr); dcl a_arg_ptr ptr; /* ptr to structure describing job to be run */ autp = as_data_$autp; ansp = as_data_$ansp; call as_meter_$enter (AUM_METER); utep = null; static_label = retr; code_mask_ev_calls, code_unmask_ev_calls = -1; call condition_ ("cleanup", cleaner_up); call condition_ ("any_other", ucs); abs_run_sw = "1"b; /* remember where we came in */ abs_arg_ptr = a_arg_ptr; /* copy ptr to arg structure */ goto lg; /* go get an aute and call AU to get the job from the Q */ %page; abs_as_init: entry; /* entry called when system is brought up */ autp = as_data_$autp; ansp = as_data_$ansp; code_mask_ev_calls, code_unmask_ev_calls = -1; if ^sc_stat_$Multics_typed | sc_stat_$Go_typed then do /* no! */ code = error_table_$out_of_sequence; init_error: call sub_err_ (code, initid, "s"); return; end; call hcs_$truncate_seg (autp, 0, code); /* truncate absentee user table */ if code ^= 0 then do; call sys_log_$error_log (1, code, initid, "Cannot truncate absentee_user_table."); go to init_error; end; autbl.mnbz = "1"b; /* cause records used > 0 */ /* now those having r access can read header */ autbl.header_version = AUTBL_version_4; /* set up some other bumf */ autbl.entry_version = UTE_version_4; autbl.user_table_type = PT_ABSENTEE; /* absentee table */ autbl.header_length = fixed (rel (addr (autbl.entry (1)))); autbl.max_size = divide (sys_info$max_seg_size - autbl.header_length, size (ute), 17, 0); autbl.number_free, autbl.first_free = 0; if abs_stop_before_startup then /* abs stop command given before startup */ autbl.abs_stopped = "1"b; /* this means don't start absentee */ call update_whotab_abs_copy; /* just like it says */ return; %page; init_aum: entry (a_code); dcl a_code fixed bin (35); /* entry called when absentee facility is brought up */ autp = as_data_$autp; ansp = as_data_$ansp; code_mask_ev_calls, code_unmask_ev_calls = -1; unspec (unlock_msg) = unspec (unlock_string); /* initialize message sent by unlock procedure */ call ipc_$create_ev_chn (absentee_rq_chn, a_code);/* Create event channels. */ if a_code ^= 0 then go to chn_error; call ipc_$decl_ev_call_chn (absentee_rq_chn, absentee_user_manager_$absentee_user_manager_, (null), ABS_LOGIN_PRIO, a_code); if a_code ^= 0 then do; chn_error: call sys_log_$error_log (2, a_code, id, "Cannot create absentee event channel."); return; end; call get_process_id_ (absentee_procid); /* get process id of absentee user manager */ autbl.as_procid = absentee_procid; /* copy process id into absentee_user_table */ whotab.abs_procid = absentee_procid; /* copy process id and event channel into whotable */ whotab.abs_event = absentee_rq_chn; /* so that ear can send wakeup to absentee */ call absentee_utility_$init_au (a_code); /* initialize utility which handles message segment */ if a_code ^= 0 then do; call sys_log_ (1, "^a: ^a ^a", id, error_message_2, error_message_3); return; end; call update_whotab_abs_copy; return; %page; term_aum: entry; /* entry call when absentee facility is shutdown */ autp = as_data_$autp; ansp = as_data_$ansp; code_mask_ev_calls, code_unmask_ev_calls = -1; if ^sc_stat_$Go_typed then do; /* abs stop command given before startup */ abs_stop_before_startup = "1"b; /* remember this in int static since startup truncates AUTBL */ return; end; call ipc_$delete_ev_chn (absentee_rq_chn, code); whotab.abs_procid = (36)"0"b; whotab.abs_event = 0; call absentee_utility_$term_au; call update_whotab_abs_copy; return; aum_trace: entry; trace = "1"b; return; aum_no_trace: entry; trace = "0"b; return; update_whotab_abs_control: entry; autp = as_data_$autp; ansp = as_data_$ansp; call update_whotab_abs_copy; /* call internal procedure to do work */ return; %page; /* INTERNAL PROCEDURES, IN ALPHABETIC ORDER */ cleaner_up: proc; if utep = null then return; call user_table_mgr_$free (utep); end cleaner_up; %page; notify: proc (message); /* user said ear -notify, so do so */ dcl message char (*); call ioa_$rsnnl ("Absentee job ^a ^a ^a.", abort_message, j, ute.input_seg, request_id_ (ute.request_id), message); call notify_request_owner (abort_message); return; end notify; %page; notify_request_owner: proc (message); /* send message to owner of absentee request in aute */ dcl message char (*); if ute.proxy then call ioa_$rsnnl ("^a.^a", hisid, (0), ute.proxy_person, ute.proxy_project); else call ioa_$rsnnl ("^a.^a", hisid, (0), ute.person, ute.project); call send_mail (hisid, ute.process_authorization, rtrim (message)); return; end notify_request_owner; %page; reset_alarm: proc; call timer_manager_$reset_alarm_wakeup (ute.event); return; end reset_alarm; %page; send_mail: proc (user_id, auth, message); dcl user_id char (32); dcl auth bit (72) aligned; dcl message char (*); unspec (send_mail_info) = "0"b; send_mail_info.version = 1; send_mail_info.wakeup = "1"b; send_mail_info.always_add = "1"b; send_mail_info.sent_from = "absentee"; call send_mail_$access_class (user_id, message, addr (send_mail_info), auth, code); if code ^= 0 & code ^= error_table_$messages_deferred & code ^= error_table_$messages_off then call sys_log_$error_log (0, code, id, "Unable to notify user ^a of absentee event", user_id); return; end send_mail; %page; ucs: proc (mcptr, condname, coptr, infoptr, continue); dcl mcptr ptr parameter; dcl condname char (*) parameter; dcl coptr ptr parameter; dcl infoptr ptr parameter; dcl continue bit (1) parameter; dcl mbuf char (256) aligned; dcl mlth fixed bin; dcl non_local_exit bit (1); dcl as_check_condition_ entry (char (*), bit (1), bit (1)); call as_check_condition_ (condname, continue, non_local_exit); if continue | non_local_exit then return; call ioa_$rsnnl ("^a: Error: ^a", mbuf, mlth, id, condname); call sys_log_ (2, "^a", mbuf); call as_dump_ (mbuf); aborting = "1"b; /* don't try to log any more guys in */ go to static_label; end ucs; %page; unlock: procedure; /* internal procedure to unlock answer table lock */ /* copied from dialup_ */ dcl code fixed bin (35); anstbl.lock_count = anstbl.lock_count - 1; if anstbl.lock_count < 0 then anstbl.lock_count = 0; if anstbl.lock_count = 0 then if code_mask_ev_calls = 0 & code_unmask_ev_calls ^= 0 then call ipc_$unmask_ev_calls (code_unmask_ev_calls); if anstbl.lock_count = 0 then if anstbl.update_pending = "1"b then do; anstbl.update_pending = "0"b; call hcs_$wakeup (anstbl.as_procid, anstbl.update_channel, unlock_msg, code); end; end unlock; %page; update_whotab_abs_copy: proc; /* procedure called when something in absentee_user_table has changed that should be reflected in the whotab published copy. */ if whoptr = null then return; /* cover our posterior */ if autp = null then return; /* ditto */ whotab.n_abs (*) = autbl.n_abs (*); /* number in each queue */ whotab.abs_qres (*) = autbl.qres (*); /* background queue information */ whotab.abs_cpu_limit (*) = autbl.cpu_limit (*); /* auto or operator set cpu max */ string (whotab.abs_control) = string (autbl.control); /* little bitties */ return; /* all done */ end; %page; wakeup_error: proc (msg); dcl msg char (*) varying; call sys_log_ (0, "^a: ^a ^a.^a ^a", id, msg, ute.person, ute.project, ute.tty_name); return; end wakeup_error; %page; %include absentee_user_table; %page; %include answer_table; %page; %include as_data_; %page; %include as_data_definitions_; %page; %include as_meter_numbers; %page; %include as_wakeup_priorities; %page; %include dialup_values; %page; %include installation_parms; %page; %include sc_stat_; %page; %include send_mail_info; %page; %include sys_log_constants; %page; %include user_attributes; %page; %include user_table_entry; %page; %include user_table_header; %page; %include whotab; %page; /* BEGIN MESSAGE DOCUMENTATION Message: absentee_user_manager_$init: MESSAGE. Cannot truncate absentee_user_table. S: as (severity1) T: $init M: It was not possible to clear the absentee_user_table segment. A: $contact Message: absentee_user_manager_: ERROR_MESSAGE. Trying to wakeup PERSON.PROJECT.TAG process after abs release. S: $as0 T: Called in response to an operator abs release command. M: A failure occurred while sending a wakeup to the absentee process being released. ERROR_MESSAGE is the text associated with the error code returned by hcs_$wakeup. A: $ignore Message: absentee_user_manager_: event calls were masked. S: sc (user_output) T: $run M: This message indicates a serious error in the Initializer programs. The system attempts to recover and keep running. A: $notify Message: absentee_user_manager_: Error in initializing absentee. Don't bring up absentee facility S: as (severity1) T: $run M: The absentee mechanism will not initialize. A: $inform Do _n_o_t try to initialize the absentee facility. Message: absentee_user_manager_: Error: CONDITION S: as (severity2) T: $run M: An unexpected fault has occurred while performing some absentee function such as logging in a new absentee user. The system automatically performs an Answering Service dump and attempts to recover. A: No action is required unless the condition persists. If this message occurs repeatedly, try stopping the absentee facility; inform the programming staff. Message: absentee_user_manager_: ERROR_MESSAGE. Cannot create absentee event channel S: as (severity2) T: $init M: The absentee facility could not create part of its communications mechanism. No absentee process can be logged in. A: Try the abs start command again. If the absentee facility still fails, inform the programming staff. Message: absentee_user_manager_: ERROR_MESSAGE. Creating proc for NAME.PROJ S: as (severity2) T: $run M: A storage system error prevented the absentee user from logging in. This is due to some error in the process creating mechanism. The user is not logged in. A: $inform Shut down the absentee facility with an abs bump * * and an abs stop if this message occurs repeatedly. Message: absentee_user_manager_: Premature stopstop for ID S: as (severity0) T: $run M: An error has occurred while trying to destroy the absentee process ID. The system recovers and continues. A: $ignore Message: absentee_user_manager_: Process terminated USER.PROJ ID MESSAGE. S: as (severity0) T: $run M: The absentee process ID of USER.PROJ has terminated for the reason specified, and will be logged out. A: $ignore Message: absentee_user_manager_: Strange event message WWWWWWWWWWWW WWWWWWWWWWWW from Initializer S: as (severity1) T: $run M: An unrecognizable event message has been received from the Answering Service. Its value is printed in octal. Usually, the first word is the function code and the second word is the index in the absentee user table. This condition is due to a error in the Answering Service or absentee programs. The system ignores the signal and goes on. The absentee facility may cease to operate. A: If absentee jobs will no longer run, try an abs stop and an abs start. Inform the system programming staff. Message: absentee_user_manager_: Strange event message WWWWWWWWWWWW WWWWWWWWWWWW from user proc WWWWWWWWWWWW S: as (severity1) T: $run M: This message is similar to the preceding message described above, except that the signal does not come from the Initializer but from some other process. The process ID of the sending process is printed in octal. The event message was not a valid item. The system ignores the signal and goes on. A: If absentee jobs will no longer run, try an abs stop and an abs start. Inform the system programming staff. Message: absentee_user_manager_: Strange event message WWWWWWWWWWWW WWWWWWWWWWWW from NAME.PROJ TTY S: as (severity1) T: $run M: This message is similar to the preceding message, except that the name, project, and tty name of the user sending the wakeup are printed. The system ignores the signal and goes on. A: $ignore Message: absentee_user_manager_: Trace .... S: as (severity1) T: $run M: This is trace output. It begins coming out about every five minutes after absentee_user_manager_$aum_trace_on is called. A: $ignore To shut this message off, type: absentee_user_manager_$aum_trace_off while in admin mode. Message: absentee_user_manager_: ERROR attempting to cancel reservation R for USER.PROJ absN S: as (severity1) T: $run M: The system was unable to cancel a resource reservation for an absentee process that is being destroyed. The resource(s) might remain unavailable to other users. There is some problem in the resource reservation mechanism. A: $inform Message: absentee_user_manager_: ERROR attempting to pre-claim reservation R for USER.PROJ absN S: as (severity1) T: $run M: The system was unable to assign a resource reservation to an absentee job that is being logged in. The job will be run, but it might fail if the resources it needs happen to be unavailable when it requests them. There is some problem in the resource reservation mechanism. A: $inform Message: absentee_user_manager_ (abs run): System too full; no absentee jobs can be started now. S: as (severity1) T: In response to an abs run command. M: The system is too near the upper limit on logged in users to start any absentee jobs. A: If the immediate running of the job is essential, use "abs stop queue all" to halt all other absentee logins, change the login word to halt all interactive logins, and either wait for a process to log out, or bump one, before repeating the abs run command. END MESSAGE DOCUMENTATION */ end absentee_user_manager_;  absentee_utility_.pl1 08/01/88 1047.1r w 08/01/88 1028.4 1216080 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-05-13,GJohnson), approve(86-05-13,MCR7387), audit(86-05-13,Martinson), install(86-05-14,MR12.0-1055): Correct error message documentation. 2) change(86-05-20,Gilcrease), approve(86-05-22,MCR7370), audit(86-07-07,Fawcett), install(86-06-30,MR12.0-1082): Implement -truncate absout files, SCP6296. 3) change(86-05-20,Lippard), approve(85-12-30,MCR7326), audit(86-10-27,GDixon), install(86-10-28,MR12.0-1200): Modified on 7 November 1985 (above date given to satisfy picky hcom) by Jim Lippard to add check_queue_access. 4) change(87-04-26,GDixon), approve(87-07-12,MCR7741), audit(87-07-23,Brunelle), install(87-08-04,MR12.1-1055): A) Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1. B) Replace calls to lg_ctl_$reset with user_table_mgr_$reset. (dsa 214) 5) change(87-05-14,GDixon), approve(87-07-12,MCR7741), audit(87-07-23,Brunelle), install(87-08-04,MR12.1-1055): Use constants to set ute.tag. 6) change(87-05-20,Lippard), approve(87-07-12,MCR7709), audit(87-07-23,Brunelle), install(87-08-04,MR12.1-1055): Modified to null adp after termination. 7) change(87-07-12,GDixon), approve(87-07-12,MCR7741), audit(87-07-23,Brunelle), install(87-08-04,MR12.1-1055): A) Change cleanup handler to reset the UTE, rather than just freeing args associated with it. The user_table_mgr_$reset will free the args. B) Remove cleanup window when allocating the args by storing ptr to arg storage directly in the UTE. C) Change abs_run proc to reset the UTE if the operator-specified job is not found. D) Since user_table_mgr_$reset now does the arg freeing, remove the free_args proc. 8) change(87-07-28,GDixon), approve(87-07-28,MCR7741), audit(87-07-28,Brunelle), install(87-08-04,MR12.1-1055): Remove hardcoded SysDaemon & SysAdmin access to submit proxy abs jobs. (phx19578) 9) change(88-02-11,Parisek), approve(88-02-11,MCR7849), audit(88-03-23,Lippard), install(88-07-13,MR12.2-1047): Add code for filling in UTE elements for new absentee request structure elements (version 6) SCP6367. END HISTORY COMMENTS */ /* format: style4 */ absentee_utility_: proc (up, a_arg_ptr, a_code); /* ABSENTEE_UTILITY_ - utility procedure for the absentee user manager. This program is the only answering service program which manipulates the absentee message segments. Its main entry point is called from absentee_user_manager_ (AUM) to attempt to start another absentee. This program maintains a database (absentee_data) in the system directory, listing all requests read from the queues and not yet disposed of. These include running requests, and those that have been deferred for any reason. Comments at the beginning of abs_data.incl.pl1 describe the structure of this database, and the management of it by this program. As of the MR7.0 rewrite, this procedure consists of the following sections, in the order shown: - declarations - main entry point - additional entry points, in alphabetic order - internal procedures, in alphabetic order - include files, in alphabetic order - message documentation Modified 3/22/72 by Dennis Capps Modified 750404 by PG for AIM checks Modified August 1977 by D. Vinograd to fix proxy bug and by T. Casey to get it to compile with the new improved compiler. Modified April 1978 by T. Casey for new absentee request format, and many new features. Modified November 1978 by T. Casey for MR7.0 absentee control parameters. An extensive rewrite was required. Modified March 1979 by T. Casey for MR7.0a to deal with suspended absentee jobs. Modified March 1980 by Tom Casey to add metering. Modified January 1981 by Benson I Margulies for user proxy acs. Modified February 1981 by Tom Casey to un-format_pl1 Benson's changes. Please, nobody ever do that again... Modified June 1981 by T. Casey for MR9.0 to make absentee load control more efficient, . by remembering group and UserID in absentee_data, and not trying to log in any more jobs . from a group, project, or user, whose job was just deferred by load control. Modified Spetember 1981 by E. N. Kittlitz to remove User_proxy.acs support. Modified November 1981, E. N. Kittlitz. user_table_entry conversion. Modified December 1981, E. N. Kittlitz. put defer_channel into absentee_user_table Modified April 1982, E. N. Kittlitz. New AS initialization. bugfixes. Modified 1985-01-15 by E. Swenson for new location of admin acs segments. Modified 1985-04-19 by E. Swenson to fix any other handler. */ /* parameters */ dcl a_code fixed bin (35); dcl up ptr; /* parameter - pointer to absentee user table entry */ dcl a_arg_ptr ptr; /* pointer to abs_args structure, used by abs command */ dcl a_asr_sender_ptr ptr; /* pointer to access info for process cancelling request */ dcl a_ute_ptr ptr; /* pointer to user table entry */ /* based */ dcl system_area area (1048) based (areap); dcl lengths (number_of_arguments) based fixed bin aligned; /* lens of args to abs */ dcl xstring char (length_of_arguments) based aligned; /* string of args to abs */ /* automatic */ dcl search_code fixed bin (35); /* used by main loop. do not use anywhere else */ dcl code fixed bin (35); /* error code for internal use */ dcl lc_code fixed bin (35); /* load_ctl_'s reason for deferring a job */ dcl queue_index fixed bin; /* index of current message segment */ dcl queue fixed bin; /* number of queue now being processed */ dcl list_searched fixed bin; /* list being searched: cput, ready, or queue */ dcl aix fixed bin; /* index of current list entry */ dcl next_aix fixed bin; /* index of next entry on list */ dcl ii fixed bin; /* A temporary */ dcl time_now fixed bin (71); /* current time */ dcl length_of_arguments fixed bin; /* information on arguments from request */ dcl number_of_arguments fixed bin; dcl request_found bit (1) aligned; /* turned on if we find a request that can be logged in */ dcl abort_label automatic label variable; /* where to go if infinite loop in list searching */ dcl loop_limit fixed bin; /* counter to detect infinite loops in list searching */ dcl ev_calls_masked bit (1) aligned; /* remember if we need to unmask ev calls on cleanup */ dcl ctl_wakeup bit (1) aligned; /* to remember which kind of wakeup to send: login or aum_ctl */ dcl p ptr; /* not used, but required by compiler to avoid warning msg */ dcl has_access bit (1) aligned; /* if user has access to bump absentee */ dcl ext_mode bit (36) aligned; /* user's extended access on queue */ dcl has_o_permission bit (1) aligned; /* user has own on queue */ dcl has_d_permission bit (1) aligned; /* user has delete on queue */ dcl has_ring1_priv bit (1) aligned; /* user has ring1 privilege */ dcl user char (32); /* user ID */ dcl person char (22); /* person ID */ dcl project char (9); /* project ID */ dcl authorization bit (72) aligned; /* AIM authorization */ dcl anonymous_user bit (1) aligned; /* an anonymous user */ dcl abs_arg_ptr ptr; /* copy of a_arg_ptr, pointer to abs command arg structure */ dcl found bit (1) aligned; /* on if found a request in defer list when timer goes off */ dcl 1 return_args aligned, 2 reqp ptr aligned, /* pointer to message which is put in area */ 2 len fixed bin (18) aligned, /* length of message in bits */ 2 sender char (32) aligned, /* process group id of sender of message */ 2 ring fixed bin aligned, /* validation level of sender */ 2 mess_id bit (72) aligned, /* message id */ 2 sender_authorization bit (72) aligned, 2 access_class bit (72) aligned; dcl 1 acl (3) aligned, /* structure used to set access */ 2 access_name char (32), 2 access bit (36), 2 ex_access bit (36), 2 status fixed bin (35); dcl based_mess_id fixed bin (71) based (addr (cur_message_id)); /* for date_time_ call */ dcl cur_message_id bit (72) aligned; /* id of current msg, for incremental read */ /* Stuff used for remembering that there was an error in a request, and sending the user a message about it */ dcl date char (16); /* room for yy/mm/dd hhmm.m */ dcl rqid char (19); dcl short char (8); dcl long char (100); dcl reason char (160) varying; dcl user_message char (200); dcl message_in_error bit (1) aligned; /* on if any error found in request */ dcl error (10) bit (1) aligned; dcl message_error_code fixed bin (35); /* Conditions */ dcl any_other condition; dcl cleanup condition; /* entries, in alphabetic order */ dcl as_any_other_handler_$no_cleanup entry (char (*), label); dcl (as_meter_$enter, as_meter_$exit) entry (fixed bin); dcl absentee_utility_$timer_rang entry; dcl aim_check_$greater_or_equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl aim_check_$equal entry (bit(72) aligned, bit(72) aligned) returns(bit(1) aligned); dcl as_dump_ entry (char (*)); dcl available_slots_ entry (fixed bin, fixed bin, (4) fixed bin, (4) fixed bin) returns (fixed bin); dcl convert_status_code_ entry (fixed bin (35), char (8), char (100)); dcl date_time_ entry (fixed bin (71), char (*)); dcl freen_ entry (ptr); dcl get_system_free_area_ entry () returns (ptr); dcl hcs_$add_acl_entries entry (char (*), char (*), ptr, fixed bin, 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 hcs_$get_user_effmode entry (char (*), char (*), char (*), fixed bin, fixed bin (5), fixed bin (35)); dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); dcl hcs_$terminate_noname entry (ptr, fixed bin (35)); dcl hcs_$truncate_seg entry (ptr, fixed bin, fixed bin (35)); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl ioa_$rsnnl entry options (variable); dcl ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)); dcl ipc_$decl_ev_call_chn entry (fixed bin (71), entry, ptr, fixed bin, fixed bin (35)); dcl ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35)); dcl ipc_$mask_ev_calls entry (fixed bin (35)); dcl ipc_$unmask_ev_calls entry (fixed bin (35)); dcl match_request_id_ entry (fixed bin (71), char (*)) returns (bit (1) aligned); dcl match_star_name_ entry (char (*), char (*), fixed bin (35)); dcl message_segment_$close entry (fixed bin, fixed bin (35)); dcl message_segment_$create entry (char (*), char (*), fixed bin (35)); dcl message_segment_$delete_index entry (fixed bin, bit (72) aligned, fixed bin (35)); dcl message_segment_$incremental_read_index entry (fixed bin, ptr, bit (2) aligned, bit (72) aligned, ptr, fixed bin (35)); dcl message_segment_$ms_acl_add entry (char (*), char (*), ptr, fixed bin, fixed bin (35)); dcl message_segment_$open entry (char (*), char (*), fixed bin, fixed bin (35)); dcl message_segment_$read_index entry (fixed bin, ptr, bit (1) aligned, ptr, fixed bin (35)); dcl message_segment_$update_message_index entry (fixed bin, fixed bin (18) aligned, bit (72) aligned, ptr, fixed bin (35)); dcl parse_resource_desc_ entry (char (*) aligned, ptr, ptr, ptr, fixed bin (35)); dcl rcp_sys_$cancel_id entry (fixed bin (71), char (*), fixed bin (35)); dcl request_id_ entry (fixed bin (71)) returns (char (19)); dcl resource_control_$reserve entry (ptr, ptr, bit (72) aligned, bit (1) aligned, fixed bin (35)); dcl send_mail_$access_class entry (char (*), char (*), ptr, bit (72), fixed bin (35)); dcl sys_log_ entry options (variable); dcl sys_log_$error_log entry options (variable); dcl timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71)); dcl timer_manager_$reset_alarm_wakeup entry (fixed bin (71)); dcl user_table_mgr_$reset entry (ptr); /* builtins */ dcl (addr, after, before, bit, clock, copy, currentsize, divide, hbound, index, lbound, length, max, null, rtrim, string, substr, unspec, verify) builtin; /* external static */ dcl as_error_table_$proj_max ext fixed bin (35); dcl error_table_$bad_segment ext fixed bin (35); dcl error_table_$device_limit_exceeded ext fixed bin (35); dcl error_table_$messages_deferred ext fixed bin (35); dcl error_table_$messages_off ext fixed bin (35); dcl error_table_$no_e_permission fixed bin (35) ext static; dcl error_table_$no_message ext fixed bin (35); dcl error_table_$reservation_failed ext fixed bin (35); dcl error_table_$resource_unknown ext fixed bin (35); dcl sys_info$max_seg_size ext fixed bin (35); /* internal static variables */ dcl absentee_ename (-1:4) char (32) int static; /* entry names of absentee message segments */ dcl adp ptr int static init (null); /* pointer to absentee data */ dcl areap ptr int static init (null); /* ptr to area that requests are read into */ dcl queue_indices (-1:4) fixed bin int static init ((6) 0);/* indices of message segments containing abs requests */ dcl resource_timer_set bit (1) aligned int static init (""b); /* "1"b if timer is for resource rather than deferred job */ dcl static_alarm_time fixed bin (71) int static init (0); /* time when alarm timer is set to go off */ /* internal static constants */ dcl ABS_VER_4 fixed bin (17) init (4) static options (constant); /* a request_version of 4 means that this abs was queued under MR11. */ /* Any abs queued under MR12 will be version 5. */ dcl ABS_VER_5 fixed bin (17) init (5) static options (constant); /* a request_version of 5 means that this abs was queued under MR12.1 */ /* Any abs queued under MR12.2 will be version 6. */ dcl QERR_MAX fixed bin int static options (constant) init (3); /* drop queue after 3 consecutive read errors */ dcl MAX_QUEUE fixed bin int static options (constant) init (4); /* Maximum abs queue. PDT must change to make bigger */ dcl const1 fixed bin (35) int static options (constant) init (59999999); /* constants used for rounding */ dcl const2 fixed bin (35) int static options (constant) init (60000000); /* time up to nearest minute */ dcl LEGAL char (95) int static options (constant) init /* Printables except PAD, semicolon, but with BS */ (" !""#$%&'()*+,-./0123456789:<=>?@ABCDEFGHIJKLMNOPQRSTUVWXYZ[\]^_`abcdefghijklmnopqrstuvwxyz{|}~"); dcl NEVER fixed bin (71) int static options (constant) init (1f52b); /* one more than largest possible clock value */ dcl NO_QUEUE fixed bin int static options (constant) init (-9); /* used as q number argument when no current q is defined */ dcl err_msg (2:10) char (28) int static options (constant) init ( "invalid request version", /* 2 */ "no proxy permission", /* 3 */ "invalid person name", /* 4 */ "invalid project name", /* 5 */ "invalid absin pathname", /* 6 */ "invalid absout pathname", /* 7 */ "invalid resource description", /* 8 */ "invalid argument string", /* 9 */ "inconsistent request format"); /* 10 */ dcl deferral_reasons (7) char (24) int static options (constant) init ( "by operator", "indefinitely by operator", "- resources unavailable", "because of cputime limit", "because of queue limit", "because of user limit", "by load control"); dcl FORWARD bit (2) aligned int static options (constant) init ("01"b); dcl REREAD bit (2) aligned int static options (constant) init ("00"b); dcl BACKWARD bit (2) aligned int static options (constant) init ("10"b); dcl absentee_data_base char (32) int static options (constant) init ("absentee_data"); /* name of segment used for internal table */ dcl name char (17) int static options (constant) init ("absentee_utility_"); /* name of procedure - for error messages */ dcl CPUT_LIST fixed bin int static options (constant) init (1); /* values for list_searched */ dcl READY_LIST fixed bin int static options (constant) init (2); dcl QUEUE_LIST fixed bin int static options (constant) init (3); dcl ONE fixed bin int static options (constant) init (1); dcl MANY fixed bin int static options (constant) init (2); dcl DEFER fixed bin int static options (constant) init (1); dcl RELEASE fixed bin int static options (constant) init (2); dcl RUN fixed bin int static options (constant) init (3); dcl USER_LIMIT fixed bin int static options (constant) init (1); dcl PROJECT_LIMIT fixed bin int static options (constant) init (2); dcl GROUP_LIMIT fixed bin int static options (constant) init (3); dcl TRUE bit (1) aligned int static options (constant) init ("1"b); dcl FALSE bit (1) aligned int static options (constant) init (""b); /* INCLUDE FILES are at the end, after all the code, but before the message documentation */ /* MAIN ENTRY POINT absentee_utility_ proc (up, a_arg_ptr, a_code) MAIN ENTRY POINT */ /* Initialize */ call setup; /* init automatic variables */ abort_label = au_abort; /* where to go if fault, or infinite loop in list searching */ call as_meter_$enter (AU_METER); /* meter the cpu time and paging used by this procedure */ lc_code = a_code; /* load control deferral reaosn might be in a_code */ a_code = 0; /* clear any garbage from return code */ utep = up; /* copy pointer to absentee user table entry */ abs_arg_ptr = a_arg_ptr; /* and ptr to argument structure */ time_now = clock (); /* get current time, to decide whether to run deferred requests */ resource_desc_ptr, resource_res_ptr = null; /* declared in reservation include file, not init (null) */ on cleanup call cleaner_up; /* to free allocated storage in case of problems */ /* Decide whether this is a continuation of a sequence of calls from AUM, in which case we should resume our search for a request that can log in, from the point where we left off in the last call, or whether this is the beginning of a new sequence, in which case we should start our search from the top. */ if ^ute.abs_run then /* unless we're here because of an operator abs run command, in which case this has nothing to do with a sequence */ if ^autbl.aum_ctl then do; /* if AUM wants us to start from the top */ absentee_data.last_rsc (*) = 0; /* clear saved resource list indices */ /* see comment in find_eligible_ready for further explanation */ absentee_data.rebuilding = ""b; /* clear it, in case it was turned on by a rebuild */ autbl.aum_ctl = "1"b; /* AUM turns it off when going blocked with no more work to do */ end; /* First, see if AUM is returning a job to us because load control said "not now" to it. */ if ute.login_result = 2 then do; /* 2 means "not now, but try again later" to an absentee job */ call search_skip_for_aute (code); /* locate skip list entry for request described by aute */ if code = 0 then do; /* if we found it */ call thread_resource; /* thread it into the resource list */ abs_info.waiting_for_load_ctl = "1"b; /* remember which kind of resource it's waiting for */ abs_info.deferral_logged = ute.uflags.deferral_logged; /* remember if we've logged the deferral once */ abs_info.group = ute.group; /* remember group, for lc list */ if ute.failure_reason = 1 then /* lg_ctl_ said no */ abs_info.lc_reason = USER_LIMIT; /* remember deferral reason, for lc_list */ else /* load_ctl_ said no */ if lc_code = as_error_table_$proj_max then /* could be either project limit */ abs_info.lc_reason = PROJECT_LIMIT; else abs_info.lc_reason = GROUP_LIMIT; /* or group limit */ call thread_lc; /* thread entry onto end of lc list */ if ute.reservation_id ^= 0 then do; /* if it had a resource reservation, cancel it */ call rcp_sys_$cancel_id (ute.reservation_id, rtrim (ute.person) || "." || rtrim (ute.project) || ".*", code); if code ^= 0 then call sys_log_$error_log (SL_LOG_SILENT, code, name, "Attempting to cancel reservation ^a for ^a.^a (^a)", request_id_ (ute.reservation_id), ute.person, ute.project, ute.input_seg); end; /* Rewrite message in queue to inform user of deferral and reason for it. */ call read_msg (REREAD, ute.message_id, code); if code = 0 then do; request.state = STATE_DEFERRED; unspec (request.abs_status_flags) = ""b; /* clear any previous flags */ if ute.failure_reason = 3 then /* 3 means load_ctl_ said no */ request.load_control = "1"b; else if ute.failure_reason = 1 then/* 1 means lg_ctl_ said no */ request.user_limit = "1"b; /* and he only says no if user limit would be exceeded */ call rewrite_msg; call notify_deferral; /* send user a message if so requested and we haven't already */ call free_req; /* free storage that request was read into */ end; else call sys_log_$error_log (SL_LOG_SILENT, code, name, "While reading message ^24.3b from ^a.^a (^a) to be rewritten.", ute.message_id, ute.person, ute.project, ute.input_seg); end; else call sys_log_$error_log (SL_LOG_SILENT, code, name, "Searching queue ^d skip list for ^a.^a (^a)", queue, ute.person, ute.project, ute.input_seg); call user_table_mgr_$reset (utep); /* clear out the user table entry before re-using it */ end; /* Now, try to find a job to log in */ request_found = ""b; /* gets turned on if we find one */ if ute.abs_run then /* if we were told which job to run */ call abs_run; /* go find it */ else do queue = -1 to autbl.last_queue_searched /* else search all active queues */ while (^request_found); /* until we find a request to run */ call setup_queue; /* see if we really want to search this one; if we do, set up for it */ search_code = 0; if queue_index > 0 then /* if the setup of the queue succeeded */ do while (^request_found & search_code = 0); /* search queue until we find a request or hit end of it */ call get_next_request (search_code); /* get next request from this queue */ if search_code = 0 then /* if there was one */ call decode_request; /* see if it is suitable for logging in now */ if ^request_found then /* if it is, request_found is turned on */ call user_table_mgr_$reset (utep); /* if it isn't, clear user table entry before re-using it */ end; /* end inner loop thru one queue */ end; /* end outer loop over all queues */ if ^request_found then /* if there's no job that can be run now */ au_abort: a_code = error_table_$no_message; /* tell AUM */ abort_label = au_return; call as_meter_$exit (AU_METER); /* turn off the meter before we return */ au_return: return; /* THIS IS THE ONLY RETURN FROM THE MAIN ENTRY POINT */ /* ADDITIONAL ENTRY POINTS, IN ALPHABETIC ORDER */ abs_defer: entry (up); /* called by operator command abs defer */ call setup; /* init automatic variables */ abort_label = abs_defer_abort; /* where to go if fault, or infinite loop in skip list search */ abs_arg_ptr = up; call search_queues (MANY, DEFER); abs_defer_abort: return; /* ***** ***** */ abs_release: entry (up, release_count); /* called by operator command abs release */ call setup; /* init automatic variables */ dcl release_count fixed bin; abort_label = abs_release_abort; /* where to go if fault, or infinite loop in skip list search */ abs_arg_ptr = up; call search_queues (MANY, RELEASE); abs_release_abort: return; /* ***** ***** */ au_send_ctl_wakeup: entry; /* to send "aum_ctl" wakeup */ ctl_wakeup = "1"b; /* set switch (which is init (""b)) and fall thru to next entry */ au_send_wakeup: entry; /* to allow other procs to call our send_abs_wakeup subroutine */ call setup; /* init automatic variables */ abort_label = au_send_wakeup_abort; /* where to go if fault, or infinite loop in list searching */ call send_abs_wakeup; au_send_wakeup_abort: return; check_queue_access: entry (a_ute_ptr, a_asr_sender_ptr) returns (bit (1) aligned); /* This entry is called by AUM to make sure a user has appropriate access to an absentee queue in order to bump a running absentee. */ call setup; /* init automatic variables */ utep = a_ute_ptr; as_request_sender_ptr = a_asr_sender_ptr; has_access = "0"b; call search_skip_for_aute (code); if code ^= 0 then do; call sys_log_$error_log (SL_LOG_SILENT, code, name, "Searching queue ^d skip list for ^a.^a (^a)", queue, ute.person, ute.project, ute.input_seg); return ("0"b); end; /* Check the user's access. */ if queue_index ^= 0 then do; user = as_request_sender.group_id; call hcs_$get_user_access_modes (sysdir, absentee_ename (queue), user, (as_request_sender.validation_level), (""b), ext_mode, code); /* If the code is ^= 0, something must be wrong, so we just don't let the user have access. */ if code = 0 then do; has_d_permission = ((MSEG_D_ACCESS & ext_mode) ^= ""b); has_o_permission = ((MSEG_O_ACCESS & ext_mode) ^= ""b); /* We allow the bump if: a) the bumper has "d" permission on the absentee queue and is at the same AIM authorization (or has ring1 priv). b) the bumper is the same person or proxy person as the absentee (and same project or proxy project for anonymous users), at the same AIM authorization (or has ring1 priv), and has "o" permission on the queue. */ person = before (user, "."); project = before (after (user, "."), "."); authorization = as_request_sender.authorization; has_ring1_priv = addr (as_request_sender.authorization) -> aim_template.ring1; anonymous_user = (person = "anonymous"); /* case a */ if has_d_permission then if aim_check_$equal (authorization, ute.process_authorization) | has_ring1_priv then has_access = "1"b; else ; /* case b */ else if has_o_permission then if (person = ute.person | person = ute.proxy_person | (anonymous_user & (ute.anonymous = 1))) & (^anonymous_user | (project = ute.project | project = ute.proxy_project)) & ((aim_check_$equal (authorization, ute.process_authorization)) | has_ring1_priv) then has_access = "1"b; end; end; return (has_access); clear_lc_list: entry; /* This entry is called by AUM to clear the load control list, when AUM decides that it is time to allow all requests deferred by load control to have another chance to try logging in. The purpose of the lc list, and the logic that decides when to clear it, is to allow requests to log in as soon as possible, but minimize the overhead involved in repeatedly trying to log requests in, only to have them deferred by load control. When a request is deferred because of a user limit, or a group or project limit, we know that other requests from the same user, group, or project would also be deferred, and there is no use trying to log them in. We put the first deferred request from a particular user, group, or project on the lc list. Thus, the lc list serves as a list of users, groups, and projects whose requests can't log in now. We put other requests from those users, groups, and projects on the resource list immediately, without trying to log them in. They do have their lc_reason set, but they do not get put on the lc list. In the initial implementation of the lc list (June 1981 for MR9.0), we clear the lc list when we are no longer sure that it is valid. This happens whenever an absentee process logs out, and whenever AUM gets a login wakeup with the "aum_ctl" switch off. (See comments in AUM for an explanation of that switch.) This policy is biased in the direction of incurring some extra overhead, in the form of unsuccessful login attempts, in order to avoid delaying requests that could log in. If this policy results in an insufficient reduction in overhead, a closer cooperation between load_ctl_ and the maintainer of the lc list can be implemented in a future release. The ABS_TRYLOG meter will show the number and cost of login attempts, both successful and unsuccessful. */ call setup; /* init automatic variables */ abort_label = clear_lc_abort; /* place to go if fault or infinite loop in list search */ loop_limit = 0; /* initialize loop detector */ aix = absentee_data.head_lc; /* start at head of list */ do while (aix ^= 0); /* and stop after last one */ aip = addr (absentee_data.entry (aix)); /* get pointer to entry */ aix = abs_info.next_lc; /* save index of next entry (will be zero if this is last entry) */ abs_info.lc_list = ""b; /* clear lc list indicator bit */ abs_info.prev_lc, abs_info.next_lc = 0; /* zero the lc threads */ loop_limit = loop_limit + 1; /* avoid infinite loop if list damaged */ if loop_limit > absentee_data.last then call loop_error ("clear_lc_list", "lc", NO_QUEUE); /* goes to abort_label instead of returning */ end; absentee_data.head_lc, absentee_data.tail_lc = 0; /* zero head and tail threads */ autbl.lc_list = ""b; /* tell AUM that the list is empty */ clear_lc_abort: return; delete_message: entry (up); /* This entry is called whenever a running absentee job has completed. The message requesting that it be run will be deleted from the message segment and information concerning it will be deleted from an internal list of running jobs */ call setup; /* init automatic variables */ abort_label = dm_abort; /* where to go if fault, or infinite loop in list searching */ utep = up; /* copy pointer to absentee user table entry */ call search_skip_for_aute (code); /* search skip list for this request */ if code = 0 then /* if request was found in skip list */ call delete_skip; /* delete it from the list */ else call sys_log_$error_log (SL_LOG_SILENT, code, name, "Searching queue ^d skip list for ^a.^a (^a)", queue, ute.person, ute.project, ute.input_seg); dm_abort: /* even if the skip list search aborted */ if queue_index > 0 then /* if we know the queue */ call delete_msg (ute.message_id); /* Try to delete the message */ else call sys_log_ (SL_LOG_SILENT, "^a: Unable to delete request for ^a.^a (^a); queue: ^d; index: ^d", name, ute.person, ute.project, ute.input_seg, queue, queue_index); return; init_au: entry (a_code); /* initialization entry point */ call setup; /* init automatic variables */ a_code = 0; /* clear error code to be returned */ areap = get_system_free_area_ (); /* initialize static area pointer */ do queue = -1 to MAX_QUEUE; /* initiate absentee message segments */ /* construct name of absentee message segment */ if queue = -1 then absentee_ename (queue) = "absentee_foreground.ms"; else call ioa_$rsnnl ("absentee_^d.ms", absentee_ename (queue), (0), queue); call message_segment_$open (sysdir, absentee_ename (queue), queue_indices (queue), code); /* if can't initiate it, try to create it - assume it got deleted */ if code ^= 0 then do; call sys_log_$error_log (SL_LOG, code, name, "Creating new ^a>^a", sysdir, absentee_ename (queue)); call message_segment_$create (sysdir, absentee_ename (queue), code); if code ^= 0 then do; call sys_log_$error_log (SL_LOG, code, name, "Unable to create ^a>^a", sysdir, absentee_ename (queue)); go to setup_next_queue; end; acl.access_name (1) = "*.SysAdmin.*"; /* set 3 extended acls */ acl.access_name (2) = "*.SysDaemon.*"; /* in addition to *.sys_control.a set in creation */ acl.access_name (3) = "*.*.*"; acl.access (1), acl.access (2), acl.access (3) = "111"b; /* set real modes */ acl.ex_access (1), /* add, delete, read, own, status for */ acl.ex_access (2) = "11111"b; /* SysAdmin & SysDaemon */ if queue ^= 0 then /* except for queue 0 */ acl.ex_access (3) = "10011"b; /* add, own, status for everyone else */ else acl.ex_access (3) = "00011"b; /* but everyone else is denied add permission on Q 0 */ /* set extended access */ call message_segment_$ms_acl_add (sysdir, absentee_ename (queue), addr (acl), 3, code); if code ^= 0 then do; call sys_log_$error_log (SL_LOG, code, name, "Unable to set extended access on ^a>^a", sysdir, absentee_ename (queue)); go to setup_next_queue; end; /* now try to open abs message segment */ call message_segment_$open (sysdir, absentee_ename (queue), queue_indices (queue), code); if code ^= 0 then do; /* give up */ call sys_log_$error_log (SL_LOG, code, name, "Unable to open new ^a>^a", sysdir, absentee_ename (queue)); go to setup_next_queue; end; end; setup_next_queue: end; call ipc_$create_ev_chn (autbl.defer_channel, code); /* create an event call channel */ if code = 0 then call ipc_$decl_ev_call_chn (autbl.defer_channel, absentee_utility_$timer_rang, (null), ABS_DEFER_PRIO, code); if code ^= 0 then do; call sys_log_$error_log (SL_LOG_BEEP, code, name, "Error in creating defer event channel"); a_code = code; return; end; call hcs_$initiate (sysdir, absentee_data_base, "", 0, 1, adp, code); if adp = null then do; call sys_log_$error_log (SL_LOG, code, name, "Creating new ^a>^a", sysdir, absentee_data_base); call hcs_$make_seg (sysdir, absentee_data_base, "", 01011b, adp, code); if adp = null then do; /* Something is wrong */ call sys_log_$error_log (SL_LOG_BEEP, code, name, "Unable to create ^a>^a", sysdir, absentee_data_base); a_code = code; return; end; acl (1).access_name = "*.SysDaemon.*"; acl (1).access = "1011"b; acl (1).ex_access = "0"b; acl (2).access_name = "*.*.*"; acl (2).access = "0"b; acl (2).ex_access = "0"b; call hcs_$add_acl_entries (sysdir, absentee_data_base, addr (acl), 2, code); if code ^= 0 then do; call sys_log_$error_log (SL_LOG, code, name, "Unable to set access on ^a>^a", sysdir, absentee_data_base); a_code = code; end; end; call hcs_$truncate_seg (adp, 0, code); /* truncate absentee data - zeroing out previous abs data */ if code ^= 0 then a_code = code; absentee_data.version = ABS_DATA_version_2; /* set current structure version */ return; mark_request_running: entry (up); /* This entry is called by AUM after a request is logged in, to rewrite the request, changing its state to running. */ call setup; /* init automatic variables */ utep = up; /* copy ptr to user table entry */ call get_queue_from_aute; /* get queue number from aute */ if queue_index ^= 0 then do; /* if queue information is ok, continue */ call read_msg (REREAD, ute.message_id, code); if code = 0 then do; request.state = STATE_RUNNING; unspec (request.abs_status_flags) = ""b; call rewrite_msg; /* rewrite message with new state and reason */ call free_req; /* free storage that request was read into */ end; else call sys_log_$error_log (SL_LOG_SILENT, code, name, "While reading message ^24.3b to be rewritten.", ute.message_id); end; return; set_resource_timer: entry; /* entry point called by absentee_user_manager_ to tell us that there are slots available to the jobs waiting for resources, and we should set a timer and check periodically to see if those resources have become available, even though we are not logging jobs in and out at the moment. */ if resource_timer_set then /* if the resource timer is already set */ return; /* leav it - don't reset it for a later time */ call setup; /* init automatic variables */ time_now = clock (); call set_rsc_timer (time_now + installation_parms.rsc_timer_seconds * 1000000); return; term_au: entry; /* entry point which terminates absentee message segments */ call setup; /* init automatic variables */ do queue = -1 to MAX_QUEUE; /* terminate absentee message segments */ if queue_indices (queue) ^= 0 then do; call message_segment_$close (queue_indices (queue), code); if code ^= 0 then call sys_log_$error_log (SL_LOG, code, name, "Closing ^a>^a", sysdir, absentee_ename (queue)); queue_indices (queue) = 0; end; end; call reset_alarm_timer; /* reset deferred request alarm timer */ call ipc_$delete_ev_chn (autbl.defer_channel, code); /* delete timer event channel */ if adp ^= null then do; call hcs_$terminate_noname (adp, code); /* terminate absentee data base */ if code ^= 0 then call sys_log_$error_log (SL_LOG, code, name, "Unable to terminate ^a>^a", sysdir, absentee_data_base); else adp = null; end; return; timer_rang: entry; /* called when the deferred-request timer goes off */ call setup; /* init automatic variables */ dcl was_rsc_timer bit (1) aligned; abort_label = tr_abort; /* where to go if fault, or infinite loop in list searching */ call as_meter_$enter (AU_METER); resource_desc_ptr, resource_res_ptr = null; /* so cleanup handler won't try to free what they point to */ on condition (cleanup) call cleaner_up; /* establish cleanup handler */ on condition (any_other) call as_any_other_handler_$no_cleanup ("absentee_utility_", abort_label); was_rsc_timer = resource_timer_set; /* remember which kind of timer it was */ static_alarm_time = 0; /* there is currently no timer set, since it just went off */ call ipc_$mask_ev_calls (code); /* mask event calls until list is updated */ ev_calls_masked = "1"b; /* remember that we did this, in case of cleanup */ found = "0"b; /* to see if we find any request whose time has arrived */ time_now = clock (); /* read clock only once */ loop_limit = 0; do aix = absentee_data.head_defer /* start at head of defer list */ repeat next_aix /* and keep going */ while (aix ^= 0 /* until we hit the end of the list */ & absentee_data.entry (aix).time <= time_now); /* or find an entry whose time is in the future */ aip = addr (absentee_data.entry (aix)); /* get pointer to entry whose time has arrived */ found = "1"b; /* remember that we found one */ next_aix = abs_info.next_defer; /* remember index of next entry on defer list */ queue = abs_info.queue; /* pull queue info out of list entry, for convenient reference */ queue_index = queue_indices (queue); call thread_ready; /* put request on ready list */ call delete_defer; /* and delete it from defer list */ loop_limit = loop_limit + 1; /* avoid infinite loop if list damaged */ if loop_limit > absentee_data.last then call loop_error ("timer_rang", "defer", NO_QUEUE); /* goes to abort_label instead of returning */ end; if aix ^= 0 then /* if there are still deferred requests */ call set_defer_timer (absentee_data.entry (aix).time); /* set timer for first one */ if found | was_rsc_timer then /* if we found a request or we need to try for a resource */ call send_abs_wakeup; /* send a wakeup to AUM */ else call sys_log_ (SL_LOG_SILENT, "^a: Timer rang and no deferred request found.", name); tr_abort: call ipc_$unmask_ev_calls (code); /* let event calls take hold again */ abort_label = tr_return; call as_meter_$exit (AU_METER); tr_return: return; /* INTERNAL PROCEDURES, IN ALPHABETIC ORDER */ abs_run: proc; /* find request specified by abs_args, decode it, and return it to the main loop */ call search_queues (ONE, RUN); /* search the queues for it */ if request_found then do; /* if we found it */ request_found = ""b; /* gets turned back on if we decide to run it */ call search_skip_for_queue (code); /* see if it has a skip list entry */ if code = 0 then do; /* if it does, investigate further */ if abs_info.cput_list then call delete_cput; else if abs_info.ready_list then call delete_ready; else if abs_info.defer_list then call delete_defer; else do; /* it must be running */ call sys_log_ (SL_TYPE, "abs_run: request ^a>^a ^a is already running,", request.dirname, request.ename, request_id_ (request.msg_time)); call free_req; /* free the storage we read the request into */ return; /* return with request_found off */ end; end; else call create_run; /* not on skip list; put on run list (beginning of skip list) */ call decode_request; /* decode the request and turn on request_found if it's ok */ if ^request_found then call user_table_mgr_$reset (utep); end; return; end abs_run; check_for_badseg: proc (ec, repeat_sw, caller); /* Check error code returned by the message segment primitives. Report all errors to operator. Count consecutive errors on each queue and drop queue if too many. Tell caller to retry the operation if the code indicates that the message segment just got salvaged. */ dcl ec fixed bin (35); dcl repeat_sw bit (1) aligned; dcl caller char (*); repeat_sw = ""b; if ec = 0 | ec = error_table_$no_message then autbl.qerr (queue) = 0; /* clear count of consecutive errors */ else do; if queue < -1 | queue > MAX_QUEUE then if autbl.debugging = 1 then /* makeshift debugging switch */ call as_dump_ ("absentee_utility_: software error in queue selection."); autbl.qerr (queue) = autbl.qerr (queue) + 1; /* count consecutive errors */ if autbl.qerr (queue) > QERR_MAX then do; /* > QERR_MAX consecutive errors causes queue to be dropped */ call sys_log_$error_log (SL_LOG_BEEP, ec, caller, "Dropping queue ^d ^a>^a due to ^d consecutive errors", queue, sysdir, absentee_ename (queue), autbl.qerr (queue)); autbl.queue_dropped (queue) = "1"b; end; else do; call sys_log_$error_log (SL_LOG, ec, caller, "queue ^d ^a>^a", queue, sysdir, absentee_ename (queue)); if ec = error_table_$bad_segment then /* tell caller to try again if q was salvaged */ repeat_sw = "1"b; end; call free_req; /* free any storage allocated by ring1 before error occurred */ end; return; end check_for_badseg; cleaner_up: proc; /* Cleanup handler. Free allocated storage in UTE, and in local structures, and unmask event calls if we masked them. */ call user_table_mgr_$reset (utep); call free_req; call free_rsc; if ev_calls_masked then do; call ipc_$unmask_ev_calls (code); ev_calls_masked = ""b; end; return; end cleaner_up; create_skip: proc; /* Procedure to add an entry to the skip list. An entry is taken from the free list, or a new one is created at the end of the array. Input arguments: queue and cur_message_id. Output arguments: aix is index of new entry; aip is ptr to it. */ dcl run_sw bit (1) aligned init (""b); goto create_skip_common; create_run: entry; /* put new entry on run list (beginning of skip list) */ run_sw = "1"b; create_skip_common: if absentee_data.tail_free ^= 0 then do; /* free entry exists */ aix = absentee_data.tail_free; aip = addr (absentee_data.entry (aix)); /* use it */ absentee_data.tail_free = abs_info.prev_free;/* define new tail of free list */ abs_info.prev_free = 0; /* clear thread value in used entry */ abs_info.free_list = ""b; end; else do; /* if no free entry exists */ aix, absentee_data.last = absentee_data.last + 1; /* create new one */ if currentsize (absentee_data) > sys_info$max_seg_size then do; call sys_log_ (SL_LOG_BEEP, "^a: ^a>^a has overflowed its limit of ^d entries.", name, sysdir, absentee_data_base, absentee_data.last - 1); call suspend_absentee_processing; /* DOES NOT RETURN */ end; aip = addr (absentee_data.entry (aix)); end; abs_info.queue = queue; /* fill in queue and message id */ abs_info.message_id = cur_message_id; abs_info.request_id = request.msg_time; /* and request id */ abs_info.skip_list = "1"b; abs_info.group = ""; /* stays blank unless request gets deferred by load_ctl_ */ /* Set back thread to last entry on run or ready list. */ if run_sw then do; abs_info.run_list = "1"b; abs_info.prev_skip = absentee_data.queue_data (queue).tail_run; end; else abs_info.prev_skip = absentee_data.queue_data (queue).tail_skip; /* Set the forward thread, and then thread the previous entry to this one. */ if abs_info.prev_skip > 0 then do; /* if there was a previous entry */ abs_info.next_skip = absentee_data.entry (abs_info.prev_skip).next_skip; /* copy its forward thread */ absentee_data.entry (abs_info.prev_skip).next_skip = aix; /* point its forward thread at this entry */ end; else do; /* no previous entry, so copy the head-of-list thread */ abs_info.next_skip = absentee_data.queue_data (queue).head_skip; absentee_data.queue_data (queue).head_skip = aix; /* then point head of list at this entry */ end; /* Now, thread following entry to this one */ if abs_info.next_skip > 0 then /* if following entry exists (only possible for run list) */ absentee_data.entry (abs_info.next_skip).prev_skip = aix; /* point its back thread at current entry */ /* We are threading onto the tail of one of the lists. Set the appropriate tail thread(s). */ if run_sw then absentee_data.queue_data (queue).tail_run = aix; if ^run_sw | absentee_data.queue_data (queue).tail_skip = 0 then absentee_data.queue_data (queue).tail_skip = aix; end create_skip; decode_lc_ineligible: proc returns (bit (1) aligned); /* This procedure is called by decode_request to see if the request will be rejected by load control. The load control test is made by another procedure (lc_will_reject) which is called by this one. The purpose of this procedure is to detect a request that has already passed the load control test, and return FALSE immediately, avoiding the overhead of repeating the test. Such a request can be identified by its non-zero lc_reason field, which indicates that it was deferred by load control in the past. We know that it would only get un-deferred and passed to decode_request if it had passed the load control test. */ if abs_info.lc_reason > 0 then /* if it was previously deferred by load control */ return (FALSE); /* we know it has already passed the test */ return (lc_will_reject ()); /* return whatever lc_will_reject returns to us */ end decode_lc_ineligible; decode_request: proc; /* decode message and fill in structure to be returned */ ute.real_queue, ute.queue = queue; /* Set queue number. This is the abs flag because > 0 */ if queue <= 0 then do; /* if queue zero or foreground queue */ ute.queue = ute.queue + 1; /* 0 => 1 since Q 0 is logically the front of Q 1; -1 => 0 since foreground Q contains "interactive" jobs */ ute.adjust_abs_q_no = "1"b; /* remember what we just did */ if queue = -1 then /* if foreground queue */ ute.foreground_job = "1"b; /* remember it even more explicitly */ end; ute.uflags.deferral_logged = abs_info.deferral_logged; /* note if request's deferral was already logged */ ute.outer_module = as_data_$abs_dim; /* Set outer module to be used. */ ute.message_id = cur_message_id; /* record message id */ /* The absentee request contains variables with refer extents. A request with garbage values for the extents could cause the initializer process to take faults. So we check the extents for validity before referencing any of those variables. */ /* First check version of request */ if request.hdr_version ^= queue_msg_hdr_version_1 /* Allow old version 4 */ | (request.request_version ^= abs_message_version_6 & request.request_version ^= ABS_VER_5 & request.request_version ^= ABS_VER_4) then call message_error (2); /* 2 = invalid request version */ else do; /* if version ok, check extents */ ii = divide (return_args.len + 35, 36, 17, 0); /* number of words returned from message segment */ if ii ^= currentsize (request) | ii ^= request.std_length then call message_error (10); /* 10 = inconsistent request format */ end; /* Fill in project name from sender's project */ ute.project = before (after (return_args.sender, "."), "."); /* Fill in person name */ if before (return_args.sender, ".") ^= "anonymous" then do; /* if normal user - login_name from return_args.sender's name */ ute.person = before (return_args.sender, "."); ute.anonymous = 0; end; else do; /* if anonymous user - login_name from message */ if ^message_in_error then ute.person = request.name; ute.anonymous = 1; end; /* Copy and validate various other items from the request */ ute.sender = request.sender; ute.notify = request.notify; string (ute.abs_attributes) = string (request.abs_attributes); ute.uflags.foreground_secondary_ok = ute.abs_attributes.secondary_ok; ute.tag = TAG_ABSENTEE; /* validate_proxy will change to "p" if proxy */ if ute.abs_attributes.proxy & ^message_in_error then /* Submitted for someone else? */ call validate_proxy; /* this will call message_error if it is bad */ abs_info.person = substr (ute.person, 1, length (abs_info.person)); /* copy UserID into abs_info entry */ abs_info.project = substr (ute.project, 1, length (abs_info.project)); /* (must be done after proxy processing) */ if verify (ute.person, LEGAL) ^= 0 then call message_error (4); /* 4 = invalid person name */ if verify (ute.project, LEGAL) ^= 0 then call message_error (5); /* 5 = invalid project name */ ute.input_seg = rtrim (request.dirname) || ">" || rtrim (request.ename); /* pathname of absin segment */ if substr (ute.input_seg, 1, 1) ^= ">" then call message_error (6); /* 6 = invalid absin pathname */ else if verify (ute.input_seg, LEGAL) ^= 0 then call message_error (6); /* ditto */ if request.len_output > 0 & ^message_in_error then do; /* fill in output segment name if any given */ ute.output_seg = request.output_file; if substr (ute.output_seg, 1, 1) ^= ">" then call message_error (7); /* 7 = invalid absout pathname */ else if verify (ute.output_seg, LEGAL) ^= 0 then call message_error (7); /* ditto */ end; else ute.output_seg = ""; ute.request_id = request.msg_time; /* Validate the authorization that the request is to be run at. It must be greater than or equal to the authorization of the sender. If it isn't, then "upgrade" it to the authorization of the sender */ if ^aim_check_$greater_or_equal (request.requested_authorization, return_args.sender_authorization) then request.requested_authorization = return_args.sender_authorization; ute.process_authorization = request.requested_authorization; /* Fill in information on arguments */ number_of_arguments = request.arg_count; ute.arg_count = number_of_arguments; ute.arg_lengths_ptr = null; ute.args_ptr = null; ute.ln_args = 0; if number_of_arguments > 0 & ^message_in_error then do; /* If there are any */ length_of_arguments = request.len_args; ute.ln_args = length_of_arguments; if number_of_arguments > length_of_arguments | length_of_arguments > (4 * request.std_length) then call message_error (9); /* 9 = invalid argument string */ else do; /* Get storage for the array of arg lengths and fill it in */ allocate lengths in (system_area) set(ute.arg_lengths_ptr); do ii = 1 to number_of_arguments; ute.arg_lengths_ptr -> lengths (ii) = request.arg_lengths (ii); end; /* Get storage for string of arguments and fill it in */ allocate xstring in (system_area) set (ute.args_ptr); ute.args_ptr -> xstring = request.args; end; /* end allocate args */ end; /* end there are args */ /* Copy cpu time and deferred time */ ute.max_cpu_time = max (0, request.max_cpu_time); /* Validate user-specified cpu limit */ if ute.max_cpu_time = 0 then /* if user didn't set a limit */ if ute.queue > 0 then /* if not foreground queue */ ute.max_cpu_time = installation_parms.abs_cpu_default_limit (ute.queue); /* use background dflt */ else ute.max_cpu_time = installation_parms.foreground_cpu_default_limit; /* else use foreground dflt */ ute.deferred_time = divide (request.deferred_time + const1, /* fill in deferred time, */ const2, 63, 0) * const2; /* rounded up to next minute * */ /* Now fill in request version 6 elements; home_dir, init_proc & initial_ring */ if request.request_version > ABS_VER_5 then do; /* version 6 elements */ if request.len_homedir > 0 & ^message_in_error then ute.home_dir = substr (request.home_dir, 1, request.len_homedir); if request.len_initproc > 0 & ^message_in_error then do; ute.uflags.ip_given = "1"b; /* initial proc given */ ute.ip_len = request.len_initproc; ute.init_proc = substr (request.init_proc, 1, request.len_initproc); end; if request.initial_ring ^= -1 then ute.initial_ring = request.initial_ring; /* specified initial ring value */ if request.abs_attributes.no_start_up then do; /* specfied no_start_up */ ute.at.nostartup = "1"b; ute.ur_at.nostartup = "1"b; end; end; /* Now, decide if request can run or must be deferred */ if ^message_in_error then do; /* but skip it if bad request */ if ^ute.abs_run then do; /* if not being ordered to run the job, treat it normally */ if ute.deferred_time > time_now then do; call defer_request_until_time; /* put into deferred list according to its time */ call mark_request_deferred (""b); end; else if (request.user_deferred_indefinitely | request.operator_deferred_indefinitely) then do; call defer_request_indefinitely; /* put at end of defer list */ call mark_request_deferred (unspec (request.abs_status_flags)); end; else if ute.queue > 0 & ute.max_cpu_time > autbl.cpu_limit (max (1, ute.queue)) then do; call thread_cput; /* put at end of cpu time list */ call mark_request_deferred ("0001"b); end; else if decode_lc_ineligible () then do;/* if load control won't let this one run now */ call thread_resource; /* put it on the resource list */ abs_info.waiting_for_load_ctl = "1"b; /* the resource is load control */ if abs_info.lc_reason = USER_LIMIT then /* put reason into request */ request.user_limit = "1"b; else request.load_control = "1"b; request.state = STATE_DEFERRED; call rewrite_msg; /* rewrite request in queue so lar will show deferral reason */ call notify_deferral; /* send user a message if so requested and we haven't already */ end; else if rsc_reservation_unavailable () then do; call thread_resource; abs_info.waiting_for_resources = "1"b; call mark_request_deferred ("001"b); end; else if ^message_in_error then /* resource reservation attempt can detect error in message */ request_found = "1"b; end; /* end not abs run */ else do; /* job selected by abs run */ if rsc_reservation_unavailable () then call sys_log_ (SL_LOG, "^a (abs run): Request ^a ^a will be run in spite of unavailable resource(s): ^a", name, ute.input_seg, request_id_ (ute.request_id), request.resource); if ^message_in_error then /* unless error detected during resource processing */ request_found = "1"b; /* confirm that we found the request and can run it */ end; end; /* No matter what is going to happen to this request, allow any formerly-deferred requests waiting behind it in the ready list to go ahead. See comments in thread_resource (thread_ready entry point) for further explanation. */ call update_ready; /* Now, do some final bookkeeping */ if message_in_error then do; /* if bad msg, delete it and tell user and operator */ call delete_msg (cur_message_id); /* delete bad msg from queue */ call delete_skip; /* delete its skip list entry */ call notify_user; /* format error message (reason); mail it to user if possible */ /* then tell operator, printing request id if known, else date-time entered */ call sys_log_ (SL_LOG, "^a: rejected request^[^x^a^;^s^] (^a) in ^[queue ^d^;^sforeground queue^] from ^a^[^x(entered ^a)^;^s^]: ^a", name, (rqid ^= ""), rqid, ute.input_seg, (queue > 0), queue, return_args.sender, (rqid = ""), date, reason); message_in_error = ""b; /* clear error flag before reading next request */ error (*) = ""b; /* ditto for individual flags */ end; /* end bad message */ if request_found then do; /* we are returning a request to AUM to be logged in */ request.state = STATE_TRANSITION; /* state will be changing momentarily */ call rewrite_msg; /* mark the request in the queue */ end; call free_req; /* in all cases, free storage occupied by request */ return; end decode_request; defer_request_indefinitely: proc; abs_info.defer_list = "1"b; abs_info.time = NEVER; /* very long time in future */ abs_info.next_defer = 0; /* next entry is tail of defer list */ abs_info.prev_defer = absentee_data.tail_defer; /* previous entry used to be last in list */ if abs_info.prev_defer > 0 then /* if there was a previous entry */ absentee_data.entry (abs_info.prev_defer).next_defer = aix; /* point it at this one */ else absentee_data.head_defer = aix; /* else point head of list at this entry */ absentee_data.tail_defer = aix; /* this is the last entry in the list */ return; end defer_request_indefinitely; defer_request_until_time: proc; dcl ix fixed bin; dcl loop_limit fixed bin; abs_info.defer_list = "1"b; /* identify entry as being on defer list */ abs_info.time = ute.deferred_time; /* copy deferred time into list entry */ loop_limit = 0; do ix = absentee_data.head_defer /* start at head of defer list */ repeat absentee_data.entry (ix).next_defer /* and go thru the list */ while (ix ^= 0 /* until we hit the end of it */ & absentee_data.entry (ix).time <= abs_info.time); /* or find one with time > this one's */ loop_limit = loop_limit + 1; /* avoid infinite loop if list damaged */ if loop_limit > absentee_data.last then call loop_error ("defer_request", "defer", NO_QUEUE); /* DOES NOT RETURN */ end; /* Now, ix is the index of the first entry with a time after the current one. We will thread the current one in just before it. */ /* First set threads in entry being added */ abs_info.next_defer = ix; if ix > 0 then /* if ix points to a real entry */ abs_info.prev_defer = absentee_data.entry (ix).prev_defer; /* copy its back thread */ else /* if ix is zero, either it points to the tail of the list, or the list is empty */ abs_info.prev_defer = absentee_data.tail_defer; /* and this does the right thing in either case */ /* Then set threads in previous and following entries */ if abs_info.prev_defer > 0 then /* if previous entry exists */ absentee_data.entry (abs_info.prev_defer).next_defer = aix; /* make it point to current entry */ else do; absentee_data.head_defer = aix; /* else make head of list point to it */ call set_defer_timer (abs_info.time); /* and set new timer since there's a new first deferred request */ end; if ix > 0 then /* if next entry exists */ absentee_data.entry (ix).prev_defer = aix; /* make it point back to current entry */ else absentee_data.tail_defer = aix; /* else make tail of list point back to it */ return; end defer_request_until_time; delete_cput: proc; /* Unthread entry from cput list. Input arguments: aip (on which abs_info is based) points to entry to be unthreaded, queue is queue it is from. */ /* First, thread previous and following entries together. */ if abs_info.prev_cput > 0 then /* if there is a previous entry */ absentee_data.entry (abs_info.prev_cput).next_cput = abs_info.next_cput; /* set its forward thread */ else absentee_data.queue_data (queue).head_cput = abs_info.next_cput; /* else set head of list */ if abs_info.next_cput > 0 then /* if there is a following entry */ absentee_data.entry (abs_info.next_cput).prev_cput = abs_info.prev_cput; /* set its back thread */ else absentee_data.queue_data (queue).tail_cput = abs_info.prev_cput; /* else set tail of list */ /* Then clear cput list information out of current entry */ abs_info.prev_cput = 0; abs_info.next_cput = 0; abs_info.cpu_limit = 0; abs_info.cput_list = ""b; return; end delete_cput; delete_defer: proc; /* Unthread entry from defer list. Input arguments: aip (on which abs_info is based) points to entry to be unthreaded. */ /* First, thread previous and following entries together. */ if abs_info.prev_defer > 0 then /* if previous entry exists */ absentee_data.entry (abs_info.prev_defer).next_defer = abs_info.next_defer; /* set its forward thread */ else absentee_data.head_defer = abs_info.next_defer; /* else set head of list */ if abs_info.next_defer > 0 then /* if following entry exists */ absentee_data.entry (abs_info.next_defer).prev_defer = abs_info.prev_defer; /* set its back thread */ else absentee_data.tail_defer = abs_info.prev_defer; /* else set tail of list */ /* Then clear defer list information out of current entry */ abs_info.next_defer = 0; /* blank out defer items */ abs_info.prev_defer = 0; abs_info.time = 0; abs_info.defer_list = ""b; return; end delete_defer; delete_lc: proc; /* Unthread entry from lc list. Input arguments: aip (on which abs_info is based) points to entry to be unthreaded. */ /* First, thread previous and following entries together. */ if abs_info.prev_lc > 0 then /* if previous entry exists */ absentee_data.entry (abs_info.prev_lc).next_lc = abs_info.next_lc; /* set its forward thread */ else absentee_data.head_lc = abs_info.next_lc; /* else set head of list */ if abs_info.next_lc > 0 then /* if next entry exists */ absentee_data.entry (abs_info.next_lc).prev_lc = abs_info.prev_lc; /* set its backthread */ else absentee_data.tail_lc = abs_info.prev_lc; /* else set tail of list */ /* Then clear lc list info out of this entry */ abs_info.prev_lc, abs_info.next_lc = 0; /* threads */ abs_info.lc_list = ""b; /* lc list indicator */ /* we deliberately leave lc_reason set */ return; end delete_lc; delete_msg: proc (msg_id); /* Procedure to delete a message from the queue. Calls message_segment_$delete_index, and deals with a nonzero return code. */ dcl msg_id bit (72) aligned; dcl ec fixed bin (35); dcl repeat bit (1) aligned; repeat = "1"b; /* do the delete at least once */ do while (repeat); /* repeat it if queue gets salvaged */ call as_meter_$enter (ABSQ_METER); call message_segment_$delete_index (queue_index, msg_id, ec); call as_meter_$exit (ABSQ_METER); call check_for_badseg (ec, repeat, "absentee_utility_ (delete_msg)"); end; return; end delete_msg; delete_ready: proc; /* Unthread entry from ready list. It might be on the resource list, which is a subset of the ready list. Input arguments: aip (on which abs_info is based) points to entry to be unthreaded; queue is queue it is from. */ /* First, thread previous and following entries back together. */ if abs_info.prev_ready > 0 then /* if previous entry exists */ absentee_data.entry (abs_info.prev_ready).next_ready = abs_info.next_ready; /* set its forward thread */ else absentee_data.queue_data (queue).head_ready = abs_info.next_ready; /* else set head of list */ if abs_info.next_ready > 0 then /* if following entry exists */ absentee_data.entry (abs_info.next_ready).prev_ready = abs_info.prev_ready; /* set its back thread */ else absentee_data.queue_data (queue).tail_ready = abs_info.prev_ready; /* else set tail of list */ if absentee_data.queue_data (queue).tail_resource = aix then /* if this was tail of resource list */ absentee_data.queue_data (queue).tail_resource = abs_info.prev_ready; /* previous entry is now the tail */ /* Then, clear ready list information out of current entry. */ abs_info.prev_ready = 0; abs_info.next_ready = 0; abs_info.can_run = "0"b; abs_info.last_message_id = (72)"0"b; if abs_info.resource_list then do; autbl.rsc_waiting (queue) = autbl.rsc_waiting (queue) - 1; abs_info.waiting_for_resources = ""b; abs_info.waiting_for_load_ctl = ""b; abs_info.resource_list = ""b; end; abs_info.ready_list = ""b; /* Finally, if it is on the lc list, go unthread it from that list. */ if abs_info.lc_list then call delete_lc; return; end delete_ready; delete_skip: proc; /* Procedure to delete an entry from the skip list. The entry gets zeroed out and put into the free list. Input arguments: aix is index of entry to be deleted; aip is ptr to it; queue is queue it came from. */ /* First, thread previous and following entries together. */ if abs_info.prev_skip > 0 then /* if previous entry exists */ absentee_data.entry (abs_info.prev_skip).next_skip = abs_info.next_skip; /* set its forward thread */ else absentee_data.queue_data (queue).head_skip = abs_info.next_skip; /* else set head of list */ if abs_info.next_skip > 0 then /* if following entry exists */ absentee_data.entry (abs_info.next_skip).prev_skip = abs_info.prev_skip; /* set its back thread */ else absentee_data.queue_data (queue).tail_skip = abs_info.prev_skip; /* else set tail of list */ if absentee_data.queue_data (queue).tail_run = aix then /* if this was tail of run list */ absentee_data.queue_data (queue).tail_run = abs_info.prev_skip; /* previous entry is now the tail */ /* Then clear the entry completely and thread it onto the free list */ unspec (abs_info) = ""b; /* zero out entry */ abs_info.prev_free = absentee_data.tail_free; /* thread in new free entry */ absentee_data.tail_free = aix; /* define new tail of free list */ abs_info.free_list = "1"b; return; end delete_skip; find_eligible_cput: proc (ec); /* Find the first entry on the cput list whose time limit does not exceed the current upper limit for its queue. There might not be one. Input arguments: queue is queue whose cput list should be searched; aix and next_aix are indices of current and next cput list entries; they allow us to come back to the same place in the cput list, if the first entry we select can not be run for some reason other than cpu time. */ dcl ec fixed bin (35); dcl loop_limit fixed bin; ec = error_table_$no_message; /* be pessimistic; we zero it if we find one */ if aix = 0 then /* if we just started searching the cput list */ aix, next_aix = absentee_data.queue_data (queue).head_cput; /* pick up head of list */ loop_limit = 0; do while (aix ^= 0 & ec ^= 0); /* repeat until we hit the end or find one */ do aix = next_aix /* start where we left off last time */ repeat absentee_data.entry (aix).next_cput /* and step thru the cput list */ while (aix ^= 0 /* until we hit the end, or find one with low enough limit */ & absentee_data.entry (aix).cpu_limit > autbl.cpu_limit (max (1, queue))); loop_limit = loop_limit + 1; /* avoid infinite loop if list damaged */ if loop_limit > absentee_data.last then call loop_error ("find_eligible_cput", "cput", queue); /* does not return */ end; if aix > 0 then do; /* if we found one with a low limit, see if it's still in queue */ aip = addr (absentee_data.entry (aix)); /* get ptr to entry, for convenient referencing */ next_aix = abs_info.next_cput; /* save index of next one, since we delete this one */ call read_msg (REREAD, abs_info.message_id, ec); /* read request from queue */ call delete_cput; /* delete it from cput list */ if ec = error_table_$no_message then /* if user or operator deleted request */ call delete_skip; /* clear it off our records */ else cur_message_id = return_args.mess_id; /* else remember message id in global variable */ end; end; return; end find_eligible_cput; find_eligible_ready: proc (ec); /* Find an entry on the ready list that can run now. Because of the way the ready list is built up from deferred requests as their times arrive, it is always true that the first N requests on the list can run (where N can be zero), and all the rest can't. So we always start at the head of the list and quit as soon as we find one that can't run. (The above is true only of the non-resource part of the ready list. Read on.) The resource list is the first part of the ready list. It contains requests waiting for either a resource reservation or a load control slot. We want to try logging these requests in periodically, but we must avoid the overhead of trying too often. And of course we must avoid attempting to log in the resource list entries repeatedly in an infinite loop. Since requests are taken from the head of the resource list, and put back onto its tail if they can't log in, an infinite loop would result if we did not do something to avoid it. We want to make only one pass thru the resource list each time AUM starts a new sequence of calls to AU. When a new sequence starts, AUM turns off the aum_ctl bit in the AUT header. When we find that bit off, upon entry to the main loop of AU, we turn it on and clear our saved resource list indices. As long as it remains on, we know we're still in the same sequence. Then, the first time thereafter that we add an entry to each queue's resource list, we save its index. Thus, when searching the resource list, if we come to an entry whose index is equal to the saved index, we know we've completed one pass thru the resource list, so we skip to the second part of the list, which is the "real" ready list. As a further optimization, requests on the resource list that are waiting for load control are checked against the lc list, and rethreaded immediately to the tail of the resource list if it looks like they would not be allowed to log in now. Input argument: queue is the queue whose ready list should be searched. */ dcl ec fixed bin (35); dcl loop_limit fixed bin; dcl found bit (1) aligned init (""b); ec = error_table_$no_message; /* gets zeroed if we find one */ next_aix = absentee_data.queue_data (queue).head_ready; /* pick up head of ready list */ call check_last_rsc; /* check for end of pass thru resource list */ loop_limit = 0; do aix = next_aix repeat next_aix /* step thru ready list */ while (aix ^= 0 & ec ^= 0); /* until we hit end or find one that can or can't run (really!) */ aip = addr (absentee_data.entry (aix)); /* get ptr to entry */ next_aix = abs_info.next_ready; /* save index of next one, in case we delete this one */ call check_last_rsc; /* check for end of pass thru resource list */ if ^abs_info.can_run then do; /* if request waiting behind another one */ call read_msg (REREAD, abs_info.last_message_id, ec); /* see if it's still there */ if ec = error_table_$no_message then /* if it's not */ abs_info.can_run = "1"b; /* the one behind it can run */ else do; /* it is still in the queue */ call free_req; /* free the storage we read it into */ ec = 0; /* we found one that can't run; be sure to get out of the loop */ next_aix = aix; /* SLOPPY BUG FIX: loop bumps aix one time too many */ end; /* (we want to exit the loop with aix at its current value, but the loop will set it to next_aix before doing the while tests and exiting) */ end; if abs_info.can_run then do; /* if current request not held behind another */ if ready_lc_ineligible () then /* if it's going to be deferred by load control, avoid the overhead o