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 of reading it from the queue, decoding it, and trying to log it in */ call rethread_resource_head_to_tail; /* but simulate the effect of all that on the list */ else do; /* it's all right with load control - treat it normally */ call delete_ready; /* delete it from ready list */ call read_msg (REREAD, abs_info.message_id, ec); /* read it from queue */ if ec = error_table_$no_message then /* if user or operator deleted it */ call delete_skip; /* clear it from our records, and stay in the loop */ else do; found = "1"b; /* remember that we found one */ cur_message_id = return_args.mess_id; /* remember its message id in global variable */ next_aix = aix; /* SLOPPY BUG FIX: loop bumps aix one time too many */ end; /* end we found one still in the queue */ end; /* end it's all right with load control */ end; /* end request not held behind another */ loop_limit = loop_limit + 1; /* avoid infinite loop if list damaged */ if loop_limit > absentee_data.last then call loop_error ("find_eligible_ready", "ready", queue); /* does not return */ end; if ^found then ec = error_table_$no_message; /* tell caller if we didn't find one */ return; /* ---------- */ check_last_rsc: proc; /* See if next entry is a resource list entry that we have already looked at during this wakeup. */ if next_aix > 0 then if next_aix = absentee_data.last_rsc (queue) then /* if it is */ next_aix = absentee_data.entry (absentee_data.queue_data (queue).tail_resource).next_ready; return; /* skip over the resource list to the "real" ready list */ end check_last_rsc; end find_eligible_ready; find_next_queue_entry: proc (ec); /* Find a request in the queue. It will be decoded and either run now or deferred, as appropriate. In either case, it will stay on the skip list (unless it is a bad request and gets deleted from both the queue and the skip list). So we always want to read the request after the last one in the skip list (or the first one in the queue, if the skip list is empty). When reading requests from the queue, we might find one whose state is RUNNING. Either it was running when the system crashed, and we want to rerun it only if it is restartable, or it is running now, and we are rebuilding the lists in absentee_data. Another possibility is that it was started early by the abs run command, and we just got to its spot in the queue. In this case, we want to skip it and read the next message. */ dcl ec fixed bin (35); dcl repeat bit (1) aligned; /* Get the index of the last skip list entry, if the list is non-empty. If the skip list contains only entries that are on the run list, pretend the skip list is empty. If the skip list is empty (or we are pretending it is), read the first message in the queue. Otherwise, read the message after the last one in the skip list. */ aix = absentee_data.queue_data (queue).tail_skip; /* get index of last entry on skip list */ if aix = absentee_data.queue_data (queue).tail_run then /* if it is on the run list */ aix = 0; /* pretend the skip list is empty */ if aix ^= 0 then /* if the non-run skip list section is non-empty */ cur_message_id = absentee_data.entry (aix).message_id; /* read the request after it in the queue */ else cur_message_id = ""b; /* else read first request in queue */ ec = 0; /* initialize do group controls */ repeat = "1"b; do while (repeat & ec = 0); /* read msgs 'til suitable msg found, or no more left */ call read_msg (FORWARD, cur_message_id, ec); /* read either first msg in Q or first after last skip */ if ec = 0 then do; /* if read worked */ cur_message_id = return_args.mess_id; /* remember message id in global variable */ call create_skip; /* put request onto skip list right away */ repeat = check_for_running (); /* if request.state = RUNNING, maybe read another request */ end; end; return; /* ---------- */ check_for_running: proc returns (bit (1) aligned); /* The following possibilities exist: * state ^= RUNNING Case I: normal; try to run the job. * state = RUNNING * not rebuilding absentee_data * job is on run list Case I.5: skip over job started by abs run * system crashed while job was running * job is restartable Case II: rerun the job. * job not restartable Case III: delete job and read next request. * rebuilding absentee_data Case IV: job is now running: put it on skip list and read next request. */ if request.state ^= STATE_RUNNING then return (""b); /* Case I - run job */ do ii = absentee_data.queue_data (queue).tail_run /* search run list for this request */ repeat absentee_data.entry (ii).prev_skip while (ii > 0); /* fails immediately with ii=0 if run list is empty */ if absentee_data.entry (ii).message_id = abs_info.message_id then do; /* found it */ call free_req; /* it was started by abs run; free its storage */ call delete_skip; /* delete the duplicate skip list entry we created */ return ("1"b); /* tell caller to read next message */ end; end; if request.restartable & ^absentee_data.rebuilding then do; if request.request_version > ABS_VER_4 then do; /* Only version 5 & above requests */ request.restarted = "1"b; /* flag as restarted */ call rewrite_msg; end; return (""b); /* Case II - rerun the job */ end; call free_req; /* Cases III and IV both want to read next request, so free this one's storage */ if ^absentee_data.rebuilding then do; /* Case III - delete job */ call delete_msg (cur_message_id); call delete_skip; /* since we had already put it on the skip list */ end; return ("1"b); /* tell caller to read next message */ end check_for_running; end find_next_queue_entry; free_req: proc; if return_args.reqp ^= null then call freen_ (return_args.reqp); return; end free_req; free_rsc: proc; if resource_desc_ptr ^= null then call freen_ (resource_desc_ptr); if resource_res_ptr ^= null then call freen_ (resource_res_ptr); return; end free_rsc; get_effmode: procedure (dir, entry, user, ring, code) returns (bit (36)); declare (dir, entry, user) character (*); declare code fixed bin (35); declare ring fixed bin; declare mode fixed bin (5); call hcs_$get_user_effmode (dir, entry, user, ring, mode, code); if code ^= 0 then return (""b); else return (substr (bit (mode, 5), 2, 3) || copy ("0"b, 33)); end get_effmode; get_next_request: proc (ec); /* Get "the next" request. It will be decoded and either logged in or deferred. If the request we return gets deferred, we will be called again, and we want to resume our search with the request "after" the one we returned before. The search sequence that defines "the next" request, and the one "after" the one we returned is the following: the cput list, the ready list, and finally the queue itself, starting with the request after the last one on the skip list. This sequence is followed as long as we keep returning requests to the main loop and having them deferred. The search sequence is restarted from the beginning whenever we switch to the next queue, or whenever AU returns to AUM and gets called again. */ dcl ec fixed bin (35); ec = 0; /* gets set nonzero if there is no next request */ if list_searched = CPUT_LIST then do; call find_eligible_cput (ec); if ec ^= 0 then /* if no eligible request on cput list, try ready list */ list_searched = READY_LIST; end; if list_searched = READY_LIST then do; call find_eligible_ready (ec); if ec ^= 0 then /* if no eligible request on ready list, try the queue */ list_searched = QUEUE_LIST; end; if list_searched = QUEUE_LIST then call find_next_queue_entry (ec); return; end get_next_request; get_queue_from_aute: proc; /* Get queue number out of aute, and check it for legal value */ queue = ute.real_queue; /* set queue number */ if queue >= -1 & queue <= MAX_QUEUE then /* be sure queue has legal value */ queue_index = queue_indices (queue); /* if it does, pick up its message segment index */ else do; /* if not, log the error for debugging */ call sys_log_ (SL_LOG_SILENT, "^a: Illegal queue number (^d) for ^a.^a (^a)", name, queue, ute.person, ute.project, ute.input_seg); queue_index = 0; /* don't try to read or write from some random queue */ end; return; end get_queue_from_aute; lc_will_reject: proc returns (bit (1) aligned); /* This procedure predicts the deferral of a request by load control, by searching the load control list for a request from the same user, project, or load control group. The purpose of this is to avoid the overhead of repeatedly trying to log in all the requests deferred by load control, just to see if they can log in now. It often happens that there are a lot of requests from one user, or from one group, and as soon as one of them is deferred by load control, we know that all the rest would also be deferred, at least until someone logs out. If we aren't sure the request will be deferred by load control, we return FALSE and let the login attempt proceed. The load control list is made up of requests that have actually been deferred by load_ctl_. Requests deferred by the test we are about to make are not on the lc list, although they are placed on the resource list, and they do have their lc_reason set. The list is cleared and rebuilt periodically, at least as often as every absentee logout. */ dcl ix fixed bin; dcl loop_limit fixed bin init (0); do ix = absentee_data.head_lc /* start at head of list */ repeat (absentee_data.entry (ix).next_lc) /* and look at each entry */ while (ix ^= 0); /* until we hit the end */ if absentee_data.entry (ix).project /* if project of list entry */ = abs_info.project then do; /* equals project of current entry */ if absentee_data.entry (ix).lc_reason = PROJECT_LIMIT /* if list entry deferred for project limit */ then goto return_true; /* then this one will be deferred too */ if absentee_data.entry (ix).person /* if person is equal as well as project */ = abs_info.person /* then this request will be deferred for the same reason */ then goto return_true; /* whatever the reason - think about it - you'll see it */ end; /* end projects the same */ if absentee_data.entry (ix).lc_reason = GROUP_LIMIT /* if list entry's group was full */ then if absentee_data.entry (ix).group /* and the full group */ = abs_info.group /* is the one the current entry is in */ then goto return_true; /* then this request would be deferred */ loop_limit = loop_limit + 1; /* avoid infinite loop if list damaged */ if loop_limit > absentee_data.last then call loop_error ("lc_will_reject", "lc", NO_QUEUE); /* DOES NOT RETURN */ end; /* end loop thru lc list */ return (FALSE); /* we have no reason to think it will be deferred, so we'll try logging it in, and let load_ctl_ decide */ return_true: abs_info.lc_reason = absentee_data.entry (ix).lc_reason; /* copy deferral reason from list entry */ return (TRUE); end lc_will_reject; loop_error: proc (proc_name, list_name, queue_number); dcl (proc_name, list_name) char (*); dcl queue_number fixed bin; call sys_log_ (SL_LOG, "^a: Loop in ^a, searching ^a list^[^xfor queue ^d^].", name, proc_name, list_name, (queue_number ^= NO_QUEUE), queue_number); if absentee_data.rebuilding then do; /* if it has happened twice in a row */ call sys_log_ (SL_LOG_BEEP, "^a: Loop occurred while rebuilding ^a>^a after previous loop.", name, sysdir, absentee_data_base); call suspend_absentee_processing; /* does not return */ end; else do; call sys_log_ (SL_LOG, "^a: ^a>^a will be rebuilt", name, sysdir, absentee_data_base); call reset_alarm_timer; /* first reset deferred-request timer */ call hcs_$truncate_seg (adp, (0), code); if code ^= 0 then do; call sys_log_$error_log (SL_LOG_BEEP, code, name, "Truncating ^a>^a", sysdir, absentee_data_base); call suspend_absentee_processing; /* does not return */ end; absentee_data.rebuilding = "1"b; /* avoid infinite loop of rebuild attempts */ absentee_data.version = ABS_DATA_version_2; /* set current structure version */ call send_abs_wakeup; /* send wakeup to AU to get the rebuild started again */ end; goto abort_label; /* abort whatever was happening, and return to caller of AUM */ end loop_error; mark_request_deferred: proc (status_flags); dcl status_flags bit (36); request.state = STATE_DEFERRED; unspec (request.abs_status_flags) = status_flags; call rewrite_msg; if status_flags then /* if deferred for an unexpected reason */ call notify_deferral; /* send user a message if so requested and not already done */ return; end mark_request_deferred; message_error: proc (ec); /* Procedure to remember errors in request, so user and operator can be notified. */ dcl ec fixed bin; /* 1 = reservation error, 2 = invalid request version, 3 = no proxy permission, 4 = invalid login name, 5 = invalid project, 6 = invalid absin pathname, 7 = invalid absout pathname, 8 = invalid resource description, 9 = invalid argument string, 10= inconsistent request format. */ message_in_error = "1"b; /* remember that there was an error */ error (ec) = "1"b; /* and remember which one(s) occurred */ if ec = 1 then /* if reservation error */ message_error_code = code; /* remember what the reserver said */ return; end message_error; notify_deferral: proc; /* notify user if he so requested and we haven't already done it once */ dcl already_notified bit (1) aligned init (""b); if aip ^= null then /* if request has skip list entry */ already_notified = abs_info.deferral_notified; /* see if we already sent a deferral message */ ii = index (unspec (request.abs_status_flags), "1"b); /* find reason for deferral */ if request.notify & ^already_notified & ii >= lbound (deferral_reasons, 1) & ii <= hbound (deferral_reasons, 1) then do; call ioa_$rsnnl ("Absentee job ^a>^a ^a deferred ^a", user_message, (0), request.dirname, request.ename, request_id_ (request.msg_time), deferral_reasons (ii)); call send_user_message; if aip ^= null then /* avoid fault in abs defer command */ abs_info.deferral_notified = "1"b; end; return; end notify_deferral; notify_user: proc; /* Called if there were errors in the request. Construct message describing error, to send to both user and operator */ reason = ""; if error (1) then do; /* reservation error */ call convert_status_code_ (message_error_code, short, long); reason = "reservation error: " || rtrim (long) || ", "; end; if substr (reason, length (reason) - 2, 3) = "., " then /* "., " looks dumb */ reason = substr (reason, 1, length (reason) - 3) || ", "; do ii = 2 to hbound (err_msg, 1); if error (ii) then do; reason = reason || rtrim (err_msg (ii)); reason = reason || ", "; end; end; reason = substr (reason, 1, length (reason) - 2) || "."; /* Format request id or date-time of submission. We only use latter if former is unavailable due to incorrect version. */ if error (2) then do; /* if incorrect version, format date */ call date_time_ (based_mess_id, date); rqid = ""; /* and remember that we don't have the request id */ end; else rqid = request_id_ (ute.request_id); /* If we don't have the user's name and project, we can't notify him, so just tell the operator */ if error (4) | error (5) | ((error (2) | error (10)) & ute.proxy) then return; call ioa_$rsnnl ("rejected request^[^x^a^;^s^] (^a) in ^[queue ^d^;^sforeground queue^]^[^x(entered ^a)^;^s^]: ^a", user_message, (0), (rqid ^= ""), rqid, ute.input_seg, (queue > 0), queue, (rqid = ""), date, reason); call send_user_message; return; end notify_user; read_msg: proc (direction, msg_id, ec); /* Procedure to read a request from a queue, check for errors, reread if necessary, and drop queue if too many errors. The following global variables are used: queue_index index of already-opened message segment to read request from areap pointer to free area into which request is read return_args structure in which information about the message is returned */ dcl direction bit (2) aligned; /* direction in which to read, relative to msg_id: "01"b = forward, or head of queue; "10"b = backward, or tail of queue; "00"b = reread the specified message. */ dcl msg_id bit (72) aligned; /* read this msg, or one before or after it (0 means head or tail of queue) */ dcl ec fixed bin (35); /* set to zero if a message is returned to caller */ dcl repeat bit (1) aligned; repeat = "1"b; /* do the read at least once */ do while (repeat); /* retry the read if queue gets salvaged */ call as_meter_$enter (ABSQ_METER); if msg_id ^= ""b then /* if message id given, read relative to it */ call message_segment_$incremental_read_index (queue_index, areap, direction, msg_id, addr (return_args), ec); else /* otherwise read first or last message in queue */ call message_segment_$read_index (queue_index, areap, substr (direction, 1, 1), addr (return_args), ec); call as_meter_$exit (ABSQ_METER); call check_for_badseg (ec, repeat, "absentee_utility_ (read_msg)"); /* check ec, report any error, turn on repeat if salvaged, drop queue if too may errors */ end; return; end read_msg; ready_lc_ineligible: proc returns (bit (1) aligned); /* This procedure is called by find_eligible_ready, to check for a request that is on the resource list, was deferred by load control, and still can't run because other requests from the same user or group have recently been deferred by load control and it is certain that this one would also be deferred. 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 separate out requests deferred by load control in the past from those deferred for want of other resources, and those in the non-resource part of the ready list, and only make the test for the first of those categories. Requests in the other two categories might also end up being deferred by load control, but that decision will be made later, when decode_request calls decode_lc_ineligible. The logic involved in moving requests in the other categories into the first category, at this point in the processing, would be too complicated to be worth it. The purpose of special-casing requests in the first category is to minimize the overhead involved in processing a large number of requests from a single user or load control group, a few at a time, governed by load control. When we detect a request that has already been deferred by load control once, we see if it is going to be deferred again, and if it is, we don't bother reading it from the queue and decoding it. */ if ^abs_info.waiting_for_load_ctl /* if this request was not deferred by load control in the past */ then return (FALSE); /* handle it normally */ return (lc_will_reject ()); /* return whatever lc_will_reject returns to us */ end ready_lc_ineligible; reset_alarm_timer: proc; /* Internal procedure to reset the alarm timer and remember that we did so */ call timer_manager_$reset_alarm_wakeup (autbl.defer_channel); static_alarm_time = 0; /* remember that no timer is set */ resource_timer_set = ""b; return; end reset_alarm_timer; rethread_resource_head_to_tail: proc; /* This procedure rethreads the current entry from the head of the resource list to the tail of that list. (If the current entry is not the one at the head of the resource list, then there is a serious logic design flaw, so we print a message with an audible alarm, and return without doing any rethreading. We hope that never happens.) This procedure is called by find_eligible_ready, when the request it just found is certain to be deferred by load control. Rethreading it simulates the effect of unthreading it from the head of the list, going and trying to log it in, having it deferred by load control, coming back and threading it onto the tail of the list, and going on to the next request (which is now at the head of the list). Doing it this way avoids a lot of overhead. Input arguments: aix is index of entry; aip (on which abs_info is based) points to it; queue is its queue. */ if absentee_data.queue_data (queue).head_ready ^= aix then do; /* if entry not at head */ call sys_log_ (SL_LOG_BEEP, "^a: BUG: lc ineligible (^d) not at head of resource list", name, aix); return; end; if absentee_data.queue_data (queue).tail_ready = aix then /* if current entry is also last in list */ return; /* its's silly to rethread a one-element list */ /* First, unthread it from head, by threading following entry (which we know exists) to the head. */ absentee_data.queue_data (queue).head_ready = abs_info.next_ready; /* point head at next entry */ absentee_data.entry (abs_info.next_ready).prev_ready = 0; /* point next entry's backthread to head */ /* Now that the current entry has been unthreaded from the head, we want to thread it onto the tail. thread_resource will do that for us. */ call thread_resource; /* The only thing thread_resource does wrong in this case is to increment the counter of requests in the resource list. Since this entry was already on the resource list, and already counted, we have to decrement the counter. */ autbl.rsc_waiting (queue) = autbl.rsc_waiting (queue) - 1; return; end rethread_resource_head_to_tail; rsc_reservation_unavailable: proc returns (bit (1) aligned); /* Check for resource requirements and try to reserve them */ if request.len_resource > 0 & ^message_in_error then do; /* if there are resources required */ call parse_resource_desc_ (request.resource, areap, resource_desc_ptr, resource_res_ptr, code); if code = 0 then do; /* if resource description is ok */ reservation_description.reserved_for, reservation_description.reserved_by = rtrim (ute.person) || "." || rtrim (ute.project) || ".*"; reservation_description.flags.auto_expire = "1"b; call resource_control_$reserve (resource_desc_ptr, resource_res_ptr, ute.process_authorization, ("1"b), code); if code ^= 0 then do; /* we did not get the reservation */ if code = error_table_$device_limit_exceeded /* if we never will get it */ | code = error_table_$resource_unknown then call message_error (1); /* 1 = reservation error */ else do; /* otherwise assume we will eventually get it */ if code ^= error_table_$reservation_failed then /* but if code is not "wait awhile", complain */ call sys_log_$error_log (SL_LOG_BEEP, code, name, "Attempting to reserve ^a for ^a.^a (^a)", request.resource, ute.person, ute.project, request_id_ (ute.request_id)); call free_rsc; /* free storage used by resource reservation structures */ return ("1"b); /* tell caller to put this one on the resource list */ end; /* end wait for resources */ end; /* end resources not available */ else do; /* resources available. run the job */ ute.reservation_id = reservation_description.reservation_id; call free_rsc; /* free storage used by resource reservation structures */ end; end; /* end resource description ok */ else call message_error (8); /* 8 = invalid resource description */ end; /* end resources required */ else ute.reservation_id = 0; /* positive indication that no resources are required */ return (""b); /* tell caller not to put this one on the resource list */ end rsc_reservation_unavailable; rewrite_msg: proc; /* Procedure to rewrite a message in the queue. (We want to do that to update its state so the user can see how it's coming.) Calls message_segment_$update_message_index and deals with a nonzero return code. Input arguments: queue_index is index of message segment; return_args and request structures are assumed to contain data on, and the contents of, the message to be rewritten, respectively. */ dcl repeat bit (1) aligned; repeat = "1"b; /* do the rewrite at least once */ do while (repeat); /* repeat the rewrite if queue gets salvaged */ call as_meter_$enter (ABSQ_METER); call message_segment_$update_message_index (queue_index, return_args.len, return_args.mess_id, return_args.reqp, code); call as_meter_$exit (ABSQ_METER); call check_for_badseg (code, repeat, "absentee_utility_ (rewrite_msg)"); end; return; end rewrite_msg; search_queues: proc (howmany, what); /* search queues for howmany jobs, and do what to them */ dcl howmany fixed bin; /* how many jobs we want: ONE or MANY */ dcl what fixed bin; /* what to do to it (RUN) or them (DEFER, RELEASE) */ dcl match_count fixed bin init (0); /* count of jobs that matched args */ dcl match_queue fixed bin; /* queue that ONE job was found in */ dcl match_message_id bit (72) aligned; /* id of ONE job */ dcl ec fixed bin (35); /* temp error code, for subroutine calls */ dcl (fq, lq) fixed bin; /* first and last queue(s) to be searched */ /* Decide which queues to search */ if abs_args.queue_sw then do; /* if operator supplied queue number */ if abs_args.queue = 1 then do; /* Q 0 is treated as first part of Q 1 */ fq = 0; lq = 1; end; else fq, lq = abs_args.queue; end; else do; /* search all queues */ fq = -1; lq = 4; end; /* Search those queues */ do queue = fq to lq; ec = 0; cur_message_id = ""b; queue_index = queue_indices (queue); /* get message segment index */ if queue_index > 0 then /* avoid errors on unopened segments */ do while (ec = 0); /* keep reading from this queue until no more */ call read_msg (FORWARD, cur_message_id, ec); if ec = 0 then do; /* if we got a message, look at it */ cur_message_id = return_args.mess_id; /* copy its id for use in incremental read of next one */ /* See if request matches arguments */ if request.hdr_version ^= queue_msg_hdr_version_1 then goto sq_nomatch; /* avoid faults if bad request format */ if (request.request_version ^= abs_message_version_6 & request.request_version ^= ABS_VER_5 & request.request_version ^= ABS_VER_4) then goto sq_nomatch; ii = divide (return_args.len + 35, 36, 17, 0); if ii ^= currentsize (request) then goto sq_nomatch; if ii ^= request.std_length then goto sq_nomatch; if abs_args.user_sw then do; /* check user name if given */ if abs_args.person ^= "*" then do; /* * matches all persons so don't bother checking */ if abs_args.person ^= before (return_args.sender, ".") then do; if ^request.proxy then goto sq_nomatch; if abs_args.person ^= before (request.proxy_name, ".") then goto sq_nomatch; end; end; if abs_args.project ^= "*" then do; if abs_args.project ^= before (after (return_args.sender, "."), ".") then do; if ^request.proxy then goto sq_nomatch; if abs_args.project ^= before (after (return_args.sender, "."), ".") then goto sq_nomatch; end; end; end; if abs_args.id_sw then if ^match_request_id_ (request.msg_time, (abs_args.request_id_string)) then goto sq_nomatch; if abs_args.path_sw then if abs_args.dirname ^= request.dirname then goto sq_nomatch; if abs_args.path_sw | abs_args.entry_sw then do; call match_star_name_ ((request.ename), (abs_args.ename), code); if code ^= 0 then goto sq_nomatch; end; if abs_args.sender_sw then do; call match_star_name_ ((request.sender), (abs_args.sender), code); if code ^= 0 then goto sq_nomatch; end; /* Job matches all arguments given. Now decide what to do with it */ if howmany = ONE then do; /* if we want one job, count them and save Q and ID of first */ match_count = match_count + 1; if match_count = 1 then do; /* if the first */ match_queue = queue; /* save queue and ID */ match_message_id = cur_message_id; end; end; else do; /* we want MANY jobs, and we'll do what to them */ call search_skip_for_queue (ec); /* see if it already has a skip list entry */ if ec = 0 & request.state = STATE_RUNNING then /* if it does, and it's running */ goto sq_nomatch; /* we don't want to do anything to it */ if what = DEFER then do; match_count = match_count + 1; call mark_request_deferred ("01"b); /* rewrite queue entry */ if ec = 0 then do; /* if it has a skip list entry, rethread it */ 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; call defer_request_indefinitely; end; end; else if what = RELEASE then do; if (request.user_deferred_indefinitely | request.operator_deferred_indefinitely) then do; match_count = match_count + 1; /* only release deferred-indefinitely requests */ unspec (request.abs_status_flags) = ""b; request.user_deferred_indefinitely = ""b; request.state = STATE_ELIGIBLE; call rewrite_msg; if ec = 0 then do; /* if it has a skip list entry */ call delete_defer; /* it can only be on the defer list */ call thread_ready; end; /* end on skip list */ end; /* end deferred-indefinitely */ end; /* end what = RELEASE */ ec = 0; /* clear out code from skip list search */ end; /* end howmany = MANY */ sq_nomatch: call free_req; /* free storage that request was read into */ end; /* end request was read from queue */ end; /* end do while there are more requests in queue */ end; /* end loop thru all queues */ /* Having gone thru the queues, see what we found */ if howmany = MANY then do; call sys_log_ (SL_LOG, "abs ^[defer^;release^]: ^[^sno^;^d^] ^[^;deferred^x^]request^[s^] ^[deferr^;releas^]ed.", what, (match_count = 0), match_count, what, (match_count ^= 1), what); if what = RELEASE then do; /* if release */ release_count = match_count; /* return count of jobs released */ if match_count > 0 then /* if count is nonzero */ call send_abs_wakeup; /* make sure we try immediately to log them in */ end; end; else do; /* we wanted one request */ if match_count = 1 then do; /* if that's what we got */ queue = match_queue; /* go back to its queue */ queue_index = queue_indices (queue); cur_message_id = match_message_id; /* and to that message */ call read_msg (REREAD, cur_message_id, ec); /* and read it in again */ if ec ^= 0 then /* must have gotten cancelled out from under us */ match_count = 0; /* so pretend we never saw it */ else request_found = "1"b; /* if it's still there, tell caller we found it */ end; if match_count ^= 1 then call sys_log_ (SL_TYPE, "abs run: job selection arguments matched ^[^sno^;^d^] requests^[; be more specific^].", (match_count = 0), match_count, (match_count > 1)); else request_found = "1"b; /* tell caller we found one */ end; /* end one request wanted */ return; end search_queues; search_skip_for_aute: proc (ec); /* Procedure to search skip list for entry belonging to job described in aute. */ dcl ec fixed bin (35); dcl loop_limit fixed bin; cur_message_id = ute.message_id; /* copy id of message whose skip list entry we seek */ /* Get queue number out of aute. */ call get_queue_from_aute; search_skip_for_queue: entry (ec); /* queue, queue_index, and cur_message_id were set by caller */ ec = error_table_$no_message; /* be pessimistic; zero it if we find the request */ aip = null; /* gets set if we find the request */ if queue_index = 0 then return; /* if bad queue number, which skip list would we search? */ /* Search skip list belonging to specified queue */ loop_limit = 0; do aix = absentee_data.queue_data (queue).tail_skip /* go thru skip list from tail */ repeat absentee_data.entry (aix).prev_skip /* backwards */ while (aix ^= 0 /* until we hit the end or find the one we want */ & absentee_data.entry (aix).message_id ^= cur_message_id); loop_limit = loop_limit + 1; /* avoid infinite loop if list damaged */ if loop_limit > absentee_data.last then call loop_error ("search_skip", "skip", queue); /* does not return */ end; if aix > 0 then do; /* if we found it */ ec = 0; /* tell caller we found it */ aip = addr (absentee_data.entry (aix)); /* return ptr to it in global variable */ end; return; end search_skip_for_aute; send_abs_wakeup: proc; dcl mess char (8) aligned, /* contents of wakeup message sent to AUM */ event fixed bin (71) based (addr (mess)); /* overlay signal with variable that hcs_$wakeup will accept */ if ctl_wakeup then mess = "aum_ctl"; /* special case: AUM is sending itself an "aum_ctl" wakeup */ else mess = "login "; /* normal case: somebody is sending AUM a "login" wakeup */ call hcs_$wakeup (whotab.abs_procid, whotab.abs_event, event, code); if code ^= 0 then call sys_log_$error_log (SL_LOG_SILENT, code, name, "Sending ^a wakeup to ^12.3b (^24.3b)", mess, whotab.abs_procid, unspec (whotab.abs_event)); return; end send_abs_wakeup; send_user_message: proc; /* Send message to user. Arguments: user_message, return_args.sender, return_args.sender_authorization. */ unspec (send_mail_info) = ""b; send_mail_info.version = send_mail_info_version_2; send_mail_info.wakeup = "1"b; send_mail_info.always_add = "1"b; send_mail_info.sent_from = "absentee"; call send_mail_$access_class (substr (rtrim (return_args.sender), 1, length (rtrim (return_args.sender)) - 2), rtrim (user_message), addr (send_mail_info), (return_args.sender_authorization), code); if code ^= 0 & code ^= error_table_$messages_off & code ^= error_table_$messages_deferred then call sys_log_$error_log (SL_LOG_SILENT, code, name, "Unable to notify user ^a of absentee event.", return_args.sender); return; end send_user_message; set_defer_timer: proc (time); /* Internal procedure to set the alarm timer for both deferred requests and requests waiting for resources, and remember which, and when it is set for. */ dcl time fixed bin (71); dcl rsc_sw bit (1) aligned; /* "1"b if called to set the resource timer */ if time >= NEVER then return; /* if accidentally called for a deferred-indefinitely request */ rsc_sw = ""b; goto set_timer_common; /* ---------- */ set_rsc_timer: entry (time); rsc_sw = "1"b; set_timer_common: if static_alarm_time = 0 | /* if there is no current timer */ time < static_alarm_time then do; /* or new time is before current timer */ if static_alarm_time > 0 then /* if there is a current timer */ call timer_manager_$reset_alarm_wakeup (autbl.defer_channel); /* reset it */ if time <= time_now then do; /* trap bug */ call sys_log_ (SL_LOG_SILENT, "^a: Attempt to set defer timer to time in past (^24.3b). Setting it to a minute from now.", name, unspec (time)); static_alarm_time = time_now + 1000000; /* one million microseconds from now */ end; else static_alarm_time = time; /* remember when the timer is set for */ call timer_manager_$alarm_wakeup (static_alarm_time, "00"b, autbl.defer_channel); resource_timer_set = rsc_sw; /* remember if it was for the resource timer */ end; return; end set_defer_timer; setup_queue: proc; /* See if we want to search current queue; if so, initialize for the search */ if queue >= -1 & queue <= MAX_QUEUE then /* TRAP BUG */ queue_index = queue_indices (queue); /* get its message segment index */ else do; /* THE BUG HAS OCCURRED */ queue_index = 0; /* don't try to read from nonexistent queue */ call sys_log_ (SL_LOG_BEEP, "^a (setup_queue): Invalid queue number: ^d", name, queue); if autbl.debugging = 1 then /* makeshift debugging switch */ call as_dump_ ("absentee_utility_: invalid queue number."); end; if queue_index > 0 then do; /* if queue was opened successfully */ if autbl.queue_dropped (queue) then /* if queue has been dropped */ queue_index = 0; /* tell caller to skip it */ else do; if queue >= 0 then /* if not foreground queue, which isn't bound by reserved slots */ if available_slots_ (max (queue, 1), autbl.max_abs_users, (autbl.qres), (autbl.n_abs)) <= 0 then queue_index = 0; /* if no slots available to this queue, tell caller to skip it */ end; if queue_index > 0 then do; /* if we're going to search this queue */ list_searched = CPUT_LIST; /* start search at beginning of cput list */ aix = 0; /* there is no current list entry */ cur_message_id = ""b; /* and no current message */ end; end; return; end setup_queue; suspend_absentee_processing: proc; do queue = -1 to MAX_QUEUE; /* drop all queues */ autbl.queue_dropped (queue) = "1"b; end; call reset_alarm_timer; /* make sure we don't get any alarm wakeups */ call as_dump_ ("absentee_utility_: absentee processing suspended."); call sys_log_ (SL_LOG_BEEP, "^a: Absentee processing suspended. Contact system programmer.", name); goto abort_label; end suspend_absentee_processing; thread_cput: proc; /* Thread request onto end of cput list. Input arguments: aix is index of entry to be threaded; aip is ptr to it; queue is queue it is from. */ abs_info.cput_list = "1"b; /* identify entry as being on cput list */ abs_info.cpu_limit = ute.max_cpu_time; /* remember how high a limit this one needs */ abs_info.next_cput = 0; /* next entry is tail of list */ abs_info.prev_cput = absentee_data.queue_data (queue).tail_cput; /* previous request was last in list */ if abs_info.prev_cput > 0 then /* if previous entry exists */ absentee_data.entry (abs_info.prev_cput).next_cput = aix; /* set its forward thread */ else absentee_data.queue_data (queue).head_cput = aix; /* else set head of list */ absentee_data.queue_data (queue).tail_cput = aix; /* this is the new last entry in list */ return; end thread_cput; thread_lc: proc; /* Thread request onto end of lc list. Input arguments: aix is index of entry to be threaded; aip (on which abs_info is based) is ptr to it. */ autbl.lc_list = "1"b; /* tell AUM that the lc list is non-empty */ abs_info.lc_list = "1"b; /* identify entry as being on lc list */ /* first set threads in entry being added */ abs_info.prev_lc = absentee_data.tail_lc; /* point backthread at former last entry */ abs_info.next_lc = 0; /* point forward thread at tail of list */ /* then set threads in previous entry and tail */ if abs_info.prev_lc > 0 then /* if there is a previous entry */ absentee_data.entry (abs_info.prev_lc).next_lc = aix; /* point its forward thread to this one */ else absentee_data.head_lc = aix; /* else point head of list to this one */ absentee_data.tail_lc = aix; /* point tail of list at this entry */ return; end thread_lc; thread_resource: proc; /* Procedure to thread an entry onto the end of either the ready list or the resource list (which is the first section of the ready list). Input arguments: aix is index of entry to be threaded; aip is ptr to it; queue is which queue it is from. */ abs_info.resource_list = "1"b; /* this also tells us which entry point we came in at */ abs_info.can_run = "1"b; /* requests waiting for resources are always eligible. See below for explanation of eligibility and the can_run switch. */ autbl.rsc_waiting (queue) = autbl.rsc_waiting (queue) + 1; /* remember how many of these we have, for each queue */ abs_info.prev_ready = absentee_data.queue_data (queue).tail_resource; /* thread onto end of resource list */ /* ---------- */ thread_ready: entry; /* enter here to thread entry onto end of ready list */ abs_info.ready_list = "1"b; /* set this switch no matter which entry we came in at */ if ^abs_info.resource_list then /* if we did not enter at thread_resource */ abs_info.prev_ready = absentee_data.queue_data (queue).tail_ready; /* thread onto end of ready list */ /* The current entry's back thread is now set. Set the forward thread, and then thread the previous entry to this one. */ if abs_info.prev_ready > 0 then do; /* if previous entry exists */ abs_info.next_ready = absentee_data.entry (abs_info.prev_ready).next_ready; /* copy its forward thread */ absentee_data.entry (abs_info.prev_ready).next_ready = aix; /* and then point it at this entry */ end; else do; abs_info.next_ready = absentee_data.queue_data (queue).head_ready; /* else copy head-of-list thread */ absentee_data.queue_data (queue).head_ready = aix; /* and then point it at this entry */ end; /* Now thread following entry to this one */ if abs_info.next_ready > 0 then /* if following entry exists (only possible for resource list) */ absentee_data.entry (abs_info.next_ready).prev_ready = aix; /* point its back thread at current entry */ else absentee_data.queue_data (queue).tail_ready = aix; /* else point tail thread at this entry */ /* If we are threading onto the resource list, set its tail thread, and flag the entry if it's the first in this wakeup */ if abs_info.resource_list then do; absentee_data.queue_data (queue).tail_resource = aix; if absentee_data.last_rsc (queue) = 0 then /* if this is first addition to resource list in this wakeup */ absentee_data.last_rsc (queue) = aix; /* save its index to tell when to stop resource list search */ end; /* Now, if this is a ready list entry, for a request whose time has just arrived, we want to treat it as if it had just been entered in the queue, so we mark it as to be run after the one that's currently last in the queue. There are several complications to this: since we might defer the last request for any one of a number of reasons when we finally get around to processing it, we want to delay this new ready request only until we get to the last request in the queue and put it in the skip list, whether we run it then or not. It follows from this that if the last request in the queue is already in the skip list, we don't want to delay the new ready request at all, so we mark it as eligible to run immediately. */ if ^abs_info.resource_list then do; /* if ready list */ call read_msg (BACKWARD, (""b), code); /* read last message in queue */ if code ^= 0 then /* if we can't read a request */ abs_info.can_run = "1"b; /* we can't hold the current one behind it */ else do; /* we did read a request */ if absentee_data.queue_data (queue).tail_skip > 0 then /* if there is a last skip list entry */ if absentee_data.entry (absentee_data.queue_data (queue).tail_skip).message_id >= return_args.mess_id then abs_info.can_run = "1"b; /* if last request is on skip list, let current one run */ if ^abs_info.can_run then /* otherwise delay it until last request in queue is processed */ abs_info.last_message_id = return_args.mess_id; call free_req; /* free storage that request was read into */ end; end; return; end thread_resource; %page; update_ready: proc; /* Procedure to search ready list for requests that can not be run until after the current one, and mark them as now free to run. Since several requests could have the same deferred time, it is possible that we will find more than one request to mark as free to run. Input argument: cur_message_id identifies the current request. */ dcl loop_limit fixed bin; dcl ix fixed bin; dcl found_one bit (1) aligned init (""b); /* Pick up index of first ready list entry that is not part of resource list */ if absentee_data.queue_data (queue).tail_resource > 0 then /* if resource list is non-empty */ ix = absentee_data.entry (absentee_data.queue_data (queue).tail_resource).next_ready; /* pick up index of first entry after resource list */ else ix = absentee_data.queue_data (queue).head_ready; /* else pick up index of first ready list entry */ /* Look at all entries from there to the end of the list. */ loop_limit = 0; do while (ix ^= 0); if absentee_data.entry (ix).last_message_id = cur_message_id then /* if this request held behind current one */ absentee_data.entry (ix).can_run, /* it is now eligible to run */ found_one = "1"b; /* and remember to send a login wakeup later */ ix = absentee_data.entry (ix).next_ready; /* get index of next ready list entry */ loop_limit = loop_limit + 1; /* avoid infinite loop if list damaged */ if loop_limit > absentee_data.last then call loop_error ("update_ready", "ready", queue); /* does not return */ end; if found_one then /* if we found any requests that can run now */ call send_abs_wakeup; /* make sure we try to log them in immediately */ return; end update_ready; validate_proxy: procedure; declare code fixed bin (35); declare ( proxy_sender, desired_project varying, desired_person varying ) character (32); proxy_sender = request.proxy_name; /* copy name of proxy for efficiency */ desired_project = rtrim (before (after (proxy_sender, "."), ".")); desired_person = rtrim (before (proxy_sender, ".")); if ^valid_proxy (code) then do; call sys_log_$error_log (SL_LOG, code, name, "Illegal proxy for ^a from ^a for job ^a>^a", proxy_sender, return_args.sender, request.dirname, request.ename); call message_error (3); /* 3 = no proxy permission */ return; end; ute.proxy_person = ute.person; /* save userid of user who actually entered the job */ ute.proxy_project = substr (ute.project, 1, length (ute.proxy_project)); ute.project = desired_project; ute.person = desired_person; ute.tag = TAG_PROXY; valid_proxy: procedure (code) returns (bit (1)); declare code fixed bin (35); declare modes bit (36); dcl Absentee_proxy_dot_acs character (32) initial ("absentee_proxy.acs") internal static options (constant); /* Check the acs controlling proxy access */ modes = get_effmode (as_data_$acsdir, Absentee_proxy_dot_acs, (return_args.sender), return_args.ring, code); if code = 0 then if (modes & "010"b) ^= ""b then return ("1"b); else code = error_table_$no_e_permission; /* here ==> no proxy permission and code set to a reason */ /* no go nowhere. Return code for system acs. */ return (""b); end valid_proxy; end validate_proxy; setup: /* initialize automatic variables */ procedure; autp = as_data_$autp; /* absentee_user_table pointer */ ev_calls_masked, ctl_wakeup = ""b; p = null; return_args.reqp = null; message_in_error = ""b; error (*) = ""b; end setup; /* format: off */ %page; %include abs_args; %page; %include abs_data; %page; %include abs_message_format; %page; %include absentee_user_table; %page; %include aim_template; %page; %include as_data_; %page; %include as_data_definitions_; %page; %include as_meter_numbers; %page; %include as_request_sender_; %page; %include as_wakeup_priorities; %page; %include dialup_values; %page; %include installation_parms; %page; %include mseg_access_mode_values; %page; %include queue_msg_hdr; %page; %include resource_control_desc; %page; %include sc_stat_; %page; %include send_mail_info; %page; %include sys_log_constants; %page; %include user_table_entry; %page; %include user_table_header; %page; %include user_attributes; %page; %include whotab; /* BEGIN MESSAGE DOCUMENTATION Message: absentee_utility_: Entry not found. Creating new >sc1>absentee_N.ms S: as (severity1) T: During startup of the absentee facility. M: The absentee message segment for queue N was missing, and a new one has been created. Any previously submitted absentee jobs in queue N are not executed. A: If the absentee queues never existed or were deliberately deleted or removed, this message should be ignored. Otherwise, it may be necessary to inform users via the message of the day that the absentee requests for queue N were lost. Contact the system programming staff for help in recovering the queue. Message: absentee_utility_: ERROR_MESSAGE. Unable to create >sc1>absentee_N.ms S: as (severity1) T: During startup of the absentee facility. M: The absentee message segment for queue N cannot be created. Users cannot queue jobs in queue N, and jobs in queue N cannot be executed. A: $inform Message: absentee_utility_: ERROR_MESSAGE. Unable to set extended access on >sc1>absentee_N.ms S: as (severity1) T: During startup of the absentee facility. M: The absentee message segment for queue N just created cannot be set up so that users can access it properly. Users will not be able to submit absentee requests. A: $inform Message: absentee_utility_: ERROR_MESSAGE. Unable to open new >sc1>absentee_N.ms S: as (severity1) T: During startup of the absentee facility. M: The absentee message segment for queue N just created cannot be found. No absentee jobs are run. A: $inform Message: absentee_utility_: ERROR_MESSAGE. Error in creating defer event channel S: as (severity2) T: During startup of the absentee facility. M: The event channel used in processing absentee requests that are deferred until a later time cannot be created. No deferred requests are activated. A: Issue an abs stop command and wait until all absentees run to completion. Then, issue an abs start command. If this same message recurs, contact the system programming staff. Message: absentee_utility_: Entry not found. Creating new >sc1>absentee_data S: as (severity1) T: During startup of the absentee facility. M: The absentee data segment was missing and a new one has been created. A: $note Message: absentee_utility_: ERROR_MESSAGE. Unable to create >sc1>absentee_data S: as (severity2) T: During startup of the absentee facility. M: The absentee data segment could not be created. Faults will probably occur in the absentee facility if the system attempts to run absentee jobs. A: Notify the system programming staff. Do _n_o_t attempt to run absentee jobs. Message: absentee_utility_: ERROR_MESSAGE. Unable to set access on >sc1>absentee_data S: as (severity1) T: During startup of the absentee facility. M: The newly-created segment absentee_data cannot be given correct access. The system should continue to run. A: $note Message: absentee_utility_: ERROR_MESSAGE. Closing >sc1>absentee_N.ms S: as (severity1) T: While shutting down the absentee facility. M: A storage system error occurred as part of the processing of "abs stop" while attempting to terminate the absentee message segment for queue N. Absentee requests for queue N may have been lost. A: If you are shutting down the absentee facility because of some previous message-segment error, contact the system programming staff and do not try to restart the absentee facility. If this absentee shutdown is a normally scheduled one, notify the system programmers of the message and do not try to restart the absentee facility again until they have looked at the problem. Message: absentee_utility_: ERROR_MESSAGE. Unable to terminate >sc1>absentee_data S: as (severity1) T: During shutdown of the absentee facility. M: While shutting down the absentee facility, the system attempted to terminate the segment absentee_data and received an error. This condition is not serious. A: $note Message: abs run: request PATH ID is already running. S: as (severity1) T: In response to an abs run command. M: The specified job is already running. A: If a mistake was made, repeat the command, specifying the correct job. Message: absentee_utility_: ERROR_MESSAGE Dropping queue >sc1>absentee_N.ms due to M consecutive errors S: as (severity2) T: $run M: This message is printed when a series of errors prevents the absentee facility from reading jobs from a given queue. Absentee requests in queue N are ignored until the absentee facility is stopped and restarted, or the command abs start queue N is used to restart the dropped queue. A: $note Message: absentee_utility_: ERROR_MESSAGE. queue N >sc1>absentee_N.ms S: as (severity1) T: $run M: An error occurred while reading, rewriting, or deleting a request from queue N. An attempt is made to correct the error and retry the operation. Additional messages are printed if this attempt fails. A: $inform Message: absentee_utility_: >sc1>absentee_data has overflowed its limit of N entries. S: as (severity2) T: $run M: The absentee facility keeps a list of absentee jobs that are either deferred or currently running. This list has a capacity of about 13,000 entries. It is extremely unlikely that this data area will fill up unless some user program has entered a loop and is submitting requests for jobs faster than the jobs are being run. A: $contact Message: absentee_utility_: Illegal proxy for NAME.PROJ from NAME1.PROJ1 for job JJJJ S: as (severity1) T: $run M: This message is printed whenever a proxy absentee job is submitted by some user who is not allowed to submit a proxy. User NAME1.PROJ1 submitted job JJJJ to be run with the user ID NAME.PROJ, but the absentee facility will not do so and ignores the request. A: $note Message: absentee_utility_ (abs run): Request PATH ID will be run in spite of unavailable resource(s): RESOURCE S: as (severity1) T: In response to an abs run command. M: The job selected by the abs run command needs RESOURCE, which is unavailable. The job will be logged in anyway. A: If the job is critical, the resource could be made available by force detaching it from some other process. This is a drastic action, and should not be taken without the System Administrator's approval. Message: absentee_utility_: rejected request ID (PATH) in queue N from PERS.PROJ: REASON S: as (severity1) T: $run M: This message is printed if a message that appears to be garbled or meaningless is found in absentee queue N. The garbled message is ignored. This condition may be evidence of damage to absentee queue N, unless REASON indicates otherwise. A: $note Message: absentee_utility_: Loop in PROC, searching NAME list for queue N. S: as (severity1) T: $run M: A software error has damaged the list of requests in absentee_data. The error was detected by the internal procedure, PROC, while searching the NAME list belonging to queue N. The system makes one attempt to rebuild the list. Additional messages are printed if this attempt fails. A: $inform Message: absentee_utility_: Loop occurred while rebuilding absentee_data after previous loop. S: as (severity2) T: $run M: The error reported by the previous message occurred while absentee_data was being rebuilt following an earlier error. The rebuild attempt will not be repeated. A: $contact Message: absentee_utility_: >sc1>absentee_data will be rebuilt. S: as (severity1) T: $run M: An attempt will be made to rebuild the request lists in absentee_data to correct the error reported by the previous message. A: $note Message: absentee_utility_: ERROR_MESSAGE Truncating absentee_data. S: as (severity2) T: $run M: An error occurred during the attempt to truncate absentee_data prior to rebuilding it. It will not be possible to rebuild it. A: $contact Message: absentee_utility_: Attempting to reserve RESOURCE for PERS.PROJ (PATH) S: as (severity2) T: $run M: An error occurred during the attempt to reserve a resource for an absentee job. The job is deferred and the attempt to reserve the resource is repeated at some later time. The absentee facility continues to operate. There is something wrong with the resource reservation mechanism or with some other part of RCP. A: $inform Message: abs ACTION: N requests ACTIONed. S: as (severity1) T: In response to an abs defer or abs release command. M: Indicates success or failure of the command. ACTION can be defer or release, and N can be "no" or the number of requests acted upon. A: Confirm that the expected results were obtained. Message: abs run: job selection arguments matched N requests; be more specific. S: as (severity1) T: In response to an abs run command. M: The specified arguments matched either zero, or more than one, request, and so no job was run. A: Re-enter the command with correct arguments, to select exactly one job for running. Message: absentee_utility_: Absentee processing suspended. Contact system programmer. S: as (severity2) T: $run M: Absentee processing has been suspended because of the error described in the previous message. No more jobs will be started, but logged in jobs will continue running. The absentee facility has not been stopped, and an "abs start" command will be rejected. After the error has been corrected, the "abs start queue N" command may be used to resume the processing of requests from queues unaffected by the error. A: $contact Message: absentee_utility_: BUG: lc ineligible (INDEX) not at head of resource list. S: as (severity2) T: $run M: The current absentee request, which would be deferred by load control, is not at the head of the absentee list. If this occurs, there is a logic error in absentee_utility_. A: $contact Message: absentee_utility_ (setup_queue): Invalid queue number: QUEUE S: as (severity2) T: $run M: The internal queue number in absentee_utility_ was invalid when trying to find an absentee to login. If this occurs, there is a logic error in absentee_utility_. A: $contact Message: absentee_utility_: ERROR_MESSAGE. Attempting to cancel reservation REQUEST for USER (ABSENTEE) S: $log T: $run M: An error occurred while cancelling an RCP reservation for an absentee being deferred. A: $ignore Message: absentee_utility_: ERROR_MESSAGE. While reading message MESSAGE from USER (ABSENTEE) to be rewritten. S: $log T: $run M: An error occurred while reading a request from the absentee queue. A: $ignore Message: absentee_utility_: ERROR_MESSAGE. While reading message MESSAGE to be rewritten. S: $log T: $run M: An error occurred while reading an absentee request to be marked as "running". A: $ignore Message: absentee_utility_: ERROR_MESSAGE. Searching queue QUEUE skip list for USER (ABSENTEE) S: $log T: $run M: An error occurred while searching the skip list for an absentee request. A: $ignore Message: absentee_utility_: ERROR_MESSAGE. Searching skip list for USER (ABSENTEE) S: $log T: $run M: An error occurred while searching the skip list for an absentee request. A: $ignore Message: absentee_utility_: ERROR_MESSAGE. Unable to delete request for USER (ABSENTEE); queue: QUEUE; index: QUEUE_INDEX S: as (severity0) T: $run M: An error occurred while deleting a request from the absentee queue. A: $ignore Message: absentee_utility_: Timer rang and no deferred request found. S: as (severity0) T: $run M: The deferred request timer went off and no deferred absentee jobs were found. A: $ignore Message: absentee_utility_: Illegal queue number (QUEUE) for USER (ABSENTEE) S: as (severity0) T: $run M: The queue number specified for the absentee job in the absentee user table has an illegal value. A: $ignore Message: absentee_utility_: ERROR_MESSAGE. Sending TYPE wakeup to PROCID (ABS-EVENT) S: $log T: $run M: An error occurred while sending an "aum_ctl" or "login" wakeup to the specified absentee process. A: $ignore Message: absentee_utility_: ERROR_MESSAGE. Unable to notify user USER of absentee event. S: $log T: $run M: An error occurred while sending a message to USER as notification of an absentee event. Message: absentee_utility_: Attempt to set defer timer to time in past (TIME). Setting it to a minute from now. S: as (severity0) T: $run M: An attempt was made to set the absentee deferred request timer to a time in the past. A: $ignore END MESSAGE DOCUMENTATION */ end absentee_utility_;  available_slots_.pl1 11/12/82 1356.1rew 11/12/82 1042.9 14715 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ available_slots_: proc (q, maxu, res, used) returns (fixed bin); /* Procedure to return the number of absentee slots available to a given queue. Input parameters are the queue, the total abs maxu, and the arrays giving the number of slots reserved for each queue and the number in use by each queue. Written by T. Casey, May 1978 */ dcl q fixed bin; dcl maxu fixed bin; dcl res (4) fixed bin; dcl used (4) fixed bin; dcl (i, temp_maxu) fixed bin; temp_maxu = maxu; /* copy max abs users */ do i = 1 to 4; /* go through all queues */ temp_maxu = temp_maxu - used (i); /* deduct slots in use */ if i < q then /* if this is a higher priority queue */ if res (i) > used (i) then /* and slots must be reserved for it */ temp_maxu = temp_maxu - (res (i)-used (i)); /* deduct them */ end; if temp_maxu < 0 then temp_maxu = 0; /* if it goes negative, that means that not only this queue, but one or more higher priority queues, are shut off because their slots have been grabbed by jobs from even higher priority queues */ return (temp_maxu); end available_slots_;  asr_abs_command_server_.pl1 07/13/88 1114.8r w 07/13/88 0938.6 61020 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-12-12,Lippard), approve(85-12-30,MCR7326), audit(86-10-27,GDixon), install(86-10-28,MR12.0-1200): Written by Jim Lippard. 2) change(87-04-26,GDixon), approve(87-07-12,MCR7741), audit(87-07-23,Brunelle), install(87-08-04,MR12.1-1055): Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1 END HISTORY COMMENTS */ /* This module is the server for the absentee command AS request. It logs in absentees and cancels running absentees. */ asr_abs_command_server_: proc (P_asr_info_ptr, P_asr_sender_ptr); dcl (P_asr_info_ptr, P_asr_sender_ptr) ptr parameter; dcl absentee_user_manager_$login_any_absentee entry; dcl absentee_user_manager_$cancel_absentee entry (ptr); dcl absentee_utility_$check_queue_access entry (ptr, ptr) returns (bit (1) aligned); dcl as_access_audit_$abs_command_cancel entry (ptr, ptr, fixed bin (71), bit (1) aligned); dcl as_access_audit_$abs_command_login entry (ptr); dcl as_send_user_message_ entry (char (*), char (*), char (*), char (*), bit (72) aligned, char (*), bit (1) aligned); dcl (error_table_$as_bump_user_not_found, error_table_$insufficient_access, error_table_$undefined_order_request, error_table_$unimplemented_version) external fixed bin (35); dcl ioa_$rsnnl entry () options (variable); dcl sys_log_ entry options (variable); dcl error_message char (256); dcl found bit (1) aligned; dcl idx fixed bin; dcl TRUE bit (1) aligned internal static options (constant) init ("1"b); dcl FALSE bit (1) aligned internal static options (constant) init ("0"b); dcl (addr, after, length, null, reverse) builtin; %page; /* Initialize variables. */ asr_abs_command_info_ptr = P_asr_info_ptr; as_request_sender_ptr = P_asr_sender_ptr; asr_reply_ac_ptr = addr (as_request_sender.reply_message); asr_reply_abs_command.code = 0; /* Make sure structure version is correct. */ if asr_abs_command_info.version ^= ASR_AC_INFO_VERSION_1 then do; asr_reply_abs_command.code = error_table_$unimplemented_version; call ioa_$rsnnl ("An invalid structure was passed in the AS request.", error_message, length (error_message)); go to RETURN_FROM_ASRACS; end; /* Make sure the AS request specifies a known action. */ if asr_abs_command_info.action_code ^= ASR_AC_LOGIN & asr_abs_command_info.action_code ^= ASR_AC_CANCEL then do; asr_reply_abs_command.code = error_table_$undefined_order_request; call ioa_$rsnnl ("An invalid action was specified in the AS request.", error_message, length (error_message)); go to RETURN_FROM_ASRACS; end; /* CANCEL: requires access checking. */ if asr_abs_command_info.action_code = ASR_AC_CANCEL then do; /* Find AUT entry for the specified absentee job. */ found = FALSE; autp = as_data_$autp; do idx = 1 to autbl.current_size while (^found); utep = addr (autbl.entry (idx)); if ute.active >= NOW_HAS_PROCESS & ute.request_id = asr_abs_command_info.request_id then found = TRUE; end; /* Absentee not found. Log it. */ if ^found then do; call sys_log_ (SL_LOG_SILENT, "asr_abs_command_server_: Request ^d not found, could not cancel for ^a.", asr_abs_command_info.request_id, as_request_sender.group_id); asr_reply_abs_command.code = error_table_$as_bump_user_not_found; call ioa_$rsnnl ("Request ^d is not logged in.", error_message, length (error_message), asr_abs_command_info.request_id); goto RETURN_FROM_ASRACS; end; /* Check user's queue access for this job. */ if ^absentee_utility_$check_queue_access (utep, as_request_sender_ptr) then do; call as_access_audit_$abs_command_cancel (utep, as_request_sender_ptr, asr_abs_command_info.request_id, TRUE); asr_reply_abs_command.code = error_table_$insufficient_access; call ioa_$rsnnl ("You lack permission to bump request ^d.", error_message, length (error_message), asr_abs_command_info.request_id); go to RETURN_FROM_ASRACS; end; /* Log this action. */ call as_access_audit_$abs_command_cancel (utep, as_request_sender_ptr, asr_abs_command_info.request_id, FALSE); end; /* CANCEL */ /* Log other actions. */ if asr_abs_command_info.action_code ^= ASR_AC_CANCEL then call as_access_audit_$abs_command_login (as_request_sender_ptr); /* Do what we were asked to do. For LOGIN, we just notify absentee_user_manager_ that there are some jobs waiting to login. For CANCEL, we tell absentee_user_manager_ which job and who the requester is so that reply messages can be sent. In the future there should be action codes added to replace the IPC wakeups currently sent by absentees themselves, so that all the IPC code can be removed from absentee_user_manager_. */ if asr_abs_command_info.action_code = ASR_AC_LOGIN then call absentee_user_manager_$login_any_absentee (); else if asr_abs_command_info.action_code = ASR_AC_CANCEL then call absentee_user_manager_$cancel_absentee (utep); RETURN_FROM_ASRACS: /* Send user mail if code is non-zero. */ if asr_reply_abs_command.code ^= 0 then do; call as_send_user_message_ ("asr_abs_command_server_", reverse (after (reverse (as_request_sender.group_id), ".")), as_request_sender.group_id, error_message, as_request_sender.authorization, "Absentee command server", (FALSE)); end; return; %page; %include absentee_user_table; %page; %include as_data_; %page; %include as_data_definitions_; %page; %include as_request_header; %page; %include asr_abs_command; %page; %include as_request_sender_; %page; %include dialup_values; %page; %include sys_log_constants; %page; %include user_attributes; %page; %include user_table_entry; %page; %include user_table_header; %page; /* BEGIN MESSAGE DOCUMENTATION Message: asr_abs_command_server_: Request REQUEST not found, could not cancel for USER. S: as (severity0) T: $run M: User USER requested cancellation of absentee job REQUEST which did not exist. A: $ignore END MESSAGE DOCUMENTATION */ end asr_abs_command_server_; bull_copyright_notice.txt 08/30/05 1008.4r 08/30/05 1007.3 00020025 ----------------------------------------------------------- Historical Background This edition of the Multics software materials and documentation is provided and donated to Massachusetts Institute of Technology by Group Bull including Bull HN Information Systems Inc. as a contribution to computer science knowledge. This donation is made also to give evidence of the common contributions of Massachusetts Institute of Technology, Bell Laboratories, General Electric, Honeywell Information Systems Inc., Honeywell Bull Inc., Groupe Bull and Bull HN Information Systems Inc. to the development of this operating system. Multics development was initiated by Massachusetts Institute of Technology Project MAC (1963-1970), renamed the MIT Laboratory for Computer Science and Artificial Intelligence in the mid 1970s, under the leadership of Professor Fernando Jose Corbato.Users consider that Multics provided the best software architecture for managing computer hardware properly and for executing programs. Many subsequent operating systems incorporated Multics principles. Multics was distributed in 1975 to 2000 by Group Bull in Europe , and in the U.S. by Bull HN Information Systems Inc., as successor in interest by change in name only to Honeywell Bull Inc. and Honeywell Information Systems Inc. . ----------------------------------------------------------- Permission to use, copy, modify, and distribute these programs and their documentation for any purpose and without fee is hereby granted,provided that the below copyright notice and historical background appear in all copies and that both the copyright notice and historical background and this permission notice appear in supporting documentation, and that the names of MIT, HIS, Bull or Bull HN not be used in advertising or publicity pertaining to distribution of the programs without specific prior written permission. Copyright 1972 by Massachusetts Institute of Technology and Honeywell Information Systems Inc. Copyright 2006 by Bull HN Information Systems Inc. Copyright 2006 by Bull SAS All Rights Reserved