admin_.pl1 10/04/90 1640.8rew 10/04/90 1635.1 1150947 /****^ *********************************************************** * * * Copyright, (C) BULL HN Information Systems Inc., 1990 * * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /* format: style4 */ admin_: procedure (); /* *** The entries in admin_ implement the various operator commands of the same name. They are called as a result of entries in sc_request_table_ via sc_process_command_line_. */ /* *** NOTE -- Entries should call sys_log, rather than sys_log_. Whenever this program is entered as something other than a command (a timer handler or the like) the entry variable sys_log is set to the non-command entrypoints in sys_log_, otherwise they use the command entrypoints. Note than recursive internal calls have to be capable of doing this right. */ /* The following answering service functions are provided by this module (entry points are in the order shown): * MISC. COMMANDS login cause a daemon user to be logged in logout cause a daemon user to be logged out word set login word and dialup buffer sysid set system ID (typed at dialup) down schedule automatic shutdown of system at later time stop shut down answering service; bump all users warn blast message onto a user's console rcp reply to RCP requests (only list now implemented) log enter comments in the answering service log. maxunits set maximum number of load units shift set shift and shift change time, overriding shift table * FNP COMMANDS fdump_fnp, or take an fdump of a specified FNP, crashing it if it is up dump_fnp load_fnp initiate a bootload of a specified FNP start_fnp listen to the phones configured on a specified FNP stop_fnp prevents booting of specified FNP or listening to its phones * MULTIPLEXER COMMANDS (similiar to fnp commands) dump_mpx take a dump of the specified multiplexer load_mpx initialize the specified multiplexcer start_mpx listen to the phones on a specified multiplexer stop_mpx stop listening to the phones in the specified multiplexer shutdowm_mpx shutdown multiplexer without crash * ABSENTEE COMMANDS abs maxu set maximum absentee users abs maxq set maximum absentee queue abs start start absentee abs stop stop absentee abs bump bump absentee job abs cancel bump and do not restart absentee job abs qres set number of reserved slots for each queue abs cpu_limit set max cpu limit for each queue abs defer do not log job(s) in until they are released abs list list specified job(s) abs move move specified job(s) to different queue abs next log specified job in next abs release allow specified deferred or suspended job(s) to log in or resume running abs run log specified job in immediately abs suspend don't run specified logged-in job until released abs terminate terminate absentee process (bump by simulating fatal process error) Modified 750415 by PG to use printer_on order call. Modified 751020 by PG to fix bug in DOWN command and delete obsolete TAPE command. Modified May 1976 by T. Casey to implement SHIFT command. Modified July, 1976 by D. M. Wells to understand bumping FTP channels Modified 760819 by Roy Planalp to produce correct message if chnl with no user logged in is detached, and to write ftp-format message when bumping ftp users Modified August 1976 by T. Casey and M. Grady to add commands that deal with FNPs Modified November 1976 by T. Casey to fix bug in stop_fnp command. Modified September 1977 by T. Casey to make drop, accept, substty, detach, and remove treat MC_SERVICE consistently, . and to make the word command with no arguments print current word, session type, and message. Modified January 1978 by T. Casey to fix bugs in previous modification. Modified May 1978 by T. Casey to add abs qres command, and modify several other commands to print the current values . of the parameters they set, instead of complaining, when no arguments are given. Modified August 1978 by Larry Johnson for multiplexer commands Modified November 1978 by T. Casey, for new abs command keywords. Modified March 1979 by T. Casey for MR7.0a, to add abs terminate, abs suspend, and abs release of suspended jobs. Modified August 1979 by T. Casey for MR8.0 to support process preservation across hangups and fix bugs. Modified December 1980 by E. N. Kittlitz for Person.Project & bugfixes Modified June 1981 by T. Casey for MR9.0 for new wakeup priorities. Modified November 1981, E. N. Kittlitz. user_table_entry conversion. Modified December 1981, E. N. Kittlitz. whotab copies of autbl control info. Modified April 1982, E. N. Kittlitz. down: insist uptime > downtime Modified May 1982, E. N. Kittlitz. New AS initialization. Modified June 1982, E. N. Kittlitz. Kluge MR10.0 stop_mpx support. Modified July 1982, E. N. Kittlitz. rename to admin_. Modified August 1982, E. N. Kittlitz. dialup_ re-introduction. Modified October 1982, E. N. Kittlitz. minor 'word' fixes. Modified 83-12-14, BIM. added shutdown_mpx Modified March 1984 by GMP to fix the "word" command to set the special message again. Modified 09/10/84 by R. Michael Tague: Changed $down so that system_shutdown_scheduled_ IPS is sent to all processes when a shutdown is scheduled. Modified 1984-11-02, BIM: Stop masking and unmasking, its not our job. call the restricting entry in mc_commands_ for quit. Modified 84-11-14 for whotab.session. -E. A. Ranzenbach... Modified 1985-01-10, BIM: Add calls to mc_check_access_ for quit and login/logout. Modified 1985-02-07, E. Swenson: to allow cancellation of absentee shutdown once one has begun, but not yet been completed. Modified 1985-02-13, E. Swenson: to fix bump code. Modified 1985-03-12, E. Swenson: to fix system shutdown scheduling. Modified 1985-03-22, E. Swenson: to fix drop code. Modified 1985-06-28, E. Swenson: allow substty to again work for otw_. */ /****^ HISTORY COMMENTS: 1) change(86-01-09,MSharpe), approve(87-05-01,MCR7690), audit(87-05-07,Parisek), install(87-08-04,MR12.1-1055): Changed to move message coordinator, process and channel comm commands to the newly created programs to hold them. (These commands were previously in admin_.) 2) 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. 3) change(86-09-26,Beattie), approve(86-09-22,MCR7542), audit(86-10-31,Brunelle), install(86-11-12,MR12.0-1211): Remove references to the 963 and 029 preaccess commands and remove support for ARDS, 202_ETX, 2741 and 1050 in system interfaces. 4) change(87-04-27,GDixon), approve(87-05-01,MCR7690), audit(87-05-07,Parisek), install(87-08-04,MR12.1-1055): Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1 5) change(87-06-25,Parisek), approve(87-06-25,MCR7690), audit(87-07-31,Beattie), install(87-08-04,MR12.1-1055): Added a cleanup handler for all entry points thereby nulling all pointers to system data bases previously opened up. 6) change(87-08-06,GDixon), approve(87-08-06,MCR7690), audit(87-08-06,Parisek), install(87-08-06,MR12.1-1064): Remove the cleanup handler. It was performing a mis-service by terminating segments pointed to by static pointers in as_data_. 7) change(87-09-18,Parisek), approve(87-09-18,PBF7716), audit(87-09-18,Farley), install(87-09-21,MR12.1-1111): Correct an incorrectly formatted ioa_ control string. 8) change(87-10-04,Beattie), approve(87-10-26,MCR7785), audit(87-12-04,Parisek), install(87-12-07,MR12.2-1008): Accomodate changes in format of date_time strings. 9) change(88-09-30,Parisek), approve(88-10-19,MCR8014), audit(89-01-12,Farley), install(89-01-23,MR12.3-1009): Divide installation_parms.warning_time by 60 seconds to produce the correct number of minutes a process has left before shutdown which is reported by the stop command. 10) change(90-09-20,Vu), approve(90-09-20,MCR8201), audit(90-09-24,Schroth), install(90-10-04,MR12.4-1037): Correct the oprerator command "abs stop q fg" which cause queue 1 to stop. Absentees are bumped at random time for a scheduled shutdown due to an uninitialized value. END HISTORY COMMENTS */ /* Entries */ dcl absentee_user_manager_$aum_abs_run entry (ptr); dcl absentee_user_manager_$init_aum entry (fixed bin (35)); dcl absentee_user_manager_$term_aum entry; dcl absentee_user_manager_$update_whotab_abs_control entry; dcl absentee_utility_$abs_defer entry (ptr); dcl absentee_utility_$abs_release entry (ptr, fixed bin); dcl absentee_utility_$au_send_wakeup entry; dcl act_ctl_$shift_cmnd_update entry; dcl admin_$abs entry options (variable); dcl admin_$absentee_down entry; dcl admin_$absentee_off entry; dcl asu_$bump_user entry (ptr, char (*), fixed bin (35), fixed bin); dcl admin_$timed_stop_command entry (); dcl asu_$blast_user entry (ptr, char (*), char (*), fixed bin (35)); dcl available_slots_ entry (fixed bin, fixed bin, (4) fixed bin, (4) fixed bin) returns (fixed bin); dcl convert_date_to_binary_ entry (char (*), fixed bin (71), fixed bin (35)); dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned); dcl cu_$arg_list_ptr entry returns (ptr); dcl cu_$generate_call entry (entry, ptr); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl cu_$arg_count_rel entry (fixed bin, ptr, fixed bin (35)); dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); dcl daemon_user_manager_$login entry (char (*), char (*), char (*), char (*)); dcl daemon_user_manager_$logout entry (char (*), char (*), char (*)); dcl dialup_$re_introduce entry; dcl multiplexer_mgr_$dump_mpx entry (char (*), bit (1) aligned, fixed bin (35)); dcl multiplexer_mgr_$load_mpx entry (char (*), bit (1) aligned, bit (1) aligned, bit (1) aligned, fixed bin (35)); dcl multiplexer_mgr_$start_mpx entry (char (*), bit (1) aligned, fixed bin (35)); dcl multiplexer_mgr_$listen_mpx entry (char (*), fixed bin (35)); dcl multiplexer_mgr_$stop_mpx entry (char (*), fixed bin (35)); dcl multiplexer_mgr_$shutdown_mpx_command entry (character (*), bit (1) aligned, fixed binary (35)); dcl datebin_$next_shift_change entry (fixed bin (71), fixed bin (71), fixed bin, fixed bin); dcl date_time_$format entry (char (*), fixed bin (71), char (*), char (*)) returns (char (250) var); dcl get_process_id_ entry () returns (bit (36)); dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl hphcs_$ips_wakeup entry (bit (36) aligned, char (*)); dcl ioa_$rsnnl entry options (variable); dcl ioa_$rs entry options (variable); dcl ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35)); 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 load_ctl_$set_maxunits entry (fixed bin); dcl load_ctl_$set_abs_parms entry; dcl mc_check_access_$log_daemon_in entry (pointer, character (*), fixed binary (35)); dcl ssu_$get_info_ptr entry (pointer) returns (pointer); dcl sys_log entry variable options (variable) init (sys_log_$command); dcl sys_log$error_log entry variable options (variable) init (sys_log_$command_error); dcl (sys_log_, sys_log_$error_log, sys_log_$command, sys_log_$command_error) external entry; 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 rcp_list entry; dcl rcp_cancel entry; dcl match_star_name_ entry (char (*), char (*), fixed bin (35)); dcl match_request_id_ entry (fixed bin (71), char (*)) returns (bit (1) aligned); dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); dcl list_abs_requests$abs_list entry (ptr, fixed bin, fixed bin (71), fixed bin); /* last arg is NOT fixed bin (35) */ dcl cancel_abs_request$as_abs entry (ptr, fixed bin, fixed bin (71), fixed bin (35)); /* External */ dcl as_error_table_$try_again_at_msg fixed bin (35) ext; dcl as_error_table_$special_sess_msg fixed bin (35) ext; dcl as_error_table_$sys_down_msg fixed bin (35) ext; dcl error_table_$action_not_performed fixed bin (35) ext; dcl error_table_$noarg fixed bin (35) ext; dcl error_table_$noentry fixed bin (35) ext static; /* Builtin */ dcl (addr, after, before, clock, divide, hbound, index, length, max, min, null, rtrim, substr, sum, unspec, verify) builtin; /* Internal Static */ dcl goingdown bit (1) int static init ("0"b); /* TRUE if auto shutdown scheduled */ dcl auto_bump_chn fixed bin (71) int static; /* channel for auto shutdown */ dcl stopflag bit (1) aligned init ("0"b) int static; /* TURE once operator has typed stop */ dcl abs_stop_chn int static fixed bin (71); /* event channel associated with shutting down abs */ dcl absolute_max_queue fixed bin int static init (4); /* maximum number of queues */ dcl abs_shut_interval fixed bin int static init (1800); /* 30 minutes between shutdown and abs stop */ dcl abs_shut_offset fixed bin int static init (600); /* allow abs to run for 10 mins after interactives out */ dcl saved_max_abs_users fixed bin (17) internal static; dcl saved_abs_maxu_auto bit (1) aligned internal static; /* Constant */ dcl DIGITS char (10) int static init ("0123456789") options (constant); /* for checking time. */ dcl ME char (6) int static init ("admin_") options (constant); dcl MILLION fixed bin (35) int static init (1000000) options (constant); /* useful constant */ dcl NL char (1) internal static options (constant) init (" "); dcl ONE_WEEK fixed bin (71) int static init (604800000000) options (constant); /* microseconds in a week */ dcl SECS_IN_MIN fixed bin int static init (60) options (constant); /* seconds in a minute */ dcl n_called fixed bin int static; /* accumulative time from which stop absentee issued */ dcl abs_command (16) char (12) int static options (constant) initial ("maxu", "maxq", "stop", "start", "bump", "cancel", "qres", "cpu_limit", "defer", "list", "move", "next", "release", "run", "suspend", "terminate" ); dcl four_zeros (4) fixed bin int static options (constant) init ((4) 0); dcl CAPITALS char (26) int static options (constant) init ("ABCDEFGHIJKLMNOPQRSTUVWXYZ"); /* Automatic */ dcl code fixed bin (35); dcl (i, j, k, l, strl) fixed bin; /* temps */ dcl lng fixed bin (21); dcl temp_sw bit (1) aligned; dcl (clock_value, saveclk) fixed bin (71); /* clock readings in microseconds */ dcl prefix char (200) aligned; /* message for user */ dcl shortinfo char (8) aligned, (longinfo, longinfo1) char (100) aligned; dcl comname char (24); dcl msg char (80); /* message */ dcl (day_now, day_back) char (6); /* dates */ dcl reason char (124); /* reason for next shutdown */ dcl string char (256); /* string of arguments */ dcl (wpers, wproj) char (28) init (""); /* person and proj id to look for */ dcl answer char (256) init (""); /* message typed to operator */ dcl arg_count fixed bin; /* set in validate */ dcl arg_list_ptr ptr; /* pointer to our argument list */ dcl p ptr; /* junk ptr */ dcl action_flag bit (1) aligned; dcl abs_funct char (12); /* function to be performed by absentee commands */ dcl mess char (8); /* event message for use by absentee commands */ dcl ev_p ptr; /* pointer to above */ dcl temp char (2); /* abs q number */ dcl source char (8), /* Source name, used in "route" */ attchan char (32); /* .. channel ID or file name */ dcl (check_sw, force_sw, go_sw) bit (1) aligned; dcl qres (4) fixed bin; dcl mpx_name char (32); /* name of a mltiplexer */ dcl fnp_only bit (1) init ("0"b); /* set if one of obsolete fnp only commands called */ dcl nargs fixed bin; dcl abs_start_at_startup bit (1) aligned; dcl fb71 fixed bin (71); /* temp */ dcl b12 bit (12); dcl c4 char (4); dcl temp_dir char (168); dcl temp_ename char (32); dcl abs_arg_ptr ptr; dcl continue bit (1) aligned; dcl error_message char (256); /* text of error message */ /* Based */ dcl 1 auto_abs_args like abs_args aligned; dcl arg char (lng) based (p); /* pickup structure for arguments */ dcl bf fixed binary (71) based (p); /* for event message */ dcl 1 xmessage aligned based (ev_p), /* structure which describes a two part */ 2 string char (4) aligned, /* event message sent to absentee user manager */ 2 table_index fixed bin; /* index in AUT */ dcl based_anstbl_message char (lng) based (addr (anstbl.special_message)); %page; login: entry options (variable); /* *** This entry implements the operator "login" command. It allows the operator to log in system daemons. */ arg_list_ptr = cu_$arg_list_ptr (); comname = "admin_: login"; call validate; /* locate anwer table */ if arg_count = 0 then LOGIN_USAGE: do; answer = "Usage: login Person.Project SOURCE {-control_args}"; go to admin_answers; end; call get_pers_proj (arg_list_ptr, 1, i, code); /* get person, project */ if code ^= 0 then go to LOGIN_USAGE; call cu_$arg_ptr_rel (i, p, lng, code, arg_list_ptr); /* see if source arg */ if code ^= 0 then go to LOGIN_USAGE; attchan = arg; sc_subsystem_info_ptr = ssu_$get_info_ptr (sc_stat_$admin_sci_ptr); call mc_check_access_$log_daemon_in (sc_subsystem_info_ptr, attchan, code); if code ^= 0 then do; if code = error_table_$noentry then answer = "No MC ACS segment for the source " || rtrim (attchan) || "."; else answer = "Login not permitted for message coordinator source " || rtrim (attchan) || "."; go to admin_err; end; i = i + 1; /* get next arg */ call cu_$arg_ptr_rel (i, p, lng, code, arg_list_ptr); /* See if optional args. */ if code ^= 0 then string = ""; else call build_string (arg_list_ptr, (i)); /* we don't need i any more, but build_string does */ call daemon_user_manager_$login (wpers, wproj, attchan, string); /* Cause automatic login of daemon */ return; %page; logout: entry options (variable); /* *** This entry implements the operator "logout" command. It allows an operator to logout system daemons. */ arg_list_ptr = cu_$arg_list_ptr (); comname = "admin_: logout"; call validate; /* locate answer table */ call get_pers_proj (arg_list_ptr, 1, i, code); /* get person, project, set i */ if code ^= 0 then do; answer = "Usage: logout Person.Project {SOURCE}"; go to admin_answers; end; call cu_$arg_ptr_rel (i, p, lng, code, arg_list_ptr); /* get source */ if code ^= 0 then source = "*"; else source = arg; call daemon_user_manager_$logout (wpers, wproj, source); /* bop */ return; %page; word: entry options (variable); /* *** This entry implements the operator "word" command. It allows the operator to set the login word. */ arg_list_ptr = cu_$arg_list_ptr (); comname = "admin_: word"; call cu_$generate_call (SET_LOGIN_WORD, cu_$arg_list_ptr ()); return; %page; sysid: entry options (variable); /* *** This entry implements the operator "sysid" command. It allows the operator to set the published system id in the who table. */ arg_list_ptr = cu_$arg_list_ptr (); comname = "admin_: sysid"; call validate; /* locate answer table */ call cu_$arg_ptr_rel (1, p, lng, code, arg_list_ptr); /* get system id argument */ if code ^= 0 then go to admin_err; if whoptr = null then return; /* in case trouble */ whotab.sysid = arg; /* change public system id */ return; %page; down1: entry (dn_time, dn_msg, dn_until); /* *** This entry is called by as_init_ to restore an old scheduled shutdown. */ dcl (dn_time, dn_until) fixed bin (71), dn_msg char (*); arg_list_ptr = cu_$arg_list_ptr (); call validate; comname = "admin_: down"; call SCHEDULE_SYSTEM_SHUTDOWN (dn_time, dn_msg, dn_until); return; %page; down: entry options (variable); /* *** This is the operator "down" command. It schedules a system shutdown, stops a scheduled shutdown, or tells the operator when the next system shutdown is scheduled. */ arg_list_ptr = cu_$arg_list_ptr (); comname = "admin_: down"; call validate; call cu_$arg_ptr_rel (1, p, lng, code, arg_list_ptr); /* get shutdown time */ if code ^= 0 then do; /* If no args, tell when shutdown will be. */ if ^goingdown then call sys_log (SL_LOG, "^a: down: No shutdown is scheduled.", ME); else do; msg = date_time_$format ("date_time", whotab.nextsd, "", ""); answer = date_time_$format ("date_time", whotab.until, "", ""); call sys_log (SL_LOG, "^a: down: Next shutdown from ^a to ^a ^a", ME, msg, answer, whotab.why); end; return; end; string = arg; /* align argument */ if lng = 1 then if string = "0" then do; /* if time is 0 then reset previous shutdown command */ call CANCEL_SYSTEM_SHUTDOWN (answer, code); if code ^= 0 then goto admin_answers; else return; end; if verify (arg, DIGITS) = 0 then call convert_date_to_binary_ (arg || ".", saveclk, code); else call convert_date_to_binary_ (arg, saveclk, code); if code ^= 0 then do; /* Check if time is legal. */ bad_t: answer = arg || " invalid clock time."; go to admin_answers; end; if saveclk < clock () then go to bad_t; /* Silly. We passed that. */ j = 3; /* arg. position */ call cu_$arg_ptr_rel (2, p, lng, code, arg_list_ptr); /* Next uptime, message, or nothing */ if code ^= 0 then do; clock_value = 0; /* default time up */ reason = " "; /* default reason */ end; else do; if verify (arg, DIGITS) = 0 then call convert_date_to_binary_ (arg || ".", clock_value, code); else call convert_date_to_binary_ (arg, clock_value, code); if code ^= 0 then do; /* Must be a message, not time. */ clock_value = 0; /* default up time */ go to why; /* assign message */ end; if clock_value < saveclk then do; answer = "uptime is earlier than downtime."; go to admin_answers; end; j = 4; /* arg. pos */ call cu_$arg_ptr_rel (3, p, lng, code, arg_list_ptr); /* message, or nothing */ if code ^= 0 then reason = " "; /* default reason */ else do; /* there is a reason */ why: call build_string (arg_list_ptr, j - 1); reason = substr (string, 1, strl); end; end; if goingdown then do; /* already a shutdown? */ msg = date_time_$format ("date_time", whotab.nextsd, "", ""); call sys_log (SL_LOG, "^a: down: resetting previous shutdown at ^a", ME, msg); call CANCEL_SYSTEM_SHUTDOWN (answer, (0)); end; call SCHEDULE_SYSTEM_SHUTDOWN (saveclk, reason, clock_value); return; %page; stop: entry options (variable); /* *** This is the operator "stop" command. It allows a graceful shutdown of the system by bumping all the users with grace time. */ arg_list_ptr = cu_$arg_list_ptr (); comname = "admin_: stop"; call validate; /* locate answer table */ call cu_$arg_count_rel (i, arg_list_ptr, (0)); /* operators keep typing "stop absentee" ... */ if i > 0 then do; /* .. so reject this */ answer = "no arguments are allowed for ""stop"""; go to admin_answers; /* .. try again, dummy */ end; call stop_command; /* do the work */ return; /* that was easy... */ %page; timed_stop_command: entry; /* *** This entry is called as a result of an alarm timer set by the "down" command. It allows the system to shut down in an orderly fashion */ arg_list_ptr = cu_$arg_list_ptr (); comname = "admin_: stop"; call set_non_command_sys_loggers; call sys_log (SL_LOG, "^a: stop: Automatic shutdown", ME); /* and fix all up */ call validate; /* going to need answer table */ call stop_command; /* now bump everybody */ return; %page; /* format: style5,ind5 */ warn: entry options (variable); /* *** This entry implements the operator "warn" command. It allows the operator to blast a message on a user's terminal. */ arg_list_ptr = cu_$arg_list_ptr (); comname = "admin_: warn"; call validate; /* locate answer table */ call get_pers_proj (arg_list_ptr, 1, i, code);/* get person, project, set i */ if code ^= 0 then do; answer = "Usage: warn Person.Project MESSAGE"; go to admin_answers; end; call build_string (arg_list_ptr, i); /* get message to be sent to user */ action_flag = "0"b; /* haven't done anybody yet */ continue = "1"b; do i = 1 to anstbl.current_size while (continue); utep = addr (anstbl.entry (i)); /* get ptr to a user entry */ if ute.active >= NOW_LOGGED_IN then /* if user logged in */ do; if wpers = "*" | wpers = ute.person then if wproj = "*" | wproj = ute.project then do; action_flag = "1"b; /* did something */ if ^ute.uflags.disconnected then do; call asu_$blast_user (utep, string, error_message, code); if code ^= 0 then call sys_log (SL_LOG, "^a: warn: ^a", ME, error_message); end; if wpers ^= "*" & wproj ^= "*" then continue = "0"b; /* no more searching */ end; end; end; if ^action_flag then call sys_log (SL_LOG, "^a: warn: ^a.^a not found.", ME, wpers, wproj); return; %page; /* format: style4 */ rcp: entry options (variable); /* *** This is the operator "rcp" command. It forwards the call to the appropriate rcp command: rcp_list or rcp_cancel. */ arg_list_ptr = cu_$arg_list_ptr (); comname = "admin_: rcp"; call validate; /* locate answer table */ call cu_$arg_ptr_rel (1, p, lng, code, arg_list_ptr); /* get opcode, or index */ if code ^= 0 then goto admin_err; if arg = "list" then call cu_$generate_call (rcp_list, cu_$arg_list_ptr ()); else if arg = "cancel" then call cu_$generate_call (rcp_cancel, cu_$arg_list_ptr ()); else do; answer = "unknown rcp command " || arg; goto admin_answers; end; return; %page; log: entry options (variable); /* *** This is the operator "log" command. It allows the operator to place an entry in the answering service log. */ arg_list_ptr = cu_$arg_list_ptr (); comname = "admin_: log"; call build_string (arg_list_ptr, 1); /* make up a string which is the comment */ call sys_log (SL_LOG_SILENT, "^a: log: ^a", ME, string); /* write off line */ return; %page; maxunits: entry options (variable); /* *** This is the "maxu" operator command. It allows the operator to set the maximum number of load units allowed on the system. */ arg_list_ptr = cu_$arg_list_ptr (); comname = "admin_: maxunits"; call validate; /* locate answer table */ call cu_$arg_ptr_rel (1, p, lng, code, arg_list_ptr); /* get first arg */ if code ^= 0 then do; /* if no argument given, print current maxu */ call sys_log (SL_LOG, "^a: maxu: ^[^; (auto)^; (level)^]: ^d (^d normal users)", ME, anstbl.auto_maxu + 1, anstbl.max_units, divide (anstbl.max_units, 10, 17, 0)); return; end; string = arg; /* get maxunits */ if string = "auto" then do; /* turn on auto setting of max */ anstbl.auto_maxu = 1; /* whee */ call load_ctl_$set_maxunits (anstbl.shift); /* stimulate */ end; else if string = "level" then do; /* make adjustment of max be dynamic */ anstbl.auto_maxu = 2; /* whee wheee */ call load_ctl_$set_maxunits (anstbl.shift); /* and poke it once */ end; else do; i = cv_dec_check_ (string, code); /* want to shut off automatic thing and force it */ if code ^= 0 then go to wrong_maxunits; if i <= 0 then do; /* simple checks */ wrong_maxunits: answer = arg || " is invalid value for maxunits"; go to admin_answers; end; if i < 200 then /* check for a likely mistake */ call sys_log (SL_LOG, "^a: maxu: Warning: maxunits are in tenths of load units.^/^-You just set maxu to ^d, or ^d normal users.", ME, i, divide (i, 10, 17, 0)); anstbl.max_units = i; /* set the system max load units. */ anstbl.auto_maxu = 0; /* Turn off automatic adjustment */ whotab.mxunits = i; /* tell users too */ end; call sys_log (SL_LOG, "^a: maxu^[^; (auto)^; (level)^]: ^d (^d normal users)", ME, anstbl.auto_maxu + 1, anstbl.max_units, divide (anstbl.max_units, 10, 17, 0)); return; %page; /* ADMIN_$SHIFT - Override shift table - set specified shift until specified time. Usage: shift prints "shift S until T" shift auto resets to shift given in shift table shift S sets shift to S until next regular shift change time shift S T sets shift to S until time T (T < one week in future) */ shift: entry options (variable); arg_list_ptr = cu_$arg_list_ptr (); comname = "admin_: shift"; call validate; /* get ptrs to various tables */ clock_value = clock (); /* use same clock value throughout execution of command */ j = -1; /* do not log the command unless we change something */ call cu_$arg_ptr_rel (1, p, lng, code, arg_list_ptr); /* see if there is at least one argument */ if code = 0 then do; /* there is */ string = arg; /* align the argument */ if string = "auto" then do; /* revert to using shift table */ whotab.next_shift_change_time = 0; /* force datebin_ to look in shift table */ call datebin_$next_shift_change (clock_value, whotab.next_shift_change_time, whotab.shift, (0)); end; else do; /* first arg must be shift number */ i = cv_dec_check_ (string, code); if code ^= 0 | i < 0 | i > 7 then do; answer = arg || " is not a legal shift number."; goto admin_answers; end; call cu_$arg_ptr_rel (2, p, lng, code, arg_list_ptr); /* see if time has also been given */ if code = 0 then do; /* it has */ if verify (arg, DIGITS) = 0 then call convert_date_to_binary_ (arg || ".", saveclk, code); else call convert_date_to_binary_ (arg, saveclk, code); if code ^= 0 then do; answer = arg || " invalid clock time."; goto admin_answers; end; if saveclk <= clock_value | saveclk > clock_value + ONE_WEEK then do; answer = arg || " is not within the next week."; goto admin_answers; end; whotab.next_shift_change_time = saveclk; end; /* end of time-given do group */ whotab.shift = i; /* we waited to see if time was ok before changing shift */ end; /* end of shift-given do group */ j = 1; /* we changed something, so log the command */ end; /* end of first-arg-given do group */ msg = date_time_$format ("date_time", whotab.next_shift_change_time, "", ""); call sys_log (SL_LOG, "admin_: shift: ^d until ^a", whotab.shift, msg); /* print shift and time on opr cons */ if anstbl.shift ^= whotab.shift then do; /* only if shift actually changed */ whotab.last_shift_change_time = clock_value; /* remember when it did */ call act_ctl_$shift_cmnd_update; /* tell accounting to use new rates */ end; return; %page; /* The following four entry points deal with FNPs. They allow the operator to perform manually some functions that are usually performed automatically by the answering service. These commands are provided for debugging and reconfiguration purposes, and should not have to be used during normal system operation. */ /* ADMIN_$FDUMP_FNP = CALL SUBROUTINE TO DUMP A SPECIFIED FNP */ /* ADMIN_$DUMP_FNP = CALL SUBROUTINE TO DUMP A SPECIFIED FNP */ /* ADMIN_$DUMP_MPX = CALL SUBROUTINE TO DUMP A SPECIFIED MULTIPLEXER */ fdump_fnp: entry options (variable); dump_fnp: entry options (variable); fnp_only = "1"b; comname = "admin_: fdump_fnp"; dump_mpx: entry options (variable); arg_list_ptr = cu_$arg_list_ptr (); if ^fnp_only then comname = "admin_: dump_mpx"; call validate; call get_mpx_name (1); /* first arg should be multiplexer name */ force_sw = "0"b; code = 0; do i = 2 by 1 while (code = 0); /* check rest of args */ call cu_$arg_ptr_rel (i, p, lng, code, arg_list_ptr); if code = 0 then do; if arg = "-force" then force_sw = "1"b; else do; answer = "unknown argument " || arg; go to admin_answers; end; end; end; call multiplexer_mgr_$dump_mpx (mpx_name, force_sw, code); return; /* ================================================= */ /* ADMIN_$LOAD_FNP = INITIATE A BOOTLOAD OF THE SPECIFIED FNP */ /* ADMIN_$LOAD_MPX = INITIATE A LOAD OF THE SPECIFIED MULTIPLEXER */ load_fnp: entry options (variable); fnp_only = "1"b; comname = "admin_: load_fnp"; load_mpx: entry options (variable); /* new, general command */ arg_list_ptr = cu_$arg_list_ptr (); if ^fnp_only then comname = "admin_: load_mpx"; call validate; call get_mpx_name (1); /* arg 1 is mpx name */ /* Look for additional arguments */ check_sw, force_sw = ""b; /* defaults, if no more args given */ go_sw = "1"b; code = 0; /* to get past the "while" */ do i = 2 by 1 while (code = 0); call cu_$arg_ptr_rel (i, p, lng, code, arg_list_ptr); if code = 0 then do; /* if there is an arg */ if arg = "-ck" | arg = "-check" then check_sw = "1"b; else if arg = "-ns" | arg = "-no_start" | arg = "-nostart" then go_sw = ""b; else if arg = "-force" then force_sw = "1"b; else do; answer = "unknown argument " || arg; goto admin_answers; end; end; end; call multiplexer_mgr_$load_mpx (mpx_name, check_sw, go_sw, force_sw, code); return; /* ================================================= */ /* ADMIN_$START_FNP = LISTEN TO THE PHONES CONFIGURED ON A SPECIFIED FNP */ /* ADMIN_$START_MPX = LISTEN TO THE PHONES CONFIGURED ON A SPECIFIED MULTIPLEXER */ start_fnp: entry options (variable); fnp_only = "1"b; comname = "admin_: start_fnp"; start_mpx: entry options (variable); arg_list_ptr = cu_$arg_list_ptr (); if ^fnp_only then comname = "admin_: start_mpx"; call validate; call get_mpx_name (1); /* arg 1 should be the multiplexer name */ call multiplexer_mgr_$start_mpx (mpx_name, "0"b, code); if code ^= 0 then return; call multiplexer_mgr_$listen_mpx (mpx_name, code); return; /* ================================================= */ /* ADMIN_$STOP_FNP = PREVENT LOADING, OR LISTENING TO THE PHONES OF, OR ACCEPTANCE OF CALLS BY, THE SPECIFIED FNP */ /* ADMIN_$STOP_MPX = PREVENT LOADING, OR LISTENING TO THE PHONES OF, OR ACCEPTANCE OF CALLS BY, THE SPECIFIED MULTIPLEXER */ stop_fnp: entry options (variable); fnp_only = "1"b; comname = "admin_: stop_fnp"; stop_mpx: entry options (variable); arg_list_ptr = cu_$arg_list_ptr (); if ^fnp_only then comname = "admin_: stop_mpx"; call validate; call get_mpx_name (1); /* first arg is multiplexer name */ call multiplexer_mgr_$stop_mpx (mpx_name, code); return; shutdown_mpx: entry options (variable); arg_list_ptr = cu_$arg_list_ptr (); comname = "admin_: shutdown_mpx"; call validate; call get_mpx_name (1); /* first arg is multiplexer name */ force_sw = "0"b; code = 0; do i = 2 by 1 while (code = 0); /* check rest of args */ call cu_$arg_ptr_rel (i, p, lng, code, arg_list_ptr); if code = 0 then do; if arg = "-force" then force_sw = "1"b; else do; answer = "unknown argument " || arg; go to admin_answers; end; end; end; call multiplexer_mgr_$shutdown_mpx_command (mpx_name, force_sw, code); return; /* END of FNP commands */ /* ================================================= */ /* ADMIN_$ABS = A SET OF FUNCTIONS PERTAINING TO ABSENTEE FACILITY */ /* admin_$abs - all operator commands which deal with absenteee enter here */ /* - first argument indicates which absentee function is intended */ admin_$abs_not_a_command_: entry options (variable); call set_non_command_sys_loggers; /* ** fall down here */ abs: entry options (variable); arg_list_ptr = cu_$arg_list_ptr (); comname = "admin_: abs"; call validate; /* locate answer table */ if autp = null then do; /* first call? */ call hcs_$initiate (sysdir, "absentee_user_table", "", 0, 0, autp, code); if autp = null then do; call sys_log$error_log (SL_LOG, code, "admin_", "^a>absentee_user_table", sysdir); return; end; end; call cu_$arg_count_rel (nargs, arg_list_ptr, code); /* several abs commands need the count */ abs_arg_ptr = addr (auto_abs_args); /* initialize ptr to arg structure */ call cu_$arg_ptr_rel (1, p, lng, code, arg_list_ptr); /* get actual command */ if code ^= 0 then go to admin_err; /* abs differs from other system control cmds */ abs_funct = p -> arg; /* copy absentee opr command */ ev_p = addr (mess); /* get ptr to ipc-event message */ /* look up absentee operator command in table & go to label associated with it */ do i = 1 to hbound (abs_command, 1) while (abs_funct ^= abs_command (i)); end; if i > hbound (abs_command, 1) then do; answer = "unknown absentee command " || arg; go to admin_answers; end; if ^sc_stat_$Multics then if abs_funct ^= "stop" then do; call ioa_$rsnnl ( "The abs ^a command can not be used before answering service startup.", answer, (0), abs_funct); goto admin_answers; end; comname = "admin_: abs " || abs_funct; goto abs_action (i); %page; abs_action (3): /* ABS STOP */ /* *** graceful shutdown of absentee facility - keeps checking until no absentee processes left */ if ^sc_stat_$Multics then /* abs stop before startup means "don't abs start" */ autbl.abs_stopped, autbl.abs_up = ""b; /* clear any garbage from last bootload */ call cu_$arg_ptr_rel (2, p, lng, code, arg_list_ptr); /* see if second arg given */ if code = 0 then do; if arg = "now" then do; /* "abs stop now" ? */ n_called = abs_shut_interval + 1; /* yes. cause all process to get bumped */ go to abs_s1; end; else if arg = "q" | arg = "queue" then do; /* drop one or all queues */ if ^sc_stat_$Multics then do; answer = "abs stop queue only works after answering service startup" ; goto admin_answers; end; call cu_$arg_ptr_rel (3, p, lng, code, arg_list_ptr); if code ^= 0 then do; answer = "missing argument: queue to be stopped"; goto admin_answers; end; if arg = "all" then autbl.queue_dropped (*) = "1"b; else if arg = "fg" | arg = "foreground" then autbl.queue_dropped (-1) = "1"b; else do; i = cv_dec_check_ (arg, code); if code = 0 then do; if i >= -1 & i <= absolute_max_queue then autbl.queue_dropped (i) = "1"b; else code = 1; /* any nonzero value, to get error msg printed */ end; if code ^= 0 then do; answer = "invalid queue to be stopped: " || arg; goto admin_answers; end; end; /* end not all or foreground */ goto print_dropped_queues; /* go do a "abs start queue" to show what happened */ end; /* end abs stop queue */ else do; /* bad arg. ignore command */ answer = "unknown argument " || arg; go to admin_answers; end; end; else n_called = 0; /* wasn't "abs stop now" - wait a while first */ if autbl.abs_stopped & autbl.abs_up then do; /* don't stop absentee if in process of going down */ abs_stopping: answer = "absentee stop in progress"; go to admin_answers; end; abs_s1: if ^autbl.abs_up then do; /* don't stop absentee if it is not up */ autbl.abs_stopped = "1"b; call sys_log (SL_LOG, "^a: abs: absentee not up, and will not be started automatically", ME); if ^sc_stat_$Multics then /* if before startup */ call absentee_user_manager_$term_aum; /* tell him not to start absentee automatically */ go to admin_abs_returns; end; if goingdown then do; call sys_log (SL_LOG, "^a: abs: resetting auto abs stop", ME); call timer_manager_$reset_alarm_wakeup (abs_stop_chn); end; else call ipc_$create_ev_chn (abs_stop_chn, code); call START_ABSENTEE_SHUTDOWN (); return; %page; absentee_off: entry (); /* *** This entry is called automatically every 30 seconds once an absentee shutdown has been started if there are remaining absentee processes running to await their logging out. */ arg_list_ptr = cu_$arg_list_ptr (); call set_non_command_sys_loggers; comname = "admin_: abs stop"; call validate; n_called = n_called + 30; /* keep track of time since abs shutdown performed */ call CHECK_FOR_ABSENTEE_SHUTDOWN (); /* Done yet? */ return; %page; absentee_down: entry (); /* *** This entry is called automatically by a timer wakeup when the absentee facility is supposed to begin shutdown. The "down" command schedules this absentee shutdown. */ arg_list_ptr = cu_$arg_list_ptr (); call set_non_command_sys_loggers (); comname = "admin_: abs stop"; call validate; if (^autbl.abs_up | autbl.abs_stopped) then /* do nothing if not up or already stopped */ call absentee_user_manager_$update_whotab_abs_control (); else do; n_called = 0; call sys_log (SL_LOG, "^a: stop: auto abs stop", ME); call START_ABSENTEE_SHUTDOWN (); end; return; %page; /* The bump, cancel, terminate, suspend, and release functions of the abs command share common code. They all take the same set of arguments, and they all operate by sending a wakeup to AUM, with the AUT index in one word, and a 4 letter abbreviation of the command name in the other. The cancel and release functions can also operate on non-running jobs, so they call entry points in AU instead of, or in addition to, sending the wakeup, depending on the arguments given. */ /* bumps absentee users - by name, project, absentee id - leaves restartable requests in message segment */ /* ********** abs bump ********** */ abs_action (5): /* ABS BUMP */ ev_p -> xmessage.string = "bump"; go to abs_bump_common; /* bumps absentee users - by name, project, absentee id - deletes restartable requests from message segment */ /* ********** abs cancel ********** */ abs_action (6): /* ABS CANCEL */ ev_p -> xmessage.string = "canc"; goto abs_bump_common; /* ********** abs release ********** */ abs_action (13): ev_p -> xmessage.string = "rlse"; goto abs_bump_common; /* ********** abs suspend ********** */ abs_action (15): ev_p -> xmessage.string = "susp"; goto abs_bump_common; /* ********** abs terminate ********** */ abs_action (16): ev_p -> xmessage.string = "term"; goto abs_bump_common; abs_bump_common: if ^autbl.abs_up then goto abs_not_up; k = 0; /* clear counter of selected jobs */ call parse_abs_args (arg_list_ptr); /* look at job selection args and fill in structure */ if abs_funct = "cancel" then /* abs cancel must give user name and not "*" */ call validate_abs_args ("1"b, "1"b); /* allow absN, require user */ else call validate_abs_args ("1"b, "0"b); /* allow absN, don't require user */ if abs_funct ^= "cancel" | abs_args.absn_sw | abs_args.abs_star_sw then do; /* scan AUT unless cancel &^absN */ if abs_args.absn_sw then i, j = abs_args.aut_index; /* if absN, just look at slot N */ else do; i = 1; j = autbl.current_size; end; do i = i to j; utep = addr (autbl.entry (i)); if ute.active < NOW_LOGGED_IN then if abs_args.absn_sw then do; call ioa_$rsnnl ( "No job in absentee slot ^d (status= ^d).", answer, (0), i, ute.active); goto admin_answers; end; else goto abs_bump_nomatch; if abs_args.user_sw then if (abs_args.person ^= "*" & abs_args.person ^= ute.person) | (abs_args.project ^= "*" & abs_args.project ^= ute.project) then if abs_args.absn_sw then do; call ioa_$rsnnl ( "Job in absentee slot ^d is not from user ^a.^a", answer, (0), i, abs_args.person, abs_args.project); goto admin_answers; end; else goto abs_bump_nomatch; if abs_args.id_sw then if ^match_request_id_ (ute.request_id, (abs_args.request_id_string)) then if abs_args.absn_sw then do; call ioa_$rsnnl ( "Job in absentee slot ^d does not match request ID ^a", answer, (0), i, abs_args.request_id_string); goto admin_answers; end; else goto abs_bump_nomatch; if abs_args.path_sw | abs_args.entry_sw then do; call expand_pathname_ (ute.input_seg, temp_dir, temp_ename, (0)); call match_star_name_ (temp_ename, abs_args.ename, code); if code ^= 0 | (abs_args.path_sw & temp_dir ^= abs_args.dirname) then if abs_args.absn_sw then do; call ioa_$rsnnl ( "Job in absentee slot ^d does not match absin ^[path ^a>^a^;entry name ^s^a^]", answer, (0), i, abs_args.path_sw, abs_args.dirname, abs_args.ename); goto admin_answers; end; else goto abs_bump_nomatch; end; if abs_args.sender_sw then do; call match_star_name_ (ute.sender, abs_args.sender, code); if code ^= 0 then if abs_args.absn_sw then do; call ioa_$rsnnl ( "Job in absentee slot ^d is not from sender ^a", answer, (0), i, abs_args.sender); goto admin_answers; end; else goto abs_bump_nomatch; end; if abs_args.queue_sw then if (abs_args.queue > 0 & ute.queue ^= abs_args.queue) | (abs_args.queue = 0 & (ute.queue ^= 1 | ^ute.adjust_abs_q_no)) | (abs_args.queue = -1 & ^ute.foreground_job) then if abs_args.absn_sw then do; call ioa_$rsnnl ( "Job in absentee slot ^d is not from queue ^d", answer, (0), i, abs_args.queue); goto admin_answers; end; else goto abs_bump_nomatch; if abs_funct = "release" then /* if release */ if ^ute.sus_sent then /* and job not suspended */ if abs_args.absn_sw then do; call ioa_$rsnnl ( "Job in absentee slot ^d is not suspended.", answer, (0), i); goto admin_answers; end; else goto abs_bump_nomatch; if abs_funct = "suspend" then /* if suspend */ if ute.sus_sent then /* and job already suspended */ if abs_args.absn_sw then do; call ioa_$rsnnl ( "Job in absentee slot ^d is already suspended.", answer, (0), i); goto admin_answers; end; else goto abs_bump_nomatch; /* This job has been selected. Put AUTBL slot number into message */ ev_p -> xmessage.table_index = i; /* Send wakeup to absentee user manager. It contains the slot number and the action to be taken. */ call hcs_$wakeup (whotab.abs_procid, whotab.abs_event, ev_p -> bf, code); k = k + 1; /* count selected jobs */ abs_bump_nomatch: end; /* end loop thru aute's */ if abs_funct = "release" /* if release */ & ^(abs_args.absn_sw | abs_args.abs_star_sw) then do; /* and a running job was not specified, see if we need to release deferred job(s) */ call absentee_utility_$abs_release (abs_arg_ptr, l); /* l is returned count of released jobs */ if k + l = 0 then do; /* no jobs released */ answer = "Selection arguments matched no deferred or suspended absentee requests." ; goto admin_answers; end; else if k > 0 then do; /* one or more suspended jobs were released */ call ioa_$rsnnl ("^d suspended request^[s^] released.", answer, (0), k, (k ^= 1)); goto admin_replies; end; end; else do; /* see if scan of AUT found any jobs */ if autbl.n_abs_run = 0 then do; answer = "There are no absentee jobs running."; goto admin_replies; end; else if k = 0 then do; answer = "Selection arguments matched no running absentee jobs." ; goto admin_answers; end; end; end; /* end ^cancel | absN */ else do; /* abs cancel, and not absN */ call cancel_abs_request$as_abs (arg_list_ptr, nargs, fb71, code); if code ^= 0 & fb71 ^= 0 then do; /* a running job was cancelled, so we must bump it */ do i = 1 to autbl.current_size while (addr (autbl.entry (i)) -> ute.request_id ^= fb71) ; end; if i <= autbl.current_size then do; ev_p -> xmessage.table_index = i; call hcs_$wakeup (whotab.abs_procid, whotab.abs_event, ev_p -> bf, code); end; end; end; goto admin_abs_returns; /* code to initialize the absentee facility */ /* set max abs users */ /* signals absentee user manager so that it will */ /* attempt to login max abs users */ /* ********** abs start ********** */ abs_action (4): /* ABS START */ if (autbl.abs_up & autbl.abs_stopped) then do; /* If absentee is running down */ if autbl.n_abs_run > 0 then call ABORT_ABSENTEE_SHUTDOWN (); call ipc_$delete_ev_chn (abs_stop_chn, code); call absentee_user_manager_$term_aum; autbl.abs_up, autbl.abs_stopped = ""b; /* all finished, clear indicators */ end; if goingdown then /* If an automatic shutdown is scheduled, */ if (whotab.nextsd - clock ()) < abs_shut_interval * MILLION then do; answer = "system coming down soon: no abs start"; go to admin_answers; end; abs_start_at_startup = ""b; /* gets turned on if "abs start startup" */ call cu_$arg_ptr_rel (2, p, lng, code, arg_list_ptr); /* fetch second argument - max number of absentee users */ if code ^= 0 then do; /* if no argument default values for max users + max queue */ if autbl.abs_up then do; /* initialization of absentee non-reentrant */ abs_already_up: answer = "absentee already up"; /* abs start queue (checked for below) is allowed with abs up */ go to admin_answers; end; default_u: autbl.abs_maxu_auto = "1"b; /* remember to set default maxu later */ default_q: autbl.abs_maxq_auto = "1"b; /* remember to set default maxq later */ end; else if arg = "queue" | arg = "q" then do; /* trying to restart a previously dropped queue */ call cu_$arg_ptr_rel (3, p, lng, code, arg_list_ptr); /* get queue to be restarted */ if code ^= 0 then do; /* if no q to restart given, print q status */ if sum (autbl.qerr) = 0 & unspec (autbl.queue_dropped) = ""b then call sys_log (SL_LOG, "^a: abs: Zero errors on all absentee queues.", ME); else do; print_dropped_queues: temp_sw = (unspec (autbl.queue_dropped) ^= ""b); /* make temp_sw "1"b if any queues dropped */ call sys_log (SL_LOG, "^a: abs: Queue errors^[^x(*=dropped)^]:", ME, temp_sw); call sys_log (SL_LOG, "^a: abs: FG^2x0^2x1^2x2^2x3^2x4", ME); call sys_log (SL_LOG, "^a: abs:^6(^x^2d^)", ME, autbl.qerr); if temp_sw then call sys_log (SL_LOG, "^a: abs:^6(^2x^[*^;^x^]^)", ME, autbl.queue_dropped); end; goto admin_abs_returns; end; if ^(autbl.abs_up & ^autbl.abs_stopped) then do; /* can only do this when absentee is up */ answer = "absentee not up. cannot restart queue " || arg; goto admin_answers; end; if arg = "all" then do; autbl.qerr (*) = 0; autbl.queue_dropped (*) = ""b; goto nudge; end; else if arg = "fg" | arg = "foreground" then do; code = 0; i = -1; end; else i = cv_dec_check_ (arg, code); if code = 0 then do; if i >= -1 & i <= absolute_max_queue then do; autbl.qerr (i) = 0; /* clear error count for this queue */ autbl.queue_dropped (i) = ""b; goto nudge; /* go send wakeup to see if any jobs waiting to be run */ end; else code = 1; /* any nonzero value, to get error message printed */ end; if code ^= 0 then do; answer = "invalid queue to be restarted " || arg; goto admin_answers; end; end; /* end of abs start queue */ else do; /* normal abs start */ if autbl.abs_up then goto abs_already_up; if arg = "startup" then do; /* if called by load_ctl_ at a.s. startup */ abs_start_at_startup = "1"b; /* remember that for later */ goto default_u; /* go turn on default switches for maxu and maxq */ end; else do; call abs_maxu (arg); /* set max users for absentee from value in command line */ call cu_$arg_ptr_rel (3, p, lng, code, arg_list_ptr); /* fetch third argument - highest queue to be searched */ if code ^= 0 then go to default_q; /* if no argument set default value in absentee user table */ call abs_maxq (arg); /* set max queue to be searched to value from command */ end; end; call absentee_user_manager_$init_aum (code); /* call initialization entry point */ if code ^= 0 then go to admin_abs_returns; /* message already printed */ autbl.abs_up = "1"b; /* set indicators correctly */ autbl.abs_stopped = ""b; autbl.qerr (*) = 0; /* clear per-queue error indicators */ autbl.queue_dropped (*) = ""b; autbl.abs_qres_auto, autbl.abs_cpu_limit_auto = "1"b; /* assume defaults for these */ if ^abs_start_at_startup then /* if command was "abs start startup", this is a.s. startup */ /* and we were called from load_ctl_$set_maxunits */ /* of which load_ctl_$set_abs_parms is an entrypoint */ call load_ctl_$set_abs_parms; /* if not called from load_ctl_, call load_ctl_ */ if goingdown then /* if a scheduled shutdown set up timer */ call SCHEDULE_ABSENTEE_SHUTDOWN (); nudge: if autbl.max_abs_users > 0 | abs_start_at_startup then /* wakeup absentee user manager if slots */ call absentee_utility_$au_send_wakeup; go to admin_abs_returns; %page; abs_action (1): /* ABS MAXU */ if ^autbl.abs_up then do; abs_not_up: answer = "absentee not up"; goto admin_answers; end; if autbl.abs_stopped then goto abs_stopping; call cu_$arg_ptr_rel (2, p, lng, code, arg_list_ptr); /* get new max. abs. users from command */ if code ^= 0 then do; /* if no argument, print current maxu */ call sys_log (SL_LOG, "^a: abs: maxu (^[auto^;manual^]): ^d", ME, autbl.abs_maxu_auto, autbl.max_abs_users); goto admin_abs_returns; end; if arg = "auto" then do; autbl.abs_maxu_auto = "1"b; call load_ctl_$set_abs_parms; go to admin_abs_returns; end; else call abs_maxu (arg); /* set new value of max abs users */ goto nudge; %page; /* set queue number which is highest queue searched */ /* ********** abs maxq ********** */ abs_action (2): /* ABS MAXQ */ if ^autbl.abs_up then go to abs_not_up; if autbl.abs_stopped then goto abs_stopping; call cu_$arg_ptr_rel (2, p, lng, code, arg_list_ptr); /* get new max queue from command */ if code ^= 0 then do; /* if no argument, print current maxq */ call sys_log (SL_LOG, "^a: abs: maxq (^[auto^;manual^]): ^d", ME, autbl.abs_maxq_auto, autbl.last_queue_searched); goto admin_abs_returns; end; if arg = "auto" then do; autbl.abs_maxq_auto = "1"b; call load_ctl_$set_abs_parms; go to admin_abs_returns; end; else do; call abs_maxq (arg); /* set new max queue in absentee user table */ go to nudge; end; /* ********** abs qres ********** */ abs_action (7): /* ABS QRES */ if ^autbl.abs_up then goto abs_not_up; j = 0; /* clear argument counter */ qres (*) = 0; /* default = 0 for any queue whose reservation is not specified */ code = 0; /* clear possible garbage, so the while clause always works */ do i = 2 to 5 while (code = 0); /* go thru up to 4 arguments */ call cu_$arg_ptr_rel (i, p, lng, code, arg_list_ptr); if code = 0 then do; /* if argument is there */ qres (i - 1) = cv_dec_check_ (arg, code); if code ^= 0 | qres (i) < 0 then do; /* if not positive decimal number */ if arg = "auto" & nargs = 2 then ; /* it's ok if it's "auto" */ else do; /* but anything else is an error */ answer = "abs qres has invalid value: " || arg; goto admin_answers; end; end; j = j + 1; /* count valid arguments */ end; end; if nargs = 1 then /* no args means print current values */ call sys_log (SL_LOG, "^a: abs: qres ^[^2x(auto)^;(manual)^]:^4(^x^2d^)", ME, autbl.abs_qres_auto, autbl.qres); else if arg = "auto" then do; autbl.abs_qres_auto = "1"b; call load_ctl_$set_abs_parms; end; else do; autbl.abs_qres_auto = ""b; autbl.qres (*) = qres (*); /* copy them all, setting unspecified ones to zero */ end; do i = 1 to 4; /* compute the resulting limits */ qres (i) = available_slots_ (i, autbl.max_abs_users, (autbl.qres), four_zeros); end; call sys_log (SL_LOG, "^a: abs: queue^2xlimits:^4(^x^2d^)", ME, qres); /* and print them */ if nargs > 1 then if arg ^= "auto" then goto nudge; goto admin_abs_returns; /* ********** abs cpu_limit ********** */ abs_action (8): /* cpu_limit */ if ^autbl.abs_up then goto abs_not_up; call cu_$arg_ptr_rel (2, p, lng, code, arg_list_ptr); if code ^= 0 then /* no arg means print current values */ call sys_log (SL_LOG, "^a: abs: cpu_limit (^[auto^;manual^]), queues 1-4: ^d^3(,^d^) (seconds)", ME, autbl.abs_cpu_limit_auto, autbl.cpu_limit); else if arg = "auto" then do; autbl.abs_cpu_limit_auto = "1"b; call load_ctl_$set_abs_parms; end; else do; if nargs ^= 2 | verify (arg, "0123456789,") ^= 0 then do; answer = "Usage is: ""abs cpu_limit l1,l2,l3,l4"" (limits in seconds)"; goto admin_answers; end; i = 1; /* start at char 1 of limit string */ do k = 1 to 4 while (i <= lng); /* look for limits for 4 queues */ j = index (substr (arg, i), ","); /* find next comma */ if j = 0 then j = lng - i + 2; /* if none, pretend one after end of string */ if j > 1 then /* if not adjacent commas, convert and store the value */ autbl.cpu_limit (k) = cv_dec_check_ (substr (arg, i, j - 1), (0)); i = i + j; /* move past the comma */ if autbl.cpu_limit (k) < 60 then /* check for a likely mistake */ call sys_log (SL_LOG, "^a: abs: Warning: cpu limits are in seconds. You just set queue ^d limit to ^d seconds.", ME, k, autbl.cpu_limit (k)); end; autbl.abs_cpu_limit_auto = ""b; /* remember it's set by operator */ end; if nargs = 2 then if arg ^= "auto" then goto nudge; goto admin_abs_returns; /* ********** abs defer ********** */ abs_action (9): /* defer */ if ^autbl.abs_up then goto abs_not_up; call parse_abs_args (arg_list_ptr); call validate_abs_args ("0"b, "0"b); /* reject absN, don't require user */ call absentee_utility_$abs_defer (abs_arg_ptr); goto admin_abs_returns; /* ********** abs list ********** */ abs_action (10): /* list */ /* abs list works when absentee is not up */ do j = 2 to nargs; /* look for absN */ call cu_$arg_ptr_rel (j, p, lng, code, arg_list_ptr); if code = 0 then do; if substr (arg, 1, 3) = "abs" & verify (substr (arg, 4), "0123456789") = 0 then do; /* absN */ if ^autbl.abs_up then do; answer = "The absN argument cannot be used when absentee is not up."; goto admin_answers; end; temp = substr (arg, 4); /* align N */ j = cv_dec_check_ (temp, (0)); if j > autbl.current_size then do; /* if N is too large, don't try to reference slot N */ call ioa_$rsnnl ("No job in absentee slot ^d.", answer, (0), j); goto admin_answers; end; utep = addr (autbl.entry (j)); if ute.active ^= NOW_HAS_PROCESS then do; call ioa_$rsnnl ( "No job in absentee slot ^d (status= ^d).", answer, (0), j, ute.active); goto admin_answers; end; if ute.foreground_job then i = -1; else if ute.adjust_abs_q_no then i = ute.queue - 1; else i = ute.queue; fb71 = ute.request_id; j = nargs; /* get out of the loop */ end; end; end; call list_abs_requests$abs_list (arg_list_ptr, nargs, fb71, i); goto admin_abs_returns; /* ********** abs move ********** */ abs_action (11): /* move */ /* abs move works when absentee is not up */ call cancel_abs_request$as_abs (arg_list_ptr, nargs, fb71, code); goto admin_abs_returns; /* ********** abs next ********** */ abs_action (12): /* next */ /* abs next works when absentee is not up */ call cancel_abs_request$as_abs (arg_list_ptr, nargs, fb71, code); goto admin_abs_returns; /* ********** abs run ********** */ abs_action (14): /* run */ if ^autbl.abs_up then goto abs_not_up; call parse_abs_args (arg_list_ptr); call validate_abs_args ("0"b, "1"b); /* reject absN, require user */ call absentee_user_manager_$aum_abs_run (abs_arg_ptr); goto admin_abs_returns; /* ================================================= */ admin_err: call sys_log$error_log (SL_LOG, code, comname, answer); return; admin_answers: call sys_log (SL_LOG, "^a: error: ^a", comname, answer); return; admin_abs_returns: call absentee_user_manager_$update_whotab_abs_control; return; admin_replies: /* reply without saying "error:" */ call sys_log (SL_LOG, "^a: ^a", comname, answer); return; /* almost all entries exit here */ %page; /* Internal Procedures */ get_mpx_name: proc (argno); dcl argno fixed bin; call cu_$arg_ptr_rel (argno, p, lng, code, arg_list_ptr); if code ^= 0 then do; if fnp_only then answer = "No FNP tag specified"; else answer = "No multiplexer specified"; go to admin_answers; end; mpx_name = arg; if fnp_only then do; /* extra checks to be compatable with old commands */ if length (rtrim (mpx_name)) > 1 then do; bad_mpx_fnp_name: answer = "Invalid FNP tag: " || mpx_name; go to admin_answers; end; if index ("abcdefgh", substr (mpx_name, 1, 1)) = 0 then go to bad_mpx_fnp_name; end; return; end get_mpx_name; /* ****************************************************************************************************************** */ validate: proc; if ^sc_stat_$Multics_typed then as_data_$sysdir = sc_stat_$sysdir; if as_data_$ansp = null then do; call hcs_$initiate (sysdir, "answer_table", "", 0, 0, as_data_$ansp, code); as_procid = get_process_id_ (); if as_data_$ansp = null then do; call sys_log$error_log (SL_LOG_BEEP, code, ME, "^a>answer_table", sysdir); return; end; end; ansp = as_data_$ansp; autp = as_data_$autp; dutp = as_data_$dutp; if whoptr = null then do; call hcs_$initiate (sysdir, "whotab", "", 0, 0, whoptr, code); if whoptr = null then call sys_log$error_log (SL_LOG_BEEP, code, ME, "^a>whotab", sysdir); end; if ip = null then do; call hcs_$initiate (sysdir, "installation_parms", "", 0, 1, ip, code); if ip = null then call sys_log$error_log (SL_LOG_BEEP, code, ME, "^a>installation_parms", sysdir); end; if scdtp = null then do; call hcs_$initiate (sysdir, "cdt", "", 0, 1, scdtp, code); if scdtp = null then call sys_log$error_log (SL_LOG_BEEP, code, ME, "^a>cdt", sysdir); end; call cu_$arg_count_rel (arg_count, arg_list_ptr, (0)); /* AF invocation not an issue */ return; /* end of setup */ end validate; /* ****************************************************************************************************************** */ abs_maxu: proc (l_arg); dcl l_arg char (*); i = cv_dec_check_ (l_arg, code); if code = 0 then /* check legality */ if i >= 0 then if i <= divide (anstbl.max_units, 10, 17, 0) then do; autbl.abs_maxu_auto = ""b; autbl.max_abs_users = i; whotab.max_abs_users = i; return; end; if code ^= 0 then answer = "abs maxusers must be numeric or ""auto"": " || l_arg; else if i < 0 then answer = "abs maxusers may not be negative: " || l_arg; else answer = "abs maxusers may not be greater than system maxusers: " || l_arg; go to admin_answers; end abs_maxu; /* ****************************************************************************************************************** */ abs_maxq: proc (l_arg); dcl l_arg char (*); i = cv_dec_check_ (l_arg, code); if code = 0 then /* check legality */ if i >= 0 then if i <= absolute_max_queue then do; autbl.abs_maxq_auto = ""b; autbl.last_queue_searched = i; return; end; answer = "abs maxqueue has invalid value: " || l_arg; go to admin_answers; end abs_maxq; /* ****************************************************************************************************************** */ build_string: proc (arg_list_ptr, an); dcl arg_list_ptr pointer; dcl an fixed bin; /* arg no to start from */ dcl i fixed bin; i = an; call cu_$arg_ptr_rel (i, p, lng, code, arg_list_ptr); if code ^= 0 then go to admin_err; string = arg; strl = lng; bld: i = i + 1; call cu_$arg_ptr_rel (i, p, lng, code, arg_list_ptr); if code ^= 0 then return; substr (string, strl + 2) = arg; strl = strl + 1 + lng; if strl > length (string) then return; go to bld; end build_string; %page; /* Internal procedure to do the work of the STOP command. Called by the STOP command and the timer for the DOWN command. */ stop_command: procedure (); if stopflag then return; /* ignore subsequent stop commands */ stopflag = "1"b; /* prevent resignal */ whotab.nextsd = 0; /* a shutdown will prevent restoring */ call SET_LOGIN_WORD ("shutdown"); /* ok, no more logins. Set dialup message */ if anstbl.n_users = 0 then /* ready to shut down already? */ call sys_log (SL_LOG, "^a: stop: All users are out. You may shut down.", ME); else do; /* Bump everyone still on */ call convert_status_code_ (as_error_table_$sys_down_msg, shortinfo, longinfo); if whotab.until = 0 then string = ""; else do; msg = date_time_$format ("date_time", whotab.until, "", ""); call convert_status_code_ (as_error_table_$try_again_at_msg, shortinfo, longinfo1); call ioa_$rsnnl (longinfo1, string, i, msg); end; call ioa_$rs (longinfo, prefix, i, string); continue = "1"b; string = substr (prefix, 1, i - 1); do i = 1 to anstbl.current_size while (continue); /* everybody out of the pool */ utep = addr (anstbl.entry (i)); if ute.active >= NOW_LOGGED_IN then call PROCESS_UTE (action_flag); end; if ^action_flag then call sys_log (SL_LOG, "^a: stop: There were no active users to be bumped.", ME); else call sys_log (SL_LOG, "^a: stop: all users have been given ^d minutes to logout", ME, divide (installation_parms.warning_time, SECS_IN_MIN, 17, 0)); end; return; PROCESS_UTE: procedure (P_action_flag); /* *** This procedure is used to perform the desired action on the specified ute. The action is specified via the variable "action". */ dcl P_action_flag bit (1) aligned parameter; if ute.at.nobump then do; call sys_log (SL_LOG, "^a: ^a: ^a.^a has ""nobump""", ME, comname, ute.person, ute.project); if ^ute.uflags.disconnected then call asu_$blast_user (utep, "Bump attempted. " || string, (""), (0)); return; end; call asu_$bump_user (utep, string, code, installation_parms.warning_time); /* *** This tells the operator what we did and sets the flag saying that we did something. */ call sys_log (SL_LOG, "^a: bump: ^a.^a bumped.", ME, ute.person, ute.project); P_action_flag = "1"b; /* remember we did one */ return; end PROCESS_UTE; end stop_command; %page; parse_abs_args: proc (arg_list_ptr); /* fills in abs_args structure from job selection args */ dcl arg_list_ptr pointer; dcl an fixed bin; /* arg number */ dcl expecting fixed bin init (0); /* if nonzero, which arg value are we expecting */ dcl prev_arg char (20); /* previous argument, for use in error messages */ dcl ctl_arg_given bit (1) aligned init (""b); /* 1 if any control args have been processed */ dcl USER fixed bin int static options (constant) init (1); /* values for expecting */ dcl ID fixed bin int static options (constant) init (2); dcl ENTRY fixed bin int static options (constant) init (3); dcl SENDER fixed bin int static options (constant) init (4); dcl QUEUE fixed bin int static options (constant) init (5); unspec (abs_args) = ""b; /* clear out argument structure */ do an = 2 to nargs; /* skip first arg, which is command keyword */ call cu_$arg_ptr_rel (an, p, lng, code, arg_list_ptr); if code ^= 0 then goto admin_err; if substr (arg, 1, 1) = "-" then do; /* a control argument */ if expecting > 0 then do; /* but if we were expecting a value, complain */ call sys_log$error_log (SL_LOG, error_table_$noarg, comname, "After ^a.", prev_arg); return; end; if arg = "-user" then expecting = USER; else if arg = "-id" then expecting = ID; else if arg = "-et" | arg = "-entry" then expecting = ENTRY; else if arg = "-sender" then expecting = SENDER; else if arg = "-q" | arg = "-queue" then expecting = QUEUE; else if arg = "-fg" | arg = "-foreground" then do; /* equivalent to -q foreground */ if abs_args.queue_sw then do; multiple_abs_qualifiers: answer = "More than one specification of an attribute is present: " || arg; go to admin_answers; end; abs_args.queue_sw = "1"b; abs_args.queue = -1; end; else do; answer = "Invalid abs job selection argument: " || arg; goto admin_answers; end; prev_arg = arg; /* save this arg in case of error with next one */ ctl_arg_given = "1"b; /* remember not to allow any more positional args */ end; /* end control arg */ else if expecting > 0 then do; /* expecting something; pick up value in appropriate way */ if expecting = USER then call get_user (arg_list_ptr); else if expecting = ID then call get_id; else if expecting = ENTRY then do; if abs_args.entry_sw then go to multiple_abs_qualifiers; abs_args.entry_sw = "1"b; abs_args.ename = arg; end; else if expecting = SENDER then do; if abs_args.sender_sw then go to multiple_abs_qualifiers; abs_args.sender_sw = "1"b; abs_args.sender = arg; end; else if expecting = QUEUE then do; if abs_args.queue_sw then go to multiple_abs_qualifiers; abs_args.queue_sw = "1"b; if arg = "fg" | arg = "foreground" then abs_args.queue = -1; else do; temp = arg; /* align arg */ abs_args.queue = cv_dec_check_ (temp, code); if code ^= 0 then do; answer = "Invalid queue number " || arg; goto admin_answers; end; end; end; expecting = 0; end; else if substr (arg, 1, 3) = "abs" then do; if abs_args.absn_sw | abs_args.abs_star_sw then go to multiple_abs_qualifiers; if verify (substr (arg, min (4, length (arg))), DIGITS) = 0 then do; /* absN */ abs_args.absn_sw = "1"b; temp = substr (arg, 4); /* align N */ abs_args.aut_index = cv_dec_check_ (temp, (0)); end; else if arg = "abs*" then /* abs* means all running jobs */ abs_args.abs_star_sw = "1"b; end; else if substr (arg, 1, 1) = ">" then do; /* pathname */ if abs_args.path_sw then go to multiple_abs_qualifiers; abs_args.path_sw = "1"b; call expand_pathname_ (arg, abs_args.dirname, abs_args.ename, code); if code ^= 0 then do; answer = arg; goto admin_err; end; end; else if an > 3 | ctl_arg_given then do; /* if n.o.t.a., and positional args no longer allowed, complain */ full_path_required: /* come here from below if positional arg has wrong format */ answer = "Relative pathnames not allowed: " || arg; goto admin_answers; end; else if verify (arg, "0123456789.") = 0 then /* just digits and dot must be request ID */ call get_id; else if index (CAPITALS, substr (arg, 1, 1)) ^= 0 /* if it begins with capital, could be user name */ | substr (arg, 1, 1) = "*" then /* and * is also legal as user name */ call get_user (arg_list_ptr); else goto full_path_required; /* else assume it's a pathname and reject it */ end; if abs_args.entry_sw | abs_args.path_sw then do; /* check on absin suffix */ i = length (rtrim (abs_args.ename)); if substr (abs_args.ename, max (1, i - 5), 6) ^= ".absin" then /* if suffix missing */ if substr (abs_args.ename, i, 1) ^= "*" then /* avoid screwing up starnames */ if i < 27 then /* or running off the end of the string */ substr (abs_args.ename, i + 1, 6) = ".absin"; /* add the suffix */ end; return; /* ---------- */ get_id: proc; if abs_args.id_sw then go to multiple_abs_qualifiers; abs_args.id_sw = "1"b; abs_args.request_id_string = arg; return; end get_id; /* ---------- */ get_user: proc (arg_list_ptr); dcl arg_list_ptr pointer; if abs_args.user_sw then go to multiple_abs_qualifiers; abs_args.user_sw = "1"b; abs_args.person = before (arg, "."); abs_args.project = before (after (arg, "."), "."); if abs_args.person = "" then abs_args.person = "*"; if abs_args.project = "" then do; /* allow operator to forget dot between person and project */ call cu_$arg_ptr_rel (an + 1, p, lng, code, arg_list_ptr); /* look for project in next arg */ if code = 0 then do; /* if there is a next arg */ if lng <= 9 & (index (CAPITALS, substr (arg, 1, 1)) ^= 0 | arg = "*") then do; /* if it could be proj name */ abs_args.project = arg; /* assume it is */ an = an + 1; /* and move past this arg */ end; end; end; if abs_args.project = " " then abs_args.project = "*"; /* if no project name anywhere, assume * */ return; end get_user; end parse_abs_args; %page; validate_abs_args: proc (absn_ok, user_rqd); /* see if abs args are ok for this abs command */ dcl absn_ok bit (1) aligned; /* 1 of absN arg accepted by this command */ dcl user_rqd bit (1) aligned; /* 1 if user name required by this command */ if unspec (abs_args.arg_switches) = ""b then do; /* if no args were given, complain */ answer = "No job selection arguments given."; goto admin_answers; end; if user_rqd then do; /* if command requires user name */ if ^abs_args.user_sw then do; answer = "User name must be given."; goto admin_answers; end; else if abs_args.person = "*" then do; answer = "User name (not ""*"") must be given."; goto admin_answers; end; end; if ^absn_ok then if abs_args.absn_sw then do; answer = "The absN argument is not valid."; goto admin_answers; end; return; end validate_abs_args; %page; get_pers_proj: proc (arg_list_ptr, a_ix, P_new_arg_index, code); /* *** Accept command arguments "Person.Project" or "Person Project" from the argument list begining at argument a_ix and update set P_new_arg_index to the index the next argument. A number of checks are made unless the brief entry is called. */ dcl P_new_arg_index fixed bin (17) parameter; dcl a_ix fixed bin parameter; dcl arg_list_ptr pointer; dcl code fixed bin (35); /* ^= 0 --> print a usage message */ dcl flag bit (1) aligned; flag = "1"b; go to get_pp_common; get_pers_proj$$brief: entry (arg_list_ptr, a_ix, P_new_arg_index, code); flag = "0"b; get_pp_common: P_new_arg_index = a_ix; /* initialize argument index */ wpers, wproj = ""; call cu_$arg_ptr_rel (P_new_arg_index, p, lng, code, arg_list_ptr); if code ^= 0 then return; if index (arg, ".") ^= 0 then do; wpers = before (arg, "."); wproj = after (arg, "."); if flag then if length (rtrim (wpers)) > 22 then LONG_PERSON: do; call ioa_$rsnnl ("Personid ^a > 22 characters.", answer, (0), wpers); go to admin_answers; end; if wproj = "" then BAD_PP: do; call ioa_$rsnnl ("^a is not a valid Person.Project.", answer, (0), arg); go to admin_answers; end; end; else do; wpers = arg; if flag then if length (rtrim (wpers)) > 22 then go to LONG_PERSON; P_new_arg_index = P_new_arg_index + 1; call cu_$arg_ptr_rel (P_new_arg_index, p, lng, code, arg_list_ptr); if code ^= 0 then go to BAD_PP; /* Read this as bad per.proj rather than missing proj in per proj. */ wproj = arg; end; if length (rtrim (wproj)) > 9 then if flag then do; call ioa_$rsnnl ("Projectid ^a is longer than 9 characters.", answer, (0), wproj); go to admin_answers; end; P_new_arg_index = P_new_arg_index + 1; return; end get_pers_proj; %page; set_non_command_sys_loggers: procedure; sys_log = sys_log_; sys_log$error_log = sys_log_$error_log; return; end set_non_command_sys_loggers; %page; SCHEDULE_ABSENTEE_SHUTDOWN: procedure (); /* *** This procedure schedules an absentee shutdown. */ dcl time fixed bin (71) automatic; /* temporary */ dcl time_str char (48) automatic; /* temporary */ call ipc_$create_ev_chn (abs_stop_chn, (0)); call ipc_$decl_ev_call_chn (abs_stop_chn, admin_$absentee_down, null, SHUTDOWN_PRIO, (0)); time = whotab.nextsd - (abs_shut_interval - abs_shut_offset) * MILLION; call timer_manager_$alarm_wakeup (time, "00"b, abs_stop_chn); time_str = date_time_$format ("date_time", time, "", ""); call sys_log (SL_LOG, "^a: abs: auto abs stop will be at ^a", ME, time_str); return; end SCHEDULE_ABSENTEE_SHUTDOWN; %page; CHECK_FOR_ABSENTEE_SHUTDOWN: procedure (); /* *** This procedure is called to check to see if all absentee processes have logged out in preparation for an absentee shutdown. If they have, we shut down the absentee facility and perform a non-local goto to admin_abs_returns (ugh). */ if ^autbl.abs_stopped then /* we have cancelled the shutdown */ return; if autbl.n_abs_run = 0 then /* check that all absentee processes have logged out */ do; call sys_log (SL_LOG, "^a: abs: All absentee processes have run to completion.", ME); call ipc_$delete_ev_chn (abs_stop_chn, code);/* delete event channel created */ call absentee_user_manager_$term_aum; /* close out absentee facility */ autbl.abs_up = ""b; /* indicate that absentee is down */ call absentee_user_manager_$update_whotab_abs_control (); end; /* if an extra-ordinary amount of time has elapsed since abs stop */ /* and there are still absentee processes, bump them */ else if n_called > abs_shut_interval then do; call sys_log (SL_LOG, "^a: abs: Bumping all remaining absentee processes.", ME); if sys_log = sys_log_ then /* we are NOT a command */ call admin_$abs_not_a_command_ ("bump", "*", "*"); else call admin_$abs ("bump", "*", "*"); call absentee_user_manager_$update_whotab_abs_control (); end; else /* otherwise, check again in 30 seconds */ call timer_manager_$alarm_wakeup (30, "11"b, abs_stop_chn); return; end CHECK_FOR_ABSENTEE_SHUTDOWN; %page; START_ABSENTEE_SHUTDOWN: procedure (); /* *** This procedure is called to start shutting down the absentee facility. */ saved_max_abs_users = autbl.max_abs_users; /* remember in case we must reset */ whotab.max_abs_users, /* set max abs users to -1 in whotab */ autbl.max_abs_users = -1; /* and in absentee user table */ autbl.abs_stopped = "1"b; /* record fact that absentee is being shutdown */ saved_abs_maxu_auto = autbl.abs_maxu_auto; /* remember in case we must reset */ autbl.abs_maxu_auto = ""b; /* tell load_ctl_ not to change abs maxu */ /* *** reuse the event channel for our own internal timer. It will allow us to check every 30 seconds to ensure all processes are logged out before we shut down. */ call ipc_$decl_ev_call_chn (abs_stop_chn, admin_$absentee_off, null (), SHUTDOWN_PRIO, code); /* *** Check to see if all absentee processes are done yet. If not, schedule a check every 30 seconds. */ call CHECK_FOR_ABSENTEE_SHUTDOWN (); return; end START_ABSENTEE_SHUTDOWN; %page; NOTIFY_USERS_OF_SHUTDOWN_TIME_CHANGE: procedure (); /* *** This procedure sends a system_shutdown_scheduled_ IPS signal to all interactive, absentee, and daemon users on the system. */ dcl ute_index fixed bin; dutp = as_data_$dutp; do ute_index = 1 to dutbl.current_size; utep = addr (dutbl.entry (ute_index)); if ute.active > NOW_LOGGED_IN then call hphcs_$ips_wakeup (ute.proc_id, "system_shutdown_scheduled_"); end; autp = as_data_$autp; do ute_index = 1 to autbl.current_size; utep = addr (autbl.entry (ute_index)); if ute.active > NOW_LOGGED_IN then call hphcs_$ips_wakeup (ute.proc_id, "system_shutdown_scheduled_"); end; do ute_index = 1 to anstbl.current_size; utep = addr (anstbl.entry (ute_index)); if ute.active > NOW_LOGGED_IN then call hphcs_$ips_wakeup (ute.proc_id, "system_shutdown_scheduled_"); end; end NOTIFY_USERS_OF_SHUTDOWN_TIME_CHANGE; %page; SCHEDULE_SYSTEM_SHUTDOWN: procedure (P_shutdown_time, P_shutdown_reason, P_down_until_time); /* *** This procedure schedules a system shutdown. */ dcl P_shutdown_time fixed bin (71) parameter; /* when we're shutting down */ dcl P_shutdown_reason char (*) parameter; /* why */ dcl P_down_until_time fixed bin (71) parameter; /* when we'll be back up */ whotab.nextsd = P_shutdown_time; /* publish the shutdown time */ whotab.obsolete_why = substr (P_shutdown_reason, 1, length (whotab.obsolete_why)); whotab.why = P_shutdown_reason; whotab.until = P_down_until_time; call ipc_$create_ev_chn (auto_bump_chn, (0)); call ipc_$decl_ev_call_chn (auto_bump_chn, admin_$timed_stop_command, null, SHUTDOWN_PRIO, (0)); call timer_manager_$alarm_wakeup (whotab.nextsd - installation_parms.warning_time * MILLION, "00"b, auto_bump_chn); goingdown = "1"b; /* indicate that a shutdown has been scheduled */ msg = date_time_$format ("date_time", whotab.nextsd, "", ""); call sys_log (SL_LOG, "^a: down: auto shutdown will be at ^a", ME, msg); if autp ^= null then if autbl.abs_up then do; /* if absentee running */ call SCHEDULE_ABSENTEE_SHUTDOWN (); call absentee_user_manager_$update_whotab_abs_control (); end; /* *** And make sure we tell all the users of the new shutdown time */ call NOTIFY_USERS_OF_SHUTDOWN_TIME_CHANGE (); return; end SCHEDULE_SYSTEM_SHUTDOWN; %page; CANCEL_SYSTEM_SHUTDOWN: procedure (P_message, P_code); /* *** This procedure is called to cancel a system shutdown. It also cancels the absentee shutdown if it has not already been performed. */ dcl P_message char (*) parameter; /* reason why we didn't. */ dcl P_code fixed bin (35) parameter; /* status code */ if whotab.nextsd = 0 then do; /* no shutdown scheduled */ P_message = "no system shutdown scheduled"; P_code = error_table_$action_not_performed; end; else do; /* there is a shutdown scheduled */ call timer_manager_$reset_alarm_wakeup (auto_bump_chn); goingdown = "0"b; /* static flag */ whotab.nextsd = 0; /* change whotab to show no shutdown expected */ whotab.message = ""; whotab.obsolete_message = ""; whotab.until = 0; if autp ^= null () then if autbl.abs_up then /* if absentee running */ do; call timer_manager_$reset_alarm_wakeup (abs_stop_chn); /* cancel automatic abs stop */ if autbl.abs_stopped then call ABORT_ABSENTEE_SHUTDOWN (); end; call NOTIFY_USERS_OF_SHUTDOWN_TIME_CHANGE (); end; return; end CANCEL_SYSTEM_SHUTDOWN; %page; ABORT_ABSENTEE_SHUTDOWN: procedure (); /* *** This procedure is called to cancel an absentee shutdown which has already started. That is, when we have already started waiting for absentees to complete before really shutting the absentee facility down. */ autbl.abs_stopped = "0"b; /* turn off this flag */ autbl.abs_maxu_auto = saved_abs_maxu_auto; /* restore saved values */ autbl.max_abs_users, /* restore saved values */ whotab.max_abs_users = saved_max_abs_users; return; end ABORT_ABSENTEE_SHUTDOWN; %page; SET_LOGIN_WORD: procedure options (variable); arg_list_ptr = cu_$arg_list_ptr (); call validate; /* locate answer table */ call cu_$arg_ptr_rel (1, p, lng, code, arg_list_ptr); /* get the new login word */ if code ^= 0 then do; lng = max (0, anstbl.message_lng - 1); /* set length of message to omit trailing newline */ call sys_log (SL_LOG, "^a: word: ^a; ^a message: ^[^a^;"""" (NO MESSAGE)^]", ME, anstbl.login_word, anstbl.session, (anstbl.message_lng > 1), based_anstbl_message); return; end; if lng > 8 then do; /* check length */ call sys_log (SL_LOG, "^a: word: length of login-word must not exceed 8 characters", ME); return; end; do i = 3 to hbound (as_data_login_words.words, 1) while (arg ^= as_data_login_words.words (i)); end; if i <= hbound (as_data_login_words.words, 1) then do; /* Cannot use special word as login word */ call sys_log (SL_LOG, "^a: word: ^a is a reserved word.", ME, arg); return; end; anstbl.login_word = arg; /* change the login word */ call cu_$arg_ptr_rel (2, p, lng, code, arg_list_ptr); /* ??? */ if code = 0 then do; /* if message given on command line */ call build_string (arg_list_ptr, 2); /* build up message */ if strl > length (anstbl.special_message) then do; strl = length (anstbl.special_message); call sys_log (SL_LOG, "^a: word: message truncated; maximum length is ^d characters", ME, strl); end; anstbl.special_message = substr (string, 1, strl); /* set dialup buffer */ anstbl.message_lng, lng = strl; /* and length */ end; else lng = 0; /* no buffer set */ if anstbl.login_word = as_data_login_words.words (1) then /* "l" */ go to wordl; /* Normal session? */ if anstbl.login_word = as_data_login_words.words (2) then /* "login" */ do; wordl: stopflag = "0"b; /* yes. cancel stop */ anstbl.session, whotab.session = "normal"; /* allow logins to proceed */ if lng = 0 then do; anstbl.message_lng = 0; /* if changed word, reset buffer */ anstbl.special_message = ""; end; end; else do; /* not normal session */ anstbl.session, whotab.session = "special"; /* assume special */ if lng = 0 then do; /* if no message specified */ if anstbl.login_word = "shutdown" then do; /* if shutting down */ call convert_status_code_ (as_error_table_$sys_down_msg, shortinfo, longinfo); if whotab.until = 0 then string = ""; /* if not specified when come up */ else do; /* can say when to try again */ day_back = date_time_$format ("^yc^my^dm", whotab.until, "", ""); day_now = date_time_$format ("^yc^my^dm", clock (), "", ""); if day_back = day_now /* days different? */ then msg = date_time_$format ("time", whotab.until, "", ""); else msg = date_time_$format ("date_time", whotab.until, "", ""); call convert_status_code_ ( as_error_table_$try_again_at_msg, shortinfo, longinfo1); call ioa_$rsnnl (longinfo1, string, i, msg); end; call ioa_$rsnnl (longinfo, anstbl.special_message, i, string); end; else do; /* special session not shutdown */ call convert_status_code_ (as_error_table_$special_sess_msg, shortinfo, longinfo); anstbl.special_message = longinfo; end; /* end special session */ anstbl.message_lng = length (rtrim (anstbl.special_message)); end; end; /* end not normal session */ if anstbl.login_word = "shutdown" then do; anstbl.session, whotab.session = "shutdown"; fb71 = clock (); b12 = substr (unspec (fb71), 34, 12); call ioa_$rsnnl ("^4.3b", c4, (0), b12); anstbl.login_word = c4; end; if anstbl.message_lng > 0 then do; /* if there is a message, print it for operator */ call sys_log (SL_LOG, "^a: word: ^a message: ^a", ME, anstbl.session, substr (anstbl.special_message, 1, anstbl.message_lng)); anstbl.message_lng = min (anstbl.message_lng + 1, length (anstbl.special_message)); substr (anstbl.special_message, anstbl.message_lng, 1) = NL; end; call dialup_$re_introduce; /* say hello again */ /* *** Update the "time of last message update" so that the login servers will notice the change and redisplay the login banner */ anstbl.message_update_time = clock (); return; end SET_LOGIN_WORD; %page; /* format: off */ %page; %include abs_args; %page; %include absentee_user_table; %page; %include answer_table; %page; %include as_data_; %page; %include as_data_definitions_; %page; %include as_wakeup_priorities; %page; %include author_dcl; %page; %include cdt; %page; %include daemon_user_table; %page; %include dialup_values; %page; %include installation_parms; %page; %include sc_stat_; %page; %include sc_subsystem_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: admin_: down: No shutdown is scheduled. S: $as1 T: In response to an operator down command. M: The operator issued a down 0 command to reset a scheduled automatic shutdown when none was in effect. No action was taken on the command. A: $ignore Message: admin_: down: Next shutdown from DATE_TIME to DATE_TIME1 REASON S: $as1 T: Response to an operator "down" command. M: This message tells when the next scheduled shutdown is. A: $ignore Message: admin_: down: resetting previous shutdown at MM/DD/YY HHMM.T S: $as1 T: In response to an operator down command. M: A second down command has been issued before a previously issued down command has been executed. The new shutdown time is honored instead of the previous one. A: $ignore Message: admin_: stop: Automatic shutdown S: $as1 T: $shut M: A down command issued earlier has taken effect. An automatic stop command is executed. All users are bumped in three minutes. A: Prepare to shut down the system. Message: admin_: warn: NAME.PROJ has "no_warning" S: $as1 T: Response to operator warn command. M: This is the response to the command "warn NAME PROJ Message..." if the user has specified the -no_warning argument at login. The message is not sent to the user. A: Attempt to contact the user by other means. Message: admin_: warn: USER.PROJ not connected to a channel S: as (sevreity1) T: Response to operator warn command. M: This is the response to the command "warn NAME PROJ Message" if the pointer to the channel table entry in the user table entry for the named user (ute.cdtep) is not set (null). The message cannot be sent to the user. A: Attempt to contact the user by other means. Message: admin_: warn: NAME.PROJ not found. S: $as1 T: In response to an operator warn command. M: The warn command was issued for a nonexistent user. No action was taken. A: The user is probably not logged in. Check the spelling of the name. $tryagain Message: admin_: log: MESSAGE S: $as0 T: $run M: The log command simply enters its arguments in the system log. It is occasionally used by operators and system programmers to record events. A: $ignore Message: admin_: maxu: (MMMM): UUUU (DDDD normal users) S: $as1 T: When operator entered "maxu" command. M: This is an informative message indicating the current values manipulated by the maxu command. MMMM is the mode, "auto" or "level". UUUU is the load units in tenths. DDDD is the load units in whole numbers. A: $ignore Message: admin_: maxu: Warning: maxunits are in tenths of load units. .brf You just set maxu to UUUU, or DDDD normal users. S: $as1 T: When operator entered a maxu command line that specified < 200 load units or 20 normal users. M: This message is a warning to the operator that he may have made a mistake in setting the load units of the system. A normal system is not likely to set its maximum load units to less than 200. A: Take corrective action (reenter the command with corrected arguments). Message: admin_: shift: N until DATE_TIME S: $as1 T: response to an operator "shift" command. M: The operator has issued the shift command. If issued with no arguments this command types the current setting. If issued with arguments, the command changes the shift and types the new value. A: $ignore Message: admin_: ERROR_MESSAGE SYSDIR>absentee_user_table S: $as1 T: When operator entered abs command. M: The ERROR_MESSAGE gives reason why system was not able to find or access the absentee_user_table in the SYSDIR directory. Execution of the command was not completed. A: %inform Message: admin_: abs: absentee not up, and will not be started automatically S: $as1 T: When operator entered "abs stop" before absentee facility was started. M: The command can be entered at standard to prevent the absentee facility from starting up automatically after a "startup" command is used. A: $ignore Message: admin_: abs: resetting auto abs stop S: $as1 T: In response to an operator abs stop command. M: An abs stop command overrides an automatic abs stop that was set up by a down command. A: $ignore Message: admin_: stop: auto abs stop S: $as1 T: $run M: It is 30 minutes before an automatic stop, so an automatic abs stop command is being issued. This is the result of a previous down command. Refer also to the stop command description. A: $ignore Message: admin_: abs: Zero errors on all absentee queues. S: $as1 T: In response to "abs queue" operator command. M: Informative message which indicates that no queue has been dropped and no errors recorded for any queue. A: $ignore Message: admin_: abs: Queue errors (*=dropped): .brf admin_: abs: FG 0 1 2 3 4 .brf admin_: abs: TT VV WW XX YY ZZ .brf admin_: abs: * * * * * * S: $as1 T: In response to "abs queue" operator command. M: Displays the errors for each queue and indicates which one has been dropped. If none have been dropped, the last line will not be displayed nor will the string "(*=dropped)" appear in the first line. A: $inform Message: admin_: abs: maxu (MMMM): UUUU S: $as1 T: In response to "abs maxu" operator command without arguments. M: Informative message indicating current status of maxu and maximum absentee users allowed. MMMM is the mode, "auto" or "manual". UUUU is the load_units. A: $ignore Message: admin_: abs: maxq (MMMM): Q S: $as1 T: In response to "abs maxq" without arguments. M: Informative message indicating current status of maxq and queue last searched (Q). MMMM is the mode, "auto" or "manual". A: $ignore Message: admin_: abs: qres (MMMM): WW XX YY ZZ S: $as1 T: In response to "abs maxq" without arguments. M: Informative message indicating current status of absentee queue reservation for each queue. MMMM is the mode, "auto" or "manual". A: $ignore Message: admin_: abs: queue limits: WW XX YY ZZ S: $as1 T: In response to "abs qres" operator command. M: Informative message indicating the current queue reservation limits. A: $ignore Message: admin_: abs: cpu_limit (MMMM), queues 1-4: WW XX YY ZZ (seconds) S: $as1 T: In response to "abs cpu_limit" command without arguments. M: Informative message indicating current values of cpu_limit for each absentee queue. MMM is the mode, "auto" or "manual". A: $ignore Message: admin_: abs: Warning: cpu limits are in seconds. You just set queue QQ limit to LLLL seconds. S: $as1 T: In response to "abs cpu_limit" command with arguments. M: The cpu_limit (LLLL) for queue QQ is below 60 seconds which is likely to be a mistake. The value already given will be still be accepted. A: Reenter the command with corrected values if originally incorrect. Message: admin_: ERROR_MESSAGE SYSDIR>answer_table S: $as2 T: In response to operator commands that require access to the system answer_table. M: The ERROR_MESSAGE gives reason why system was not able to find or access the answer_table in the SYSDIR directory. Execution of the command was not completed. A: $inform Message: admin_: ERROR_MESSAGE SYSDIR>whotab S: $as2 T: In response to operator commands that require access to the system whotab. M: The ERROR_MESSAGE gives reason why system was not able to find or access the whotab in the SYSDIR directory. Execution of the command was not completed. A: $inform Message: admin_: ERROR_MESSAGE SYSDIR>installation_parms S: $as2 T: In response to operator commands that require access to the system installation_parms. M: The ERROR_MESSAGE gives reason why system was not able to find or access the installation_parms in the SYSDIR directory. Execution of the command was not completed. A: $inform Message: admin_: ERROR_MESSAGE SYSDIR>cdt S: $as2 T: In response to operator commands that require access to the system cdt. M: The ERROR_MESSAGE gives reason why system was not able to find or access the cdt in the SYSDIR directory. Execution of the command was not completed. A: $inform Message: admin_: stop: All users are out. You may shut down. S: $as1 T: $shut M: This is the response to the stop command if all users have been logged out. This message provides a quick check of whether all users have been bumped since it does not adversely affect system operation to issue the stop command repeatedly. A: Proceed with the shutdown. Message: admin_: stop: There were no active users to be bumped. S: $as1 T: $shut M: The system did not find any active users to be bumped. A: $ignore Message: admin_: stop: all users have been given XXXX minutes to logout S: $as1 T: $shut M: A stop command, either manual or automatic, has been initiated. All users have been warned that they have XXXX minutes to finish up and logout. After XXXX minutes, all users will be bumped except those with the nobump attribute. The login word has been set so that no more users may log in. To cancel this shutdown, issue a word login command and an unbump * * command. A: $ignore Message: admin_: COMMAND: PERSON.PROJECT has "nobump" S: $as1 T: $shut M: The PERSON.PROJECT user cannot be bumped by the automatic shutdown or in response to the stop command. The nobump attribute is normally only used by system administrator users. A: Try to contact the user to arrange a time to actually shutdown. If necessary, the user can be bumped by specifying the channel name in the bump command. This will only work if the process has not been disconnected. Otherwise, you will have to answer "yes" to the shutdown command. Message: admin_: bump: USER.PROJECT bumped. S: $as1 T: In response to the bump command or a system shutdown. M: The specified user has been notified that he or she must get off the system. If a grace time was specified, the user is allowed that amount of time to logout. Otherwise, the user is removed from the system immediately. A: $ignore Message: admin_: abs ABS_FUNCTION: Expected argument missing. After PREV_ARG. S: $as1 T: In response to an operator abs command. M: A required value to a control argument supplied in the "abs" command line is missing. A: Reenter corrected command line. Message: admin_: abs: auto abs stop will be at MM/DD/YY HHMM.T S: $as1 T: In response to an operator down command or at startup. M: This is the response to a down command if the absentee facility is running, or to an abs start command if the absentee is brought up after a down time has been set. The time for an automatic abs stop is 20 minutes before the system is to shut down. An "abs stop now" is done 10 minutes after the scheduled shutdown. Refer also to the stop command description. A: $ignore Message: admin_: abs: All absentee processes have run to completion. S: $as1 T: When shutting down the absentee facility. M: This message is printed after the operator has issued an abs stop command or the system has issued an automatic abs stop prior to shutdown. The system allows 30 minutes for all absentee jobs to finish before logging them out, then prints the message. A: It is now safe to proceed with the shutdown. Message: admin_: abs: Bumping all remaining absentee processes. S: $as1 T: $shut M: The absentee facility waits 30 minutes for all absentee jobs to run to completion after the abs stop command has been issued. Then it types this message and bumps them all. Refer also to the stop command description. A: $ignore Message: admin_: down: auto shutdown will be at MM/DD/YY HHMM.T S: $as1 T: In response to an operator down command or at startup. M: This is the response to the down command. It indicates the scheduled shutdown time. A down command is issued automatically at system startup time after a crash; if a down command was given before the crash occurred, and the time of the scheduled shutdown is more than 30 minutes in the future. A: If the value shown in the message is correct, proceed. If not correct, reset the shutdown by typing down 0 and then try again. Message: admin_: word: XXXX; TYPE message: TEXT S: $as1 T: In response to an operator word command. M: The operator issued the word command with no arguments, and the current values were typed. The login word is XXXX, the message is TEXT, and the type of session is TYPE. The TEXT is displayed as the first line of the greeting banner to interactive users making the banner 3 lines long. If TEXT is "" (NO MESSAGE), then nothing is added to the normal 2 line greeting banner. A: Check the word, type, and message for accuracy. Message: admin_: word: length of login-word must not exceed 8 characters S: $as1 T: In response to an operator word command. M: The operator tried to set the login word with the word command but the first argument was too long. No action was taken on the command. A: $tryagain Message: admin_: word: XXXX is a reserved word. S: $as1 T: In response to an operator word command. M: The operator attempted to set the system login word to enter, enterp, e, ep, dial, or d. No action was taken. A: Pick another word and type it in. Message: admin_: word: message truncated; maximum length is CCCC characters S: $as1 T: In response to an operator word command. M: The operator issued the command "word XXXX TEXT". The message TEXT was too long to fit in the dialup message buffer. The login word has been changed, and the dialup message has been set to the first CCCC characters of the given message. A: Reword the message to fit within the CCCC-character limit, and retype the command. Message: admin_: word: TYPE message: TEXT S: $as1 T: In response to an operator word command. M: The operator issued the command "word XXXX TEXT". The login word was set to XXXX, and a special buffer was loaded with the message TEXT so that it is typed out whenever a user dials up. The type of system session is TYPE; this may be special, normal, or shutdown. A: Check the message for accuracy. Message: admin_: login: Entry not found. No MC ACS segment for the source SSSS. S: $as1 T: In response to operator login command. M: An MC ACS was not found in >sc1>mc_acs directory for the source identifier, SSSS. A: $inform Message: admin_: login: ERROR_TABLE_MESSAGE Login not permitted for message coordinator source SSSS. S: $as1 T: In response to operator login command. M: The error identified by ERROR_TABLE_MESSAGE was encountered attempting to check the access to login the daemon whose source identifier is SSSS. Message: admin_: COMMAND: ERROR_TABLE_MESSAGE S: $as1 T: In response to operator command, COMMAND. M: The ERROR_TABLE_MESSAGE error was encounted when processing the operator command, COMMAND. A: Type "help COMMAND" for details of the command's usage. Message: admin_: abs: ERROR_TABLE_MESSAGE PATHNAME S: $as1 T: In response to the operator abs command. M: The ERROR_TABLE_MESSAGE was encountered when trying to expand the PATHNAME supplied in the operator abs command line. A: $tryagain Message: admin_: login: error: Usage: login Person.Project SOURCE {-control_args} S: $as1 T: In response to operator login command with no arguments. M: Informative message to operator when the login command was entered without arguments. A: Also type "help login" for further details of command line syntax. Message: admin_: logout: error: Usage: logout Person.Project {SOURCE} S: $as1 T: In response to operator logout command when entered without arguments. M: Informative message indicating usage of the logout command. A: Type "help logout" for further details of command usage. Message: admin_: down: error: no system shutdown scheduled S: $as1 T: In response to operator entering, "down 0". M: The "down 0" command line cancels a down but no system shutdown was scheduled. No action was taken. A: $ignore Message: admin_: down: error: XXX invalid clock time. S: $as1 T: In response to an operator down command. M: The time arguments of a down command must be specified in 4-digit time or some form acceptable to convert_date_to_binary_. No action was taken. If the second time argument is an invalid time, it is considered part of the message. This message is also displayed if the first time argument is not in the future. A: $tryagain Message: admin_: down: error: uptime is earlier than downtime. S: $as1 T: In response to an operator down command. M: The operator down command specifies that the expected time that the system will be up is before the time that it is scheduled to be shutdown. No action was taken. A: $tryagain Message: admin_: stop: error: no arguments are allowed for "stop" S: $as1 T: In response to an operator stop command. M: The operator has given an argument to the stop command. No arguments are allowed. No action was taken. A: If abs stop was meant, type that command. If stop was meant, type that command instead. If "down ...." was meant, type in that command. Message: admin_: warn: error: Usage: warn Person.Project MESSAGE S: $as1 T: In response to an operator warn command without any arguments. M: Informative message indicating usage of the warn command. A: Also, type "help warn" for more details on warn command usage. Message: admin_: rcp: error: unknown rcp command RRRR S: $as1 T: In response to an operator rcp command. M: The operator has entered an unknown rcp operator on the command line. A: Type "help rcp" for further details on rcp command usage. Message: admin_: maxunits: error: XXX invalid value for maxunits S: $as1 T: In response to an operator maxunits command. M: The argument of the maxunits command was not a number, or was zero, or negative. No action was taken. A: $tryagain Message: admin_: shift: error: XXXX is not a legal shift number. S: $as1 T: In response to an operator shift command. M: A shift argument to the shift command was not a valid decimal number between 1 and 6 inclusive. A: $tryagain Message: admin_: shift: error: CCCC invalid clock time. S: $as1 T: In response to an operator shift command. M: The time argument of the shift command is not a valid clock time acceptable to convert_date_to_binary_. A: $tryagain Message: admin_: shift: error: CCCC is not within the next week. S: $as1 T: In response to an operator shift command. M: The time argument of the shift command cannot specify a time stamp that is over a week in the future. A: $tryagain Message: admin_: fdump_fnp: error: unknown argument AAAA S: $as1 T: In response to an operator fdump_fnp command. M: An unknown argument, AAAA, was encountered in the fdump_fnp command. This is an obsolete command. No action was taken. A: Type "help dump_mpx" for details of the dump_mpx command and try again. Message: admin_: dump_fnp: error: unknown argument AAAA S: $as1 T: In response to an operator dump_fnp command. M: An unknown argument, AAAA, was encountered in the dump_fnp command line. This is an obsolete command. No action was taken. A: Type "help dump_mpx" for details of the dump_mpx command and try again. Message: admin_: dump_mpx: error: unknown argument AAAA S: $as1 T: In response to an operator dump_mpx command. M: An unknown argument, AAAA, was encountered in the dump_mpx command line. No action was taken. A: Type "help dump_mpx" for details of the dump_mpx command and try again. Message: admin_: load_fnp: unknown argument AAAA S: $as1 T: In response to an operator load_fnp command. M: An unknown argument, AAAA, was encountered in the load_fnp command line. This is an obsolete command. No action was taken. A: Type "help load_mpx" for details of the load_mpx command and try again. Message: admin_: load_mpx: error: unknown argument AAAA S: $as1 T: In response to an operator load_mpx command. M: An unknown argument, AAAA, was encountered in the load_mpx command line. No action was taken. A: Type "help load_mpx" for details of the load_mpx command and try again. Message: admin_: load_mpx: error: unknown argument AAAA S: $as1 T: In response to an operator load_mpx command. M: An unknown argument, AAAA, was encountered in the load_mpx command line. No action was taken. A: Type "help load_mpx" for use of the load_mpx command and try again. Message: admin_: stop_fnp: error: unknown argument AAAA S: $as1 T: In response to an operator stop_mpx command. M: An unknown argument, AAAA, was encountered in the stop_fnp command line. This is an obsolete command. No action was taken. A: Type "help stop_mpx" for details of the stop_mpx command and try again. Message: admin_: stop_mpx: error: unknown argument AAAA S: $as1 T: In response to an operator stop_mpx command. M: An unknown argument, AAAA, was encountered in the stop_mpx command line. No action was taken. A: Type "help stop_mpx" for details of the stop_mpx command and try again. Message: admin_: shutdown_mpx: error: unknown argument AAAA S: $as1 T: In response to an operator shutdown_mpx command. M: An unknown argument, AAAA, was encountered in the shutdown_mpx command line. No action was taken. A: The shutdown_mpx command is the same as the dump_mpx command except that no dump is created. Type "help dump_mpx" for command usage details and try again. Message: admin_: abs: error: unknown absentee command WXYZ S: $as1 T: $response M: The operator typed abs WXYZ where WXYZ was unrecognizable to the system. No action was taken. A: $tryagain Message: admin_: abs: error: The abs CCCC command can not be used before answering service startup. S: $as1 T: In response to an operator abs command. M: Only the "abs stop" command may be given before the answering service starts up. This allows the operator to stop the absentee facility before the system finishes initialzation. A: $tryagain Message: admin_: abs: stop: error: abs stop queue only works after answering service startup S: $as1 T: In response to an operator abs stop queue command. M: The answering service must complete initialization before the "abs stop queue" command can be used. A: Allow the system to complete initialization and try again. Message: admin_: abs: stop: error: missing argument: queue to be stopped S: $as1 T: In response to an operator "abs stop queue" command. M: The "abs stop queue" command was entered without supplying the number of the queue to be stopped. A: $tryagain Message: admin_: abs: stop: error: invalid queue to be stopped: DDDD S: $as1 T: In response to an operator "abs stop queue" command. M: The value of the queue number was not within the values of 1 and 4, inclusive. A: $tryagain Message: admin_: abs: stop: error: unknown argument SSSS S: $as1 T: In response to an operator "abs stop" command. M: An unknown argument, SSSS, was supplied to the "abs stop" command. A: Type "help abs" for details of the abs command and try again. Message: admin_: abs: stop: error: absentee stop in progress S: $as1 T: $response M: An abs start, abs stop, abs maxu, abs maxq, or down command was issued while the absentee facility was in the process of shutting down. A: Wait for the message that all absentee processes have run to completion, then reissue the command. Message: admin_: abs: ABS_FUNCT: error: No job in absentee slot X (status= SSSS). S: $as1 T: $response M: The absentee slot absX has an entry status of SSSS indicating that no user is using it. A: $tryagain Message: admin_: abs: ABS_FUNCT: error: Job in absentee slot X is not from user NAME.PROJ S: $as1 T: $response M: The job running in specified absentee slot of absX is not from specified user, NAME.PROJ. A: Recheck job specifications and try again. Message: admin_: abs: ABS_FUNCT: error: Job in absentee slot X does not match request ID YYYY S: $as1 T: $response M: The ID of the job running in specified absentee slot of absX does not match the specified ID of YYYY. A: Recheck job specifications and try again. Message: admin_: abs: ABS_FUNCT: error: Job in absentee slot X does not match absin path DIR_PATH>ENTRY_NAME S: $as1 T: $response M: The pathname of the absin of the job running in specified absentee slot of absX does not match the specified absin pathname. A: Recheck job specifications and try again. Message: admin_: abs: ABS_FUNCT: error: Job in absentee slot X does not match absin entry name SSSS S: $as1 T: $response M: The entry name SSSS of the absin of the job running in specified absentee slot of absX does not match the specified absin entry name. A: Recheck job specifications and try again. Message: admin_: abs: ABS_FUNCT: error: Job in absentee slot X is not from sender SSSS S: $as1 T: $response M: The sender of the absin of the job running in specified absentee slot of absX does not match the specified sender, SSSS. A: Recheck job specifications and try again. Message: admin_: abs: ABS_FUNCT: error: Job in absentee slot X is not from queue DDDD S: $as1 T: $response M: The queue of the absin of the job running in specified absentee slot of absX does not match the queue number DDDD. A: Recheck job specifications and try again. Message: admin_: abs: release: error: Job in absentee slot X is not suspended. S: $as1 T: $response M: The specified job running in absentee slot of absX is not suspended so a release does not apply. A: Recheck job specifications and try again. Message: admin_: abs: suspend: error: Job in absentee slot X is already suspended. S: $as1 T: $response M: The specified job running in absentee slot of absX is already suspended and cannot be suspended again. A: Recheck job specifications and try again. Message: admin_: abs: release: error: Selection arguments matched no deferred or suspended absentee requests. S: $as1 T: $response M: No suspended or deferred job was found to release with the arguments supplied on the abs release command line. A: Recheck job specifications and try again. Message: admin_: abs: ABS_FUNCT: error: Selection arguments matched no running absentee jobs. S: $as1 T: $response M: No running job was found that matched the selection arguments supplied on the abs command line. A: Recheck job specifications and try again. Message: admin_: abs: start: error: system coming down soon: no abs start S: $as1 T: $response M: The system is shutting down within 30 minutes so the absentee facility will not be started. A: $ignore Message: admin_: abs: start: error: absentee already up S: $as1 T: In response to an operator abs start command. M: abs start was typed twice. No action was taken on the second issuance of the command. A: $ignore Message: admin_: abs: start: error: absentee not up. cannot restart queue X S: $as1 T: $response M: Cannot use the "abs start queue" command until the absentee facility has been started. A: Issue the "abs start" command and try again. Message: admin_: abs: start: error: invalid queue to be restarted X S: $as1 T: $response M: An invalid queue number was specified in an operator "abs start queue" command line. It must be between 1 and 4 inclusive. A: $tryagain Message: admin_: abs: ABS_FUNCT: error: absentee not up S: $as1 T: $response M: An abs command was given, but the absentee facility had never been started up. No action was taken on the command. A: Type abs start to start up the absentee facility. Message: admin_: abs: qres: error: abs qres has invalid value: DDDD S: $as1 T: $response M: An invalid qres argument was detected in an operator "abs qres" command. The argument must be "auto" or a positive decimal number. A: $tryagain Message: admin_: abs: cpu_limit: error: Usage is: "abs cpu_limit l1,l2,l3,l4" (limits in seconds) S: $as1 T: $response M: Informative message that is displayed when an operator "abs cpu_limit" command without arguments is entered. A: $tryagain Message: admin_: abs: list: error: The absN argument cannot be used when absentee is not up. S: $as1 T: $reponse M: Cannot use the "absN" argument to select absentee jobs to list until the absentee facility has been started. A: Use other job selection criteria or type "abs start" and try again. Message: admin_: abs: list: error: No job in absentee slot X. S: $as1 T: $response M: The absentee slot absX does not exist. A: $tryagain Message: admin_: COMMAND: error: No FNP tag specified. S: $as1 T: Response to an operator "load_fnp", "fdump_fnp", "dump_fnp", "start_fnp", or "stop_fnp" command. M: The operator did not supply an FNP identifier. A: $tryagain Message: admin_: COMMAND: error: No multiplexer specified. S: $as1 T: Response to an operator "load_mpx", "dump_mpx", "start_mpx", "shutdown_mpx" or "stop_mpx" command. M: The operator did not supply a multiplexer name. A: $tryagain Message: admin_: COMMAND: error: Invalid FNP tag: X S: $as1 T: Response to an operator "load_fnp", "fdump_fnp", "dump_fnp", "start_fnp", or "stop_fnp" command. M: The supplied FNP tag was more than one character or was not between a-h inclusive. A: $tryagain Message: admin_: abs: maxu: error: abs maxusers must be numeric or "auto": SSSS S: $as1 T: $response M: The argument, SSSS, to the operator "abs maxu" command was not a positive numeric or the string, "auto". The numeric value is in tenths of a load unit. A: $tryagain Message: admin_: abs: maxu: error: abs maxusers may not be negative: SSSS S: $as1 T: $response M: The argument, SSSS, to the operator "abs maxu" command was not a positive numeric or the string, "auto". The numeric value is in tenths of a load unit. A: $tryagain Message: admin_: abs: maxu: error: abs maxusers may not be greater than system maxusers: SSSS S: $as1 T: $response M: The argument, SSSS, to the operator "abs maxu" command cannot be greater than the maximum allowed users that can be on the system. A: $tryagain Message: admin_: abs: maxq: error: abs maxqueue has invalid value: XXX S: $as1 T: $response M: An abs maxq or abs start command had as an argument something that was not a number, or was too big, or was a negative number. No action is taken. A: $tryagain Message: admin_: abs: ABS_FUNCT: error: More than one specification of an attribute is present: SSSS S: $as1 T: $response M: The SSSS attribute has already been specified to select an absentee job on the operator abs command. An attribute can only be used once. A: $tryagain Message: admin_: abs: ABS_FUNCT: error: Invalid abs job selection argument: SSSS S: $as1 T: $response M: The job selection argument SSSS is not recognized as valid. A: Type "help abs" for details of the abs command usage and try again. Message: admin_: abs: ABS_FUNCT: Invalid queue number DDDD S: $as1 T: $response M: The value after the -queue job selection argument is invalid. It must be the strings "fg" or "foreground" or a between the values of 1 and 4, inclusive. A: $tryagain Message: admin_: abs: ABS_FUNCT: error: Relative pathnames not allowed: SSSS S: $as1 T: $response M: The pathname of the absin was expected and it must be an absolute pathname, starting with a ">" character. A: $tryagain Message: admin_: abs: ABS_FUNCT: No job selection arguments given. S: $as1 T: $response M: After processing the arguments on the "abs abs_funct" operator command, no job selection arguments were encountered. A: Type "help abs" for details of the abs command usage and try again. Message: admin_: abs: ABS_FUNCT: error: User name must be given. S: $as1 T: $response M: The "abs ABS_FUNCT" operator command requires that a user name be supplied. A: $tryagain Message: admin_: abs: ABS_FUNCT: error: User name (not ""*"") must be given. S: $as1 T: $response M: The "abs ABS_FUNCT" operator command requires that a user name be supplied. Cannot use "*". A: $tryagain Message: admin_: abs: ABS_FUNCT: error: The absN argument is not valid. S: $as1 T: $response M: The "abs ABS_FUNCT" operator command cannot allow use of the absN argument for job selection. A: $tryagain Message: admin_: abs: ABS_FUNCT: error: Personid NAME > 22 characters. S: $as1 T: $response M: The "abs ABS_FUNCT" operator command specified a user name that is longer than 22 characters. A: $tryagain Message: admin_: abs: ABS_FUNCT: error: SSSS is not a valid Person.Project. S: $as1 T: $response M: The "abs ABS_FUNCT" operator command did not specify a valid Person.Project in the string SSSS. A: $tryagain Message: admin_: abs: ABS_FUNCT: error: Projectid SSSS is longer than 9 characters. S: $as1 T: $response M: The "abs ABS_FUNCT" operator command incorrectly specified a project name that is longer than 9 characters. A: $tryagain END MESSAGE DOCUMENTATION */ end admin_;  as_.alm 11/12/82 1404.2rew 11/12/82 1116.4 18009 " *********************************************************** " * * " * Copyright, (C) Honeywell Information Systems Inc., 1982 * " * * " * Copyright (c) 1972 by Massachusetts Institute of * " * Technology and Honeywell Information Systems, Inc. * " * * " *********************************************************** " " AS_ - answering service transfer vector " " Modified 750430 by PG to add as_$reset " Modified 750519 by PG to delete unused as_$tty_xxx entries " Modified June 1981 by T. Casey to add device_acct_(on off setup) entry points " Modified August 1981 by E. N. Kittlitz to add dump_dont_use_mc as synonym for dump_mc, add set_as_dump_dir. name as_ entry as_init entry dialup_ entry dump entry dump_dont_use_mc entry dump_mc entry set_as_dump_dir entry go entry reset entry shut_ok entry shutdown entry startup entry find_process entry device_acct_on entry device_acct_off entry device_acct_setup entry meter_enter entry meter_exit entry meter_exit_values entry meter_init entry meter_ptr as_init: tra |[as_init] reset: tra |[reset] startup: tra |[startup] go: tra |[go] shut_ok: tra |[check_shut_ok] shutdown: tra |[shutdown] dialup_: tra |[dialup_] dump: tra |[as_dump_] dump_dont_use_mc: tra |[dont_use_mc] dump_mc: tra |[dump_mc] set_as_dump_dir: tra |[set_as_dump_dir] find_process: tra |[find_process] device_acct_on: tra |[on] device_acct_off: tra |[off] device_acct_setup: tra |[setup] meter_enter: tra |[enter] meter_exit: tra |[exit] meter_exit_values: tra |[exit_values] meter_init: tra |[asmt_init] meter_ptr: tra |[asmt_ptr] end  as_access_audit_.pl1 07/20/88 1251.6r w 07/19/88 1536.1 245835 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-07-23,Swenson), approve(86-08-13,MCR7512), audit(86-08-13,EJSharpe), install(86-09-08,MR12.0-1150): Modified to correctly set the grant/deny flag in binary data of audit messages. 2) change(86-09-11,Lippard), approve(85-12-30,MCR7326), audit(86-10-27,GDixon), install(86-10-28,MR12.0-1200): Added entry points abs_command_login and abs_command_cancel. 3) change(87-03-11,GDixon), approve(87-07-13,MCR7737), audit(87-07-27,Brunelle), install(87-08-04,MR12.1-1055): A) Added login and logout entrypoints for Login Server use. B) Correct coding standard violations. C) Updated for change to user_table_entry.incl.pl1. 4) change(87-05-20,GDixon), approve(87-07-13,MCR7737), audit(87-07-27,Brunelle), install(87-08-04,MR12.1-1055): A) Change as_access_audit_$process to accept a negative action code to audit a DENIED operation. 0-action identifies the operation that failed. 5) change(87-06-08,GDixon), approve(87-07-13,MCR7741), audit(87-07-27,Brunelle), install(87-08-04,MR12.1-1055): A) Make $process correctly audit failed LOGIN attempts as being DENIED. B) Restructure all messages to have the same format and content. C) Change calling sequence of $channel entrypoint to accommodate DIALIN, DIALOUT and DIAL SYSTEM, and MNA connections. 6) change(87-06-29,GDixon), approve(87-07-13,MCR7741), audit(87-07-27,Brunelle), install(87-08-04,MR12.1-1055): A) Omit tag from LOGOUT audit message if it hasn't been filled in yet. B) Add tag to process CREATE/CONNECT/etc messages. 7) change(87-07-15,GDixon), approve(87-07-15,MCR7741), audit(87-07-27,Brunelle), install(87-08-04,MR12.1-1055): A) Add AS_AUDIT_PROCESS_TERMINATE action to $process entrypoint. 8) change(87-07-24,Dickson), approve(87-07-24,MCR7722), audit(87-07-27,Brunelle), install(87-08-04,MR12.1-1055): Added three entry points for auditing access checks: dpg_buzzard, as_rqt_nt_pnt_chg, and asr_com_chnl_info_srvr. 9) change(88-03-18,Parisek), approve(88-03-18,MCR7849), audit(88-03-22,Lippard), install(88-07-13,MR12.2-1047): Changed reference of ute.initial_ring to ute.lowest_ring when copying it to the ASIAAR.record.min_ring value. END HISTORY COMMENTS */ /* format: style4,delnl,insnl,^ifthendo,ll79 */ as_access_audit_: procedure (); /**** This program is the auditing module for the Answering Service. All programs which audit security-relevant actions should call this program to audit. An exception to this is lg_ctl_, which due to the way it accumulates the audit information, is difficult to interface to as_access_audit_. */ /**** NOTE Since all of the messages logged by this module are described in AK50, the error message documentation requirement is waived. */ /* Modification History: 85-01-18 E. Swenson: Written. 85-02-07 E. Swenson: Fixed bug which resulted in garbage in channel names. */ /* Parameters */ dcl P_action fixed bin (17) parameter; dcl P_added_info char (*) parameter; dcl P_asrccip pointer parameter; dcl P_asrsp pointer parameter; dcl P_cdtep pointer parameter; dcl P_channel_audit_info_ptr pointer parameter; dcl P_code fixed bin (35) parameter; dcl P_dial_server_info_ptr ptr parameter; dcl P_dial_utep ptr parameter; /* MNA ute for dialed terminal */ dcl P_failed bit (1) aligned parameter; dcl P_name char (*) parameter; dcl P_request_id fixed bin (71) parameter; dcl P_target_process_utep ptr parameter; /* pointer to ute we are trying to conect to */ dcl P_utep pointer parameter; /* Automatic */ dcl 1 ACAR aligned like as_channel_audit_record; dcl 1 ADAR aligned like as_dial_service_audit_record; dcl 1 ARH aligned like audit_record_header automatic; dcl 1 ARHP aligned like audit_record_header_proxy automatic; dcl 1 ASIAAR aligned like as_ia_audit_record_abs_proxy; dcl action fixed bin (17); /* copy of P_action */ dcl added_info char (128); /* additional info for log message */ dcl audit_record_size fixed bin automatic; dcl dial_utep ptr; dcl 1 event_flags aligned like audit_event_flags automatic; dcl grant_sw bit (1) aligned; /* whether the operation was a success or a failure */ dcl mins fixed bin (35) automatic; dcl operation bit (36) aligned automatic; dcl secs fixed bin (35) automatic; dcl proc_type char (4) automatic; dcl request_id fixed bin (71) automatic; dcl severity fixed bin automatic; dcl target_utep ptr; /* Based */ dcl 1 dial_ute aligned like ute based (dial_utep); /* ute for dialed */ /* MNA terminal */ dcl 1 target_ute aligned like ute based (target_utep); /* pointer to process's ute we are trying to connect to. */ /* External Entries */ dcl sys_log_ entry options (variable); dcl sys_log_$binary entry options (variable); dcl sys_log_$error_log entry entry options (variable); /* External Static */ dcl ( access_operations_$abs_command_cancel, access_operations_$abs_command_login, access_operations_$channel_attach, access_operations_$channel_detach, access_operations_$dial_system, access_operations_$dialid_start, access_operations_$dialid_stop, access_operations_$dialin, access_operations_$dialout, access_operations_$process_connect, access_operations_$process_create, access_operations_$process_destroy, access_operations_$process_disconnect, access_operations_$process_terminate, access_operations_$user_login, access_operations_$user_logout ) bit (36) aligned external; dcl error_table_$action_not_performed fixed bin (35) external static; /* Constant */ dcl AS_AUDIT_DATA_CLASS char (16) varying initial ("access_audit") internal static options (constant); dcl ( DENIED initial ("0"b), GRANTED initial ("1"b) ) bit (1) aligned internal static options (constant); dcl ME char (32) initial ("as_access_audit_") internal static options (constant); dcl MILLION fixed bin (35) initial (1000000) internal static options (constant); dcl PROCESS_TYPES (-1:3) char (3) initial ("int", "???", "int", "abs", "dmn") internal static options (constant); dcl QNAME (0:4) char (4) internal static options (constant) initial ("Q FG", "Q 1", "Q 2", "Q 3", "Q 4"); /* Builtin */ dcl (addr, after, before, divide, length, mod, null, reverse, rtrim, string, size, substr, unspec) builtin; %page; /* Program */ process: entry (P_utep, P_action, P_added_info); utep = P_utep; /* get into automatic storage for efficiency */ action = P_action; /* ditto */ if action < 0 then do; /* allow auditing */ grant_sw = DENIED; /* of denials by */ action = -action; /* negative */ end; /* action */ else grant_sw = GRANTED; if (action ^= AS_AUDIT_PROCESS_CREATE & action ^= AS_AUDIT_PROCESS_DESTROY & action ^= AS_AUDIT_PROCESS_CONNECT & action ^= AS_AUDIT_PROCESS_DISCONNECT & action ^= AS_AUDIT_PROCESS_TERMINATE) then do; call sys_log_$error_log (SL_LOG_SILENT, error_table_$action_not_performed, ME, "Invalid action code ^d for as_access_audit_$process entrypoint.", action); return; end; call FILL_IN_ARH (addr (ARH), grant_sw); if action = AS_AUDIT_PROCESS_CREATE then ARH.header.operation_code = access_operations_$process_create; else if action = AS_AUDIT_PROCESS_DESTROY then ARH.header.operation_code = access_operations_$process_destroy; else if action = AS_AUDIT_PROCESS_CONNECT then ARH.header.operation_code = access_operations_$process_connect; else if action = AS_AUDIT_PROCESS_DISCONNECT then ARH.header.operation_code = access_operations_$process_disconnect; else if action = AS_AUDIT_PROCESS_TERMINATE then ARH.header.operation_code = access_operations_$process_terminate; if action = AS_AUDIT_PROCESS_CREATE then do; if ute.logout_type = "new_" | substr (ute.logout_type, 1, 2) = "np" then added_info = "new_proc"; else added_info = "login"; end; else if action = AS_AUDIT_PROCESS_DESTROY then do; added_info = ute.logout_type; if substr (added_info, 1, 2) = "np" | added_info = "new_" then added_info = "new_proc"; else if added_info = "alar" then added_info = "bump"; else if added_info = "dest" then added_info = "destroy"; end; else added_info = P_added_info; call sys_log_$binary (SL_LOG_SILENT, addr (ARH), size (ARH), AS_AUDIT_DATA_CLASS, "^a^[ DENIED^]^20t^[*^]^a.^a.^a ^a ^12.3b ^[(^a)^;^s^]", AS_AUDIT_PROCESS_ACTIONS (action), ^grant_sw, (ute.anonymous = 1), ute.person, ute.project, ute.tag, ute.tty_name, ute.proc_id, (added_info ^= ""), added_info); return; %page; process_connect_denied: entry (P_utep, P_target_process_utep, P_added_info); utep = P_utep; target_utep = P_target_process_utep; added_info = P_added_info; call FILL_IN_ARH (addr (ARH), DENIED); ARH.header.operation_code = access_operations_$process_connect; call sys_log_$binary (SL_LOG_SILENT, addr (ARH), size (ARH), AS_AUDIT_DATA_CLASS, "CONNECT DENIED^20t^[*^]^a.^a ^a to ^[*^]^a.^a.^a ^12.3b (^a)", (ute.anonymous = 1), ute.person, ute.project, ute.tty_name, (target_ute.anonymous = 1), target_utep -> ute.person, target_ute.project, target_ute.tag, target_ute.proc_id, added_info); return; %page; channel: entry (P_cdtep, P_dial_utep, P_utep, P_action, P_channel_audit_info_ptr, P_added_info); cdtep = P_cdtep; dial_utep = P_dial_utep; utep = P_utep; action = P_action; /* action/success fail indicator */ channel_audit_info_ptr = P_channel_audit_info_ptr; added_info = P_added_info; if action < 0 then do; grant_sw = DENIED; /* negative actions are failures */ action = -action; end; else grant_sw = GRANTED; /* positive actions are successes */ if action ^= AS_AUDIT_CHANNEL_ATTACH & action ^= AS_AUDIT_CHANNEL_DETACH & action ^= AS_AUDIT_CHANNEL_DIALIN & action ^= AS_AUDIT_CHANNEL_DIALOUT & action ^= AS_AUDIT_CHANNEL_DIAL_SYSTEM then do; call sys_log_$error_log (SL_LOG, error_table_$action_not_performed, ME, "Invalid action code ^d for as_access_audit_$channel entrypoint.", action); return; end; call FILL_IN_ARH (addr (ACAR.header), grant_sw); if action = AS_AUDIT_CHANNEL_ATTACH then ACAR.header.operation_code = access_operations_$channel_attach; else if action = AS_AUDIT_CHANNEL_DETACH then ACAR.header.operation_code = access_operations_$channel_detach; else if action ^= AS_AUDIT_CHANNEL_DIALIN then ACAR.header.operation_code = access_operations_$dialin; else if action ^= AS_AUDIT_CHANNEL_DIALOUT then ACAR.header.operation_code = access_operations_$dialout; else if action ^= AS_AUDIT_CHANNEL_DIAL_SYSTEM then ACAR.header.operation_code = access_operations_$dial_system; if channel_audit_info.valid.user_validation_level then ACAR.header.subject.ring = channel_audit_info.user_validation_level; else ACAR.header.subject.ring = 0; ACAR.record.type = AAB_channel; ACAR.record.version = AS_AUDIT_RECORD_CHN_VERSION_1; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* This entrypoint may be called by MCS user control (dial_ctl_) or by MNA */ /* ls user control (uc_dial_). */ /* */ /* MCS passes a cdte pointer if there is a channel associated with the */ /* attach, detach, dial, dial system or dial_out request. For dial */ /* requests, if dial -user was given, then the authenticated user's */ /* person.project is stored in the cdte along with the channel attributes. */ /* */ /* MNA passes a dial_ute pointer if there is an authenticated user */ /* associated with the dial, dial system or login -operator request. */ /* */ /* In all cases the ute pointer identifies the process doing the attach, */ /* detach or dial_out; or the target process of a dial, dial system or login */ /* -operator request. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ if cdtep = null () & dial_utep = null () /* No auth user */ then do; ACAR.record.flags.channel_info_valid = "0"b; ACAR.record.flags.current_access_class_valid = channel_audit_info.valid.access_class; ACAR.record.pad1 = ""b; ACAR.record.channel_name = channel_audit_info.channel_name; if channel_audit_info.valid.access_class then ACAR.record.current_access_class = channel_audit_info.access_class; else ACAR.record.current_access_class = ""b; if channel_audit_info.valid.access_class_range then ACAR.record.access_class_range = channel_audit_info.access_class_range; else ACAR.record.access_class_range = ACAR.record.current_access_class; ACAR.record.current_service_type = 0; ACAR.record.service_type = 0; ACAR.record.terminal_type = ""; ACAR.record.authenticated_user.personid = ""; ACAR.record.authenticated_user.projectid = ""; ACAR.record.authenticated_user.pad2 = ""b; end; %page; else if cdtep ^= null () then do; /* attach, detach */ ACAR.record.flags.channel_info_valid = "1"b; /* dial chn known */ ACAR.record.flags.current_access_class_valid = cdte.dialup_flags.current_access_class_valid; ACAR.record.pad1 = ""b; ACAR.record.channel_name = cdte.name; ACAR.record.current_access_class = cdte.current_access_class; ACAR.record.access_class_range = cdte.access_class; ACAR.record.current_service_type = cdte.current_service_type; ACAR.record.service_type = cdte.service_type; ACAR.record.terminal_type = cdte.current_terminal_type; ACAR.record.authenticated_user.personid = cdte.user_name.person; ACAR.record.authenticated_user.projectid = cdte.user_name.project; ACAR.record.authenticated_user.pad2 = ""b; end; else if dial_utep ^= null () then do; /* dial, */ /* login -op */ ACAR.record.flags.channel_info_valid = "1"b; /* auth user info */ ACAR.record.flags.current_access_class_valid = "1"b; ACAR.record.pad1 = ""b; ACAR.record.channel_name = dial_ute.tty_name; if channel_audit_info.valid.access_class then ACAR.record.current_access_class = channel_audit_info.access_class; else ACAR.record.current_access_class = ""b; if channel_audit_info.valid.access_class_range then ACAR.record.access_class_range = channel_audit_info.access_class_range; else ACAR.record.access_class_range = ACAR.record.current_access_class; ACAR.record.current_service_type = 0; ACAR.record.service_type = 0; ACAR.record.terminal_type = dial_ute.terminal_type; ACAR.record.authenticated_user.personid = rtrim(dial_ute.person); ACAR.record.authenticated_user.projectid = rtrim(dial_ute.project); ACAR.record.authenticated_user.pad2 = ""b; end; call sys_log_$binary (SL_LOG_SILENT, addr (ACAR), size (ACAR), AS_AUDIT_DATA_CLASS, "^a^[ DENIED^]^20t^[^a.^a ^;^s^s^]channel ^a ^a ^[*^]^a.^a.^a ^12.3b^[ ^a=^a^;^s^s^]^[ (^a)^]", AS_AUDIT_CHANNEL_ACTIONS (action), ^grant_sw, ACAR.record.authenticated_user.personid ^= "", ACAR.record.authenticated_user.personid, ACAR.record.authenticated_user.projectid, ACAR.record.channel_name, AS_AUDIT_CHANNEL_DIRECTION (action), (ute.anonymous = 1), ute.person, ute.project, ute.tag, ute.proc_id, channel_audit_info.valid.service_info, AS_AUDIT_CHANNEL_SERVICE_INFO (action), channel_audit_info.service_info, (added_info ^= ""), added_info) ; return; %page; dialid: entry (P_utep, P_action, P_dial_server_info_ptr, P_added_info); utep = P_utep; action = P_action; /* action/success fail indicator */ added_info = P_added_info; dial_server_info_ptr = P_dial_server_info_ptr; if action < 0 then do; grant_sw = DENIED; /* negative actions are failures */ action = -action; end; else grant_sw = GRANTED; /* positive actions are successes */ if action ^= AS_AUDIT_DIALID_START & action ^= AS_AUDIT_DIALID_STOP then do; call sys_log_$error_log (SL_LOG_SILENT, error_table_$action_not_performed, ME, "Invalid action code ^d for as_access_audit_$dialid entrypoint.", action); return; end; call FILL_IN_ARH (addr (ADAR.header), grant_sw); if action = AS_AUDIT_DIALID_START then ADAR.header.operation_code = access_operations_$dialid_start; else ADAR.header.operation_code = access_operations_$dialid_stop; ADAR.header.subject.ring = dial_server_info.server_ring; ADAR.record.type = AAB_dial_service; ADAR.record.version = AS_AUDIT_RECORD_DIALID_VERSION_1; ADAR.record.dial_server_ring = dial_server_info.server_ring; ADAR.record.flags.registered_server = dial_server_info.registered; ADAR.record.flags.privileged_server = dial_server_info.privileged; ADAR.record.dial_qualifier = dial_server_info.dial_qualifier; call sys_log_$binary (SL_LOG_SILENT, addr (ADAR), size (ADAR), AS_AUDIT_DATA_CLASS, "DIALID^[ DENIED^]^20t^[start^;stop^] service for ^[*^]^a.^a.^a ^12.3b id=^a^[ (^a)^]", ^grant_sw, (action = AS_AUDIT_DIALID_START), (ute.anonymous = 1), ute.person, ute.project, ute.tag, ute.proc_id, dial_server_info.dial_qualifier, (added_info ^= ""), added_info); return; %page; abs_command_cancel: entry (P_utep, P_asrsp, P_request_id, P_failed); utep = P_utep; as_request_sender_ptr = P_asrsp; request_id = P_request_id; grant_sw = ^P_failed; ARHP.header.type = ARH_TYPE_PROXY; ARHP.header.version = ACCESS_AUDIT_HEADER_VERSION_3; string (ARHP.header.flags) = ""b; ARHP.header.flags.subject_is_process = "1"b; ARHP.header.operation_code = access_operations_$abs_command_cancel; unspec (event_flags) = ""b; event_flags.special_op = "1"b; event_flags.grant = grant_sw; ARHP.header.event_flags = unspec (event_flags); ARHP.header.session_uid = ute.session_uid; /* Binary info for the absentee process for which a cancellation request has been sent. */ ARHP.subjects (1).person = substr (ute.person, 1, length (ARHP.subjects (1).person)); ARHP.subjects (1).project = substr (ute.project, 1, length (ARHP.subjects (1).project)); ARHP.subjects (1).tag = ute.tag; ARHP.subjects (1).ring = ute.initial_ring; ARHP.subjects (1).anonymous = (ute.anonymous = 1); ARHP.subjects (1).pad3 = ""b; ARHP.subjects (1).process_id = ute.proc_id; ARHP.subjects (1).authorization = ute.process_authorization; ARHP.subjects (1).authorization_range (1) = ute.process_authorization_range (1); ARHP.subjects (1).authorization_range (2) = ute.process_authorization_range (2); /* Binary info for the process requesting the cancellation. */ ARHP.subjects (2).person = before (as_request_sender.group_id, "."); ARHP.subjects (2).project = before (after (as_request_sender.group_id, "."), "."); ARHP.subjects (2).tag = after (after (as_request_sender.group_id, "."), "."); ARHP.subjects (2).ring = as_request_sender.validation_level; ARHP.subjects (2).anonymous = (ARHP.subjects (2).person = "anonymous"); ARHP.subjects (2).pad3 = ""b; ARHP.subjects (2).process_id = as_request_sender.process_id; ARHP.subjects (2).authorization = as_request_sender.authorization; ARHP.subjects (2).authorization_range (1) = as_request_sender.authorization; ARHP.subjects (2).authorization_range (2) = as_request_sender.max_authorization; call sys_log_$binary (SL_LOG_SILENT, addr (ARHP), size (ARHP), AS_AUDIT_DATA_CLASS, "ABS CANCEL^[ DENIED^]^20t^[*^]^a.^a.^a ^a ^12.3b (car by ^[*^]^a)", ^grant_sw, (ute.anonymous = 1), ute.person, ute.project, ute.tag, ute.tty_name, ute.proc_id, ARHP.subjects (2).anonymous, as_request_sender.group_id); return; %page; abs_command_login: entry (P_asrsp); as_request_sender_ptr = P_asrsp; operation = access_operations_$abs_command_login; /* make pcref */ /* find where op */ /* being audited */ call sys_log_ (SL_LOG_SILENT, "ABS LOGIN^20trequested by ^a Level=^d", as_request_sender.group_id, as_request_sender.validation_level); return; %page; login: entry (P_utep, P_added_info); utep = P_utep; added_info = P_added_info; grant_sw = (ute.login_result = 0); unspec (ASIAAR) = ""b; call FILL_IN_ARH (addr (ASIAAR.header), grant_sw); ASIAAR.header.operation_code = access_operations_$user_login; if ute.process_type = PT_ABSENTEE then if ute.abs_attributes.proxy then ASIAAR.record.type = AAB_ia_abs_proxy; else ASIAAR.record.type = AAB_ia_abs; else ASIAAR.record.type = AAB_ia_int_dmn; ASIAAR.record.version = AS_AUDIT_RECORD_IA_VERSION_1; ASIAAR.record.process_type = ute.process_type; ASIAAR.record.min_ring = ute.lowest_ring; ASIAAR.record.max_ring = ute.highest_ring; ASIAAR.record.attributes = ute.at; ASIAAR.record.audit_flags = ute.audit; ASIAAR.record.channel = ute.tty_name; ASIAAR.record.terminal_type = ute.terminal_type; ASIAAR.record.answerback = ute.tty_id_code; ASIAAR.absentee_input_path = ute.input_seg; ASIAAR.proxy_user = rtrim (ute.proxy_person) || "." || ute.proxy_project; proc_type = PROCESS_TYPES (ute.process_type); if ute.process_type = PT_ABSENTEE then do; proc_type = QNAME (ute.queue); if ute.abs_attributes.proxy then audit_record_size = size (as_ia_audit_record_abs_proxy); else audit_record_size = size (as_ia_audit_record_abs); end; else audit_record_size = size (as_ia_audit_record_int_dmn); if grant_sw then severity = SL_LOG; else severity = SL_LOG_SILENT; call sys_log_$binary (severity, addr (ASIAAR), audit_record_size, AS_AUDIT_DATA_CLASS, "LOGIN^[ DENIED^]^20t^[*^]^a.^a ^a ^a^[ [^a]^;^s^]^[ (^a)^;^]", ^grant_sw, (ute.anonymous = 1), ute.person, ute.project, proc_type, ute.tty_name, (ute.process_type = PT_ABSENTEE), Abs_Entry_Name (ute.input_seg), (added_info ^= ""), added_info); return; %page; logout: entry (P_utep, P_added_info); utep = P_utep; added_info = P_added_info; secs = divide (ute.cpu_usage, MILLION, 35, 0); mins = divide (secs, 60, 35, 0); secs = mod (secs, 60); proc_type = PROCESS_TYPES (ute.process_type); if ute.process_type = PT_ABSENTEE then proc_type = QNAME (ute.queue); call FILL_IN_ARH (addr (ASIAAR.header), GRANTED); ASIAAR.header.operation_code = access_operations_$user_logout; call sys_log_$binary (SL_LOG, addr (ASIAAR.header), size (audit_record_header), AS_AUDIT_DATA_CLASS, "LOGOUT^20t^[*^]^a.^a^[.^a^;^s^] ^a ^a ^3d:^2d $^.2f (^a)", (ute.anonymous = 1), ute.person, ute.project, (ute.tag ^= ""), ute.tag, proc_type, ute.tty_name, mins, secs, ute.session_cost, added_info); return; %page; FILL_IN_ARH: procedure (P_ahrp, P_grant_sw); dcl P_ahrp pointer parameter; dcl P_grant_sw bit (1) aligned parameter; dcl p pointer automatic; p = P_ahrp; /* get pointer to audit_record_header */ p -> audit_record_header.header.type = ARH_TYPE_NO_PROXY; p -> audit_record_header.header.version = ACCESS_AUDIT_HEADER_VERSION_3; string (p -> audit_record_header.header.flags) = ""b; p -> audit_record_header.header.flags.subject_is_process = "1"b; /* Here, we really should have more information passed to us about whether this is a privileged operation or not. We could set the priv flag if we had this information. */ unspec (event_flags) = ""b; event_flags.special_op = "1"b; event_flags.grant = P_grant_sw; p -> audit_record_header.header.event_flags = unspec (event_flags); p -> audit_record_header.header.session_uid = ute.session_uid; p -> audit_record_header.subject.person = substr (ute.person, 1, length (p -> audit_record_header.subject.person)); p -> audit_record_header.subject.project = substr (ute.project, 1, length (p -> audit_record_header.subject.project)); p -> audit_record_header.subject.tag = ute.tag; p -> audit_record_header.subject.ring = ute.initial_ring; /* updated later */ p -> audit_record_header.subject.anonymous = (ute.anonymous = 1); p -> audit_record_header.subject.pad3 = ""b; p -> audit_record_header.subject.process_id = ute.proc_id; p -> audit_record_header.subject.authorization = ute.process_authorization; p -> audit_record_header.subject.authorization_range = ute.process_authorization_range; return; end FILL_IN_ARH; %page; Abs_Entry_Name: procedure (P_pathname) returns (char (*)); /**** This internal procedure returns the entryname portion of the absentee pathname minus the ".absin" suffix. */ dcl P_pathname char (*) parameter; dcl dirname char (168); dcl entryname char (32); dcl code fixed bin (35); dcl expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); call expand_pathname_ (P_pathname, dirname, entryname, code); if code ^= 0 then return ("-invalid-"); else return (reverse (after (reverse (entryname), "nisba."))); end Abs_Entry_Name; %page; as_rqt_nt_pnt_chg: entry (P_name, P_asrsp, P_code); as_request_sender_ptr = P_asrsp; call sys_log_$error_log (SL_LOG_SILENT, P_code, P_name, "^[GRANTED^;Rejected^] NOTE_PNT_CHANGE request from ^a.^[ Validation level (^d) not Ring-1.^]", (P_code = 0), as_request_sender.group_id, (P_code ^= 0), as_request_sender.validation_level); return; %page; asr_com_chn_info_srvr: entry (P_name, P_asrsp, P_asrccip, P_code); as_request_sender_ptr = P_asrsp; asr_com_channel_info_ptr = P_asrccip; call sys_log_$error_log (SL_LOG, P_code, ME, "^[GRANTED^;DENIED^] com_channel_info request for ^a on channel ^a.", (P_code = 0), as_request_sender.group_id, asr_com_channel_info.channel_name); return; %page; dpg_buzzard: entry (P_name, P_asrsp, P_code); as_request_sender_ptr = P_asrsp; call sys_log_$error_log (SL_LOG_SILENT, P_code, P_name, "^[GRANTED^;DENIED^] process_termination_monitor request by ^a.", (P_code = 0), as_request_sender.group_id); return; /* Includes */ /* format: off */ %page; %include access_audit_binary_def; %page; %include access_audit_bin_header; %page; %include access_audit_eventflags; %page; %include as_audit_structures; %page; %include as_request_header; %page; %include as_request_sender_; %page; %include asr_com_channel_info; %page; %include author_dcl; %page; %include cdt; %page; %include sys_log_constants; %page; %include user_attributes; %page; %include user_table_entry; /* format: on */ end as_access_audit_;  as_add_admin_acl_.pl1 07/13/88 1112.8r w 07/13/88 0941.4 59463 /****^ *********************************************************** * * * 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. END HISTORY COMMENTS */ /* AS_ADD_ADMIN_ACL_ Program to put all system administrators and all project administrators on the ACL of some entry. PG 741121 Modified 750214 (Valentine's Day) by PG to add instance tag to user names. Modified 750813 by PG to watch out for null system administrator names. */ as_add_admin_acl_: procedure (bv_dname, bv_ename, bv_sat_ptr, bv_acl_program, bv_mode, bv_code); /* parameters */ declare (bv_dname char (*), bv_ename char (*), bv_sat_ptr ptr, bv_acl_program variable entry (char (*), char (*), ptr, fixed bin, fixed bin (35)), bv_mode bit (*), bv_code fixed bin (35)) parameter; /* automatic */ declare (satp, satep) ptr, (satx, adminx, aclx, n_dir_acls, n_seg_acls) fixed bin, seg bit (1) aligned, name char (32), code fixed bin (35); /* builtins */ declare (addr, length, reverse, substr, verify) builtin; /* entries */ declare sys_log_$error_log entry options (variable); /* external static */ declare error_table_$argerr fixed bin (35) external static; /* include files */ %include sat; %include user_attributes; /* program */ satp = bv_sat_ptr; n_seg_acls = (4 * satp -> sat.n_projects) + 2; /* maximum number of proj admins + 2 sys admins */ n_dir_acls = 0; seg = "1"b; go to join; as_add_admin_acls_$dir: entry (bv_dname, bv_ename, bv_sat_ptr, bv_acl_program, bv_mode, bv_code); satp = bv_sat_ptr; n_dir_acls = (4 * satp -> sat.n_projects) + 2; n_seg_acls = 0; seg = "0"b; join: begin; /* allocate the acl structure */ declare 1 directory_acls aligned dim (n_dir_acls) automatic, 2 access_name char (32), 2 modes bit (36), 2 status_code fixed bin (35); declare 1 segment_acls aligned dim (n_seg_acls) automatic, 2 access_name char (32), 2 modes bit (36), 2 zero_pad bit (36), 2 status_code fixed bin (35); aclx = 1; do satx = 1 to sat.current_size; /* loop thru all used entries */ satep = addr (sat.project (satx)); /* ptr to project entry */ if project.state = 1 then do; /* in use */ do adminx = 1 to 4 while (project.admin (adminx).userid ^= ""); if seg then do; segment_acls (aclx).access_name = add_tag (project.admin (adminx).userid); segment_acls (aclx).modes = bv_mode; segment_acls (aclx).zero_pad = ""b; segment_acls (aclx).status_code = 0; end; else do; directory_acls (aclx).access_name = add_tag (project.admin (adminx).userid); directory_acls (aclx).modes = bv_mode; directory_acls (aclx).status_code = 0; end; aclx = aclx + 1; end; end; end; do adminx = 1 to 2 while (sat.system_admin (adminx) ^= ""); if seg then do; segment_acls (aclx).access_name = add_tag (sat.system_admin (adminx)); segment_acls (aclx).modes = bv_mode; segment_acls (aclx).zero_pad = ""b; segment_acls (aclx).status_code = 0; end; else do; directory_acls (aclx).access_name = add_tag (sat.system_admin (adminx)); directory_acls (aclx).modes = bv_mode; directory_acls (aclx).status_code = 0; end; aclx = aclx + 1; end; aclx = aclx - 1; /* normalize to number used */ if seg then call bv_acl_program (bv_dname, bv_ename, addr (segment_acls), aclx, code); else call bv_acl_program (bv_dname, bv_ename, addr (directory_acls), aclx, code); if code ^= 0 then do; if code = error_table_$argerr then do; /* oh, damn! */ do adminx = 1 to aclx; if seg then do; code = segment_acls (adminx).status_code; name = segment_acls (adminx).access_name; end; else do; code = directory_acls (adminx).status_code; name = directory_acls (adminx).access_name; end; if code ^= 0 then call sys_log_$error_log (2, code, "as_add_admin_acl_", "Could not add ^a to ACL of ^a>^a", name, bv_dname, bv_ename); end; end; else call sys_log_$error_log (2, code, "as_add_admin_acl_", "Could not add to ACL of ^a>^a", bv_dname, bv_ename); bv_code = code; return; end; end; /* the begin block */ bv_code = 0; /* a-ok */ return; /* Internal procedure to add an instance tag to an administrator name */ add_tag: procedure (bv_access_name) returns (char (32)); /* parameters */ declare bv_access_name char (*); /* automatic */ declare access_name char (32); declare n fixed bin; /* program */ access_name = bv_access_name; /* expand to char (32) */ n = length (access_name) - verify (reverse (access_name), " ") + 1; /* find length of access_name */ substr (access_name, n + 1, 2) = ".*"; /* splat */ return (access_name); end add_tag; /* BEGIN MESSAGE DOCUMENTATION Message: as_add_admin_acl_: ERROR_MESSAGE. Could not add PGID to ACL of PATH. S: as (severity2) T: Answering Service initialization, or while the system is running. M: An error occurred while trying to rebuild the access control list (ACL) on PATH where: ERROR_MESSAGE is an error_table_ message .br PGID is a process group id .br PATH is a full pathname A: Manually give PGID read access (or status permission) to PATH. Message: as_add_admin_acl_: ERROR_MESSAGE. Could not add to ACL of PATH. S: as (severity2) T: Answering Service initialization, or while the system is running. M: Some fatal error occurred while rebuilding the access control list (ACL) of PATH. ERROR_MESSAGE is an error_table_ message and PATH is the full pathname of a segment or a directory. A: $contact The operation that caused the error must be determined and the operation repeated after correction. END MESSAGE DOCUMENTATION */ end as_add_admin_acl_;  as_any_other_handler_.pl1 11/29/84 1039.5r w 11/28/84 1141.1 27927 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ as_any_other_handler_: procedure (P_caller, P_cleanup_proc, P_cleanup_label, P_error_label); /* * AS_ANY_OTHER_HANDLER_ * * This procedure is used to handle unexpected conditions in the * Answering Service. It is designed to be called as follows: * * on condition (any_other) * call as_any_other_handler_ ("name-of-calling-procedure", * cleanup_procedure_for_owning_procedure, * exit_label_for_exit_after_cleanup, * exit_label_for_exit_without_cleanup); * * It was abstracted from syserr_log_man_ in order to keep that * procedure a little simpler. * * Modification history: * 84-10-15, W. Olin Sibert: Moved from syserr_log_man_ */ declare P_caller char (*) parameter; declare P_cleanup_proc entry () parameter; declare P_cleanup_label label parameter; declare P_error_label label parameter; declare code fixed bin (35); declare call_cleanup_procedure bit (1); declare continue_sw bit (1); declare non_local_exit bit (1); declare 1 cond_info aligned like condition_info automatic; declare as_check_condition_ entry (char (*), bit (1), bit (1)); declare as_dump_ entry (char (*)); declare continue_to_signal_ entry (fixed bin (35)); declare find_condition_info_ entry (pointer, pointer, fixed bin (35)); declare sys_log_ entry options (variable); declare sys_log_$error_log entry options (variable); declare WHOAMI char (32) internal static options (constant) init ("as_any_other_handler_"); declare SYS_LOG_TYPE fixed bin internal static options (constant) init (1); declare any_other condition; declare (addr, null) builtin; /* */ call_cleanup_procedure = "1"b; goto HANDLER_COMMON; as_any_other_handler_$no_cleanup: entry (P_caller, P_error_label); call_cleanup_procedure = "0"b; HANDLER_COMMON: on condition (any_other) /* Not a thing that can be done */ goto P_error_label; cond_info.version = condition_info_version_1; call find_condition_info_ (null (), addr (cond_info), code); if (code ^= 0) then do; call sys_log_$error_log (SYS_LOG_TYPE, code, WHOAMI, "Cannot get condition information."); goto P_error_label; end; call as_check_condition_ ((cond_info.condition_name), continue_sw, non_local_exit); if continue_sw then do; /* ONLY way to "return" from this procedure */ call continue_to_signal_ ((0)); return; end; call sys_log_ (SYS_LOG_TYPE, "^a: Condition ^a signalled.", P_caller, cond_info.condition_name); call as_dump_ (P_caller); if ^call_cleanup_procedure then /* None supplied by caller */ goto P_error_label; else if non_local_exit then do; call P_cleanup_proc (); goto P_cleanup_label; end; else goto P_error_label; %page; %include condition_info; end as_any_other_handler_;  as_check_condition_.pl1 08/04/87 1457.4rew 08/04/87 1221.9 20250 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-12-05,Swenson), approve(87-07-13,MCR7741), audit(87-07-24,Brunelle), install(87-08-04,MR12.1-1055): Modified to pass the command_error and command_question conditions. END HISTORY COMMENTS */ /* format: style4 */ as_check_condition_: proc (a_condition, a_continue, a_non_local); /* Answering Service utility to do the right thing by "ucs" handlers. */ /* 82-09-24 wrought by E. N. Kittlitz. */ /* 82-12-02 modified by E. N. Kittlitz. don't continue on command_question, command_error, command_abort_ */ /* 1985-01-02, BIM: added signal_io_ to condition list. */ dcl a_condition char (*); /* condition name */ dcl a_continue bit (1) unaligned; /* set "1"b if caller should pass on condition */ dcl a_non_local bit (1) unaligned; /* set "1"b if this is an unwinder */ dcl i fixed bin; dcl hbound builtin; dcl non_local_names (3) char (20) unaligned static options (constant) init ( "cleanup", "finish", "program_interrupt"); dcl continue_names (12) char (20) unaligned static options (constant) init ( "alrm", "cput", "command_error", "command_question", "endfile", "endpage", "mme2", "quit", "signal_io_", "storage", "sus_", "trm_"); %page; do i = 1 to hbound (non_local_names, 1); if a_condition = non_local_names (i) then do; a_continue = "0"b; /* it's up to you */ a_non_local = "1"b; /* but I'd like to go further */ return; end; end; do i = 1 to hbound (continue_names, 1); if a_condition = continue_names (i) then do; a_continue = "1"b; /* don't bother looking */ a_non_local = "0"b; return; end; end; a_continue, a_non_local = "0"b; return; end as_check_condition_;  as_dump_.pl1 10/28/88 1411.3r w 10/28/88 1302.2 115398 /****^ *********************************************************** * * * 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(87-03-11,GDixon), approve(87-07-13,MCR7741), audit(87-07-24,Brunelle), install(87-08-04,MR12.1-1055): Correct coding standard violations. 3) change(87-05-06,GDixon), approve(87-07-13,MCR7741), audit(87-07-24,Brunelle), install(87-08-04,MR12.1-1055): Disable stringsize checking when assigning input parameter. Caller may have passed a long string. END HISTORY COMMENTS */ /* format: style4 */ as_dump_: proc (dumpid); /* AS_DUMP_ - program to take off line dump of answering service stack. Modified 750210 by PG to try to cleanup after aborted dump. Modified January 1978 by T. Casey to try once more after an aborted dump so we can see why it aborted. Modified August 1981 by E. N. Kittlitz to not use mc until as_init_ says it is ok. Modified May 1982 by E. N. Kittlitz. New AS initialization. Modified Spetember 1982 by E. N. Kittlitz. USE static_dump_dir. Modified 1985-03-06, BIM: call trace_stack_$hregs Modified 1985-03-18, E. Swenson to pass signal_io_ condition. */ /* parameter */ dcl dumpid char (*) parameter; /* anything caller wants to say */ /* Automatic */ dcl abort label; /* escape route */ dcl argl fixed bin (21); dcl argp ptr; dcl datstr char (24); dcl dir char (168); /* where the dump goes */ dcl dir_dumpid char (256) varying; /* dump dir + dumpid for messages */ dcl doing_stack_trace bit (1) aligned init (""b); dcl ec fixed bin (35); dcl error_entry entry variable options (variable); dcl i fixed bin; dcl iocbp ptr; dcl iqct fixed bin; dcl outname char (32); dcl quota fixed bin; dcl sp ptr; dcl taccsw fixed bin (1); dcl trp fixed bin (35); dcl tup bit (36) aligned; dcl ucs_recursion fixed bin initial (0); /* trouble in as_dump_ counter */ dcl use_r0m bit (1) aligned; /* use phcs_ ("1"b)or use the Message Coord ("0"b) */ dcl used fixed bin; /* internal static */ dcl ENOUGH fixed bin int static init (64); dcl STREAM char (32) int static init ("as_dump_stream_"); dcl static_dump_dir char (168) static internal init (""); /* based */ dcl arg char (argl) based (argp); /* entries */ dcl absolute_pathname_ entry (char (*), char (*), fixed bin (35)); dcl com_err_ entry options (variable); dcl condition_ entry (char (*), entry); dcl cu_$arg_count entry (fixed bin, fixed bin (35)); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); dcl cu_$stack_frame_ptr entry (ptr); dcl date_time_ entry (fixed bin (71), char (*)); dcl dprint_ entry (char (*), char (*), ptr, fixed bin (35)); dcl hcs_$quota_get entry (char (*), fixed bin, fixed bin (35), bit (36) aligned, fixed bin, fixed bin (1), fixed bin, fixed bin (35)); dcl ioa_ entry options (variable); dcl ioa_$ioa_switch entry () options (variable); dcl iox_$attach_ptr entry (ptr, char (*), ptr, fixed bin (35)); dcl iox_$close entry (ptr, fixed bin (35)); dcl iox_$detach_iocb entry (ptr, fixed bin (35)); dcl iox_$find_iocb entry (char (*), ptr, fixed bin (35)); dcl iox_$open entry (ptr, fixed bin, bit (1) aligned, fixed bin (35)); dcl pathname_ entry (char (*), char (*)) returns (char (168)); dcl phcs_$ring_0_message entry (char (*)); dcl sys_log_ entry options (variable); dcl sys_log_$error_log entry options (variable); dcl trace_stack_$hregs entry (ptr, fixed bin, fixed bin, char (32) aligned, fixed bin); /* builtins */ dcl (addr, clock, null, rtrim, substr) builtin; /* ====================================================== */ /* When taking an as_dump, we don't want to use portions of the AS of which we are not certain. During initialization, our problems might be due to something in the message coordinator, so we elect to not use the mc. After as_init_ has run, and sc_stat_$Multics is set at the end of initialization, we will avoid the MC only when we are dumping the MC itself (indicated by the user calling the dump_mc entry. */ use_r0m = ^sc_stat_$Multics; /* as as_init_ goes... */ go to common; dont_use_mc: /* use ring_0_message for all console messages */ dump_mc: /* this entry-name retained for compatibility */ entry (dumpid); /* Entry called from message coordr */ use_r0m = "1"b; common: if ^sc_stat_$test_mode then error_entry = phcs_$ring_0_message; else error_entry = ioa_; abort = try_to_cleanup; /* if get error while dumping, try to finish up */ iocbp = null; call condition_ ("any_other", errx); /* No recursion! */ if static_dump_dir ^= "" then dir = static_dump_dir; /* something specific? */ else dir = sc_stat_$sysdir; /* no use default place */ dir_dumpid = rtrim (dir) || " "; /* set-up for messages */ (nostringsize): dir_dumpid = dir_dumpid || dumpid; /* directory name and dump identifier */ call hcs_$quota_get (dir, quota, trp, tup, iqct, taccsw, used, ec); if ec ^= 0 then do; if use_r0m then call error_entry ("as_dump_: Cannot obtain quota, dump aborted. " || dir_dumpid); else call sys_log_$error_log (1, ec, "as_dump_", "Cannot obtain quota, dump aborted. ^a", dir_dumpid); return; end; if quota ^= 0 then /* Make sure there is room for the dump. */ if (quota - used) < ENOUGH then do; if use_r0m then call error_entry ("as_dump_: Out of room for dump " || dir_dumpid); else call sys_log_ (1, "as_dump_: Out of room for dump ^a", dir_dumpid); return; end; call date_time_ (clock (), datstr); outname = "asdump.-." || substr (datstr, 1, 8) || "-" || substr (datstr, 11, 4); call iox_$find_iocb (STREAM, iocbp, ec); if ec ^= 0 then do; attach_fail: if use_r0m then call error_entry ("as_dump_: Cannot attach I/O switch. No dump " || dir_dumpid); else call sys_log_$error_log (1, ec, "as_dump_", "Cannot attach ^a to ^a. No dump ^a", STREAM, outname, dir_dumpid); return; end; call iox_$close (iocbp, (0)); call iox_$detach_iocb (iocbp, (0)); call iox_$attach_ptr (iocbp, "vfile_ " || pathname_ (dir, outname), null (), ec); if ec ^= 0 then go to attach_fail; call iox_$open (iocbp, Stream_output, ""b, ec); if ec ^= 0 then go to attach_fail; call ioa_$ioa_switch (iocbp, "^a ^a^2/", datstr, dumpid); call cu_$stack_frame_ptr (sp); doing_stack_trace = "1"b; call trace_stack_$hregs (sp, 2, -1, (STREAM), 1); doing_stack_trace = ""b; call ioa_$ioa_switch (iocbp, "^/End of dump.^/"); try_to_cleanup: abort = just_return; /* any errors from now on will return and not try to cleanup */ if iocbp ^= null then do; call iox_$close (iocbp, (0)); call iox_$detach_iocb (iocbp, (0)); end; dpap = addr (dprint_arg_buf); /* Set up to print segment. */ dprint_arg.version = 1; dprint_arg.copies = 1; dprint_arg.delete = 0; dprint_arg.queue = 1; dprint_arg.pt_pch = 1; dprint_arg.notify = 0; (nostringsize): dprint_arg.heading = " for asdump " || dumpid; dprint_arg.output_module = 1; dprint_arg.dest = "SysAdmin"; /**** Don't submit a dprint request for ASDUMP when we are debugging the answering service. */ if ^sc_stat_$test_mode then call dprint_ (dir, outname, dpap, ec); /* Request IO daemon to print the dump. */ if use_r0m then call error_entry ("as_dump_: Message coordinator dump created in segment " || outname); else call sys_log_ (1, "as_dump_: Answering service dump created in segment ^a", outname); just_return: return; %page; set_as_dump_dir: entry options (variable); /* establish residence of dumps */ dcl reason char (64); reason = "Usage: as_$set_as_dump_dir "; call cu_$arg_count (i, ec); if i ^= 1 | ec ^= 0 then do; sdd_error: call com_err_ (ec, "as_dump_$set_as_dump_dir", reason); return; end; call cu_$arg_ptr (1, argp, argl, ec); /* must have 1 arg */ if ec ^= 0 then do; /* how could this happen? */ call com_err_ (ec, "as_dump_$set_as_dump_dir", reason); return; end; if arg = "" | arg = "-none" then do; static_dump_dir = ""; /* indicate we should use working dir at time of fault */ return; end; reason = arg; call absolute_pathname_ (arg, dir, ec); /* make sure it's absolute */ if ec ^= 0 then go to sdd_error; /* oh dear */ reason = "getting quota"; /* make sure we can do this much later */ call hcs_$quota_get (dir, quota, trp, tup, iqct, taccsw, used, ec); if ec ^= 0 then go to sdd_error; /* but don't worry about actual quota */ static_dump_dir = dir; /* good enough to remember */ return; %page; errx: proc (mcptr, cname, coptr, infoptr, cont); dcl (mcptr, coptr, infoptr) ptr, cname char (*), cont bit (1); /* automatic */ dcl reason char (64); dcl ucs_sp ptr; dcl try_again bit (1) aligned; /* program */ try_again = doing_stack_trace; /* keep plugging to limit of recursion */ if cname = "cleanup" then return; if cname = "storage" then go to foo; if cname = "command_error" then go to foo; if cname = "stack" then go to foo; if cname = "finish" then go to foo; if cname = "mme2" then go to foo; if cname = "cput" then go to foo; if cname = "alrm" then go to foo; if cname = "program_interrupt" then go to foo; if cname = "signal_io_" then go to foo; if cname = "quit" then do; foo: cont = "1"b; return; end; ucs_recursion = ucs_recursion + 1; if ucs_recursion <= 2 then do; reason = "as_dump_: " || cname || " while dumping. Dump aborted."; if ucs_recursion = 2 then do; /* definitely the last time */ use_r0m = "1"b; /* don't use MC */ try_again = "1"b; /* remember to try */ end; if use_r0m then /* tell SOMEBODY */ call error_entry (reason); else call sys_log_ (1, reason); if try_again then do; /* once more? */ call cu_$stack_frame_ptr (ucs_sp); call trace_stack_$hregs (ucs_sp, 2, -1, (STREAM), 1); end; end; go to abort; end; /* format: off */ %page; %include dprint_arg; %page; %include iox_modes; %page; %include sc_stat_; /* BEGIN MESSAGE DOCUMENTATION Message: as_dump_: Answering service dump created in segment >sc1>asdump.-.MM/DD/YY-HHMM S: as (severity1) T: $run M: Some program has encountered an unexpected fault and has called for a dump of the Answering Service. This segment is automatically dprinted. A: $ignore Message: as_dump_: Message coordinator dump created in segment >sc1>asdump.-.MM/DD/YY-HHMM S: $info T: $run M: Some program has encountered an unexpected fault and has called for a dump of the message coordinator. This segment is automatically dprinted. A: $ignore Message: as_dump_: CONDITION while dumping. Dump aborted S: as (severity1) T: $run M: During the attempt to perform an Answering Service dump, some unexpected fault occurred. The dump is stopped and the system tries to continue. A: Notify the system programming staff. Message: as_dump_: ERROR_MESSAGE. Cannot attach as_dump_stream_ to FILENAME. No dump asdump.MM/DD/YY-HHMM S: as (severity1) T: $run M: The Answering Service dump program could not attach a file for the Answering Service dump. The dump will abort, and the system will continue. A: $inform Message: as_dump_: ERROR_MESSAGE. Cannot obtain quota of >sc1, dump aborted. DUMPID S: as (severity2) T: $run M: An error occurred while dumping. No dump was taken. A: $inform Message: as_dump_: Out of room for dump DUMPID S: as (severity2) T: $run M: An error occurred while dumping. No dump was taken. A: $inform Message: as_dump_: Cannot obtain quota, dump aborted. NAME S: as (severity2) T: $run M: An error occurred while dumping. No dump was taken. A: $inform Message: as_dump_: Cannot attach I/O switch. No dump NAME S: as (severity2) T: $run M: An error occurred while dumping. No dump was taken. A: $inform END MESSAGE DOCUMENTATION */ end;  as_init_.pl1 10/14/90 0953.6rew 10/14/90 0949.6 475794 /****^ *********************************************************** * * * Copyright, (C) BULL HN Information Systems Inc., 1990 * * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ 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-15,Gilcrease), approve(86-05-16,MCR7370), audit(86-06-25,Lippard), install(86-06-30,MR12.0-1082): Update UTE version to 3, for -truncate .absout SCP 6297. 3) change(86-06-29,Swenson), approve(87-07-13,MCR7741), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Modified to zero anstbl.login_server_present upon AS initialization. B) Also added code to allow testing of answering service. 4) change(87-03-10,GDixon), approve(87-07-13,MCR7741), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Also zeroed anstbl.(login_server_process_id login_server_event_channel) upon AS initialization. B) Removed initialization of ls_request_server_ from as_init_, since this facility is not B2 certified and is only needed at sites running DSA. C) Corrected coding errors and standard violations. D) Move initialization of ls_message_buffer back into as_init_. It is needed for act_ctl_ and load_ctl_. E) Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1 5) change(87-05-06,GDixon), approve(87-07-13,MCR7741), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): Don't call mc_quiesce_ when running test Answering Service. 6) change(87-06-22,GDixon), approve(87-07-13,MCR7741), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Correctly set as_data_$rs_ptrs. The do group index wasn't properly used, causing reference through unset variable. 7) change(87-06-28,GDixon), approve(87-07-13,MCR7741), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Correct error message printed for sub_error_ condition by ucs procedure. 8) change(87-07-11,GDixon), approve(87-07-11,MCR7741), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Set as_data_$rtdtp to null after the RTDT is terminated by as_init_. 9) change(87-07-27,GDixon), approve(87-07-27,MCR7741), audit(87-07-30,Brunelle), install(87-08-04,MR12.1-1055): A) Removed call to network_accounting_gate_$test. This is now done in ls_request_server_$init. B) Added descriptions for undoc'd operator messages. C) Convert to sys_log_$general for many calls. 10) change(87-08-28,GDixon), approve(87-08-28,PBF7741), audit(87-08-28,Martinson), install(87-09-01,MR12.1-1095): A) Correct calls to Abort internal proc to ensure that they always pass a ioa_ control string. Otherwise, sys_log_$general reports an error. B) Change $check_shut_ok to check for as_data_$ansp being null. If so, then set return arg to indicate no users are logged in. 11) change(87-09-24,GDixon), approve(88-01-06,MCR7786), audit(88-01-08,Parisek), install(88-01-12,MR12.2-1012): A) Change calls to Abort internal proc to pass a code of -1 rather than 0. Abort calls sys_log_$general which ignores the message in the call when the code is 0. It special-cases code values of -1 by printing the ioa_ control string but excluding expansion of the error table code value. (as 562) B) Call condition_interpreter_ to further describe unexpected conditions occurring during as initialization. (as 394, phx18406) 12) change(90-10-03,WAAnderson), approve(90-10-03,MCR8213), audit(90-10-10,Vu), install(90-10-14,MR12.4-1040): Removed extraneous '^a:' from log message. END HISTORY COMMENTS */ /* format: style4 */ as_init_: proc (a_code); /* Answering Service initization procedure Originally coded by J. F. Ossanna Jan 1969 Recoded by Michael J. Spier and Robert C. Daley February 1969 Revised by Michael D. Schroeder, June 1969 Recoded in PL/1 for new System/User Control by Michael J. Spier, January 1970 revised nov 70 THVV modified for new SAT format by Janice B. Phillipps, March 1972 revised March 73 THVV Modified 750309 by PG to add request dispatcher Modified 750415 by PG to initialize initial_modes_table Modified July 1975 by: WSS, TAC, and LJS, for RCP, Priority Scheduler, and syserr logging, respectively. Modified Aug 75 by THVV for Channel Definition Table Modified April 1976 by T. Casey to be sure to print error messages if initialization fails Modified May 1976 by T. Casey to save and restore shift information in whotab header, . and by P. Green to change initial modes for network lines. Modified 760618 by Roy P. Planalp to attach FTP channels Modified August 1976 by T. Casey to initialize for loading FNPs. Modified November 1976 by T. Casey to fix initialization of stopped FNP. Modified December, 1976, by D. M. Wells to validate ARPANET host number in installation_parms. Modified June, 1977, by Robert S. Coren to remove references to initial_modes_table. Modified August 1977 by T. Casey to call pdir_volume_manager_$init. . and to complete channel deletions requested by CDT installations during last bootload. Modified 03/20/78 by C. D. Tavares for new rcp handling (RTDT). Modified May 1978 by T. Casey to add an argument to the load_ctl_$set_maxunits call. Modified Fall 1978 by Larry Johnson for ring-0 demultiplexing. Modified November 1978 by T. Casey for MR7.0 absentee control parameters and other new installation_parms. Modified April 1979 by T. Casey for Mr7.0a to put back feature to not do automatic abs start in a special session. Modified August 1979 by C. Hornig to only listen to non-MCS channels during initialization and for new PNT. Modified Feb 1980 by M. B. Armstrong to implement multiple rate structures. (UNCA) Modified March 1980 by Tom Casey to implement metering of answering service resource usage. Modified June 1981 by E. N. Kittlitz for UNCA rate-structures Modified June 1981 by T. Casey for MR9.0 to set event wait channel priority highest. Modified August 1981 by E. N. Kittlitz for ucs recursion counter. Modified November 1981, E. N. Kittlitz. user_table_entry conversion. Modified December 1981, E. N. Kittlitz. convert to whotab version 1. Modified December 1981, Benson I. Margulies. CDT tree initialization. Modified February 1982, E. N. Kittlitz to fix ucs recursion counter. Modified April 1982, E. N. Kittlitz. beginnings of new AS initialization strategy. Modified October 1982, E. N. Kittlitz. rename as_request_ to as_request_server_, add mc_quiesce_. Modified January 1982, E. N. Kittlitz. turn_on_mc_ before doing anything else. Modified 83-11-21 BIM. turn quota checking on, having changed pds to start out with quota checking off. Modified 84-04-02 BIM. Remove support for cdte.dim. All channels are MCS. Modified 1984-09-13 BIM. Initialize anstbl.max_users, the answering service's idea of the number of APTE's, from the TCD card. This insures consistency with the hardcore. Modified: 10/02/84 by R. Michael Tague: Changed the as_data_$acsdir from rcp to admin_acs. Modified 84-11-04 by E. A. Ranzenbach for whotab.session... Modified 1984-12, BIM: ssu_ system control and related changed. Modified 1985-01-15 by E. Swenson for anstbl.session_uid_counter. Modified 1985-02-18, BIM: call as_user_message_$system_init. Modified 1985-04-19, E. Swenson to correct any_other handler. */ /* Parameters */ dcl a_code fixed bin (35) parameter; dcl a_n_users fixed bin (35) parameter; /* External Static */ dcl active_all_rings_data$system_id char (8) aligned ext; dcl error_table_$action_not_performed fixed bin (35) ext static; dcl error_table_$no_r_permission fixed bin (35) ext static; dcl error_table_$no_w_permission fixed bin (35) ext static; dcl error_table_$noentry fixed bin (35) ext static; dcl error_table_$unexpected_condition fixed bin (35) ext static; dcl error_table_$unimplemented_version fixed bin (35) ext static; dcl sys_info$max_seg_size fixed bin (35) ext static; /* Entries */ dcl absentee_user_manager_$abs_as_init entry; dcl absentee_user_manager_$term_aum entry; dcl act_ctl_$act_ctl_close entry; dcl act_ctl_$init entry; dcl admin_$down1 entry (fixed bin (71), char (*) aligned, fixed bin (71)); dcl as_dump_$dont_use_mc entry (char (*)); dcl as_meter_$asmt_init entry; dcl as_meter_$enter entry (fixed bin); dcl as_meter_$exit entry (fixed bin); dcl as_request_server_$init entry; dcl asu_$init entry; dcl as_user_message_$priv_system_init entry (fixed bin (35)); dcl cdt_mgr_$thread entry (ptr, fixed bin (35)); dcl condition_ entry (char (*), entry); dcl config_$find entry (character (4) aligned, pointer); dcl cu_$level_set entry (fixed bin (6)); dcl daemon_user_manager_$init entry; dcl device_acct_$init entry; dcl dialup_$init entry; dcl get_group_id_ entry () returns (char (32)); dcl get_group_id_$tag_star entry () returns (char (32)); dcl get_process_id_ entry () returns (bit (36)); dcl get_ring_ entry () returns (fixed bin (3)); dcl get_system_free_area_ entry() returns(ptr); dcl hash_$search entry (ptr, char (*), bit (36) aligned, fixed bin (35)); dcl hc_initlzr_auxl_init_$init entry; dcl hcs_$add_acl_entries entry (char (*), char (*), ptr, fixed bin, fixed bin (35)); dcl hcs_$make_seg entry (char (*), char (*), char (*), fixed bin (5), ptr, fixed bin (35)); dcl hcs_$replace_acl entry (char (*), char (*), ptr, fixed bin, bit (1), fixed bin (35)); dcl hcs_$set_ring_brackets entry (char (*), char (*), (3) fixed bin (3), fixed bin (35)); dcl hcs_$terminate_noname ext entry (pointer, 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 hphcs_$restore_quota entry; dcl ipc_$set_wait_prior entry (fixed bin (35)); dcl initiate_file_ entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35)); dcl ioa_ entry () options (variable); dcl ioa_$rsnnl entry () options (variable); dcl lg_ctl_$init entry (bit (1) aligned); dcl load_ctl_$init entry; dcl load_ctl_$set_maxunits entry (fixed bin); dcl ls_request_server_$shutdown entry (fixed bin (35)); dcl mail_table_priv_$test entry (char (*)); dcl mc_quiesce_ entry; dcl multiplexer_mgr_$init entry (pointer, fixed bin (35)); dcl multiplexer_mgr_$shut entry; dcl multiplexer_mgr_$system_go entry; dcl multiplexer_mgr_$system_init entry (fixed bin (35)); dcl pathname_ entry (char (*), char (*)) returns (char (168)); dcl pdir_volume_manager_$init entry; dcl phcs_$ring_0_message entry (char (*)); dcl pnt_manager_$test entry (char (*)); dcl rcp_sys_$initialize ext entry (1 aligned like rcp_init_flags, fixed bin (35)); dcl reassign_work_classes_ entry (fixed bin (35)); dcl sys_log_ entry options (variable); dcl syserr_log_man_$as_copy_init entry (char (*), fixed bin (9)); dcl syserr_log_man_$as_copy_log entry; dcl timer_manager_$sleep entry (fixed bin (71), bit (2)); dcl turn_on_mc_ entry; dcl up_sat_$make_sat_hash entry (ptr, fixed bin, ptr, char (*), fixed bin (35)); dcl up_sysctl_$init entry; /* builtins */ dcl (addr, bin, bit, clock, divide, fixed, hbound, length, null, rel, rtrim, size, substr) builtin; /* Internal Static */ dcl (next_sd, next_sd_until) fixed bin (71) int static; dcl next_sd_msg char (124) aligned int static; /* Constant */ dcl FALSE bit (1) aligned initial ("0"b) internal static options (constant); dcl ME char (8) int static init ("as_init_") options (constant); dcl MINS_30 fixed bin (71) int static init (1800000000) options (constant); dcl NL char (1) aligned int static init (" ") options (constant); dcl TRUE bit (1) aligned initial ("1"b) internal static options (constant); /* Automatic */ dcl abort_label label automatic; dcl answer char (100); dcl autp ptr automatic; dcl cdt_scan_try_count fixed bin; dcl check fixed bin; dcl code fixed bin (35); dcl debug_flag bit (1) aligned automatic; dcl dutp ptr automatic; dcl error_message_entry entry variable options (variable); dcl i fixed bin; dcl ip ptr automatic; dcl last_sc fixed bin (71); dcl metering_enabled bit (1) aligned automatic; dcl n_acl fixed bin; dcl next_sc fixed bin (71); dcl normal_flag bit (1) aligned; dcl rbkt (3) fixed bin (3); dcl rs_name char (32) automatic; dcl rs_number fixed bin automatic; dcl sat_htp ptr automatic; dcl satp ptr automatic; dcl shift fixed bin; /* to save shift info while truncating whotab */ dcl system_area_ptr ptr automatic; dcl system_control_dir char (168) automatic; dcl ucs_recursion fixed bin init (0); /* level of signal recursion */ dcl x fixed bin; dcl whoptr ptr automatic; dcl 1 acla (5) aligned, /* ACL structure */ 2 userid char (32), 2 mode bit (36), 2 rpad bit (36) init ((5) (36)"0"b), 2 retcd fixed bin (35); dcl 1 our_acl aligned like general_extended_acl_entry automatic; /* Based */ dcl system_area area based (system_area_ptr); /* INCLUDE FILES are at the end, after all the code, but before the message documentation */ as_init: entry (a_code); normal_flag = "0"b; /* Special session */ go to initialize; startup: entry (a_code); normal_flag = "1"b; /* not special session */ initialize: metering_enabled = FALSE; code = 0; abort_label = INIT_RETURN; if sc_stat_$Multics then /* reject re-initialization */ call Abort (error_table_$action_not_performed, "Multics already initialized."); if sc_stat_$test_mode then do; /* are we debugging? */ as_data_$debug_flag = TRUE; debug_flag = TRUE; end; else do; /* not debugging */ as_data_$debug_flag = FALSE; debug_flag = FALSE; end; system_control_dir = sc_stat_$sysdir; /* copy system directory name into internal static */ as_data_$sysdir = system_control_dir; as_data_$pdtdir = rtrim (system_control_dir) || ">pdt"; as_data_$acsdir = rtrim (system_control_dir) || ">admin_acs"; as_data_$rcpdir = rtrim (system_control_dir) || ">rcp"; if ^debug_flag then call condition_ ("any_other", ucs); /* Set up ugh. */ if ^debug_flag then call hphcs_$restore_quota; /* allow record_quota_overflow */ call as_meter_$asmt_init; call as_meter_$enter (ASINIT_METER); metering_enabled = TRUE; /* get the SAT. We need it now to set up the acl structure */ call Initiate_Segment ("sat", satp); as_data_$satp = satp; if sat.version ^= SAT_version then /* SAT must be correct flavor. */ call Abort (error_table_$unimplemented_version, "SAT version inconsistent with declarations used in this program."); rbkt (1) = as_data_$as_ring; /* Set up ring brackets. */ rbkt (2), rbkt (3) = as_data_$max_user_ring; acla.userid (1) = get_group_id_ (); /* Set up useful ACL. */ acla.userid (2) = "*.SysDaemon.*"; /* ... */ n_acl = 3; /* Continue with 3rd acla entry. */ do i = 1 to 2 while (sat.system_admin (i) ^= ""); /* Generate ACL entries for the good guys */ acla.userid (n_acl) = rtrim (sat.system_admin (i)) || ".*"; /* Put administrators on ACL. */ n_acl = n_acl + 1; /* ... */ end; acla.userid (n_acl) = "*.*.*"; /* This ACL provides for everybody. */ do i = 1 to n_acl; /* More setup. */ acla.mode (i) = RW_ACCESS; /* RW for all entries. */ end; acla.mode (2) = R_ACCESS; /* Daemons not to mess up */ acla.mode (n_acl) = N_ACCESS; /* Average user gets no access to system tables. */ call ipc_$set_wait_prior (code); /* Input on operator console has highest priority */ /* See as_wakeup_priorities.incl.pl1 for more information */ if code ^= 0 then call Log_Error (code, "Could not set priority for IPC wait channels."); /* set up the template pit */ call hcs_$make_seg ("", "pit_temp_", "", 01011b, as_data_$pit_ptr, code); /* create pit template segment */ if as_data_$pit_ptr = null then /* what! our own process directory? */ call Abort (code, "Cannot create pit_temp_."); /* get the SAT paraphernalia */ call Create_Segment ("sat.ht", sat_htp); /* by hook or by crook */ if sat_htp -> htable.id ^= "ht01" & sat_htp -> htable.id ^= "ht02" then go to make_sat_hash; /* reasonable? */ call hash_$search (sat_htp, "SysDaemon", (""b), code); /* give it a try */ if code ^= 0 then do; make_sat_hash: call Log_Error (-1, "Rebuilding SAT hash table."); call up_sat_$make_sat_hash (satp, sat.n_projects, sat_htp, answer, code); if code ^= 0 then call Abort (code, "Cannot create ^a>sat.ht. ^a.", system_control_dir, answer); end; as_data_$sat_htp = sat_htp; /* Setup the various user tables */ call Create_Segment ("answer_table", ansp); as_data_$ansp = ansp; call Create_Segment ("absentee_user_table", autp); as_data_$autp = autp; call Create_Segment ("daemon_user_table", dutp); as_data_$dutp = dutp; /* Get installation parameters and rate structures */ call Initiate_Segment ("installation_parms", ip); as_data_$rs_ptrs (0) = ip; if installation_parms.version ^= installation_parms_version_2 then call Abort (error_table_$unimplemented_version, "installation_parms version ^d", installation_parms.version); if installation_parms.nrates < 0 | installation_parms.nrates > hbound (as_data_$rs_ptrs, 1) then call Abort (-1, "installation_parms damaged. ^d rate structures defined; from ^d to ^d are allowed.", installation_parms.nrates, 0, hbound(as_data_$rs_ptrs,1)); do rs_number = 1 to installation_parms.nrates; /* other rates */ call ioa_$rsnnl ("rate_structure_^d", rs_name, (0), rs_number); call Initiate_Segment (rs_name, as_data_$rs_ptrs (rs_number)); end; if installation_parms.chn_wakeup_error_loop_count <= 0 then installation_parms.chn_wakeup_error_loop_count = 10; if installation_parms.chn_wakeup_error_loop_seconds <= 0 then installation_parms.chn_wakeup_error_loop_seconds = 3; /* The resource stuff */ call Initiate_Segment ("rtdt", rtdtp); as_data_$rtdtp = rtdtp; RTDT_area_len = 0; /* avoid PL/1 warning */ if rtdt.installed_under_resource_mgt then if installation_parms.rcp_init_flags.resource_mgmt_enabled = ""b then call Abort (-1, "Resource management is disabled; ^a>rtdt needs it enabled.", system_control_dir); as_data_$rtdtp = null; call hcs_$terminate_noname (rtdtp, 0); /* First shot at the multiplexers */ call multiplexer_mgr_$init (cdtp, code); /* Get cdt ptr */ if code ^= 0 then call Abort (code, "Calling multiplexer_mgr_$init."); as_data_$cdtp = cdtp; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Initialize the who table. This is a public listing of logged-in users */ /* Cannot use Create_Segment for this, since whotab must have nonnull */ /* reference name. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ call hcs_$make_seg (system_control_dir, "whotab", "whotab_", 1010b, whoptr, code); if whoptr = null then call Abort (code, "Could not create ^a>whotab", system_control_dir); our_acl.access_name = get_group_id_$tag_star (); our_acl.mode = RW_ACCESS; our_acl.extended_mode = ""b; our_acl.status_code = 0; call hcs_$add_acl_entries (system_control_dir, "whotab", addr (our_acl), 1, code); if code ^= 0 then call Abort (code, "Could not set RW access on ^a>whotab.", system_control_dir); as_data_$whoptr = whoptr; next_sd = whotab.nextsd; /* Was previous shutdown? */ next_sd_msg = whotab.why; /* .. if so we save it */ next_sd_until = whotab.until; shift = whotab.shift; /* save shift info */ next_sc = whotab.next_shift_change_time; last_sc = whotab.last_shift_change_time; call hcs_$truncate_seg (whoptr, 0, code); /* Clear out all old junk. */ /* truncating whotab is too drastic. change it some time. NOTE: for MR10, a kludge was devised to allow expansion of the whotab header. The header was 64 words long, user entries were 32 words. A number of the early user entries were appropriated, with the understanding the every 32 words from 100o up, there would be a word of 0s, corresponding to the user entry being empty. This allows existing programs to run without recompilation, provided that they honour the entry 'active' flag. If truncation is eliminated, it must be ensured that this contract is kept. Throughout the Answering Service, the value whotab.as_laste is used to indicate the last used whotab index. User programs use whotab.laste, which is the sum of whotab.as_laste and whotab.laste_adjust. */ whotab.version = WHOTAB_VERSION_1; whotab.header_size = fixed (rel (addr (whotab.e (1)))); whotab.entry_size = fixed (rel (addr (whotab.e (2)))) - fixed (rel (addr (whotab.e (1)))); whotab.laste_adjust, whotab.laste = divide (whotab.header_size - fixed (rel (addr (whotab.header_extension_mbz1))), whotab.entry_size, 17, 0); whotab.shift = shift; /* put shift info back */ whotab.next_shift_change_time = next_sc; whotab.last_shift_change_time = last_sc; whotab.n_rate_structures = installation_parms.nrates; /* number of R.S. at AS init */ acla.mode (n_acl) = R_ACCESS; /* whotab is public */ /* Create_Segment resets this back to N_ACCESS */ call hcs_$replace_acl (system_control_dir, "whotab", addr (acla), n_acl, "1"b, code); call hcs_$set_ring_brackets (system_control_dir, "whotab", rbkt, code); /* now initialize various control variables */ anstbl.header_version = ANSTBL_version_4; /* setup version number of dcl */ anstbl.entry_version = UTE_version_4; anstbl.user_table_type = PT_INTERACTIVE; anstbl.header_length = fixed (rel (addr (anstbl.entry (1)))); anstbl.max_size = divide (sys_info$max_seg_size - anstbl.header_length, size (ute), 17, 0); anstbl.number_free, anstbl.first_free, anstbl.current_size, /* Clear number of busy entries. */ anstbl.lock_count, /* Clear update interlock. */ anstbl.nlin, /* Reset number of lines attached. */ anstbl.n_units, /* Clear load on system. */ anstbl.n_users = 0; /* Clear number of users. */ anstbl.update_pending = "1"b; /* make sure to look in update directory */ /**** The following substring is necessary because anstbl.sysdir is only declared char (64). */ anstbl.sysdir = substr (system_control_dir, 1, 64); anstbl.special_message = NL; /* Nothing special in dialup buffer. */ anstbl.message_lng = 0; /* ... */ anstbl.message_update_time = clock (); tcd_cardp = null (); call config_$find (TCD_CARD_WORD, tcd_cardp); if tcd_cardp = null () then do; call Log_Error (-1, "No ""tcd"" card in the config deck. Assuming APT size of 1000."); anstbl.max_users = 1000; end; else anstbl.max_users = tcd_card.no_apt; /* avoid errors from hardcore when we reach APT limit */ anstbl.max_units = sat.max_units; /* ... */ anstbl.n_sessions = anstbl.n_sessions + 1; /* Number of boots. */ anstbl.as_tty = sc_stat_$master_channel; /* Copy in channel ID of initializer. */ as_data_$as_procid, anstbl.as_procid = get_process_id_ (); /* Set up system process ID. */ anstbl.processid_index = bin (substr (bit (bin (clock (), 52), 52), 9, 18), 18); anstbl.session_uid_counter = 0; /* login attempts will increment */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* The following flag, zeroed at answering service initialization time, is */ /* used by dial_ctl_ to determine whether to call uc_cleanup_network_dials_ */ /* or not. The flag is turned on by ls_rq_server_wakeup_ when a login */ /* server request comes in -- indicating that there is indeed at least one */ /* login server and it is potentially necessary to clean up MNA dialed */ /* connections. The process_id and event_channel are cleared here since */ /* they are used by ls_request_server_$init to determine if the */ /* ls_request_server_ mechanism is already on. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ anstbl.login_server_present = FALSE; anstbl.ls_request_server_process_id = ""b; anstbl.ls_request_server_event_channel = 0; if normal_flag then /* Normal startup? */ anstbl.auto_maxu = 1; /* Yes. Turn on config-dependent load setting. */ else do; anstbl.auto_maxu = 0; /* Otherwise leave it off, since this is a special session */ call absentee_user_manager_$term_aum; /* tell absentee not to start automatically */ end; call cu_$level_set ((get_ring_ ())); /* force validation level to current ring */ whotab.sysid = active_all_rings_data$system_id; /* Get supervisor version from system tape. */ whotab.timeup = clock (); /* Set bootload time. */ whotab.mxunits = anstbl.max_units; /* Publish maxunits. */ whotab.mxusers = anstbl.max_users; /* Also max users. */ /* Now let other Answering Service procedures initialize themselves */ call turn_on_mc_; /* turn on the message coordinator */ /* NOTE: we must not use the CDT */ call up_sysctl_$init; /* Allow table updates. */ if ^debug_flag then do; call multiplexer_mgr_$system_init (code); /* Initialize CDT and get FNPs started loading */ if code ^= 0 then call Abort (code, "Calling multiplexer_mgr_$system_init."); end; call dialup_$init; /* Turn on interactive user manager. */ call as_request_server_$init; call device_acct_$init; /* Set up device accounting table. */ if ^debug_flag then do; call as_user_message_$priv_system_init (code); /* Start up message transmission system. */ if code ^= 0 then call Abort (code, "Calling as_user_message_$priv_system_init."); call rcp_sys_$initialize (installation_parms.rcp_init_flags, code); if code ^= 0 then call Abort (code, "Calling rcp_sys_$initialize."); call hc_initlzr_auxl_init_$init; /* MUST COME AFTER CALL TO rcp_sys_$initialize */ end; call lg_ctl_$init (normal_flag); call load_ctl_$init; call asu_$init; call daemon_user_manager_$init; /* must do before act_ctl_$init and after lg_ctl_$init */ call absentee_user_manager_$abs_as_init; /* clear autbl before act_ctl_$init and reassign_work_classes_ */ call act_ctl_$init; /**** This is, logically, a part of load_ctl_init, but it must be done after act_ctl_$init is called, which defines the shift. */ call reassign_work_classes_ (code); /* this is, logically, a part of load_ctl_init */ if code ^= 0 then call Abort (code, "Error while defining initial work classes."); if ^debug_flag then do; call pdir_volume_manager_$init; /**** Initialize copying of syserr log out of ring 0 */ call syserr_log_man_$as_copy_init ("perm_syserr_log", installation_parms.syserr_log_copy_threshold); end; /**** If we are debugging the AS, use a special version of the PNT and MAIL_TABLE. */ if debug_flag then do; call pnt_manager_$test (system_control_dir); call mail_table_priv_$test (system_control_dir); end; call Initialize_Login_Server_Message_Buffer (); call Log_Error (-1, "Multics ^a; Answering Service ^a", whotab.sysid, as_data_$version); /* Not really an */ /* error. */ INIT_RETURN: if metering_enabled then call as_meter_$exit (ASINIT_METER); a_code = 0; return; %page; /* ============================================================= */ go: entry (a_code); ansp = as_data_$ansp; code = 0; debug_flag = as_data_$debug_flag; cdtp = as_data_$cdtp; /* get automatic storage back */ metering_enabled = FALSE; abort_label = GO_RETURN; if sc_stat_$Go then /* called already */ call Abort (error_table_$action_not_performed, "Cannot type go twice."); if ^sc_stat_$Multics then /* multics not called yet */ call Abort (error_table_$action_not_performed, "Type multics first."); if ^debug_flag then call condition_ ("any_other", ucs); /* in case die during init */ call as_meter_$enter (ASINIT_METER); if ^debug_flag then do; call Check_CDT (); call multiplexer_mgr_$system_go; /* in case any FNPs came up before we said "go" */ end; call load_ctl_$set_maxunits (anstbl.shift); /* just returns if auto_maxu is zero */ /**** Should we set up an auto shudtown? */ if next_sd > clock () + MINS_30 then do; /* Should we set up an auto shudtown? */ call admin_$down1 (next_sd, next_sd_msg, next_sd_until); end; if anstbl.update_pending then do; /* kick-off any installs */ whoptr = as_data_$whoptr; call hcs_$wakeup (whotab.installation_request_pid, whotab.installation_request_channel, 0, (0)); end; GO_RETURN: if metering_enabled then call as_meter_$exit (ASINIT_METER); a_code = 0; return; %page; /* ====================================================== */ check_shut_ok: entry (a_n_users); ansp = as_data_$ansp; if ansp = null then a_n_users = 0; else a_n_users = anstbl.n_users; return; %page; /* ====================================================== */ shutdown: entry (); /* Small entry for shutting system down. */ ansp = as_data_$ansp; whoptr = as_data_$whoptr; ip = as_data_$rs_ptrs (0); anstbl.session, whotab.session = "shutdown"; /* No more logins */ whotab.nextsd = 0; /* Prevent restoring */ if installation_parms.syserr_log_copy_threshold ^= -1 then /* If automatic copying enabled... */ call syserr_log_man_$as_copy_log (); /* ...then copy the last few messages out of ring 0 */ call act_ctl_$act_ctl_close; /* All engines stop */ if ^as_data_$debug_flag then call mc_quiesce_; /* wait for messages to finish */ call timer_manager_$sleep (2, "11"b); /* and a bit more for good luck */ if ^as_data_$debug_flag then call multiplexer_mgr_$shut; /* don't listen to them anymore */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Although we didn't start up the ls_request_server_ during initialization, */ /* we will force it to stop running during AS shutdown. It gets started by */ /* the ls_request_server command. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ call ls_request_server_$shutdown (code); if code ^= 0 then call Log_Error (code, "Shutting down the login server request mechanism."); return; %page; Create_Segment: procedure (P_table_name, P_table_ptr); dcl P_table_name char (*) parameter; dcl P_table_ptr ptr parameter; dcl local_code fixed bin (35) automatic; TRY_AGAIN: call initiate_file_ (system_control_dir, P_table_name, RW_ACCESS, P_table_ptr, (0), local_code); if local_code = 0 then return; else if local_code = error_table_$noentry then do; call Log_Error (-1, "^a>^a missing. Creating new one.", system_control_dir, P_table_name); call hcs_$make_seg (system_control_dir, P_table_name, "", 01010b, P_table_ptr, local_code); if P_table_ptr = null () then call Abort (local_code, "Could not create ^a>^a.", system_control_dir, P_table_name); return; end; else if local_code ^= error_table_$no_r_permission & local_code ^= error_table_$no_w_permission then call Abort (local_code, "Could not initiate ^a>^a.", system_control_dir, P_table_name); else do; /* no access */ call Log_Error (local_code, "^a>^a. Forcing access.", system_control_dir, P_table_name); acla.mode (n_acl) = N_ACCESS; /* random user get null access */ call hcs_$replace_acl (system_control_dir, P_table_name, addr (acla), n_acl, "1"b, local_code); if local_code ^= 0 then call Abort (local_code, "Could not force access on ^a>^a.", system_control_dir, P_table_name); else goto TRY_AGAIN; end; return; end Create_Segment; %page; ucs: proc (mcptr, cname, coptr, infoptr, contin); dcl mcptr ptr parameter; dcl cname char (*) parameter; dcl coptr ptr parameter; dcl infoptr ptr parameter; dcl contin bit (1) parameter; dcl cond_info char(cond_info_lng) based (cond_info_ptr); dcl cond_info_lng fixed bin; dcl cond_info_ptr ptr; dcl non_local_exit bit (1); dcl as_check_condition_ entry (char (*), bit (1), bit (1)); dcl condition_interpreter_ entry (ptr, ptr, fixed bin, fixed bin, ptr, char(*), ptr, ptr); dcl cleanup condition; dcl LONG_MODE fixed bin init(3) int static options(constant); call as_check_condition_ (cname, contin, non_local_exit); if contin | non_local_exit then return; code = error_table_$action_not_performed; ucs_recursion = ucs_recursion + 1; /* recursion ok up to here */ if ucs_recursion <= 1 then do; if cname = "sub_error_" then do; sub_error_info_ptr = infoptr; if sub_error_info.default_restart & sub_error_info.quiet_restart then return; code = sub_error_info.status_code; call Log_Error (code, "^[Initialization of ^a failed.^;^a signalled sub_error_; initialization continues.^]^[ ^a^]", ^sub_error_info.default_restart, sub_error_info.name, (length (sub_error_info.info_string) > 0), sub_error_info.info_string); if sub_error_info.default_restart then return; end; else do; call Log_Error (-1, "^a: Condition ^a signalled during startup. Taking AS dump.", ME, cname); system_area_ptr = get_system_free_area_(); cond_info_ptr = null; on cleanup begin; if cond_info_ptr ^= null then free cond_info in (system_area); end; call condition_interpreter_ (addr(system_area), cond_info_ptr, cond_info_lng, LONG_MODE, mcptr, cname, coptr, infoptr); if cond_info_ptr ^= null then do; call Log_Error (-1, "^a", cond_info); free cond_info in (system_area); end; call as_dump_$dont_use_mc ("as_init_: " || cname); end; call Abort (code, ""); end; else do; if ^debug_flag then error_message_entry = phcs_$ring_0_message; else error_message_entry = ioa_; call error_message_entry ("as_init_: Condition was signalled while processing another condition. " || cname); call error_message_entry ("as_init_: Answering Service initialization failed."); call Abort (error_table_$unexpected_condition, ""); end; end ucs; %page; Initialize_Login_Server_Message_Buffer: procedure (); dcl ls_message_buffer_max_lth fixed bin automatic; dcl ls_message_buffer_ptr ptr automatic; dcl ls_message_buffer char (ls_message_buffer_max_lth) based (ls_message_buffer_ptr); /**** Start out with a buffer 512 character-long buffer. */ system_area_ptr = get_system_free_area_(); ls_message_buffer_max_lth, as_data_$ls_message_buffer_max_lth = 512; allocate ls_message_buffer in (system_area) set (ls_message_buffer_ptr); ls_message_buffer = ""; /* clear out buffer */ as_data_$ls_message_buffer_cur_lth = 0; as_data_$ls_message_buffer_ptr = ls_message_buffer_ptr; return; end Initialize_Login_Server_Message_Buffer; %page; Initiate_Segment: procedure (P_table_name, P_table_ptr); dcl P_table_name char (*) parameter; dcl P_table_ptr ptr parameter; call initiate_file_ (system_control_dir, P_table_name, RW_ACCESS, P_table_ptr, (0), code); if code ^= 0 then call Abort (code, "Could not initiate ^a.", pathname_ (system_control_dir, P_table_name)); return; end Initiate_Segment; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: Report errors via sys_log_$general, report that Answering */ /* Service initialization failed, then return to caller of as_init_ */ /* with nonzero error code. */ /* */ /* Syntax: call Abort (code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_code_msg; sl_info.arg_list_ptr = cu_$arg_list_ptr (); sl_info.severity = SL_LOG; sl_info.caller = ME; call sys_log_$general (addr (sl_info)); code = sl_info.code; if code ^= 0 then do; call sys_log_ (SL_LOG_BEEP, "^a: Answering Service initialization failed.", ME); go to abort_label; end; end Abort; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Log_Error: Report errors via sys_log_$general, continue initialization. */ /* */ /* Syntax: call Log_Error (code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Log_Error: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_code_msg; sl_info.arg_list_ptr = cu_$arg_list_ptr (); sl_info.severity = SL_LOG; sl_info.caller = ME; call sys_log_$general (addr (sl_info)); return; end Log_Error; %page; Check_CDT: procedure (); /* Scan the CDT and find all non-MCS channels which should be attached to the Answering Service. All such channels will be top level multiplexers other than FNP's */ cdt_scan_try_count = 0; RETRY_CDT_SCAN: check = 0; do x = cdt.threads.daughter repeat (cdt.cdt_entry (x).next_sister) while (x ^= 0); cdtep = addr (cdt.cdt_entry (x)); check = check + 1; if check > cdt.threads.daughter_count | check > cdt.n_cdtes | cdte.threads.mother ^= 0 then goto CDT_DAMAGE; end; return; %page; CDT_DAMAGE: begin; /* Inconsistency found while chasing cdt threads */ declare sub_error_ condition; declare find_condition_info_ entry (ptr, ptr, fixed bin (35)); declare 1 auto_condition_info aligned like condition_info; if cdt_scan_try_count > 0 then do; call multiplexer_mgr_$shut (); call Abort (error_table_$action_not_performed, "Repeated CDT threading inconsistencies."); end; call Log_Error (-1, "CDT threading inconsistency found. Rethreading."); on sub_error_ begin; call find_condition_info_ (null, addr (auto_condition_info), (0)); sub_error_info_ptr = auto_condition_info.info_ptr; call Log_Error (sub_error_info.status_code, "cdt_mgr_$thread: ^a", sub_error_info.info_string); if ^sub_error_info.default_restart then do; call multiplexer_mgr_$shut; call Abort (sub_error_info.status_code, ""); end; end; call cdt_mgr_$thread (cdtp, (0)); call Log_Error (-1, "CDT rethreading complete."); cdt_scan_try_count = 1; goto RETRY_CDT_SCAN; end; end Check_CDT; /* INCLUDE FILES, IN ALPHABETIC ORDER */ /* format: off */ %page; %include access_mode_values; %page; %include acl_structures; %page; %include answer_table; %page; %include as_data_; %page; %include as_meter_numbers; %page; %include author_dcl; %page; %include cdt; %page; %include condition_info; %include condition_info_header; %page; %include config_tcd_card; %page; %include dialup_values; %page; %include hashst; dcl htp ptr init (null); /* needed by hashst */ %page; %include installation_parms; %page; %include rtdt; %page; %include sat; dcl satep ptr automatic init (null); /* sat incl requires dcl of this pointer. */ %page; %include sc_stat_; %page; %include sub_error_info; %page; %include sys_log_constants; %page; %include user_attributes; %page; %include user_table_entry; %page; %include user_table_header; %page; %include whotab; /* BEGIN MESSAGE DOCUMENTATION Message: as_init_: The requested action was not performed. Multics already initialized. S: $as1 T: $init M: The operator typed startup, multics, or go when Multics was already in operation. No action was taken. A: $ignore Message: as_init_: The requested action was not performed. Cannot type go twice. S: $as1 T: $init M: The operator typed go when Multics was already in operation. No action was taken. A: $ignore Message: as_init_: ERROR_MESSAGE. Cannot create pit_temp_ S: $as1 T: $init M: The system could not create a temporary segment in the Answering Service process's process directory. This is a fatal error that will cause answering service startup to fail. A: $contact_sa Message: as_init_: Resource management is disabled; >sc1>rtdt needs it enabled. S: $as1 T: $init M: The copy of installation_parms encountered by system startup claims that RCP resource management is disabled. This disagrees with information in the RTDT. If startup were to continue, all information in resource registries would be lost. Answering Service initialization fails. The system administrator must use ed_installation_parms from admin mode to repair the damage. Then reboot the system. A: $contact_sa Message: as_init_: SYSTEM_CONTROL_DIR>TABLE missing. Creating new one. S: $as1 T: $init M: A new version of TABLE was created in SYSTEM_CONTROL_DIR as part of system initialization. A: $ignore Message: as_init_: ERROR_MESSAGE. SYSTEM_CONTROL_DIR>TABLE. Forcing access. S: $as1 T: $init M: During system initialization, TABLE in SYSTEM_CONTROL_DIR was found to have an incorrect ACL. Access was set for Initializer.SysDaemon. A: $ignore Message: as_init_: ERROR_MESSAGE. Could not create SYSTEM_CONTROL_DIR>TABLE. S: $as1 T: $init M: The Initializer could not create a new segment TABLE in SYSTEM_CONTROL_DIR. Answering service initialization fails. The system administrator must enter admin mode, and type "create TABLE", where TABLE is the name given above. Then reboot the system. A: $contact_sa Message: as_init_: ERROR_MESSAGE. Could not initiate SYSTEM_CONTROL_DIR>TABLE. S: $as1 T: $init M: The Initializer could not initiate the TABLE segment in SYSTEM_CONTROL_DIR. Answering service initialization fails. The system administrator must enter admin mode, and correct the problem. Then reboot the system. A: $contact_sa Message: as_init_: ERROR_MESSAGE. Could not force access on SYSTEM_CONTROL_DIR>TABLE. S: $as1 T: $init M: The Initializer could not change the ACL on the TABLE segment in SYSTEM_CONTROL_DIR. Answering service initialization fails. The system administrator must enter admin mode, and correct the problem. Then reboot the system. A: $contact_sa Message: as_init_: ERROR_MESSAGE. Could not set RW access on SYSTEM_CONTROL_DIR>TABLE. S: $as1 T: $init M: An error occurred attempting to add ACL entries to TABLE in SYSTEM_CONTROL_DIR. Answering Service initialization fails. The system administrator must enter admin mode and correct the problem. Then reboot the system. A: $contact_sa Message: as_init_: Multics SYSID; Answering Service VERSION S: $as1 T: $init M: Answering Service initialization is complete and users may now log in. The current system version number, from the system tape, is SYSID. The current Answering Service version number is VERSION. A: Proceed with startup. Message: as_init_: ERROR_MESSAGE. Initialization of MODULE failed. {ADDED_INFO.} S: $as1 T: $init M: MODULE was being initialized when it detected a problem. It called sub_err_ to report the error to as_init_. ERROR_MESSAGE gives the text associated with the error code MODULE returned to as_init_. If present, ADDED_INFO gives further details about the problem. Some steps of Answering Service initialization were not performed. This may cause the system to operate incorrectly. A: $contact Message: as_init_: ERROR_MESSAGE. MODULE signalled sub_error_; initialization continues. {ADDED_INFO.} S: $as1 T: $init M: MODULE was being initialized when it detected a problem. It called sub_err_ to report the error to as_init_. ERROR_MESSAGE gives the text associated with the error code MODULE returned to as_init_. If present, ADDED_INFO gives further details about the problem. Initialization of the module continues. A: $contact. Message: as_init_: Condition COND signalled during startup. Taking AS dump. CONDITION_INFO S. $as1 T: $init M: An unexpected condition COND occurred during system initialization. An answering service dump is taken. The stack trace information in this dump further describes the error. Some steps of Answering Service initialization were not performed. This may cause the system to operate incorrectly. CONDITION_INFO if optionally present if further information about the condition is available. A: $contact Message: as_init_: The requested action was not performed. Type multics first. S: $as1 T: $init M: The operator typed go without typing multics. No action was taken. A: Type multics first, or startup. Message: as_init_: ERROR_MESSAGE. Error while defining initial work classes. S: $as1 T: $init M: $err Answering Service initialization fails. The system administrator must enter admin mode and correct the problem. Then reboot the system. A: $contact_sa Message: as_init_: ERROR_MESSAGE. S: $as1 T: $init M: A fatal error occurred during Answering Service initialization. Previous messages describe the error in more detail. A: $contact_sa Message: as_init_: Answering Service initialization failed. S: $as2 T: $init M: $err Answering Service initialization failed. Normally, this message is preceded by a more specific indication of the reason for failure. A: $contact Attempt to correct the problem and try startup again. Message: as_init_: This procedure does not implement the requested version. installation_parms version N. S: $as1 T: $init M: $err The installation_parms segment has been damaged or is not up-to-date. The system administrator must rectify the problem using ed_installation_parms from admin mode, before the Answering Service will initialize. It will be necessary to re-boot Multics to retry Answering Serviceinitialization. A: $contact_sa Message: as_init_: installation_parms damaged. N rate structures defined; from I to J allowed. S: $as1 T: $init M: The installation_parms table claims to declare an unallowed number of rate structures. This indicates that the table has been damaged. The system administrator must rectify the problem using ed_installation_parms from admin mode, before the Answering Service will initialize. It will be necessary to re-boot Multics to retry Answering Service initialization. A: $contact_sa Message: as_init_: Condition was signalled while processing another condition. CONDITION S: $beep T: $init M: $err During Answering Service initialization, a CONDITION was raised while as_init_ was already processing some condition. It may be that the error occured while making an as_dump for the first condition. as_init_ will not attempt to make an as_dump, but will instead abort the initialization. A: $contact Message: as_init_: SAT version inconsistent with declarations used in this program. S: $as1 T: $init M: The version number stored in the SAT does not match the expected version number, which is a constant in the Answering Service programs. This may be because the SAT has been destroyed, or because an incorrect version of the Answering Service programs is being used. $crashes A: $contact_sa The System Administrator must either generate a new SAT, or install the correct version of the Answering Service. If the System Administrator is not available, enter admin mode and attempt to retrieve a recent copy of the SAT. Then exit from admin mode and try startup again. Message: as_init_: rebuilding SAT hash table. S: $as1 T: $init M: The hash table for the SAT was corrupted. The hash table is regenerated. A: $ignore Message: as_init_: ERROR_MESSAGE. Cannot create sat.ht. REASON S: $as1 T: $init M: This message indicates that the sat is damaged or that a storage system error prevented the creation of a new hash table for the sat. Answering Service startup will fail. A: $contact_sa Message: as_init_: No "tcd" card in the config deck. Assuming APT size of 1000. S: $as1 T: $init M: This message indicates that there is no TCD card in the config deck. The system will operate normally, but it is recommended that an explicit TCD card be added at the first convenience. A: $contact_sa Message: as_init_: CDT threading inconsistency found. Rethreading. S: $as1 T: $init M: An error was detected while tracing the threading of Channel Definition Table (CDT) entries into a hierarchy of multiplexer and subchannel entries. $err The entire channel hierarchy will be rethreaded. A: $notify_sa Message: as_init_: CDT rethreading complete. S: $as1 T: $init M: Rethreading of Channel Definition Table (CDT) entries into a multiplexer/subchannel hierarchy completed successfully. System initialization continues. A: $notify_sa Message: as_init_: ERROR_MESSAGE. cdt_mgr_$thread: ADDED_INFO S: $as1 T: $init M: as_init_ called cdt_mgr_$thread to rethread the Channel Definition Table (CDT) entries into a multiplexer/subchannel hierarchy. cdt_mgr_ encountered an unexpected error. ERROR_MESSAGE is the text associated with the error code returned by cdt_mgr_. ADDED_INFO further describes the error and whether or not further rethreading is attempted. A: $notify_sa Message: as_init_: ERROR_MESSAGE. Repeated CDT threading inconsistencies. S: $as1 T: $init M: Channel Definition Table (CDT) entry threads were found to be damaged even after rethreading completed successfully. $err A: $contact_sa Message: as_init_: ERROR_MESSAGE. Could not set priority for IPC wait channels. S: $as1 T: $init M: A call to ipc_$set_wait_prior failed. $err A: $notify_sa Message: as_init_: ERROR_MESSAGE. Calling multiplexer_mgr_$ENTRYPOINT. S: $as1 T: $init M: The multiplexer_mgr_ failed when accessing the Channel Definition Table (CDT) in >sc1, initializing the CDT or loading the FNPs. ERROR_MESSAGE is the text associated with the error code returned by multiplexer_mgr_. Answering service initialization fails. The system administrator must enter admin mode and correct the problem. Then reboot the system. A: $contact_sa Message: as_init_: ERROR_MESSAGE. Calling ROUTINE. S: $as1 T: $init M: An error occurred when calling ROUTINE during Answering Service initialization. ERROR_MESSAGE is the text associated with the error code returned by ROUTINE. Answering service initialization fails. The system administrator must enter admin mode and correct the problem. Then reboot the system. A: $contact_sa Message: as_init_: ERROR_MESSAGE. Shutting down the login server request mechanism. S: $as1 T: $shut M: An error occurred while shutting down the login server request mechanism. The ERROR_MESSAGE gives the text associated with the error code returned from ls_request_server_$shutdown. A: $ignore END MESSAGE DOCUMENTATION */ end as_init_;  as_request_bump_user_.pl1 07/13/88 1112.8r w 07/13/88 0938.4 91287 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-10-14,Lippard), approve(85-12-30,MCR7326), audit(86-10-27,GDixon), install(86-10-28,MR12.0-1200): Use version 2 of as_request_sender. 2) change(87-04-28,GDixon), approve(87-07-13,MCR7741), audit(87-07-27,Brunelle), install(87-08-04,MR12.1-1055): Updated for change to user_table_entry.incl.pl1. END HISTORY COMMENTS */ /* format: ^indcom */ /* DESCRIPTION: This procedure is called by as_request_server_ to request that a process be bumped from the system. Privledge for a user to bump a process is controled by the user's access to the ACS segment: bump_user.acs in as_data_$acsdir. A grace time and a message to be sent to the user's terminal can be specified. All successful and unsuccessful attempts are logged. P_asr_bump_user_info_ptr - points to the asr_bump_user_info structure which contains the process id of the process to be bumped, a message to be printed on the user's terminal, and a grace time. P_as_request_sender_ptr - points to the as_request_sender structure which describes the sender of the bump_user request. */ /* HISTORY: Written by R. Michael Tague, 08/28/84. Modified: 11/02/84 by R. Michael Tague: up_sysctl_$check_acs now returns a bit (36) mode string instead of a fixed bin (5) and no longer takes a directoy arg. 11/20/84 by R. Michael Tague: Added person.project.tag information to several error messages. Fixed omission of code setting in VALIDATE_REQUESTER. Fixed a few comments. */ /* format: style5 */ as_request_bump_user_: procedure (P_asr_bump_user_info_ptr, P_as_request_sender_ptr); /* DECLARATIONS */ /* parameters */ dcl P_asr_bump_user_info_ptr ptr parameter; dcl P_as_request_sender_ptr ptr parameter; /* automatic */ dcl mode bit (36) aligned; dcl code fixed bin (35); dcl type fixed bin; /* builtin functions */ dcl (null, addr) builtin; /* constants */ dcl myname init ("as_request_bump_user_") char (21) internal static options (constant); /* entries */ dcl aim_check_$equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl up_sysctl_$check_acs entry (char (*), char (*), fixed bin, bit (36) aligned, fixed bin (35)); dcl asu_$find_process entry (bit (36) aligned, fixed bin, ptr) ; dcl asu_$bump_user entry (ptr, char (*), fixed bin (35), fixed bin); dcl sys_log_ entry options (variable); dcl sys_log_$error_log entry options (variable); /* external static */ dcl error_table_$ai_restricted fixed bin (35) external static; dcl error_table_$as_bump_user_not_found fixed bin (35) external static; dcl error_table_$as_request_invalid_request fixed bin (35) external static; dcl error_table_$insufficient_access fixed bin (35) external static; /* END OF DECLARATIONS */ /* program */ asr_bump_user_info_ptr = P_asr_bump_user_info_ptr; as_request_sender_ptr = P_as_request_sender_ptr; call VALIDATE_REQUESTER (code); if code = 0 then do; call FIND_REQUESTEE_AND_DO_AIM_CHECK (code); if code = 0 then call REGISTER_FOR_BUMP (code); end; asr_replyp = addr (as_request_sender.reply_message); asr_reply_bump_user.reference_id = asr_bump_user_info.reply_reference_id; asr_reply_bump_user.code = code; return; /* ************************************************************************ * VALIDATE_REQUESTER - This routine checks the requester's access to * * the ACS segment: bump_user.acs in as_data_$acsdir. The requester * * must have read/write access. This routine also checks structure * * versions. * ************************************************************************ */ VALIDATE_REQUESTER: proc (code); dcl code fixed bin (35); if asr_bump_user_info.version = asr_bump_user_info_version_1 & as_request_sender.version = AS_REQUEST_SENDER_VERSION_2 then do; call up_sysctl_$check_acs ("bump_user.acs", as_request_sender.group_id, (as_request_sender.validation_level), mode, code); if code = 0 then if (mode & RW_ACCESS) = RW_ACCESS then ; /* Access is ok */ else do; code = error_table_$insufficient_access; call sys_log_$error_log (SL_LOG_SILENT, code, myname, "Rejected BUMP_USER request from ^a to bump process ^12.3b. Requestor does not have sufficient access to the bump_user.acs segment.", as_request_sender.group_id, asr_bump_user_info.process_id); end; else call sys_log_$error_log (SL_LOG_SILENT, code, myname, "Rejected BUMP_USER request from ^a to bump process ^12.3b. Error calling up_sysctl_$check_acs for requestor.", as_request_sender.group_id, asr_bump_user_info.process_id); end; else do; code = error_table_$as_request_invalid_request; call sys_log_$error_log (SL_LOG_SILENT, code, myname, "Rejected BUMP_USER request from ^a to bump process ^12.3b. Invalid version (^[^a^s^;^s^a^]) in the ^[asr_bump_user_info^;as_request_sender^] structure.", as_request_sender.group_id, asr_bump_user_info.process_id, (asr_bump_user_info.version ^= asr_bump_user_info_version_1), asr_bump_user_info.version, as_request_sender.version, (asr_bump_user_info.version ^= asr_bump_user_info_version_1)); end; end VALIDATE_REQUESTER; /* ************************************************************************* * FIND_REQUESTEE_AND_DO_AIM_CHECK - Find the process to be bumped in * * the user_table and check that the AIM level of the requester and the * * AIM level of the process to be bumped are equal. This AIM check * * prevents a covert channel between the requester and requestee which * * could be quite large given that a message specified by the requester * * is sent to the user to be bumped. * * * * This routine sets the user_table base pointer, utep. * ************************************************************************* */ FIND_REQUESTEE_AND_DO_AIM_CHECK: proc (code); dcl code fixed bin (35); call asu_$find_process (asr_bump_user_info.process_id, type, utep); if utep = null then do; code = error_table_$as_bump_user_not_found; call sys_log_$error_log (SL_LOG_SILENT, code, myname, "Rejected BUMP_USER request from ^a to bump process ^12.3b. Process to be bumped was not found.", as_request_sender.group_id, asr_bump_user_info.process_id); end; else do; if aim_check_$equal (as_request_sender.authorization, ute.process_authorization) then code = 0; else do; code = error_table_$ai_restricted; call sys_log_$error_log (SL_LOG_SILENT, code, myname, "Rejected BUMP_USER request from ^a to bump process ^12.3b (^[*^]^a.^a.^a). Authorization level of requesting process and target process do not match.", as_request_sender.group_id, asr_bump_user_info.process_id, ute.anonymous, ute.person, ute.project, ute.tag); end; end; end FIND_REQUESTEE_AND_DO_AIM_CHECK; /* ************************************************************************* * REGISTER_FOR_BUMP - Call asu_$bump_user to get the process registered * * for a bump to occur at grace time in the future. Logs request. * ************************************************************************* */ REGISTER_FOR_BUMP: proc (code); dcl code fixed bin (35); call asu_$bump_user (utep, asr_bump_user_info.message, code, asr_bump_user_info.grace_time_in_seconds); if code = 0 then call sys_log_ (SL_LOG_SILENT, "^a: BUMPING ^[*^]^a.^a.^a ^12.3b for requestor ^a.", myname, ute.anonymous, ute.person, ute.project, ute.tag, asr_bump_user_info.process_id, as_request_sender.group_id); else call sys_log_$error_log (SL_LOG_SILENT, code, myname, "Rejected BUMP_USER request from ^a to bump process ^12.3b (^[*^]^a.^a.^a). Error from asu_$bump_user.", as_request_sender.group_id, asr_bump_user_info.process_id, ute.anonymous, ute.person, ute.project, ute.tag); end REGISTER_FOR_BUMP; %page; %include access_mode_values; %page; %include as_request_header; %page; %include as_requests; %page; %include as_request_sender_; %page; %include sys_log_constants; %page; %include user_attributes; %page; %include user_table_entry; %page; /* BEGIN MESSAGE DOCUMENTATION Message: as_request_bump_user_: ERROR_MSG. Rejected BUMP_USER request from PERS.PROJ.TAG to bump process PROCESS_ID. REASON S: as (severity 0) T: $run M: The answering service request from PERS.PROJ.TAG to bump the process identified by PROCESSID failed for the given REASON and ERROR_MSG. A: $contact_sa Message: as_request_bump_user_: BUMPING PERS.PROJ.TAG PROCESSID for requestor REQ_PERS.REQ_PROJ.REQ_TAG. S: as (severity 0) T: $run M: An answering service request from REQ_PERS.REQ_PROJ.REQ_TAG to bump the process PERS.PROJ.TAG PROCESSID has been initiated. A: $ignore END MESSAGE DOCUMENTATION */ end as_request_bump_user_;  as_request_note_pnt_change_.pl1 08/29/88 0950.7rew 08/29/88 0858.7 139455 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /* format: off */ as_request_note_pnt_change_: procedure (P_asr_note_pnt_change_info_ptr, P_asr_sender_ptr); /**** This procedure in invoked by as_request_server_ upon receipt of an answering service request of type NOTE_PNT_CHANGE. This request is used by the Ring-1 PNT software to notify the answering service of security relevant changes to the PNT. */ /* Modification History: Written 1985-01-23 by E. Swenson. */ /****^ HISTORY COMMENTS: 1) change(86-10-14,Lippard), approve(85-12-30,MCR7326), audit(86-10-27,GDixon), install(86-10-28,MR12.0-1200): Modified to use version 2 as_request_sender. 2) change(87-04-26,GDixon), approve(87-07-13,MCR7741), audit(87-07-27,Brunelle), install(87-08-04,MR12.1-1055): Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1 3) change(87-07-24,Dickson), approve(87-07-24,MCR7722), audit(87-07-27,Brunelle), install(87-08-04,MR12.1-1055): Changed the VALIDATE_REQUEST procedure to audit grants as well as failures. 4) change(87-12-03,GDixon), approve(88-08-15,MCR7969), audit(88-08-03,Lippard), install(88-08-29,MR12.2-1093): A) Modify UPDATE_UTE_AND_MAYBE_BUMP_USER to bump the user if his password is time-locked. A prior modification had bumped the user if his password was locked, but time-locking was overlooked. See aref of ii.forum [782] for details. A TR may be entered on this subject. This change deserves and SRB NOTICE. B) Modify BUMP_USER to honor the ute.at.nobump attribute for all bump attempted except deletion of the user's PNT entry. For password locking and authorization range changes, users with nobump should not be bumped immediately. Reason: such users are usually System Administrators attempting to thwart breakin attempts on their personid, or to adjust their own auth ranges; they should not be bumped in such cases. END HISTORY COMMENTS */ /* Parameters */ dcl P_asr_note_pnt_change_info_ptr ptr parameter; dcl P_asr_sender_ptr ptr parameter; /* Automatic */ dcl code fixed bin (35); /* status code */ dcl person_id char (32); /* person_id we are processing */ /* Entries */ dcl aim_check_$in_range entry (bit (72) aligned, (2) bit (72) aligned) returns (bit (1) aligned); dcl as_access_audit_$as_rqt_nt_pnt_chg entry (char (*), ptr, fixed bin (35)); dcl as_any_other_handler_ entry (char(*), entry, label, label); dcl asu_$blast_user entry (ptr, char(*), char(*), fixed bin(35)); dcl asu_$bump_user entry (ptr, char(*), fixed bin(35), fixed bin); dcl display_access_class_ entry (bit (72) aligned) returns (char (32) aligned); dcl pnt_manager_$admin_get_entry entry (char (*), ptr, fixed bin (35)); dcl sys_log_ entry options (variable); dcl sys_log_$error_log entry options (variable); /* External */ dcl error_table_$id_not_found fixed bin (35) external static; dcl error_table_$not_privileged fixed bin (35) external static; dcl error_table_$unimplemented_version fixed bin (35) external static; /* Builtins */ dcl (addr, clock, null) builtin; /* Constants */ dcl (DO_HONOR_NOBUMP initial ("1"b), DONT_HONOR_NOBUMP initial ("0"b)) bit(1) int static options(constant); dcl ME char (32) initial ("as_request_note_pnt_change_") internal static options (constant); dcl RING_1 fixed bin (3) initial (1) internal static options (constant); /* Conditions */ dcl any_other condition; %page; /* Program */ /**** Since we are using as_data_ pointers, ensure they have been initialized before proceeding. If they haven't, return with no logging because the answering service must not have been initialized properly. This should never happen though. */ if as_data_$ansp = null () | as_data_$autp = null () | as_data_$dutp = null () then return; ansp = as_data_$ansp; autp = as_data_$autp; dutp = as_data_$dutp; /**** First, establish an any other handler in case of faults */ on any_other call as_any_other_handler_ (ME, NULL_PROC, MAIN_RETURN, MAIN_RETURN); /**** Copy arguments into automatic storage */ asr_note_pnt_change_info_ptr = P_asr_note_pnt_change_info_ptr; as_request_sender_ptr = P_asr_sender_ptr; /**** Validate the request in terms of access and reasonability of data */ call VALIDATE_REQUEST (code); if code = 0 then do; person_id = asr_note_pnt_change_info.person_id; call SCAN_USER_TABLES_AND_UPDATE (); end; else; /* we've already logged any errors */ MAIN_RETURN: return; %page; VALIDATE_REQUEST: procedure (P_code); dcl P_code fixed bin (35) parameter; /**** Validate the request. Check the version numbers of the structures and verify that the request came from Ring-1. Log any invalid requests */ if as_request_sender.version ^= AS_REQUEST_SENDER_VERSION_2 then do; P_code = error_table_$unimplemented_version; call sys_log_$error_log (SL_LOG_SILENT, P_code, ME, "Rejected NOTE_PNT_CHANGE request from ^a. Invalid version (^a) in as_request_sender structure.", as_request_sender.group_id, as_request_sender.version); return; end; else if asr_note_pnt_change_info.version ^= ASR_NPC_INFO_VERSION_1 then do; P_code = error_table_$unimplemented_version; call sys_log_$error_log (SL_LOG_SILENT, P_code, ME, "Rejected NOTE_PNT_CHANGE request from ^a. Invalid version number (^a) in asr_note_pnt_change_info structure.", as_request_sender.group_id, asr_note_pnt_change_info.version); return; end; /* Check access after we've determined that */ /* the data is correct for checking access. */ if as_request_sender.validation_level ^= RING_1 then P_code = error_table_$not_privileged; else P_code = 0; /* request is ok */ call as_access_audit_$as_rqt_nt_pnt_chg (ME, addr(as_request_sender), P_code); return; end VALIDATE_REQUEST; %page; SCAN_USER_TABLES_AND_UPDATE: procedure (); /**** Scan the answer table, daemon user table, and absentee user table logged in processes for the specified personid. If any are found, get the new pnt entry and update the info in the user tables, bumping any processes which are incompatible with the new PNT entry. */ dcl pnt_entry_status fixed bin(2); /* tells us whether we've retrieved the PNT entry yet */ dcl (PNT_ENTRY_NOT_RETRIEVED init(0), PNT_ENTRY_RETRIEVED init(1), PNT_ENTRY_DELETED init(2), PNT_ENTRY_RETRIEVE_ERROR init(3)) fixed bin(2) int static options(constant); dcl i fixed bin (17); /* index into user_table_entry array */ pnt_entry_status = PNT_ENTRY_NOT_RETRIEVED; /**** Scan interactive user table (answer_table) */ do i = 1 to anstbl.current_size; utep = addr (anstbl.entry (i)); call PROCESS_UTE (); end; /**** Scan absentee user table */ do i = 1 to autbl.current_size; utep = addr (autbl.entry (i)); call PROCESS_UTE (); end; /**** Scan daemon user table */ do i = 1 to dutbl.current_size; utep = addr (dutbl.entry (i)); call PROCESS_UTE (); end; return; PROCESS_UTE: procedure (); dcl 1 pnte aligned like pnt_entry automatic; if ute.active = NOW_HAS_PROCESS then if ute.person = person_id then do; if pnt_entry_status = PNT_ENTRY_NOT_RETRIEVED then call RETRIEVE_PNT_ENTRY (); if pnt_entry_status = PNT_ENTRY_DELETED /* user deleted */ then call BUMP_USER ("Deleted from PNT", DONT_HONOR_NOBUMP); else if pnt_entry_status = PNT_ENTRY_RETRIEVED then call UPDATE_UTE_AND_MAYBE_BUMP_USER (); else; /* error from RETRIEVE_PNT_ENTRY */ end; else; /* non matching person_id */ else; /* non active process */ return; RETRIEVE_PNT_ENTRY: procedure (); call pnt_manager_$admin_get_entry (person_id, addr (pnte), code); if code = error_table_$id_not_found then pnt_entry_status = PNT_ENTRY_DELETED; else if code ^= 0 then do; call sys_log_$error_log (SL_LOG_SILENT, code, ME, "Unable to retrieve PNT entry for ^a.", person_id); pnt_entry_status = PNT_ENTRY_RETRIEVE_ERROR; end; else pnt_entry_status = PNT_ENTRY_RETRIEVED; /* everything is ok */ return; end RETRIEVE_PNT_ENTRY; BUMP_USER: procedure (P_reason, honor_nobump); /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Bump this user since his PNT entry was deleted or password was locked. */ /* */ /* Bump will be prevented if password being locked and the user has nobump */ /* attribute. Usually this is the System Administrator locking his own */ /* password to thwart a break-in attempt. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ dcl P_reason char (*) parameter; /* reason for bumping */ dcl honor_nobump bit(1) parameter; /* on: nobump stops bumping*/ dcl NO_GRACE fixed bin (17) initial (0) internal static options (constant); if honor_nobump & ute.at.nobump then do; call sys_log_ (SL_LOG_SILENT, "^a: User has ""nobump"" attribute. Did not bump ^a.^a.^a ^12.3b on channel ^a (^a)", ME, ute.person, ute.project, ute.tag, ute.proc_id, ute.tty_name, P_reason); if ^ute.uflags.disconnected then call asu_$blast_user (utep, """nobump"" attribute prevented bump attempt when: " || P_reason, (""), (0)); end; else do; call sys_log_ (SL_LOG_SILENT, "^a: Bumping user ^a.^a.^a ^12.3b on channel ^a (^a)", ME, ute.person, ute.project, ute.tag, ute.proc_id, ute.tty_name, P_reason); call asu_$bump_user (utep, P_reason, code, NO_GRACE); if code ^= 0 then call sys_log_$error_log (SL_LOG_SILENT, code, ME, "Error from asu_$bump_user. Did not bump ^a.^a.^a ^12.3b on channel ^a (^a)", ute.person, ute.project, ute.tag, ute.proc_id, ute.tty_name, P_reason); end; end BUMP_USER; UPDATE_UTE_AND_MAYBE_BUMP_USER: procedure (); if pnte.flags.lock /* user's password has been locked */ then call BUMP_USER ("Password locked", DO_HONOR_NOBUMP); else if pnte.flags.pw_time_lock then if clock() <= pnte.password_timelock then call BUMP_USER ("Password time_locked", DO_HONOR_NOBUMP); else go to OTHER_TESTS; else do; OTHER_TESTS: if pnte.person_authorization (2) < ute.process_authorization_range (2) /* lowered max auth */ then do; call sys_log_ (SL_LOG_SILENT, "^a: Lowered maximum authorization for ^a.^a.^a on channel ^a from ^a to ^a. PNT change.", ME, ute.person, ute.project, ute.tag, ute.tty_name, display_access_class_ (ute.process_authorization_range (2)), display_access_class_ (pnte.person_authorization (2))); ute.process_authorization_range (2) = pnte.person_authorization (2); end; else; if pnte.person_authorization (1) > ute.process_authorization_range (1) /* raised min auth */ then do; call sys_log_ (SL_LOG_SILENT, "^a: Raised minimum authorization for ^a.^a.^a on channel ^a from ^a to ^a. PNT change.", ME, ute.person, ute.project, ute.tag, ute.tty_name, display_access_class_ (ute.process_authorization_range (1)), display_access_class_ (pnte.person_authorization (1))); ute.process_authorization_range (1) = pnte.person_authorization (1); end; else; if ^aim_check_$in_range (ute.process_authorization, ute.process_authorization_range) then call BUMP_USER ("Authorization range changed by System Administrator", DO_HONOR_NOBUMP); else; end; return; end UPDATE_UTE_AND_MAYBE_BUMP_USER; end PROCESS_UTE; end SCAN_USER_TABLES_AND_UPDATE; %page; NULL_PROC: procedure (); /**** This is a dummy cleanup handler, for as_any_other_handler_'s sake. It does nothing, but is required by as_any_other_handler_. */ return; end NULL_PROC; /* format: off */ %page; %include absentee_user_table; %page; %include answer_table; %page; %include as_data_; %page; %include as_data_definitions_; %page; %include as_request_header; %page; %include as_request_sender_; %page; %include as_requests; %page; %include daemon_user_table; %page; %include dialup_values; %page; %include pnt_entry; %page; %include sys_log_constants; %page; %include user_attributes; %page; %include user_table_entry; %page; %include user_table_header; %page; /* BEGIN MESSAGE DOCUMENTATION Message: as_request_note_pnt_change_: ERROR_MSG. Rejected NOTE_PNT_CHANGE request from PERS.PROJ. REASON S: as (severity 0) T: $run M: An answering service request to note a change to the PNT sent by PERS.PROJ failed because of REASON. $err A: $contact Message: as_request_note_pnt_change_: ERROR_MSG. Unable to retrieve PNT entry for PERS. S: as (severity 0) T: $run M: An error (ERROR_MSG) occurred while getting the PNT entry for person PERS. A: $contact_sa Message: as_request_note_pnt_change_: Bumping user PERS.PROJ.TAG PROCESSID on channel CHN. (REASON) S: as (severity 0) T: $run M: Process PERS.PROJ.TAG on channel CHN was bumped by a change to the PNT entry for PERS. REASON describes the type of PNT change. A: $ignore Message: as_request_note_pnt_change_: ERROR_MSG. Error from asu_$bump user. Did not bump PERS.PROJ.TAG PROCESSID on channel CHN (REASON) S: as (severity 0) T: $run M: An error occurred attempting to bump process PERS.PROJ.TAG PROCESSID on channel CHN. REASON indicates why bumping was attempted. A: $contact_sa Message: as_request_note_pnt_change_: User has "nobump" attribute. Did not bump PERS.PROJ.TAG PROCESSID on channel CHN. (REASON) S: as (severity 0) T: $run M: Bump attempt for process PERS.PROJ.TAG with PROCESSID on channel CHN failed, because the user has the nobump attribute. REASON indicates why bumping was attempted. A: $contact_sa Message: as_request_note_pnt_change_: Lowered maximum authorization for PERS.PROJ.TAG on channel CHN from OLD_MAX_AUTH to NEW_MAX_AUTH. PNT change. S: as (severity 0) T: $run M: A change to the PNT entry for PERS lowered the maximum authorization associated with the process PERS.PROJ.TAG on channel CHN. The authorization was changed from OLD_MAX_AUTH to NEW_MAX_AUTH. A: $ignore Message: as_request_note_pnt_change_: Raised minimum authorization for PERS.PROJ.TAG on channel CHN from OLD_MIN_AUTH to NEW_MIN_AUTH. PNT change. S: as (severity 0) T: $run M: A change to the PNT entry for PERS raised the minimum authorization associated with the process PERS.PROJ.TAG on channel CHN. The authorization was changed from OLD_MIN_AUTH to NEW_MIN_AUTH. A: $ignore END MESSAGE DOCUMENTATION */ /* format: on */ end as_request_note_pnt_change_;  as_request_server_.pl1 09/06/88 1302.0rew 09/06/88 1300.7 280746 /****^ *********************************************************** * * * 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. * * * *********************************************************** */ /* DESCRIPTION: A procedure to get requests from user processes and dispatch them to the correct answering service module. */ /* HISTORY: Written by Paul Green, 01/09/75. Modified: 04/01/79 by T. Casey: to correctly handle requests from foreground or proxy absentee processes. 12/01/80 by E. N. Kittlitz: to set anstbl.current_time on wakeup. 06/01/81 by T. Casey: for MR9.0 for new wakeup priorities. 11/01/81 by E. N. Kittlitz: user_table_entry conversion. 04/01/82 by E. N. Kittlitz: New AS initialization. bugfixes. 10/01/82 by E. N. Kittlitz: Rename as_request_ to as_request_server_, add requests 3 - 5. 04/04/84 by Benson I. Margulies: Changed to pass as_request_sender instead of event_call_info. 08/23/84 by R. Michael Tague: Added ASR_BUMP_USER request. Added length checks of structures passed from the message segment. Fixed bug with ASR_FPE_CAUSES_(LOGOUT NEW_PROC) request, it was not replying correctly. Structured $wakeup entry. Modified 1984-10-04 BIM for ASR_ADMIN_COMMAND, V5 msegs. Modified 1984-10-29 by E. Swenson to fix bug which caused asdumps when invalid messages were processed. 11/20/84 by R. Michael Tague: Fixed a few error comments. Added named access constants. Changed to use ute.tag. Modified 1985-01-23 by E. Swenson to ASR_NOTE_PNT_CHANGE and delete offending message in the cleanup code. Modified 1985-02-19, BIM: ASR_DAEMON_COMMAND and ASR_COM_CHANNEL_INFO. Modified 1985-02-22 by E. Swenson to do replies properly for the ASR_DAEMON_COMMAND and ASR_COM_CHANNEL_INFO requests. Modified 86-04-08 by SGH (UNCA) to free processed messages -- phx20268. */ /****^ 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): Modified 12 December 1985 (above date to satisfy hcom) by Jim Lippard: Added the ASR_ABS_COMMAND request. 2) 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. 3) change(86-09-26,GDixon), approve(86-09-26,MCR7499), audit(86-10-09,Lippard), install(86-10-28,MR12.0-1200): Modified by Steve Harris (Univ. of Calgary) to free processed messages in all cases. One path through the code missed freeing the message, causing the Initializers user free area to fill up, thereby degrading response. 4) change(87-04-26,GDixon), approve(87-07-13,MCR7741), audit(87-07-27,Brunelle), install(87-08-04,MR12.1-1055): Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1 5) change(87-08-31,GDixon), approve(88-08-15,MCR7969), audit(88-08-04,Lippard), install(88-08-29,MR12.2-1093): A) Add acl for administrators to as_request.ms during initialization. (Answering_Service 407, phx19057) B) Use fs_util_ to replace the ACL, with its more modern ACL structures. C) Use mseg_access_mode_values.incl.pl1 to set access mode values, rather than literal constants. 6) change(88-09-01,GDixon), approve(88-09-01,PBF7969), audit(88-09-03,Beattie), install(88-09-06,MR12.2-1100): A) Fix bug which set null access for *.*.*, instead of ao access. (Answering_Service 407, phx19057) B) Correct error message documentation. END HISTORY COMMENTS */ /* format: style2 */ as_request_server_$init: procedure; /* parameters */ dcl bv_event_call_info_ptr ptr parameter; /* automatic */ dcl code fixed bin (35); dcl code_mask_ev_calls fixed bin (35); dcl code_unmask_ev_calls fixed bin (35); dcl fixed_bin_71_reply fixed bin (71) aligned; dcl type fixed bin; dcl user_free_area_ptr ptr; dcl 1 mmi aligned like mseg_message_info; dcl 1 l_asr_reply aligned like asr_reply; dcl 1 l_as_request_sender aligned like as_request_sender; /* internal static */ dcl ms_index fixed bin initial (0) internal static; /* external static */ dcl error_table_$no_message fixed bin (35) ext static; dcl error_table_$noentry fixed bin (35) external static; dcl error_table_$out_of_sequence fixed bin (35) external static; dcl error_table_$as_request_sender_missing fixed bin (35) external static; dcl error_table_$as_request_invalid_request fixed bin (35) external static; /* entries */ dcl asu_$find_process entry (bit (36) aligned, fixed bin, ptr); dcl as_any_other_handler_ entry (character (*), entry, label, label); dcl as_request_note_pnt_change_ entry (ptr, ptr); dcl as_request_bump_user_ entry (ptr, ptr); dcl asr_abs_command_server_ entry (ptr, ptr); dcl asr_com_channel_info_srvr_ entry (ptr, ptr); dcl asr_daemon_command_server_ entry (ptr, ptr); dcl dpg_$register_buzzard entry (ptr, ptr); dcl dial_ctl_$dial_out_rq entry (ptr, ptr); dcl dial_ctl_$dial_rq entry (ptr, ptr); dcl fs_util_$replace_acl entry (char(*), char(*), ptr, bit(1), fixed bin(35)); dcl get_group_id_ entry () returns (char (32)); dcl get_process_id_ entry () returns (bit (36)); dcl get_user_free_area_ entry returns (pointer); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); 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_$drain_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 message_segment_$create entry (char (*), char (*), fixed bin (35)); dcl message_segment_$delete entry (char (*), char (*), fixed bin (35)); dcl message_segment_$delete_index entry (fixed bin, bit (72) aligned, fixed bin (35)); dcl message_segment_$read_message_index entry (fixed bin, pointer, pointer, fixed bin (35)); dcl message_segment_$get_message_count_index entry (fixed bin, fixed bin, fixed bin (35)); dcl message_segment_$open entry (char (*), char (*), fixed bin, fixed bin (35)); dcl sc_admin_command_ entry (ptr, ptr); dcl sub_err_ entry () options (variable); dcl sys_log_ entry options (variable); dcl sys_log_$error_log entry options (variable); /* based */ dcl 1 request aligned based (mmi.ms_ptr) like as_request_header; dcl user_free_area area based (user_free_area_ptr); /* builtin functions */ dcl (addr, clock, dimension, length, null, unspec) builtin; dcl cleanup condition; dcl any_other condition; /* program */ if ^sc_stat_$Multics_typed | sc_stat_$Go_typed then call sub_err_ (error_table_$out_of_sequence, "as_request_server_$init", "s"); /* Drain message segment by deleting and re-creating it. */ call message_segment_$delete (sysdir, "as_request.ms", code); if code ^= 0 then if code ^= error_table_$noentry /* don't care if it didn't exist before */ then call sys_log_$error_log (SL_LOG, code, "as_request_server_$init", "Deleting ^a>as_request.ms.", sysdir); call message_segment_$create (sysdir, "as_request.ms", code); if code ^= 0 then go to fail; call message_segment_$open (sysdir, "as_request.ms", ms_index, code); if code ^= 0 then go to fail; /* add everyone to the ACL */ call Set_Mseg_Acls(); /* The request segment is ready, set up the event channel */ call ipc_$create_ev_chn (whotab.request_channel, code); if code ^= 0 then go to ipc_fail; call ipc_$decl_ev_call_chn (whotab.request_channel, as_request_server_$wakeup, null, AS_REQUEST_PRIO, code); if code ^= 0 then do; ipc_fail: whotab.request_channel = 0; go to fail; end; ansp = as_data_$ansp; whotab.request_process_id = anstbl.as_procid; return; fail: call sys_log_$error_log (SL_LOG, code, "as_request_server_$init", "Manipulating ^a>as_request.ms or IPC channels.", sysdir); ms_index = 0; /* we didn't really finish */ call sub_err_ (code, "as_request_server_$init", "s"); Set_Mseg_Acls: procedure (); dcl 1 ms_acl aligned, /* like general_acl */ 2 version char (8) aligned, 2 count fixed bin, 2 entries (5) like general_acl_entry; dcl NO_SYSDAEMON bit (1) initial ("1"b) internal static options (constant); acl_ptr = addr (ms_acl); general_acl.version = GENERAL_ACL_VERSION_1; general_acl.count = dimension (ms_acl.entries, 1); general_acl.entries (1).access_name = get_group_id_ (); general_acl.entries (1).mode = MSEG_QUEUE_CREATOR_INITIAL_ACCESS; general_acl.entries (1).status_code = 0; general_acl.entries (2).access_name = "*.SysDaemon.*"; general_acl.entries (2).mode = MSEG_QUEUE_SYSDAEMON_INITIAL_ACCESS; general_acl.entries (2).status_code = 0; general_acl.entries (3).access_name = "*.SysAdmin.*"; general_acl.entries (3).mode = MSEG_QUEUE_ADMIN_ACCESS; general_acl.entries (3).status_code = 0; general_acl.entries (4).access_name = "*.SysMaint.*"; general_acl.entries (4).mode = MSEG_QUEUE_ADMIN_ACCESS; general_acl.entries (4).status_code = 0; general_acl.entries (5).access_name = "*.*.*"; general_acl.entries (5).mode = MSEG_QUEUE_USER_ACCESS; general_acl.entries (5).status_code = 0; call fs_util_$replace_acl (sysdir, "as_request.ms", addr (general_acl), NO_SYSDAEMON, code); if code ^= 0 then go to fail; end Set_Mseg_Acls; /* ************************************************************************ * as_request_server_$wakeup - Entry which is called when someone * * places a request in the message segment and sends us a wakeup. * * * * Note: Since the messages from the requestor can be of any size, the * * length of the message must be compared against the size of structure * * that the message should represent. * ************************************************************************ */ as_request_server_$wakeup: entry (bv_event_call_info_ptr); event_call_info_ptr = bv_event_call_info_ptr; if ms_index = 0 | sc_stat_$shutdown_typed then do; call sys_log_ (SL_LOG, "as_request_server_: Request message segment not initialized or shutdown has been typed."); return; end; code_mask_ev_calls, code_unmask_ev_calls = -1; /* close window, see CLEANUP and ERROR_RETURN */ asr_replyp = addr (l_asr_reply); unspec (asr_reply) = ""b; unspec (mmi) = ""b; mmi.version = MSEG_MESSAGE_INFO_V1; mmi.ms_ptr = null (); /* for cleanup handler */ user_free_area_ptr = get_user_free_area_(); ansp = as_data_$ansp; anstbl.current_time = clock (); on cleanup call CLEANUP; call ipc_$mask_ev_calls (code_mask_ev_calls); on any_other call as_any_other_handler_ ("as_request_server_", CLEANUP, ERROR_RETURN, ERROR_RETURN); /* we have no different exit requirements when cleanup failed. */ code = 0; call ipc_$drain_chn (event_call_info.channel_id, (0)); call PROCESS_MESSAGES (code); /* returns -2 for deferred */ /**** Here if mseg is empty, or only contains deferred messages, or we have burned a bunch of CPU time. */ if code = -2 /* deferred or processed too many. */ then call hcs_$wakeup (get_process_id_ (), whotab.request_channel, (0), (0)); go to RETURN; ERROR_RETURN: call hcs_$wakeup (get_process_id_ (), whotab.request_channel, (0), (0)); /* in case there is work left to do. */ RETURN: if code_mask_ev_calls = 0 & code_unmask_ev_calls ^= 0 then call ipc_$unmask_ev_calls (code_unmask_ev_calls); /* masked in initialize */ return; PROCESS_MESSAGES: proc (code); dcl code fixed bin (35); dcl deferred_one bit (1) aligned; dcl action fixed bin; dcl message_count fixed bin; /**** Each message is either processed, deferred, or rejected */ declare ( PROCESS init (1), DEFER init (2), REJECT init (3) ) fixed bin int static options (constant); deferred_one = "0"b; mmi.message_code = MSEG_READ_FIRST; /* start with the first one */ do while ("1"b); /* exit with return statement */ call message_segment_$read_message_index (ms_index, addr(user_free_area), addr (mmi), code); if code ^= 0 then do; if code ^= error_table_$no_message then call sys_log_$error_log (SL_LOG_SILENT, code, "as_request_server_", "Error reading message from message segment."); if deferred_one then code = -2; /* note that wakeup needs to be sent back to us */ return; end; action = EXAMINE_MESSAGE (); /* side effects are potentially utep and mmi.sender_id */ if action = PROCESS then do; call PROCESS_THE_MESSAGE; call DELETE_THE_MESSAGE; call FREE_THE_MESSAGE; call message_segment_$get_message_count_index (ms_index, message_count, code); if code ^= 0 /* ???, but be safe */ | message_count > 0 then code = -2; else code = 0; /* There is no race condition here. */ return; /* We drain the channel first, so that if we return zero here and a new message is in */ /* its wakeup will take. */ end; else if action = DEFER then do; deferred_one = "1"b; mmi.message_code = MSEG_READ_AFTER_SPECIFIED; /* continue along */ end; else if action = REJECT then do; call DELETE_THE_MESSAGE; mmi.message_code = MSEG_READ_FIRST; end; call FREE_THE_MESSAGE; end; /* Never exit this loop */ EXAMINE_MESSAGE: procedure returns (fixed bin); if mmi.ms_len < length (unspec (request)) then do; code = error_table_$as_request_invalid_request; call sys_log_$error_log (SL_LOG_SILENT, code, "as_request_server_", "Message too short from ^a.", mmi.sender_id); return (REJECT); end; call asu_$find_process (mmi.sender_process_id, type, utep); /* for now, always require live sender. */ if utep = null then do; code = error_table_$as_request_sender_missing; call sys_log_$error_log (SL_LOG_SILENT, code, "as_request_server_", "Process no longer active for request from ^a.", mmi.sender_id); return (REJECT); end; if request.type < ASR_FIRST_TYPE | request.type > ASR_LAST_TYPE then do; call sys_log_ (SL_LOG_SILENT, "as_request_server_: Rejected invalid type ^d message from ^a ^w.", request.type, mmi.sender_id, mmi.sender_process_id); return (REJECT); end; if sc_stat_$admin_listener_switch then if ASR_DEFER_IN_ADMIN_MODE (request.type) then return (DEFER); return (PROCESS); end EXAMINE_MESSAGE; PROCESS_THE_MESSAGE: procedure; l_as_request_sender.version = AS_REQUEST_SENDER_VERSION_2; l_as_request_sender.group_id = mmi.sender_id; l_as_request_sender.process_id = mmi.sender_process_id; l_as_request_sender.authorization = mmi.sender_authorization; l_as_request_sender.validation_level = mmi.sender_level; l_as_request_sender.max_authorization = mmi.sender_max_authorization; l_as_request_sender.audit_flags = mmi.sender_audit; if request.type = ASR_DIAL_SERVER then call DIAL_SERVER_REQUEST (); else if request.type = ASR_DIAL_OUT then call DIAL_OUT_REQUEST (); else if request.type = ASR_FPE_CAUSES_LOGOUT then call FPE_CAUSES_LOGOUT_REQUEST (); else if request.type = ASR_FPE_CAUSES_NEW_PROC then call FPE_CAUSES_NEW_PROC_REQUEST (); else if request.type = ASR_PROC_TERM_NOTIFY then call PROC_TERM_NOTIFY_REQUEST (); else if request.type = ASR_BUMP_USER then call BUMP_USER_REQUEST (); else if request.type = ASR_ADMIN_COMMAND then call ADMIN_COMMAND_REQUEST (); else if request.type = ASR_NOTE_PNT_CHANGE then call NOTE_PNT_CHANGE_REQUEST (); else if request.type = ASR_DAEMON_COMMAND then call DAEMON_COMMAND_REQUEST (); else if request.type = ASR_COM_CHANNEL_INFO then call COM_CHANNEL_INFO_REQUEST (); else if request.type = ASR_ABS_COMMAND then call ABS_COMMAND_REQUEST (); return; end PROCESS_THE_MESSAGE; end PROCESS_MESSAGES; /* ************************************************************************ * DIAL_SERVER_REQUEST - For a dial request. Presumably * * dial_ctl_$dial_rq logs successful and unsuccessful requests. No * * reply is sent. Note: request_ptr must be set so that length may be * * without compiler warning. * ************************************************************************ */ DIAL_SERVER_REQUEST: proc (); request_ptr = mmi.ms_ptr; if mmi.ms_len >= length (unspec (dial_server_request)) then call dial_ctl_$dial_rq (mmi.ms_ptr, addr (l_as_request_sender)); else do; code = error_table_$as_request_invalid_request; call sys_log_$error_log (SL_LOG_SILENT, code, "as_request_server_", "Message for ""^a"" (type ^d) too short from ^a.", ASR_REQUEST_NAMES (request.type), request.type, mmi.sender_id); end; end DIAL_SERVER_REQUEST; /* ************************************************************************ * DIAL_OUT_REQUEST - AS request for dial_out. No reply is sent. * * Note: request_ptr must be set do that length can be user without * * a compiler warning. * ************************************************************************ */ DIAL_OUT_REQUEST: proc (); request_ptr = mmi.ms_ptr; if mmi.ms_len >= length (unspec (dial_server_request)) then call dial_ctl_$dial_out_rq (mmi.ms_ptr, addr (l_as_request_sender)); else do; code = error_table_$as_request_invalid_request; call sys_log_$error_log (SL_LOG_SILENT, code, "as_request_server_", "Message for ""^a"" (type ^d) too short from ^a.", ASR_REQUEST_NAMES (request.type), request.type, mmi.sender_id); end; end DIAL_OUT_REQUEST; /* ************************************************************************ * FPE_CAUSES_LOGOUT_REQUEST - This sets to logout the AS flag that * * indicates whether a Fatal Process Error will cause a logout or a * * new_proc. The old value of the flag is returned in the reply. * ************************************************************************ */ FPE_CAUSES_LOGOUT_REQUEST: proc (); l_asr_reply.data = ute.fpe_causes_logout; l_asr_reply.code = 0; ute.fpe_causes_logout = "1"b; call sys_log_ (SL_LOG_SILENT, "^a: ^a (^w) set fatal process error ^[logout^;new_proc^].", "as_request_sender_", mmi.sender_id, mmi.sender_process_id, ute.fpe_causes_logout); call SEND_ASR_REPLY; end FPE_CAUSES_LOGOUT_REQUEST; /* ************************************************************************ * FPE_CAUSES_NEW_PROC_REQUEST - This sets to new_proc the AS flag * * that indicates whether a Fatal Process Error will cause a logout or * * a new_proc. The old value of the flag is returned in the reply. * ************************************************************************ */ FPE_CAUSES_NEW_PROC_REQUEST: proc (); l_asr_reply.data = ute.fpe_causes_logout; l_asr_reply.code = 0; ute.fpe_causes_logout = "0"b; call sys_log_ (SL_LOG_SILENT, "^a: ^a (^w) set fatal process error ^[logout^;new_proc^].", "as_request_sender_", mmi.sender_id, mmi.sender_process_id, ute.fpe_causes_logout); call SEND_ASR_REPLY; end FPE_CAUSES_NEW_PROC_REQUEST; /* ************************************************************************ * PROC_TERM_NOTIFY_REQUEST - This registers a user to be a buzzard * * process, i.e., the user's process will be notified when other * * processes are terminated. Note: asr_buzzard_infop must be set so * * that the length function can be used without a compiler warning. * ************************************************************************ */ PROC_TERM_NOTIFY_REQUEST: proc (); asr_buzzard_infop = mmi.ms_ptr; if mmi.ms_len >= length (unspec (asr_buzzard_info)) then do; call dpg_$register_buzzard (mmi.ms_ptr, addr (l_as_request_sender)); unspec (l_asr_reply) = unspec (l_as_request_sender.reply_message); call SEND_ASR_REPLY; end; else do; code = error_table_$as_request_invalid_request; call sys_log_$error_log (SL_LOG_SILENT, code, "as_request_server_", "Message for ""^a"" (type ^d) too short from ^a.", ASR_REQUEST_NAMES (request.type), request.type, mmi.sender_id); end; end PROC_TERM_NOTIFY_REQUEST; /* ************************************************************************ * BUMP_USER_REQUEST - The requesting process wishes to bump another * * user's process. * ************************************************************************ */ BUMP_USER_REQUEST: proc (); if mmi.ms_len >= length (unspec (asr_bump_user_info)) then do; asr_bump_user_info_ptr = mmi.ms_ptr; call as_request_bump_user_ (asr_bump_user_info_ptr, addr (l_as_request_sender)); unspec (l_asr_reply) = unspec (l_as_request_sender.reply_message); call SEND_ASR_REPLY; end; else do; code = error_table_$as_request_invalid_request; call sys_log_$error_log (SL_LOG_SILENT, code, "as_request_server_", "Message for ""^a"" (type ^d) too short from ^a.", ASR_REQUEST_NAMES (request.type), request.type, mmi.sender_id); end; end BUMP_USER_REQUEST; ADMIN_COMMAND_REQUEST: proc (); asr_admin_command_info_ptr = mmi.ms_ptr; /* trust as far as refer calculation */ if mmi.ms_len >= length (unspec (asr_admin_command_info)) then do; call sc_admin_command_ (asr_admin_command_info_ptr, addr (l_as_request_sender)); unspec (l_asr_reply) = unspec (l_as_request_sender.reply_message); call SEND_ASR_REPLY; end; else do; code = error_table_$as_request_invalid_request; call sys_log_$error_log (SL_LOG_SILENT, code, "as_request_server_", "Message for ""^a"" (type ^d) too short from ^a.", ASR_REQUEST_NAMES (request.type), request.type, mmi.sender_id); end; end ADMIN_COMMAND_REQUEST; NOTE_PNT_CHANGE_REQUEST: procedure (); /**** This request allows the Ring-1 PNT software to notify the answering service of PNT changes which may require bumping currently logged in users, or which may require updating information in the user_table_entry for a user. */ asr_note_pnt_change_info_ptr = mmi.ms_ptr; if mmi.ms_len >= length (unspec (asr_note_pnt_change_info)) then call as_request_note_pnt_change_ (asr_note_pnt_change_info_ptr, addr (l_as_request_sender)); else do; code = error_table_$as_request_invalid_request; call sys_log_$error_log (SL_LOG_SILENT, code, "as_request_server_", "Message for ""^a"" (type ^d) too short from ^a.", ASR_REQUEST_NAMES (request.type), request.type, mmi.sender_id); end; return; end NOTE_PNT_CHANGE_REQUEST; COM_CHANNEL_INFO_REQUEST: procedure (); asr_com_channel_info_ptr = mmi.ms_ptr; if mmi.ms_len >= length (unspec (asr_com_channel_info)) then do; call asr_com_channel_info_srvr_ (asr_com_channel_info_ptr, addr (l_as_request_sender)); unspec (l_asr_reply) = unspec (l_as_request_sender.reply_message); call SEND_ASR_REPLY (); end; else do; code = error_table_$as_request_invalid_request; call sys_log_$error_log (SL_LOG_SILENT, code, "as_request_server_", "Message for ""^a"" (type ^d) too short from ^a.", ASR_REQUEST_NAMES (request.type), request.type, mmi.sender_id); end; return; end COM_CHANNEL_INFO_REQUEST; DAEMON_COMMAND_REQUEST: procedure (); asr_daemon_command_info_ptr = mmi.ms_ptr; if mmi.ms_len >= length (unspec (asr_daemon_command_info)) then do; call asr_daemon_command_server_ (asr_daemon_command_info_ptr, addr (l_as_request_sender)); unspec (l_asr_reply) = unspec (l_as_request_sender.reply_message); call SEND_ASR_REPLY (); end; else do; code = error_table_$as_request_invalid_request; call sys_log_$error_log (SL_LOG_SILENT, code, "as_request_server_", "Message for ""^a"" (type ^d) too short from ^a.", ASR_REQUEST_NAMES (request.type), request.type, mmi.sender_id); end; return; end DAEMON_COMMAND_REQUEST; %page; ABS_COMMAND_REQUEST: procedure (); asr_abs_command_info_ptr = mmi.ms_ptr; if mmi.ms_len >= length (unspec (asr_abs_command_info)) then do; call asr_abs_command_server_ (asr_abs_command_info_ptr, addr (l_as_request_sender)); unspec (l_asr_reply) = unspec (l_as_request_sender.reply_message); call SEND_ASR_REPLY (); end; else do; code = error_table_$as_request_invalid_request; call sys_log_$error_log (SL_LOG_SILENT, code, "as_request_server_", "Message for ""^a"" (type ^d) too short from ^a.", ASR_REQUEST_NAMES (request.type), request.type, mmi.sender_id); end; return; end ABS_COMMAND_REQUEST; /* ************************************************************************ * SEND_ASR_REPLY - For those requests that send back replies, if the * * reply channel is non zero, then send back the reply. * ************************************************************************ */ SEND_ASR_REPLY: proc (); if request.reply_channel ^= 0 then do; unspec (fixed_bin_71_reply) = unspec (l_asr_reply); call hcs_$wakeup (mmi.sender_process_id, request.reply_channel, fixed_bin_71_reply, code); end; end SEND_ASR_REPLY; CLEANUP: procedure; if code_mask_ev_calls = 0 & code_unmask_ev_calls ^= 0 then call ipc_$unmask_ev_calls (code_unmask_ev_calls); /* masked in initialize */ call FREE_THE_MESSAGE (); if mmi.ms_id ^= ""b then call DELETE_THE_MESSAGE (); /* delete offending message */ end CLEANUP; DELETE_THE_MESSAGE: procedure; call message_segment_$delete_index (ms_index, mmi.ms_id, code); if code ^= 0 then call sys_log_$error_log (SL_LOG_SILENT, code, "as_request_server_", "Could not delete message ^.3b for ^a", mmi.ms_id, mmi.sender_id); else mmi.ms_id = ""b; /* clear out since no longer valid */ return; end DELETE_THE_MESSAGE; FREE_THE_MESSAGE: procedure; declare msg bit (mmi.ms_len) aligned based (mmi.ms_ptr); if mmi.ms_ptr ^= null () then do; free msg in (user_free_area); mmi.ms_ptr = null (); end; return; end FREE_THE_MESSAGE; /* format: off */ %page; %include absentee_user_table; %page; %include access_mode_values; %page; %include acl_structures; %page; %include answer_table; %page; %include as_data_; %page; %include as_data_definitions_; %page; %include as_request_header; %page; %include as_requests; %page; %include asr_abs_command; %page; %include asr_daemon_command; %page; %include asr_com_channel_info; %page; %include as_request_sender_; %page; %include as_wakeup_priorities; %page; %include dial_server_request; %page; %include event_call_info; %page; %include mseg_access_mode_values; %page; %include mseg_message_info; %page; %include sc_stat_; %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: as_request_server_$init: MSG. Manipulating >sc1>as_request_.ms or IPC channels. S: as (severity1) T: Answering Service initialization. M: MSG is an error_table_ message. A programming error has been encountered. A: $contact After the problem is corrected, repeat the bootload operation. Message: as_request_server_$init: MSG. Deleting >sc1>as_request_.ms. S: as (severity1) T: Answering Service initialization. M: MSG is an error_table_ message. An error was encountered while attempting to delete the as_request message segment, prior to re-creating it. as_request_server_$init continues and attempts to create the message segment. A: $ignore Message: as_request_server_: Request message segment not initialized or shutdown has been typed. S: as (severity1) T: $run M: A request is being ignored because the AS request queue has not been initialized or the the operator has typed the shutdown command. A: $ignore Message: as_request_server_: MSG. Error reading message from message segment. S: as (severity0) T: $run M: MSG is an error_table_ message. An error occurred while reading an AS message from the AS request queue. A: $ignore Message: as_request_server_: Message {for "REQUEST NAME" (type N)} too short from PERS.PROJ. S: as (severity0) T: $run M: A request of type N sent by the process group id specified by PERS.PROJ was in error. The request is ignored. If the request is shorter than the standard request header which precedes all requests, then the request type is not present in the message. A: $ignore Message: as_request_server_: MSG. Process no longer active for request from PERS.PROJ. S: as (severity0) T: $run M: MSG is an error_table_ message and PERS.PROJ isthe sender id. A process sent a wakeup to the Answering Service but then logged out before the Answering Service handled the wakeup. A: $ignore Message: as_request_server_: ERROR_MESSAGE. Can't find message from PGID S: as (severity0) T: $run M: MSG is an error_table_ message and PGID is a process group id. A process sent a wakeup to the Answering Service, but did not put a message in as_request.ms. A: $ignore Message: as_request_server_: Rejected invalid type XX message from PERS.PROJ PID. S: as (severity0) T: $run M: An invalid wakeup request has been sent to as_request_server_. The sending process ID is PID, and the sender name in the message is PERS.PROJ. The request is a type XX request. No action was taken. A: $ignore Message: as_request_sender_: MSG. Could not delete message MID for PERS.PROJ. S: as (severity0) T: $run M: MSG is an error_table_ message, MID is a message ID, PERS.PROJ is the group ID of the AS request sender. The AS request message could not be deleted after executing the AS request. A: $ignore Message: as_request_sender_: PERS.PROJ (PID) set fatal process error [logout|new_proc]. S: as (severity0) T: $run M: The process group id PERS.PROJ (process id PID) has set the AS flag which indicates that fatal process errors will cause a {logout|new_proc}. A: $ignore END MESSAGE DOCUMENTATION */ end as_request_server_$init;  as_send_user_mail_.pl1 08/05/87 0800.0r 08/04/87 1540.6 25731 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* as_send_user_mail_ -- as utility to send mail to user */ /* format: style2,idind30 */ /**** NOTE: This does NOT validate the user's access to deliver mail to the destination. Clients of this should not set Destination to other than "" unless they are willing to use the AS's full access in delivering. Also note that this does not yet send interactive messages at all. Until the mail system can do without headers on interactive messages, this seems required. */ as_send_user_mail_: procedure (Caller, Destination, Group_id, Subject, Message, Access_class, Sender); declare ( Caller, /* for error messages */ Destination, /* preferred destination */ Group_id, /* user name used to construct possible default destinations */ Subject, Message, Sender ) char (*); declare Access_class bit (72) aligned; declare code fixed bin (35); declare mlsys_utils_$send_message_to_recipient entry (char (*), char (*), fixed bin, char (*), char (*), bit (72) aligned, char (*) varying, fixed bin (35)); declare sys_log_$error_log entry options (variable); declare mlsys_et_$message_delivered fixed bin (35) ext static; declare mlsys_et_$message_queued fixed bin (35) ext static; declare mlsys_et_$message_queued_and_delivered fixed bin (35) ext static; if Destination ^= "" then do; call try_delivery (Destination, code); if code ^= 0 then call sys_log_$error_log (SL_LOG_SILENT, code, Caller, "Failed to deliver mail to requested destination ^a.", Destination); else return; /* all done */ end; call try_delivery (before (Group_id, "."), code); /* try for mail table */ if code ^= 0 then call try_delivery (substr (Group_id, 1, length (rtrim (Group_id)) - 2 /* tag */), code); if code ^= 0 then call sys_log_$error_log (SL_LOG_SILENT, code, Caller, "Failed to deliver mail to user ^a.", Group_id); return; try_delivery: procedure (addr, code); declare addr char (*); declare code fixed bin (35); call mlsys_utils_$send_message_to_recipient (Sender, addr, ORDINARY_DELIVERY, Subject, Message, Access_class, (""), code); if code = mlsys_et_$message_delivered | code = mlsys_et_$message_queued | code = mlsys_et_$message_queued_and_delivered then code = 0; return; end try_delivery; %include mlsys_deliver_info; %include sys_log_constants; end as_send_user_mail_;  as_send_user_message_.pl1 08/05/87 0800.0r 08/04/87 1540.6 23508 /* *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /* Entry to send an interactive message to a user from the answering service. */ /* format: style2,idind30 */ /**** NOTE: This does NOT validate the user's access to deliver mail to the destination. Clients of this should not set Destination to other than "" unless they are willing to use the AS's full access in delivering. */ /**** NOTE: This still uses send_mail_, because noone has bothered to make the mail system and the message facility work together in a reasonable way. It could use message_facility_, but that was not installed as of this writing. */ as_send_user_message_: procedure (Caller, Destination, Group_id, Message, Access_class, Sender, Express); declare ( Caller, /* for error messages */ Destination, /* preferred destination */ Group_id, /* user name used to construct possible default destinations */ Message, Sender ) char (*); declare Express bit (1) aligned; declare Access_class bit (72) aligned; declare code fixed bin (35); declare send_mail_$access_class entry (character (*), character (*), pointer, bit (72) aligned, fixed binary (35)); declare sys_log_$error_log entry options (variable); declare error_table_$messages_off fixed bin (35) ext static; /* Destination is ignored until we can use mail_system_ */ call try_delivery (substr (Group_id, 1, length (rtrim (Group_id)) - 2 /* tag */), code); if code ^= 0 then call sys_log_$error_log (SL_LOG_SILENT, code, Caller, "Failed to deliver mail to user ^a.", Group_id); return; try_delivery: procedure (address, code); declare address char (*); declare code fixed bin (35); %include send_mail_info; send_mail_info.version = send_mail_info_version_2; send_mail_info.sent_from = Sender; send_mail_info.switches = "0"b; send_mail_info.switches.wakeup = "1"b; send_mail_info.switches.always_add = ^Express; call send_mail_$access_class (address, Message, addr (send_mail_info), Access_class, code); if code = error_table_$messages_off & ^Express then code = 0; return; end try_delivery; %include mlsys_deliver_info; %include sys_log_constants; end as_send_user_message_;  asr_com_channel_info_srvr_.pl1 07/20/88 1251.6r w 07/19/88 1536.1 56871 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(87-04-28,GDixon), approve(87-07-13,MCR7741), audit(87-07-27,Brunelle): Updated for change to user_table_entry.incl.pl1. 2) change(87-07-24,Dickson), approve(87-07-24,MCR7722), audit(87-07-27,Brunelle): Added auditing of grants and failures. END HISTORY COMMENTS */ /* format: style2,idind30 */ asr_com_channel_info_srvr_: procedure (ASR_info_ptr, ASR_sender_ptr); /**** This program handles requests for info on com channels. */ /**** Written 1985-02-19, BIM */ /**** Modified 1985-02-22 by E. Swenson to not replace reply error code with error_table_$no_info if a more explicit error code has already been set up. */ declare (ASR_info_ptr, ASR_sender_ptr) pointer parameter; dcl cdtx fixed bin; dcl fnp_sw bit (1) aligned; dcl code fixed bin (35); dcl aim_util_$get_access_class entry (bit (72) aligned) returns (bit (72) aligned); dcl as_access_audit_$asr_com_chn_info_srvr entry (char (*), pointer, pointer, fixed bin (35)); dcl as_user_message_$priv_add_message entry (pointer, fixed bin (35)); dcl cdt_mgr_$find_cdt_channel entry (pointer, character (32), fixed binary, bit (1) aligned, fixed binary (35)); dcl ioa_$rsnnl entry () options (variable); dcl sys_log_$error_log entry options (variable); dcl error_table_$no_info fixed bin (35) ext static; dcl error_table_$unimplemented_version fixed bin (35) ext static; dcl addr builtin; dcl currentsize builtin; dcl null builtin; dcl unspec builtin; dcl ME char (32) internal static options(constant) init ("asr_com_channel_info_srvr_"); asr_com_channel_info_ptr = ASR_info_ptr; as_request_sender_ptr = ASR_sender_ptr; asr_reply_cci_ptr = addr (as_request_sender.reply_message); unspec (asr_reply_com_channel_info) = ""b; if asr_com_channel_info.version ^= ASR_CCI_VERSION_1 | asr_com_channel_info.reply_version_requested ^= AS_COM_CHANNEL_INFO_VERSION_1 then do; asr_reply_com_channel_info.code = error_table_$unimplemented_version; go to ERROR; end; cdtp = as_data_$cdtp; call cdt_mgr_$find_cdt_channel (cdtp, asr_com_channel_info.channel_name, cdtx, fnp_sw, code); if fnp_sw | code ^= 0 then go to ERROR; cdtep = addr (cdt.cdt_entry (cdtx)); if cdte.current_service_type = ANS_SERVICE then do; /* be sure it is login channel of requestor */ if ^(cdte.in_use = NOW_HAS_PROCESS & cdte.process -> ute.proc_id = as_request_sender.process_id) then go to ERROR; end; else if cdte.current_service_type = DIAL_OUT_SERVICE | cdte.current_service_type = SLAVE_SERVICE | cdte.current_service_type = TANDD_SERVICE | cdte.current_service_type = DIAL_SERVICE then do; if cdte.dialed_to_procid ^= as_request_sender.process_id then go to ERROR; end; else go to ERROR; /**** Okay, this channel belongs to this user */ if asr_com_channel_info.reply_message_handle ^= ""b then call SEND_REPLY; call as_access_audit_$asr_com_chn_info_srvr (ME, addr(as_request_sender), addr(asr_com_channel_info), asr_reply_com_channel_info.code); return; ERROR: /**** If we haven't set with a more specific code, give him the generic no_info code. */ if asr_reply_com_channel_info.code = 0 then asr_reply_com_channel_info.code = error_table_$no_info; call as_access_audit_$asr_com_chn_info_srvr (ME, addr(as_request_sender), addr(asr_com_channel_info), asr_reply_com_channel_info.code); return; SEND_REPLY: procedure; declare 1 asum_ai aligned like as_user_message_add_info; declare 1 ascci aligned like as_com_channel_info; declare code fixed bin (35); unspec (ascci) = ""b; ascci.version = AS_COM_CHANNEL_INFO_VERSION_1; ascci.channel_name = cdte.name; ascci.flags.access_control = cdte.flags.access_control, by name; ascci.attached_to_caller = "1"b; /* always true, other case not yet supported */ ascci.user_authenticated = (cdte.user_name.person ^= ""); ascci.dialed_to_caller = (cdte.current_service_type = DIAL_SERVICE); ascci.service_type = cdte.service_type; ascci.current_service_type = cdte.current_service_type; ascci.access_class = cdte.access_class; ascci.current_access_class = cdte.current_access_class (1); if ascci.user_authenticated then call ioa_$rsnnl ("^a.^a", ascci.auth_user_name, (0), cdte.user_name.person, cdte.user_name.project); else ascci.auth_user_name = ""; unspec (asum_ai) = ""b; asum_ai.version = AS_USER_MESSAGE_ADD_INFO_VERSION_1; asum_ai.message_ptr = addr (ascci); asum_ai.message_length = currentsize (ascci); asum_ai.message_access_class = aim_util_$get_access_class (as_request_sender.authorization); asum_ai.destination_info.group_id = as_request_sender.group_id; asum_ai.destination_info.process_id = as_request_sender.process_id; asum_ai.destination_info.handle = asr_com_channel_info.reply_message_handle; asum_ai.destination_info.ring = as_request_sender.validation_level; asum_ai.reader_deletes = "1"b; call as_user_message_$priv_add_message (addr (asum_ai), code); if code ^= 0 then do; call sys_log_$error_log (SL_LOG, code, "asr_com_channel_info_srvr_", "Failed to send reply message to ^a.", as_request_sender.group_id); end; return; end SEND_REPLY; %include as_data_; %include as_request_header; %include asr_com_channel_info; %include as_com_channel_info; %include as_request_sender_; %include as_user_message_add; %include cdt; %include dialup_values; %include author_dcl; %include user_table_entry; %include user_attributes; %include sys_log_constants; end asr_com_channel_info_srvr_;  asr_daemon_command_server_.pl1 08/05/87 0800.0r 08/04/87 1540.6 91386 /****^ *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /****^ 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. END HISTORY COMMENTS */ /* format: style2,idind30 */ asr_daemon_command_server_: procedure (ASR_info_ptr, ASR_sender_ptr); /**** This program handles requests from administrators for commands to be sent to daemon processes via the message coordinator */ /**** Written 1985-01-14, BIM: from sc_admin_command_ */ /**** Modified 1985-03-14, E. Swenson: Removes extra NL from message coordinator output. */ /**** Modified 1985-04-04, E. Swenson to send more precise reponse to sender. */ declare (ASR_info_ptr, ASR_sender_ptr) pointer parameter; dcl acs_mode bit (36) aligned; dcl as_error_code fixed bin (35); dcl code fixed bin (35); dcl daemon_user_manager_$login_ entry (char (*), char (*), char (*), char (*), fixed bin (35)); dcl daemon_user_manager_$logout_source_no_access_check entry (char (*), fixed bin (35)); dcl mc_wakeups_$reply_command entry (character (*) var, pointer, fixed binary (21), pointer, fixed binary (35)); dcl mc_check_acs_$reply entry (character (*), fixed binary (3), character (*), fixed binary (35)); dcl mc_check_acs_$log_daemon_in entry (character (*), fixed binary (3), character (*), fixed binary (35)); dcl mc_check_acs_$log_daemon_out entry (character (*), fixed binary (3), character (*), fixed binary (35)); dcl mc_check_acs_$quit entry (character (*), fixed binary (3), character (*), fixed binary (35)); dcl mc_commands_$reply_command entry (character (*) var, pointer, fixed binary (21), pointer, fixed binary (35)); dcl mc_commands_$quit_command entry (character (*), pointer, fixed binary (35)); dcl sys_log_ entry options (variable); dcl sys_log_$error_log entry options (variable); dcl up_sysctl_$check_acs entry (character (*), character (*), fixed binary, bit (36) aligned, fixed binary (35)); dcl error_table_$action_not_performed fixed bin (35) ext static; dcl error_table_$badstar fixed bin (35) ext static; dcl error_table_$insufficient_access fixed bin (35) ext static; dcl error_table_$ioname_not_found fixed bin (35) external static; dcl error_table_$noentry fixed bin (35) external static; dcl error_table_$unimplemented_version fixed bin (35) ext static; dcl error_table_$undefined_order_request fixed bin (35) ext static; dcl cleanup condition; asr_daemon_command_info_ptr = ASR_info_ptr; as_request_sender_ptr = ASR_sender_ptr; asr_reply_dc_ptr = addr (as_request_sender.reply_message); asr_reply_daemon_command.code = 0; asr_reply_daemon_command.flags = "0"b; if asr_daemon_command_info.version ^= ASR_DC_INFO_VERSION_1 then do; asr_reply_daemon_command.code = error_table_$unimplemented_version; go to ERROR; end; if asr_daemon_command_info.action_code ^= ASR_DC_LOGIN & asr_daemon_command_info.action_code ^= ASR_DC_LOGOUT & asr_daemon_command_info.action_code ^= ASR_DC_QUIT & asr_daemon_command_info.action_code ^= ASR_DC_REPLY then do; asr_reply_daemon_command.code = error_table_$undefined_order_request; go to ERROR; end; if asr_daemon_command_info.action_code = ASR_DC_LOGIN then /* user and project ignored in all other cases */ if asr_daemon_command_info.user_name = "*" | asr_daemon_command_info.project_name = "*" | asr_daemon_command_info.source_name = "*" then do; asr_reply_daemon_command.code = error_table_$badstar; go to ERROR; end; /**** Can we check an individual ACS, or must we check access to global acs */ if ^installation_parms.validate_daemon_commands then do; /* check global ACS segment */ call up_sysctl_$check_acs ("send_daemon_command.acs", as_request_sender.group_id, (as_request_sender.validation_level), acs_mode, code); if code ^= 0 then do; call sys_log_$error_log (SL_LOG_SILENT, code, "asr_daemon_command_server_", "Failed to check access for ^a to send_daemon_command.acs.", as_request_sender.group_id); asr_reply_daemon_command.code = error_table_$insufficient_access; asr_reply_daemon_command.flags.command_refused = "1"b; go to ERROR; end; if (acs_mode & RW_ACCESS) ^= RW_ACCESS then do; call sys_log_ (SL_LOG_SILENT, "asr_daemon_command_server_: Denied daemon command for ^a in ring ^d.", as_request_sender.group_id, as_request_sender.validation_level); asr_reply_daemon_command.code = error_table_$insufficient_access; asr_reply_daemon_command.flags.command_refused = "1"b; go to ERROR; end; end; else do; /* We can check specific access of sender to daemon */ if asr_daemon_command_info.action_code = ASR_DC_LOGIN then call mc_check_acs_$log_daemon_in (as_request_sender.group_id, (as_request_sender.validation_level), asr_daemon_command_info.source_name, asr_reply_daemon_command.code); else if asr_daemon_command_info.action_code = ASR_DC_LOGOUT then call mc_check_acs_$log_daemon_out (as_request_sender.group_id, (as_request_sender.validation_level), asr_daemon_command_info.source_name, asr_reply_daemon_command.code); else if asr_daemon_command_info.action_code = ASR_DC_REPLY then call mc_check_acs_$reply (as_request_sender.group_id, (as_request_sender.validation_level), asr_daemon_command_info.source_name, asr_reply_daemon_command.code); else if asr_daemon_command_info.action_code = ASR_DC_QUIT then call mc_check_acs_$quit (as_request_sender.group_id, (as_request_sender.validation_level), asr_daemon_command_info.source_name, asr_reply_daemon_command.code); if asr_reply_daemon_command.code ^= 0 then do; asr_reply_daemon_command.flags.no_access_to_daemon = "1"b; go to ERROR; end; end; /**** Okay, the sucker is authorized. Now log the command line. */ call sys_log_ (SL_LOG, "asr_daemon_command_server_: ^a: ^[LOGIN^;LOGOUT^;QUIT^;REPLY^]^[ ^a.^a^;^s^s^] ^a ^[^a^]", as_request_sender.group_id, asr_daemon_command_info.action_code, asr_daemon_command_info.action_code = ASR_DC_LOGIN, asr_daemon_command_info.user_name, asr_daemon_command_info.project_name, asr_daemon_command_info.source_name, (asr_daemon_command_info.action_code = ASR_DC_LOGIN | asr_daemon_command_info.action_code = ASR_DC_REPLY), rtrim (asr_daemon_command_info.command, byte (10))); /**** Now, do what the person asked */ if asr_daemon_command_info.action_code = ASR_DC_LOGIN then do; call daemon_user_manager_$login_ (asr_daemon_command_info.user_name, asr_daemon_command_info.project_name, asr_daemon_command_info.source_name, asr_daemon_command_info.command, as_error_code); /**** The following is really low-class. daemon_user_manager_$login_ returns as error table codes which the user will not be able to convert. Thus we convert it for him...in a less-than-optimal way. A better solution would be, perhaps, to use regular error_table_ codes in the AS. */ if as_error_code ^= 0 then asr_reply_daemon_command.code = error_table_$action_not_performed; else asr_reply_daemon_command.code = 0; end; else if asr_daemon_command_info.action_code = ASR_DC_LOGOUT then do; call daemon_user_manager_$logout_source_no_access_check (asr_daemon_command_info.source_name, asr_reply_daemon_command.code); if asr_reply_daemon_command.code = error_table_$noentry then asr_reply_daemon_command.no_such_daemon = "1"b; end; else if asr_daemon_command_info.action_code = ASR_DC_QUIT then do; call mc_commands_$quit_command (asr_daemon_command_info.source_name, null (), asr_reply_daemon_command.code); if asr_reply_daemon_command.code = error_table_$ioname_not_found then asr_reply_daemon_command.no_such_daemon = "1"b; end; else if asr_daemon_command_info.action_code = ASR_DC_REPLY then do; call mc_commands_$reply_command ((asr_daemon_command_info.source_name), addr (asr_daemon_command_info.command), length (asr_daemon_command_info.command), null (), asr_reply_daemon_command.code); if asr_reply_daemon_command.code = error_table_$ioname_not_found then asr_reply_daemon_command.no_such_daemon = "1"b; end; ERROR: return; %include as_data_; %include sys_log_constants; %include access_mode_values; %include as_request_header; %include asr_daemon_command; %include as_request_sender_; %include installation_parms; declare ip pointer defined (as_data_$rs_ptrs (0)); /* BEGIN MESSAGE DOCUMENTATION Message: asr_daemon_command_server_: PERSON: COMMAND INFO S: $sc T: $run M: A system administrator has sent a for a daemon to the Initializer, which executes it. A: $ignore Message: asr_daemon_command_server_: Failed to check access for USER. S: $sc T: $run M: User USER requested the system to execute a daemon command, but validate_daemon_commands was not enabled and the system could not determine their access to the send_daemon_command acs. A: $ignore Message: asr_daemon_command_server_: Denied send_daemon_command for USER in ring RING. S: $sc T: $run M: User USER requested the system to execute a daemon command, but lacked access to >sc1>admin_acs>send_admin_command.acs or the appropriate daemon source ACS. A: $ignore END MESSAGE DOCUMENTATION */ end asr_daemon_command_server_;  cdt_mgr_.pl1 07/20/88 1251.6r w 07/19/88 1536.1 229383 /****^ *********************************************************** * * * 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. * * * *********************************************************** */ /* cdt_mgr_.pl1 -- entries to manage cdt with tree of channel names */ /* format: style2 */ cdt_mgr_: procedure; /** This entry is not retained */ /* Initial Coding -- Benson I. Margulies December 1981 */ /* Fix to change daughter ptr when new entry added to head of daughter list BIM 7/82 */ /* Modified 1984-08-27 BIM for login auth ranges, com channel AIM. */ /****^ HISTORY COMMENTS: 1) change(87-06-08,Beattie), approve(87-04-06,MCR7656), audit(87-07-14,Parisek), install(87-08-04,MR12.1-1055): Initialize variables used to control use of IOCBs. END HISTORY COMMENTS */ declare ix fixed bin; declare code fixed bin (35); declare (fnpx, cdtx) fixed bin; declare first_cdtep pointer; declare first_cdte_offset fixed bin (18) unsigned; declare name_offset fixed bin (18) unsigned; declare cdte_size fixed bin (18) unsigned; declare thread_order (2711) fixed bin unaligned; /* max possible needed */ declare parse_fnp_name_ entry (char (*), fixed bin); declare sort_items_$char entry (ptr, fixed bin (24)); declare error_table_$badcall fixed bin (35) ext static; declare error_table_$unimplemented_version fixed bin (35) ext static; declare error_table_$namedup fixed bin (35) ext static; declare error_table_$noentry fixed bin (35) ext static; declare as_error_table_$cdte_in_use_wrong fixed bin (35) ext static; declare as_error_table_$illegal_top_mpx_name fixed bin (35) ext static; declare as_error_table_$salvage_cdt fixed bin (35) ext static; declare (addr, addrel, after, before, bin, currentsize, divide, index, length, null, rel, reverse, rtrim, substr, unspec) builtin; %page; /* cdt_mgr_$thread: process an entire cdt, threading cdt entries. */ /* CDT_pointer is a pointer to the cdt segment. */ /* This program calls sub_err_ with an info structure for errors */ /* to permit more explicit disgnosis. Callers should handle */ /* the sub_error_ condition with a callername of "cdt_mgr_" */ /* to avoid spurious command levels. */ thread: entry (CDT_pointer, Code); declare ( CDT_pointer pointer, Code fixed bin (35) ) parameter; cdtp = CDT_pointer; Code = 0; if cdt.version < CDT_version then do; call signal_error (error_table_$unimplemented_version, "CDT version is ^d, must be ^d", cdt.version, CDT_version); Code = error_table_$unimplemented_version; go to RETURN; end; /**** first init the fnpes */ /**** since fnpe's are not in the array of cdtes, they cannot be threaded */ /**** as siblings. */ /**** the -2 in fnpe.threads.next_sister is used to identify fnpes */ do fnpx = 1 to 8; fnpep = addr (cdt.fnp_entry (fnpx)); fnpe.next_sister = -2; /* invalid -- identifies fnpe */ fnpe.prev_sister = -2; fnpe.mother = 0; /* top of tree */ fnpe.daughter = 0; /* null for now */ fnpe.daughter_count = 0; end; /**** Now look at each cdte and thread it in. If some parent does not */ /**** exist, then the channel is remembered for postprocessing */ /**** cdt.n_cdtes may be wrong, due to threading lossage, since it is */ /**** maintained along with threads. If it is, the code fixes it and */ /**** retries. */ /**** cdt.current_size might be wrong as well, so we check for putative */ /**** cdte's for the entire length of the cdt. This depends on the fact */ /**** that unused cdte's past the end contain NOW_FREE. */ /**** note that much of this checking is not needed for the cv_cmf case, */ /**** but there is no time now (10.0) to make a salvage vs. nonsalvage */ /**** distinction. */ /**** Find the last nonzero anything in the segment. */ declare cdt_cur_length fixed bin; begin; declare 1 SB aligned like status_branch; declare d char (168); declare e char (32); declare sys_info$max_seg_size fixed bin (35) ext static; unspec (SB) = ""b; call hcs_$fs_get_path_name (cdtp, d, (0), e, (0)); call hcs_$status_long (d, e, 1 /* chase */, addr (SB), null (), (0)); if SB.current_length > 0 then cdt_cur_length = SB.current_length * 1024; /* its in records */ else cdt_cur_length = sys_info$max_seg_size; /* its in words */ end; begin; declare cdt_as_chars char (4 * cdt_cur_length) unaligned based (cdtp); /* chars because bit string ops not optimized by compiler */ declare first_non_nullx fixed bin (21); declare first_non_null fixed bin (18) unsigned; declare (length, low, reverse, verify) builtin; declare add_char_offset_ entry (ptr, fixed bin (21)) returns (ptr) reducible; first_non_nullx = verify (reverse (cdt_as_chars), low (1)); /* This is exceedingly unlikely to be nonzero, but ... */ first_non_nullx = length (cdt_as_chars) - first_non_nullx; /* ASSUME that it will not be zero !? */ first_non_null = bin (rel (add_char_offset_ (cdtp, first_non_nullx)), 18); if first_non_null < bin (rel (addr (cdt.cdt_entry (1))), 18) then go to EMPTY_CDT; /* hmmm */ do ix = 1 repeat 1 + ix; if bin (rel (addr (cdt.cdt_entry (ix))), 18) ^< first_non_null then go to FOUND_LAST_CDTE; end; FOUND_LAST_CDTE: cdt.current_size = ix; end; /* the block that finds currentsize */ RETRY_CDT_NAME_SORT: begin; declare last_in_use_cdtx fixed bin; declare 1 sort_info aligned, 2 n_cdtes fixed bin (24) init (cdt.n_cdtes), 2 cdte_name_ptrs (cdt.n_cdtes) pointer unaligned; ix = 0; do cdtx = 1 to cdt.current_size; cdtep = addr (cdt.cdt_entry (cdtx)); if cdte.in_use ^= NOW_FREE then do; last_in_use_cdtx = cdtx; /* might be smaller than the value calculated above */ ix = ix + 1; sort_info.cdte_name_ptrs (ix) = addr (cdte.name); end; else unspec (cdte.threads) = ""b; end; cdt.current_size = last_in_use_cdtx; /* correct silently */ if ix ^= cdt.n_cdtes then do; call signal_warning (as_error_table_$cdte_in_use_wrong, "There were ^d non-free channels within the current CDT size (^d), but cdt.n_cdtes was ^d.", ix, cdt.current_size, cdt.n_cdtes); cdt.n_cdtes = ix; go to RETRY_CDT_NAME_SORT; end; call sort_items_$char (addr (sort_info), 32); first_cdtep = addr (cdt.cdt_entry (1)); first_cdte_offset = bin (rel (first_cdtep)); name_offset = bin (rel (addr (first_cdtep -> cdte.name))) - first_cdte_offset; cdte_size = currentsize (cdte); do ix = 1 to cdt.n_cdtes; /* now turn the array of pointers to names */ /* into an array of cdtx's. This is a bit messy */ /**** Given a cdtep derived from the name ptr, we can get the relative */ /**** offset from the first cdte, and divide by cdte size for an index. */ /**** the first cdte will come out as 0, so we add one. */ cdtep = addrel (sort_info.cdte_name_ptrs (ix), -name_offset); thread_order (ix) = divide (bin (rel (cdtep)) - first_cdte_offset, cdte_size, 18, 0) + 1; end; end; /* Free up the array of pointers */ /**** Now we have a vector of cdtx's that represents the sort order */ /**** of the cdte names. so we can thread each one in trivially. */ /**** Since threading from scratch is not a time-critical operation, */ /**** it is done by calling the thread_in_cdte procedure once for each */ do ix = 1 to cdt.current_size; /* wipe old threads */ unspec (cdt.cdt_entry (ix).threads) = ""b; end; unspec (cdt.threads) = ""b; do ix = 1 to cdt.n_cdtes; call thread_in_cdte ((thread_order (ix))); /* unaligned to aligned across this call */ end; /* This should be a threaded cdt. */ EMPTY_CDT: return; %page; thread_in_cdte: procedure (cdtx); declare cdtx fixed bin; declare parent_name character (32); declare parentx fixed bin; /* cdt or fnpx */ declare sisx fixed bin; declare l_cdtep pointer; declare 1 lcdte aligned like cdte based (l_cdtep); declare p_cdtep pointer; declare 1 pcdte aligned like cdte based (p_cdtep); declare 1 lthreads aligned like channel_threads based (threads_ptr); declare threads_ptr pointer; declare fnpe_sw bit (1) aligned; l_cdtep = addr (cdt.cdt_entry (cdtx)); parent_name = reverse (after (reverse (lcdte.name), ".")); if parent_name = "" then parent_name = lcdte.name; if parent_name = lcdte.name /* is it top level? */ then do; /* check for conflict with fnp names and handle top level threads */ /**** inside this block, parent_XXX are really current_XXX */ call parse_fnp_name_ (parent_name, fnpx); if fnpx > 0 /* Legal FNP */ then do; call signal_error (as_error_table_$illegal_top_mpx_name, "Non-FNP channel ^a has name reserved for FNP's.", parent_name); Code = as_error_table_$illegal_top_mpx_name; go to RETURN; end; /**** valid top level mpx name. Thread into top level chain */ lcdte.threads.mother = 0; /* top of tree */ lcdte.threads.daughter, lcdte.threads.daughter_count = 0; if cdt.threads.daughter = 0 /* first nonfnp top mpx */ then do; cdt.threads.daughter = cdtx; cdt.threads.daughter_count = 1; lcdte.threads.prev_sister, lcdte.threads.next_sister = 0; /* cleaner */ end; else do; do parentx = cdt.threads.daughter repeat (cdt.cdt_entry (parentx).next_sister) while (cdt.cdt_entry (parentx).next_sister ^= 0 & parent_name > cdt.cdt_entry (parentx).name); end; /* stop on end-of-the-line or < */ /* p_cdtep points to ELDER SISTER OR YOUNGER SISTER ! */ p_cdtep = addr (cdt.cdt_entry (parentx)); if parent_name < pcdte.name then do; /* goes in before */ lcdte.prev_sister = pcdte.prev_sister; pcdte.prev_sister = cdtx; lcdte.next_sister = parentx; cdt.threads.daughter_count = cdt.threads.daughter_count + 1; end; else if parent_name > pcdte.name /* end of chain */ then do; pcdte.next_sister = cdtx; /* was 0 */ lcdte.prev_sister = parentx; lcdte.next_sister = 0; cdt.threads.daughter_count = cdt.threads.daughter_count + 1; end; else do; /* OOPS */ call signal_error (error_table_$namedup, "Channel ^a already in cdt. newx = ^d, oldx = ^d.", lcdte.name, cdtx, parentx); /***** Return here is a request to fix it, because its the live cdt. */ call signal_warning (0, "Deleting second copy of ^a (at ^d).", lcdte.name, cdtx); lcdte.in_use = NOW_FREE; end; end; end; /* top level mpx case */ else do; /* non-top-level */ call find_channel (parent_name, parentx, fnpe_sw, code); /* fnpe_sw is "1"b if parent is a FNP */ if code ^= 0 then do; call signal_error (code, "Channel ^a: parent channel ^a not in cdt.", lcdte.name, parent_name); /***** return here indicates that it was the service CDT that was busted, *****/ /***** and repairs should be attempted */ call signal_warning (0, "Deleting orphan channel ^a (^d).", lcdte.name, cdtx); lcdte.in_use = NOW_FREE; end; if fnpe_sw then threads_ptr = addr (cdt.fnp_entry (-parentx).threads); else threads_ptr = addr (cdt.cdt_entry (parentx).threads); lcdte.daughter, lcdte.daughter_count = 0; lcdte.mother = parentx; if lthreads.daughter = 0 /* first daughter */ then do; lthreads.daughter = cdtx; lthreads.daughter_count = 1; lcdte.next_sister, lcdte.prev_sister = 0; end; else do; do sisx = lthreads.daughter /** **/ repeat (cdt.cdt_entry (sisx).next_sister) /** **/ while (cdt.cdt_entry (sisx).next_sister ^= 0 /** **/ & lcdte.name > cdt.cdt_entry (sisx).name); end; /* stop on end-of-the-line or < */ p_cdtep = addr (cdt.cdt_entry (sisx)); /* pcdte is ELDER OR YOUNGER SISTER */ if lcdte.name < pcdte.name then do; /* before */ lcdte.prev_sister = pcdte.prev_sister; pcdte.prev_sister = cdtx; lcdte.next_sister = sisx; if lcdte.prev_sister > 0 then cdt.cdt_entry (lcdte.prev_sister).next_sister = cdtx; else lthreads.daughter = cdtx; /* This is now head of chain */ lthreads.daughter_count = lthreads.daughter_count + 1; end; else if lcdte.name > pcdte.name then do; lcdte.prev_sister = sisx; lcdte.next_sister = 0; pcdte.next_sister = cdtx; lthreads.daughter_count = lthreads.daughter_count + 1; end; else do; call signal_error (error_table_$namedup, "Channel ^a already in CDT. newx = ^d, oldx = ^d.", lcdte.name, cdtx, sisx); call signal_warning (0, "Deleting duplicate channel ^a (^d).", lcdte.name, cdtx); lcdte.in_use = NOW_FREE; end; end; /* nontrivial chain */ end; /* non-top-level */ end thread_in_cdte; /* thats all for that */ %page; find_channel: procedure (name, idx, fnpe_sw, code); declare name character (32); declare target_name character (32); declare idx fixed bin; declare fnpe_sw bit (1) aligned; declare code fixed bin (35); declare correct_level bit (1) aligned; declare new_compare_length fixed bin; declare x fixed bin; declare compare_length fixed bin (21); declare ltp pointer; declare start_threads_ptr pointer; declare daughters_seen fixed bin; declare total_channels_seen fixed bin; declare first_name character (32) aligned; /**** we call signal_error for inconsistencies, return code for channel-not-found */ /**** this entrypoint always starts at the top. find_channel_start is called */ target_name = name; /**** with a cdtx or fnpx to start at. It enters further down, after the top level */ /**** stuff. */ /**** we establish the search start point by checking for the FNP case. */ /**** it is too painful to make the efficient searcher deal with that. */ code = 0; first_name = before (target_name, "."); call parse_fnp_name_ ((first_name), fnpx); if fnpx > 0 then do; /* forsure */ if first_name = target_name /* thats all they wanted */ then do; idx = -fnpx; fnpe_sw = "1"b; return; end; start_threads_ptr = addr (cdt.fnp_entry (fnpx).threads); compare_length = index (substr (target_name, 3), "."); if compare_length = 0 then do; compare_length = length (rtrim (target_name)); correct_level = "1"b; end; else do; compare_length = compare_length + 1; /* dont look for trailing . */ correct_level = "0"b; end; end; else do; start_threads_ptr = addr (cdt.threads); /* start with toplevel chain */ compare_length = index (target_name, "."); if compare_length = 0 then do; correct_level = "1"b; /* looking at this level for final answer */ compare_length = length (rtrim (target_name)); end; else do; compare_length = compare_length - 1; /* channels cant end in . */ correct_level = "0"b; end; end; fnpe_sw = "0"b; /* guaranteed */ ltp = start_threads_ptr; total_channels_seen = 0; /**** ltp must be a pointer to a thread block for the parent */ /**** of the next list to examine when control gets here */ RECURSE_DOWN: begin; declare search_name character (compare_length) defined (target_name) position (1); daughters_seen = 0; if ltp -> channel_threads.daughter = 0 /* no more */ then do; code = error_table_$noentry; return; end; do x = ltp -> channel_threads.daughter /** **/ repeat (cdt.cdt_entry (x).threads.next_sister) /** **/ while (x ^= 0); daughters_seen = daughters_seen + 1; total_channels_seen = total_channels_seen + 1; if daughters_seen > ltp -> channel_threads.daughter_count then do; call signal_error (as_error_table_$salvage_cdt, "Too many daughters for cdtx = ^d.", cdt.cdt_entry (x).threads.mother); go to RETURN; /* Force a return */ end; if total_channels_seen > cdt.n_cdtes then do; call signal_error (as_error_table_$salvage_cdt, "Too many channels found via threads"); go to RETURN; end; if cdt.cdt_entry (x).name = search_name then do; /* matches so far */ if correct_level /* as far as it has to */ then do; if cdt.cdt_entry (x).in_use = NOW_FREE then call signal_error (as_error_table_$salvage_cdt, "cdt entry found, but in_use is NOW_FREE."); idx = x; return; /* found */ end; new_compare_length = index (substr (target_name, compare_length + 2), "."); if new_compare_length = 0 then do; correct_level = "1"b; compare_length = length (rtrim (target_name)); end; else compare_length = compare_length + new_compare_length; ltp = addr (cdt.cdt_entry (x).threads); go to RECURSE_DOWN; /* out and into block */ end; else if cdt.cdt_entry (x).name > search_name /* cant possibly match */ | cdt.cdt_entry (x).threads.next_sister = 0 /* noplace else to look */ then do; code = error_table_$noentry; if cdt.cdt_entry (x).threads.next_sister = 0 & daughters_seen ^= ltp -> channel_threads.daughter_count then do; call signal_error (as_error_table_$salvage_cdt, "Missing daughters for cdtx ^d.", cdt.cdt_entry (x).threads.mother); go to RETURN; end; return; end; end; /* the do loop */ end RECURSE_DOWN; end find_channel; %page; signal_error: procedure options (variable); declare alp pointer; declare cu_$arg_list_ptr entry (ptr); declare code_ptr pointer; declare code fixed bin (35) based (code_ptr); declare cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); declare ioa_$general_rs entry (ptr, fixed bin, fixed bin, char (*), fixed bin (21), bit (1) aligned, bit (1) aligned); declare sub_err_ entry () options (variable); declare errormsg character (168); declare flag character (1); declare warning bit (1) aligned; warning = "0"b; go to COMMON; signal_warning: entry options (variable); warning = "1"b; COMMON: call cu_$arg_list_ptr (alp); call cu_$arg_ptr (1, code_ptr, (0), (0)); call ioa_$general_rs (alp, 2, 3, errormsg, (0), "1"b, "0"b); if warning then flag = "c"; else flag = "h"; call sub_err_ (code, "cdt_mgr_", flag, cdtp, (0), "^a", errormsg); end signal_error; %page; find_cdt_channel: entry (CDT_pointer, Channel_name, Channel_idx, FNP_sw, Code); declare ( Channel_name character (32), Channel_idx fixed bin, FNP_sw bit (1) aligned ) parameter; cdtp = CDT_pointer; call find_channel (Channel_name, Channel_idx, FNP_sw, Code); RETURN: return; thread_in_cdt_channel: entry (CDT_pointer, Channel_idx); cdtp = CDT_pointer; call thread_in_cdte (Channel_idx); cdt.n_cdtes = cdt.n_cdtes + 1; return; thread_out_cdt_channel: entry (CDT_pointer, Channel_idx); cdtp = CDT_pointer; call thread_out_cdte (Channel_idx); cdt.n_cdtes = cdt.n_cdtes - 1; if Channel_idx = cdt.current_size then cdt.current_size = cdt.current_size - 1; return; thread_out_cdte: procedure (cdtx); declare cdtx fixed bin; if cdtx < 0 then call signal_error (error_table_$badcall, "thread_out of a FNP. fnpx = ^d.", -cdtx); cdtep = addr (cdt.cdt_entry (cdtx)); if cdte.threads.prev_sister ^= 0 /* not first in chain */ then do; cdt.cdt_entry (cdte.threads.prev_sister).next_sister = cdte.threads.next_sister; if cdte.threads.next_sister ^= 0 then cdt.cdt_entry (cdte.threads.next_sister).threads.prev_sister = cdte.threads.prev_sister; end; else do; /* head of chain or singleton */ if cdte.threads.next_sister ^= 0 then cdt.cdt_entry (cdte.threads.next_sister).prev_sister = 0; if cdte.threads.mother < 0 /* FNP */ then cdt.fnp_entry (-cdte.threads.mother).daughter = cdte.threads.next_sister; else if cdte.threads.mother > 0 /* random chn */ then cdt.cdt_entry (cdte.threads.mother).daughter = cdte.threads.next_sister; else if cdte.threads.mother = 0 /* toplevel */ then cdt.threads.daughter = cdte.threads.next_sister; end; /**** now to fix mother ****/ if cdte.threads.mother < 0 then cdt.fnp_entry (-cdte.threads.mother).daughter_count = cdt.fnp_entry (-cdte.threads.mother).daughter_count - 1; else if cdte.threads.mother > 0 then cdt.cdt_entry (cdte.threads.mother).daughter_count = cdt.cdt_entry (cdte.threads.mother).daughter_count - 1; else cdt.threads.daughter_count = cdt.threads.daughter_count - 1; end thread_out_cdte; %page; init: entry (System_dir, CDT_pointer, Code); declare System_dir character (*); declare CDT char (3) init ("cdt") internal static options (constant); /* initiate the CDT, note that it is initiated, check for damage, rethread if there is and caller restarts error. */ /* if it were not for the damn initializer segfault special case, */ /* we could just have a seg_fault_error handler. No */ /* such luck. However, we establish the handler, so that the */ /* change when the faults come back will be small */ declare initiate_file_ entry (character (*), character (*), bit (*), pointer, fixed binary (24), fixed binary (35)); declare terminate_file_ entry (pointer, fixed binary (24), bit (*), fixed binary (35)); declare hcs_$force_write entry (ptr, bit (36), fixed bin (35)); declare hcs_$fs_get_path_name entry (ptr, char (*), fixed bin, char (*), fixed bin (35)); declare hcs_$status_long entry (char (*), char (*), fixed bin (1), ptr, ptr, fixed bin (35)); declare seg_fault_error condition; declare error_table_$seg_busted fixed bin (35) ext static; declare as_error_table_$cdt_not_shut_down ext static fixed bin (35); /* The goal here it to detect inconsistent cdt's without having */ /* to track around checking for inconsistencies. The claim is that */ /* the only way a cdt can get inconsistent is by a crash during installation. */ /* The only way we could detect that, though, is by force_writing some */ /* indication that something was happening whenever an installation was */ /* done. The only existing force_write primitive writes all modified pages, */ /* so the performance penalty would be excessive. Instead, we just detect */ /* any crash in between AS startup and shutdown. In that case, we signal */ /* the need for a salvage. Since a salvage is not that expensive, and */ /* crashes are (cross fingers) fairly rare, this seems appropriate. */ /* the salvaging is not done here. The caller of this entry is expected */ /* to have a sub_error_ handler in which the codes error_table_$seg_busted */ /* and as_error_table_$cdt_not_shut_down are detected. The caller might elect */ /* to give system operations the oportunity to install a cdt instead */ /* of just salvaging this one. */ cdtp, CDT_pointer = null (); Code = 0; call initiate_file_ (System_dir, CDT, RW_ACCESS, cdtp, (0), code); if code = error_table_$noentry then do; Code = code; /* expected possibility */ return; end; if cdtp = null then do; call signal_error (code, "Could not initiate ^a>^a.", System_dir, CDT); Code = code; return; end; on seg_fault_error begin; call signal_error (error_table_$seg_busted, "Damage switch set on ^a>^a.", System_dir, CDT); /**** if we get here, we are to continue */ end; if cdt.cdt_is_live then do; code = as_error_table_$cdt_not_shut_down; call signal_error (code, "^a>^a was not shut down in last session.", System_dir, CDT); /**** if we are returned to, we are to continue. If salvaging was to ****/ /**** be done, caller has done it ****/ end; cdt.cdt_is_live = "1"b; cdt.cdt_entry.iocbp (*) = null (); /* these must start out null for each bootload */ cdt.cdt_entry.use_iocb (*) = "0"b; call hcs_$force_write (cdtp, (36)"0"b, (0)); /* do the best we can */ /* for now, this will cause mux-mgr to call the thread entrypoint and then */ /* return to us. the reason for this somewhat convoluted approach is */ /* that someday it may be desirable to allow system operations to intervene */ /* before these auto-salvages, perhaps to install a different cdt. */ if cdt.version ^= CDT_version then call signal_error (error_table_$unimplemented_version, "CDT version is ^d, should be ^d.", cdt.version, CDT_version); CDT_pointer = cdtp; Code = 0; return; shut: entry (CDT_pointer); /* orderly shutdown */ cdtp = CDT_pointer; cdt.cdt_is_live = "0"b; call terminate_file_ (cdtp, (0), TERM_FILE_TERM | TERM_FILE_FORCE_WRITE, (0)); CDT_pointer, cdtp = null; return; %page; %include author_dcl; %include cdt; %include dialup_values; %include access_mode_values; %include status_structures; %include terminate_file; end cdt_mgr_;  connection_list_manager_.pl1 03/15/89 0842.4r w 03/15/89 0800.0 421902 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1987 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-05-01,Coren), approve(87-07-08,MCR7681), audit(87-03-26,GDixon), install(87-08-04,MR12.1-1055): Initial coding. 2) change(87-03-07,GDixon), approve(87-07-08,MCR7681), audit(87-07-22,Hartogs), install(87-08-04,MR12.1-1055): A) Correct coding standard violations. B) Correct cleanup strategy. C) Correct storing of service type in active_connection.service_type. D) Thread entry back to owner when $priv_remove_user is called to remove the connection from the user. E) Remove $delete_name and $delete_offset entrypoints, which aren't called by any gate and don't fit into the gate strategy. F) Change $init to ignore all but the first call during a given bootload. G) Remove references to connection_manager_data_. H) Add force_accounting_flush_entry parameter to $add entrypoint. Return this entry in the active_connection_info structure. 3) change(87-04-28,Brunelle), approve(87-07-08,MCR7681), audit(87-07-22,Hartogs), install(87-08-04,MR12.1-1055): Corrected Thread_user to correctly thread next_act_ptr entry back to this entry. 4) change(87-05-06,GDixon), approve(87-07-08,MCR7681), audit(87-07-22,Hartogs), install(87-08-04,MR12.1-1055): A) Map error_table_$lock_wait_time_exceeded into error_table_$already_initialized. B) Use sys_info$system_control_dir to locate active_connection_list. 5) change(87-05-13,Brunelle), approve(87-07-08,MCR7681), audit(87-07-22,Hartogs), install(87-08-04,MR12.1-1055): Add .owner_group_id field to structure and change code to use it. Added check for the connection list not being initialized yet. Pass back new 6) change(87-06-22,GDixon), approve(87-07-08,MCR7681), audit(87-07-22,Hartogs), install(87-08-04,MR12.1-1055): A) Add back the delete_offset entrypoint. 7) change(87-07-21,GDixon), approve(87-07-21,MCR7681), audit(87-07-22,Hartogs), install(87-08-04,MR12.1-1055): A) Sort parameter declarations. B) Correct comments. END HISTORY COMMENTS */ /* format: style4,delnl,insnl,^ifthendo */ connection_list_manager_: procedure (); return; /* main entry is never called */ /* This procedure contains a collection of entry points for managing the system-wide list of active network connections. This list is used, for example, by the Answering Service when a user process terminates in order to clean up any connections that were assigned to the process. There is an entry for each established connection. Each one has associated with it an "owner" process (frequently a login server) and a "user" process. The table is maintained in ring 1, since it is potentially accessible by all processes. Entries in this procedure are called through one of three gates: connection_list_: process must be owner and user of connection priv_connection_list_: process must be owner, but need not be user hpriv_connection_list_: process may manipulate connections of which it is neither owner nor user Further, some of the entries may be called by inner-ring network-management programs. */ /* NOTE: Someday there should be some code added to check that the list is consistent, and take some appropriate action if it isn't. */ /* DECLARATIONS */ /* PARAMETERS */ dcl a_code fixed bin (35) parameter; dcl a_connection_handle fixed bin (35) parameter; dcl a_connection_info_ptr pointer parameter; dcl a_connection_name char (*) parameter; dcl a_force_accounting char (*) parameter; dcl a_force_disconnect char (*) parameter; dcl a_handle bit (72) aligned parameter; dcl a_offset bit (18) parameter; dcl a_owner_process_id bit (36) parameter; dcl a_service_type char (*) parameter; dcl a_terminate_event_channel fixed bin (71) parameter; dcl a_usage_type fixed bin parameter; dcl a_user_group_id char (*) parameter; dcl a_user_process_id bit (36) parameter; /* AUTOMATIC */ dcl act_dir_name char (168); dcl code fixed bin (35); dcl connection_handle fixed bin (35); dcl connection_name char (32); dcl force_acct_entry char (64); dcl force_disc_entry char (64); dcl hash_index fixed bin; dcl hash_size fixed bin; dcl hpriv_entry bit (1); dcl initializer_handle bit (72) aligned; dcl locked bit (1); dcl my_process_id bit (36); dcl name_entry bit (1); dcl next_act_ptr pointer; dcl next_offset bit (18); dcl offset bit (18); dcl orig_level fixed bin; dcl owner_process_id bit (36); dcl priv_entry bit (1); dcl service_type char (32); dcl sys_high_auth bit (72) aligned; dcl temp_lock_word bit (36) aligned; dcl term_event_channel fixed bin (71); dcl this_act_ptr pointer; dcl this_ring fixed bin; dcl usage_type fixed bin; dcl user_group_id char (32); dcl user_process_id bit (36); dcl words_used fixed bin; /* AUTOMATIC STRUCTURES */ dcl 1 auto_area_info aligned like area_info; dcl 1 auto_create_branch_info aligned like create_branch_info; /* ENTRIES */ dcl convert_authorization_$from_string entry (bit (72) aligned, char (*), fixed bin (35)); dcl cu_$level_get entry (fixed bin); dcl cu_$level_set entry (fixed bin); dcl define_area_ entry (ptr, fixed bin (35)); dcl get_group_id_ entry () returns (char (32)); dcl get_process_id_ entry () returns (bit (36)); dcl get_ring_ entry () returns (fixed bin (3)); dcl hash_index_ entry (pointer, fixed bin (21), fixed bin, fixed bin) returns (fixed bin); dcl hcs_$create_branch_ entry (char (*), char (*), ptr, fixed bin (35)); dcl initiate_file_ entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35)); dcl set_lock_$lock entry (bit (36) aligned, fixed bin, fixed bin (35)); dcl set_lock_$unlock entry (bit (36) aligned, fixed bin (35)); dcl terminate_file_ entry (ptr, fixed bin (24), bit (*), fixed bin (35)); /* EXTERNAL STATIC */ dcl ( error_table_$already_initialized, error_table_$invalid_lock_reset, error_table_$lock_wait_time_exceeded, error_table_$locked_by_other_process, error_table_$locked_by_this_process, error_table_$namedup, error_table_$noentry, error_table_$not_initialized, error_table_$not_privileged, error_table_$unimplemented_version ) fixed bin (35) external static; dcl sys_info$max_seg_size fixed bin (18) external static; dcl sys_info$system_control_dir char (168) varying external static; /* INTERNAL STATIC */ dcl ACT_SEG_NAME char (32) internal static options (constant) init ("active_connection_list"); dcl LOCK_WAIT_TIME fixed bin internal static options (constant) init (10); dcl static_connection_list_ptr pointer internal static init (null ()); /* BUILTINS AND CONDITIONS */ dcl (addr, currentsize, length, mod, null, ptr, rel, string, unspec) builtin; dcl cleanup condition; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* add: entry to add a connection -- the caller is made both user and owner */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ add: entry (a_connection_name, a_connection_handle, a_service_type, a_force_disconnect, a_force_accounting, a_usage_type, a_offset, a_code); active_connection_list_ptr = null; on cleanup call Unlock (); call Setup (); usage_type = a_usage_type; force_disc_entry = a_force_disconnect; force_acct_entry = a_force_accounting; connection_name = a_connection_name; connection_handle = a_connection_handle; service_type = a_service_type; /* make sure we don't have one by this name already */ call Find (connection_name, hash_index, offset, code); if code ^= 0 then go to EXIT; /* failure to find isn't an error */ if offset ^= ""b then do; /* in fact, in this case... */ code = error_table_$namedup; go to EXIT; end; /* now make a new entry */ allocate active_connection in (active_connection_list.connection_area) set (act_ptr); unspec (active_connection) = ""b; /* start clean */ active_connection.version = ACT_VERSION_1; active_connection.connection_name = connection_name; active_connection.service_type = service_type; active_connection.owner_process_id, active_connection.user_process_id = get_process_id_ (); active_connection.owner_group_id, active_connection.user_group_id = get_group_id_ (); active_connection.force_disconnect_entry = force_disc_entry; active_connection.force_accounting_flush_entry = force_acct_entry; active_connection.connection_handle = connection_handle; active_connection.usage_type = usage_type; call Thread (); /* threads to full list, hash list, and owner chain */ call Thread_user (); a_offset = rel (act_ptr); EXIT: if locked then call Unlock (); a_code = code; return; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* (priv hpriv)_delete_(name offset), delete_offset: */ /* The following group of entry points are used to delete a connection from */ /* the list. This call may be privileged, or highly privileged; and the */ /* connection may be identified by either its name or its offset in the list */ /* segment. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ priv_delete_name: entry (a_connection_name, a_code); priv_entry = "1"b; hpriv_entry = "0"b; name_entry = "1"b; go to DELETE_JOIN; priv_delete_offset: entry (a_offset, a_code); priv_entry = "1"b; hpriv_entry = "0"b; name_entry = "0"b; go to DELETE_JOIN; delete_offset: entry (a_offset, a_code); priv_entry = "0"b; hpriv_entry = "0"b; name_entry = "0"b; go to DELETE_JOIN; hpriv_delete_name: entry (a_connection_name, a_code); priv_entry = "0"b; hpriv_entry = "1"b; name_entry = "1"b; go to DELETE_JOIN; hpriv_delete_offset: entry (a_offset, a_code); priv_entry = "0"b; hpriv_entry = "1"b; name_entry = "0"b; DELETE_JOIN: active_connection_list_ptr = null; on cleanup call Unlock (); call Setup (); my_process_id = get_process_id_ (); if name_entry then do; /* given the name, must find it */ connection_name = a_connection_name; call Find (connection_name, hash_index, offset, code); if code ^= 0 then go to EXIT; if offset = ""b then do; code = error_table_$noentry; go to EXIT; end; end; else offset = a_offset; act_ptr = ptr (active_connection_list_ptr, offset); call Delete_one_entry (); /* do it */ go to EXIT; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* XXX_delete_all_for_user: */ /* These two entry points delete all the connections of which a given */ /* process is the user; they may be invoked when the process in question */ /* terminates. The hpriv entry is called by a process other than the owner, */ /* in the event that the owner has also terminated or is otherwise */ /* unavailable. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ priv_delete_all_for_user: entry (a_user_process_id, a_code); priv_entry = "1"b; hpriv_entry = "0"b; go to DELETE_ALL_JOIN; hpriv_delete_all_for_user: entry (a_user_process_id, a_code); priv_entry = "0"b; hpriv_entry = "1"b; DELETE_ALL_JOIN: active_connection_list_ptr = null; on cleanup call Unlock (); call Setup (); user_process_id = a_user_process_id; next_act_ptr = Get_next_for_user (null (), user_process_id); /* get first one */ do while (next_act_ptr ^= null ()); this_act_ptr = next_act_ptr; next_act_ptr = Get_next_for_user (this_act_ptr, user_process_id); /* have to get next one before we delete this one */ act_ptr = this_act_ptr; /* this little maneuver is required because */ /* Get_next_for_owner plays with act_ptr. */ call Delete_one_entry (); /* to do the real work */ end; /* if Get_next_for_user returns null, there are no more */ go to EXIT; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* priv_change_user: this entry is called by the owner of a connection to */ /* assign it to a user process. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ priv_change_user: entry (a_offset, a_user_process_id, a_user_group_id, a_usage_type, a_terminate_event_channel, a_handle, a_code); active_connection_list_ptr = null; on cleanup call Unlock (); call Setup (); offset = a_offset; user_process_id = a_user_process_id; user_group_id = a_user_group_id; usage_type = a_usage_type; term_event_channel = a_terminate_event_channel; initializer_handle = a_handle; my_process_id = get_process_id_ (); act_ptr = ptr (active_connection_list_ptr, offset); if active_connection.version ^= ACT_VERSION_1 then do; /* not really an entry */ code = error_table_$noentry; go to EXIT; end; if active_connection.owner_process_id ^= my_process_id then do; code = error_table_$not_privileged; /* not one we control */ go to EXIT; end; if active_connection.user_process_id ^= user_process_id /* see if it already belongs to this user */ then do; if active_connection.user_process_id ^= ""b /* does it belong to anyone? */ then call Unthread_user (); /* yes, unthread it from them */ active_connection.user_process_id = user_process_id; call Thread_user (); end; active_connection.user_group_id = user_group_id; active_connection.owner_terminate_event_channel = term_event_channel; active_connection.owner_initializer_id = initializer_handle; active_connection.usage_type = usage_type; active_connection.delegated = "1"b; go to EXIT; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* priv_remove_user: this entry is called by the owner of a connection to */ /* take it away from a user process without assigning it to a new one. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ priv_remove_user: entry (a_offset, a_user_process_id, a_code); active_connection_list_ptr = null; on cleanup call Unlock (); call Setup (); offset = a_offset; user_process_id = a_user_process_id; my_process_id = get_process_id_ (); act_ptr = ptr (active_connection_list_ptr, offset); if active_connection.version ^= ACT_VERSION_1 then do; /* not really an entry */ code = error_table_$noentry; go to EXIT; end; if active_connection.owner_process_id ^= my_process_id then do; code = error_table_$not_privileged; /* not one we control */ go to EXIT; end; if active_connection.user_process_id ^= user_process_id /* doesn't belong to who we thought it did */ then do; code = error_table_$noentry; go to EXIT; end; call Unthread_user (); active_connection.user_process_id = active_connection.owner_process_id; active_connection.user_group_id = active_connection.owner_group_id; active_connection.delegated = ""b; call Thread_user (); go to EXIT; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* hpriv_get_next: This entry gets the next connection after the specified */ /* one (or the first one if the offset given is ""b). It is used at */ /* login_server initialization in order to find orphaned connections. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ hpriv_get_next: entry (a_offset, a_connection_info_ptr, a_code); active_connection_list_ptr = null; on cleanup call Unlock (); call Setup (); offset = a_offset; active_connection_info_ptr = a_connection_info_ptr; priv_entry = "0"b; hpriv_entry = "1"b; if offset = ""b then next_offset = active_connection_list.first_connection_offset; else do; act_ptr = ptr (active_connection_list_ptr, offset); next_offset = active_connection.next_connection; end; if next_offset = ""b then code = error_table_$noentry; else do; act_ptr = ptr (active_connection_list_ptr, next_offset); call Fill_info (); end; go to EXIT; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* XXX_get_name: */ /* These two entry points return information for the connection with the */ /* specified name. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ priv_get_name: entry (a_connection_name, a_connection_info_ptr, a_code); priv_entry = "1"b; hpriv_entry = "0"b; go to GET_NAME_JOIN; hpriv_get_name: entry (a_connection_name, a_connection_info_ptr, a_code); priv_entry = "0"b; hpriv_entry = "1"b; GET_NAME_JOIN: active_connection_list_ptr = null; on cleanup call Unlock (); call Setup (); connection_name = a_connection_name; active_connection_info_ptr = a_connection_info_ptr; call Find (connection_name, hash_index, offset, code); if code ^= 0 then go to EXIT; if offset = ""b then do; code = error_table_$noentry; go to EXIT; end; act_ptr = ptr (active_connection_list_ptr, offset); call Fill_info (); go to EXIT; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* XXX_get_next_user: */ /* The following entries return information about the next connection after */ /* the one with the specified offset with the same user, or the first for */ /* the given user if the offset is "0"b. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ priv_get_next_user: entry (a_user_process_id, a_offset, a_connection_info_ptr, a_code); priv_entry = "1"b; hpriv_entry = "0"b; go to GET_NEXT_USER_JOIN; hpriv_get_next_user: entry (a_user_process_id, a_offset, a_connection_info_ptr, a_code); priv_entry = "0"b; hpriv_entry = "1"b; GET_NEXT_USER_JOIN: active_connection_list_ptr = null; on cleanup call Unlock (); call Setup (); user_process_id = a_user_process_id; offset = a_offset; active_connection_info_ptr = a_connection_info_ptr; if offset = ""b then act_ptr = null (); else act_ptr = ptr (active_connection_list_ptr, offset); act_ptr = Get_next_for_user (act_ptr, user_process_id); if act_ptr ^= null () then call Fill_info (); else code = error_table_$noentry; go to EXIT; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* XXX_get_next_owner: */ /* The following entries return information about the next connection for */ /* which the calling process is the owner (or the first such if offset is */ /* "0"b). */ /* */ /* The highly privileged entrypoint returns information about a specified */ /* owner. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ priv_get_next_owner: entry (a_offset, a_connection_info_ptr, a_code); priv_entry = "1"b; hpriv_entry = "0"b; owner_process_id = get_process_id_ (); go to GET_NEXT_OWNER_JOIN; hpriv_get_next_owner: entry (a_offset, a_owner_process_id, a_connection_info_ptr, a_code); priv_entry = "0"b; hpriv_entry = "1"b; owner_process_id = a_owner_process_id; GET_NEXT_OWNER_JOIN: active_connection_list_ptr = null; on cleanup call Unlock (); call Setup (); offset = a_offset; active_connection_info_ptr = a_connection_info_ptr; if offset = ""b then act_ptr = null (); else do; act_ptr = ptr (active_connection_list_ptr, offset); if active_connection.owner_process_id ^= owner_process_id /* this isn't the right process to begin with */ then do; if hpriv_entry then code = error_table_$noentry; else code = error_table_$not_privileged; go to EXIT; end; end; act_ptr = Get_next_for_owner (act_ptr, owner_process_id); if act_ptr ^= null () then call Fill_info (); else code = error_table_$noentry; go to EXIT; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* init: */ /* This entry is called during system start up to create and initialize the */ /* segment that contains the active connection table. The directory in which */ /* to create it is obtained from >sc1. hash table size is a named constant */ /* from the include file. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ init: entry (a_code); act_dir_name = sys_info$system_control_dir; hash_size = ACT_HASH_TABLE_SIZE; this_ring = get_ring_ (); call cu_$level_get (orig_level); on cleanup call cu_$level_set (orig_level); call cu_$level_set (this_ring); /* need lower-ring validation level for initiation or creation */ call initiate_file_ (act_dir_name, ACT_SEG_NAME, RW_ACCESS, active_connection_list_ptr, (0), code); if code = error_table_$noentry then do; /* doesn't exist, we'll have to create it */ auto_create_branch_info.version = create_branch_version_2; string (auto_create_branch_info.switches) = ""b; auto_create_branch_info.mode = RW_ACCESS; auto_create_branch_info.rings (*) = this_ring; auto_create_branch_info.userid = "*.*.*"; auto_create_branch_info.bitcnt = 0; auto_create_branch_info.quota = 0; /* For debugging purposes, we will create the segment (in the user ring) at system low, but in real life it should be system_high. */ call convert_authorization_$from_string (sys_high_auth, "system_low" /* "system_high" */, code); if code ^= 0 then go to INIT_EXIT; auto_create_branch_info.access_class = sys_high_auth; /* make it multi-class */ auto_create_branch_info.dir_quota = 0; call hcs_$create_branch_ (act_dir_name, ACT_SEG_NAME, addr (auto_create_branch_info), code); if code = 0 then call initiate_file_ (act_dir_name, ACT_SEG_NAME, RW_ACCESS, active_connection_list_ptr, (0), code); end; call cu_$level_set (orig_level); /* so's we don't forget */ if code = 0 then do; call set_lock_$lock (active_connection_list.initializer_of_list, 0, code); if code = error_table_$invalid_lock_reset then code = 0; else if code = error_table_$locked_by_other_process | code = error_table_$locked_by_this_process | code = error_table_$lock_wait_time_exceeded then code = error_table_$already_initialized; end; if code = 0 then do; /* created or otherwise, we have it now */ /* initialize the contents */ active_connection_list.version = ACTL_VERSION_1; active_connection_list.lock = ""b; active_connection_list.no_of_connections = 0; active_connection_list.first_connection_offset, active_connection_list.last_connection_offset = ""b; active_connection_list.hash_table.size, actl_hash_table_size = hash_size; active_connection_list.hash_table.entries (*) = ""b; connection_area_size = 0; /* so we can use currentsize */ words_used = currentsize (active_connection_list); words_used = words_used + mod (words_used, 2); /* round up to even number */ call terminate_file_ (addr (active_connection_list), words_used * BITS_PER_WORD, TERM_FILE_TRUNC, code); connection_area_size = sys_info$max_seg_size - words_used; /* rest of segment is available for area */ area_infop = addr (auto_area_info); area_info.version = 1; string (area_info.control) = ""b; area_info.owner = get_group_id_ (); area_info.size = connection_area_size; area_info.areap = addr (active_connection_list.connection_area); area_info.allocated_blocks, area_info.free_blocks, area_info.allocated_words, area_info.free_words = 0; call define_area_ (area_infop, code); end; INIT_EXIT: call cu_$level_set (orig_level); /* in case we didn't do this before */ a_code = code; return; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* I N T E R N A L P R O C E D U R E S */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Delete_one_entry: deletes the connection list entry pointed to by */ /* act_ptr. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Delete_one_entry: procedure (); if active_connection.version ^= ACT_VERSION_1 then do; if name_entry then code = error_table_$unimplemented_version; else code = error_table_$noentry; go to EXIT; end; if hpriv_entry then ; else if priv_entry then if active_connection.owner_process_id ^= my_process_id then do; /* we don't own this one */ code = error_table_$not_privileged; go to EXIT; end; else ; else if active_connection.user_process_id ^= my_process_id then do; /* no privileges, we should be user */ code = error_table_$not_privileged; go to EXIT; end; call Unthread_user (); /* take it out of user chain */ call Unthread (); /* and others */ active_connection.version = ""; /* make sure it doesn't look like a good entry */ active_connection.connection_name = ""; free active_connection in (active_connection_list.connection_area); /* get the space back */ end Delete_one_entry; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Fill_info: fills in the active_connection_info structure for the current */ /* entry. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Fill_info: procedure (); if active_connection_info.version ^= ACT_INFO_VERSION_1 then do; code = error_table_$unimplemented_version; return; end; active_connection_info.connection_name = active_connection.connection_name; active_connection_info.network_service_type = active_connection.service_type; active_connection_info.user_process_id = active_connection.user_process_id; active_connection_info.user_group_id = active_connection.user_group_id; active_connection_info.owner_process_id = active_connection.owner_process_id; active_connection_info.owner_group_id = active_connection.owner_group_id; active_connection_info.terminate_event_channel = active_connection.owner_terminate_event_channel; active_connection_info.owner_initializer_handle = active_connection.owner_initializer_id; active_connection_info.force_disconnect_entry = active_connection.force_disconnect_entry; active_connection_info.force_accounting_flush_entry = active_connection.force_accounting_flush_entry; active_connection_info.connection_handle = active_connection.connection_handle; active_connection_info.usage_type = active_connection.usage_type; active_connection_info.flags.delegated = active_connection.flags.delegated; active_connection_info.offset = rel (act_ptr); return; end Fill_info; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Find: */ /* Searches the list (using the hash table) for a connection with the */ /* specified name, and returns its offset if one is found. Also returns the */ /* index to which the name hashes, for later use in threading/unthreading. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Find: procedure (a_connection_name, a_hash_index, a_offset, a_code); dcl a_connection_name char (32) parameter; dcl a_hash_index fixed bin parameter; dcl a_offset bit (18) parameter; dcl a_code fixed bin (35) parameter; dcl hash_value fixed bin; dcl connection_name char (32) aligned; dcl offset bit (18); dcl found bit (1); connection_name = a_connection_name; hash_value = hash_index_ (addr (connection_name), length (connection_name), (0), active_connection_list.hash_table.size) + 1; /* our table is 1-based, but hash_index_'s result is 0-based */ offset = active_connection_list.hash_table.entries (hash_value); if offset ^= ""b /* if there are any names that hash to this value */ then do; found = "0"b; do while ((^found) & (offset ^= ""b)); /* find the one that actually has the same name */ act_ptr = ptr (active_connection_list_ptr, offset); if active_connection.connection_name = connection_name then found = "1"b; else offset = active_connection.next_hash; /* not this one, check next */ end; end; a_offset = offset; /* = ""b if name not found */ a_hash_index = hash_value; /* valid in any case */ a_code = 0; /* always */ return; end Find; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Get_next_for_user: */ /* Returns a pointer to the next connection for the same user (and, if not */ /* the hpriv entry, the same owner) after the one input; or the first one if */ /* a_act_ptr is null. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Get_next_for_user: procedure (a_act_ptr, a_process_id) returns (pointer); dcl a_act_ptr pointer parameter; dcl a_process_id bit (36) parameter; dcl found bit (1); dcl my_process_id bit (36); dcl next_offset bit (18); dcl owner_process_id bit (36); dcl user_process_id bit (36); act_ptr = a_act_ptr; user_process_id = a_process_id; my_process_id = get_process_id_ (); if act_ptr ^= null () /* we were given one, find next */ then do; next_offset = active_connection.next_connection_for_user; if next_offset = ""b /* there isn't one */ then return (null ()); act_ptr = ptr (active_connection_list_ptr, next_offset); /* this is the one we will consider */ end; else do; /* given nul pointer, we'll have to find first one */ found = "0"b; do next_offset = active_connection_list.first_connection_offset repeat (active_connection.next_connection) while ((next_offset ^= ""b) & (^found)); act_ptr = ptr (active_connection_list_ptr, next_offset); if active_connection.user_process_id = user_process_id then found = "1"b; end; if ^found then return (null ()); /* there weren't any */ end; /* if not privileged entry, make sure we're the owner */ if ^hpriv_entry then do while (active_connection.owner_process_id ^= my_process_id); next_offset = active_connection.next_connection_for_user; if next_offset = ""b /* we ran out */ then return (null ()); else act_ptr = ptr (active_connection_list_ptr, next_offset); end; return (act_ptr); /* if we get to here, we've got the right one */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Get_next_for_owner: */ /* Likewise, but returns a pointer to the next one for the given owner */ /* process. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Get_next_for_owner: entry (a_act_ptr, a_process_id) returns (pointer); act_ptr = a_act_ptr; owner_process_id = a_process_id; if act_ptr ^= null () /* we were given one, find next */ then do; next_offset = active_connection.next_connection_for_owner; act_ptr = ptr (active_connection_list_ptr, next_offset); /* this is the one we will consider */ if next_offset = ""b /* there isn't one */ then return (null ()); else return (act_ptr); end; else do; /* have to find first one */ do next_offset = active_connection_list.first_connection_offset repeat (active_connection.next_connection) while (next_offset ^= ""b); act_ptr = ptr (active_connection_list_ptr, next_offset); if active_connection.owner_process_id = owner_process_id then return (act_ptr); /* this is it */ end; return (null ()); /* there weren't any */ end; end Get_next_for_user; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Lock: lock the active connection table. */ /* Unlock: unlock it. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Lock: procedure (a_code) returns (bit (1)); dcl a_code fixed bin (35) parameter; dcl code fixed bin (35); call set_lock_$lock (active_connection_list.lock, LOCK_WAIT_TIME, code); if code = 0 | code = error_table_$invalid_lock_reset then do; a_code = 0; return ("1"b); end; else do; a_code = code; return ("0"b); end; end Lock; Unlock: procedure (); dcl code fixed bin (35); if active_connection_list_ptr ^= null then call set_lock_$unlock (active_connection_list.lock, code); return; end Unlock; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Setup: */ /* 1) Initialize code variable to 0. */ /* 2) Get pointer to active_connection_list segment if we don't already have */ /* a static copy. */ /* 3) Lock the connection table. */ /* 4) Make sure the table has been initialized this bootload. If not, */ /* return error back to caller. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Setup: procedure (); act_dir_name = sys_info$system_control_dir; code = 0; locked = "0"b; if static_connection_list_ptr = null () /* first use in this process */ then do; call cu_$level_get (orig_level); on cleanup call cu_$level_set (orig_level); call cu_$level_set (get_ring_ ()); /* need lower-ring validation level for initiation or creation */ call initiate_file_ (act_dir_name, ACT_SEG_NAME, RW_ACCESS, static_connection_list_ptr, (0), code); call cu_$level_set (orig_level); if code ^= 0 then go to EXIT; end; active_connection_list_ptr = static_connection_list_ptr; locked = Lock (code); if code ^= 0 then go to EXIT; /* make sure database has been initialized this bootload */ temp_lock_word = active_connection_list.initializer_of_list; call set_lock_$lock (temp_lock_word, 0, code); if code = error_table_$invalid_lock_reset then do; code = error_table_$not_initialized; go to EXIT; end; else if code = error_table_$locked_by_other_process | code = error_table_$locked_by_this_process | code = error_table_$lock_wait_time_exceeded then code = 0; if code ^= 0 then go to EXIT; return; end Setup; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Thread: threads a connection into: */ /* 1) the list of all connections, */ /* 2) the threaded list by owner, and */ /* 3) the list sharing a hash index. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Thread: procedure (); dcl found bit (1); dcl hash_value fixed bin; dcl last_hash bit (18); dcl next_act_ptr pointer; dcl next_hash bit (18); dcl next_offset bit (18); dcl offset bit (18); dcl prev_act_ptr pointer; dcl prev_hash bit (18); dcl prev_offset bit (18); dcl temp_act_ptr pointer; offset = rel (act_ptr); if active_connection_list.hash_table.entries (hash_index) = ""b then do; /* this is the first one with this hash_index */ active_connection_list.hash_table.entries (hash_index) = offset; active_connection.prev_hash = ""b; end; else do; /* hash slot occupied, thread it to hash list */ do last_hash = active_connection_list.hash_table.entries (hash_index) repeat (next_hash) while (last_hash ^= ""b); temp_act_ptr = ptr (active_connection_list_ptr, last_hash); next_hash = temp_act_ptr -> active_connection.next_hash; prev_hash = last_hash; end; temp_act_ptr -> active_connection.next_hash = offset; active_connection.prev_hash = prev_hash; end; active_connection.next_hash = ""b; /* in any case */ /* now thread into owner list */ found = "0"b; do prev_offset = active_connection_list.last_connection_offset repeat (temp_act_ptr -> active_connection.prev_connection) while ((prev_offset ^= ""b) & (^found)); temp_act_ptr = ptr (active_connection_list_ptr, prev_offset); if temp_act_ptr -> active_connection.owner_process_id = active_connection.owner_process_id then found = "1"b; /* we found the end of the list for this owner */ end; if found then do; active_connection.prev_connection_for_owner = rel (temp_act_ptr); temp_act_ptr -> active_connection.next_connection_for_owner = offset; end; else active_connection.prev_connection_for_owner = ""b; /* there aren't any others yet */ active_connection.next_connection_for_owner = ""b;/* in any case */ /* now thread it onto end of list of all connections */ active_connection.prev_connection = active_connection_list.last_connection_offset; active_connection.next_connection = ""b; if active_connection_list.last_connection_offset = ""b then do; /* this is the very first one */ active_connection_list.first_connection_offset, active_connection_list.last_connection_offset = offset; end; else do; temp_act_ptr = ptr (active_connection_list_ptr, active_connection_list.last_connection_offset); temp_act_ptr -> active_connection.next_connection = offset; active_connection_list.last_connection_offset = offset; end; active_connection_list.no_of_connections = active_connection_list.no_of_connections + 1; return; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Thread_user: */ /* threads a connection into the list by user. It finds the previous one */ /* for the same user by chasing back the global connection threads. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Thread_user: entry (); offset = rel (act_ptr); if active_connection.prev_connection = ""b then prev_act_ptr = null (); else do; found = "0"b; do prev_offset = active_connection.prev_connection repeat (prev_act_ptr -> active_connection.prev_connection) while ((prev_offset ^= ""b) & (^found)); prev_act_ptr = ptr (active_connection_list_ptr, prev_offset); if prev_act_ptr -> active_connection.user_process_id = active_connection.user_process_id then found = "1"b; end; if ^found then prev_act_ptr = null (); end; if prev_act_ptr ^= null () then do; next_offset = prev_act_ptr -> active_connection.next_connection_for_user; if next_offset = ""b then next_act_ptr = null (); else next_act_ptr = ptr (active_connection_list_ptr, next_offset); end; else do; /* none before it, find the first one after it */ if active_connection.next_connection = ""b then next_act_ptr = null (); else do; found = "0"b; do next_offset = active_connection.next_connection repeat (next_act_ptr -> active_connection.next_connection) while ((next_offset ^= ""b) & (^found)); next_act_ptr = ptr (active_connection_list_ptr, next_offset); if next_act_ptr -> active_connection.user_process_id = active_connection.user_process_id then found = "1"b; end; if ^found then next_act_ptr = null (); end; end; /* Having found next and/or previous, do the actual threading */ if next_act_ptr = null () then active_connection.next_connection_for_user = ""b; else do; active_connection.next_connection_for_user = rel (next_act_ptr); next_act_ptr -> active_connection.prev_connection_for_user = offset; end; if prev_act_ptr = null () then active_connection.prev_connection_for_user = ""b; else do; active_connection.prev_connection_for_user = rel (prev_act_ptr); prev_act_ptr -> active_connection.next_connection_for_user = offset; end; return; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Unthread: removes a connection from: */ /* 1) the list of all connections, */ /* 2) the owner list, and */ /* 3) the list sharing a hash index. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Unthread: entry (); /* Owner list first */ if active_connection.prev_connection_for_owner ^= ""b then do; prev_act_ptr = ptr (active_connection_list_ptr, active_connection.prev_connection_for_owner); prev_act_ptr -> active_connection.next_connection_for_owner = active_connection.next_connection_for_owner; end; if active_connection.next_connection_for_owner ^= ""b then do; next_act_ptr = ptr (active_connection_list_ptr, active_connection.next_connection_for_owner); next_act_ptr -> active_connection.prev_connection_for_owner = active_connection.prev_connection_for_owner; end; /* now hash list */ if active_connection.next_hash ^= ""b then do; next_act_ptr = ptr (active_connection_list_ptr, active_connection.next_hash); next_act_ptr -> active_connection.prev_hash = active_connection.prev_hash; end; if active_connection.prev_hash ^= ""b then do; prev_act_ptr = ptr (active_connection_list_ptr, active_connection.prev_hash); prev_act_ptr -> active_connection.next_hash = active_connection.next_hash; end; else do; /* this was first one in hash list, update hash table entry */ hash_value = hash_index_ (addr (active_connection.connection_name), length (active_connection.connection_name), (0), active_connection_list.hash_table.size) + 1; /* because our table is 1-based */ active_connection_list.hash_table.entries (hash_value) = active_connection.next_hash; end; active_connection.prev_hash, active_connection.next_hash = ""b; /* now unthread it from list of all connections */ if active_connection.next_connection ^= ""b then do; next_act_ptr = ptr (active_connection_list_ptr, active_connection.next_connection); next_act_ptr -> active_connection.prev_connection = active_connection.prev_connection; end; else active_connection_list.last_connection_offset = active_connection.prev_connection; if active_connection.prev_connection ^= ""b then do; prev_act_ptr = ptr (active_connection_list_ptr, active_connection.prev_connection); prev_act_ptr -> active_connection.next_connection = active_connection.next_connection; end; else active_connection_list.first_connection_offset = active_connection.next_connection; active_connection.prev_connection, active_connection.next_connection = ""b; active_connection_list.no_of_connections = active_connection_list.no_of_connections - 1; return; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Unthread_user: */ /* removes a connection from the list threaded by user. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Unthread_user: entry (); if active_connection.prev_connection_for_user ^= ""b then do; prev_act_ptr = ptr (active_connection_list_ptr, active_connection.prev_connection_for_user); prev_act_ptr -> active_connection.next_connection_for_user = active_connection.next_connection_for_user; end; if active_connection.next_connection_for_user ^= ""b then do; next_act_ptr = ptr (active_connection_list_ptr, active_connection.next_connection_for_user); next_act_ptr -> active_connection.prev_connection_for_user = active_connection.prev_connection_for_user; end; active_connection.prev_connection_for_user, active_connection.next_connection_for_user = ""b; return; end Thread; /* * * * * * * * * * * * * * * * * * * * * * * * * */ %include access_mode_values; %include active_connection_list; %include active_connection_info; %include area_info; %include create_branch_info; %include system_constants; %include terminate_file; end connection_list_manager_;  dial_ctl_.pl1 05/16/89 1058.6rew 05/16/89 1053.1 946719 /****^ *********************************************************** * * * Copyright, (C) BULL HN Information Systems Inc., 1989 * * * * 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(85-08-07,Swenson), approve(87-07-13,MCR7741), audit(87-07-24,Brunelle), install(87-08-04,MR12.1-1055): to check for access on "tandd.acs" rather than just "tandd". Also, to log errors received when issuing tandd_attach control order. 2) 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. 3) change(86-06-29,Swenson), approve(87-07-13,MCR7741), audit(87-07-24,Brunelle), install(87-08-04,MR12.1-1055): Modified to check anstbl.login_server_present before calling uc_cleanup_network_dials_ to ensure that the MNA RPQ code is only invoked if it is present. 4) change(86-07-18,Swenson), approve(86-08-13,MCR7512), audit(86-08-13,EJSharpe), install(86-09-08,MR12.0-1150): Modified to not attempt to logout channels whose service type is not normally login-type. (Actual change date was 85-07-18) 5) change(86-07-23,Swenson), approve(86-08-13,MCR7512), audit(86-08-13,EJSharpe), install(86-09-08,MR12.0-1150): Modified to increase the maximum length of "reason" so entire audit message can be displayed. (Actual change date was 85-07-23) 6) change(86-07-23,Swenson), approve(86-08-13,MCR7512), audit(86-08-13,EJSharpe), install(86-09-08,MR12.0-1150): Modified to require RW access to ACS path before allowing access to channels. (Actual change date was 85-07-23) 7) change(86-07-24,Swenson), approve(86-08-13,MCR7512), audit(86-08-13,EJSharpe), install(86-09-08,MR12.0-1150): Modified to check the dialok attribute for the terminate_dial_out request for consistency with all other requests. (Actual change date was 85-07-24) 8) change(86-07-24,Swenson), approve(86-08-13,MCR7512), audit(86-08-13,EJSharpe), install(86-09-08,MR12.0-1150): Modified to send control messages for all granted requests. (Actual change date was 85-07-24) 9) change(86-07-24,Swenson), approve(86-08-13,MCR7512), audit(86-08-13,EJSharpe), install(86-09-08,MR12.0-1150): Modified to ensure dial_out requests check the service type of the requested channel before attempting to see if it is in use. (Actual change date was 85-07-24) 10) change(86-07-25,Swenson), approve(86-08-13,MCR7512), audit(86-08-13,EJSharpe), install(86-09-08,MR12.0-1150): Modified to fix various small bugs which prevented correct operation during functional testing. (Actual change date was 85-07-25) 11) change(86-07-27,Swenson), approve(86-08-13,MCR7512), audit(86-08-13,EJSharpe), install(86-09-08,MR12.0-1150): Modified to ensure a channel's access class is correct before using it in access calculations. Also to reset the access class when the channel hangs up. (Actual change date was 85-07-25) 12) change(86-10-14,Lippard), approve(85-12-30,MCR7326), audit(86-10-27,GDixon), install(86-10-28,MR12.0-1200): Modified to use as_request_sender version 2. 13) change(87-04-03,Parisek), approve(87-07-13,MCR7741), audit(87-07-24,Brunelle), install(87-08-04,MR12.1-1055): Test for variable size before assigning value to variable to prevent stringsize errors. 14) change(87-04-27,GDixon), approve(87-07-13,MCR7741), audit(87-07-24,Brunelle), install(87-08-04,MR12.1-1055): Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1 15) change(87-06-01,GDixon), approve(87-07-13,MCR7741), audit(87-07-24,Brunelle), install(87-08-04,MR12.1-1055): Expand aliases in "dial DIAL_ID person.project". 16) change(87-06-12,GDixon), approve(87-07-13,MCR7741), audit(87-07-24,Brunelle), install(87-08-04,MR12.1-1055): A) Change to audit all dial actions via as_access_audit_$channel, rather than doing some there and some by direct calls to sys_log_. 17) change(87-06-23,GDixon), approve(87-07-13,MCR7741), audit(87-07-24,Brunelle), install(87-08-04,MR12.1-1055): A) Correct format of "dial system" audit messages. B) Avoid calling as_access_audit_ when no process is associated with the operation. 18) change(88-11-28,Farley), approve(88-12-14,MCR8035), audit(89-05-15,Parisek), install(89-05-16,MR12.3-1045): Corrected look_for_channel procedure to check for a "no available device" error before checking for a "bad access" error. END HISTORY COMMENTS */ /* format: style2,indcomtxt,^inddcls,^indattr */ dial_ctl_: procedure (P_cdtep, P_dial_qualifier, P_target_person_project, P_code); /* DIAL_CTL_ - answering service module which handles "dial" preaccess commands, user requests to attach, release, dial_out, and tandd_attach communications channels. */ /* Modified 750117 by PG for dial_qualifiers. Modified 750307 by PG for dialing to absentee and daemon processes. Modified 750716 by PG to get privileged attach to work. Modified 750812 by PG & THVV for cdt. Modified 03/18/76 by David Jordan for Auto Call. Modified 07/20/76 by D. M. Wells to use new WAIT_DIAL_GRAB cdte state Modified 760819 by Roy Planalp to produce special messages for ftp users Modified Aug-Sept 1976 by M. Grady and T. Casey to properly dispose of a dialed channel whose master process terminated Modified by S.T. Kent Nov-Dec 1976 to add registered dial qualifier facility and facility to release a selected dialed channel. Modified by D. M. Wells, May, 1977, to fix bug wrt slave channels and to improve error messages. Modified by Robert Coren, June, 1977, to use new terminal type stuff. Modified November 1978 by Larry Johnson to pass devx's in dial messages because channel names became longer than 6 characters. Modified April 1979 by T. Casey for MR7.0a to eliminate "s" as a synonym for "system" in the dial command. Modified April 1979 by Larry Johnson for no_hangup feature of release_channel. Modified July 1979 by C. Hornig to properly recognize non-FNP MCS channels. Modified September 1979 by Larry Johnson to set terminal types on slave channels. Modified November 1980 by Art Beattie to only look for dial out channels on loaded multiplexers and correct error messages. Modified November 1980 by E.N. Kittlitz for new dialout requests, cleanup and bugfixes. Modified March 1981 by Robert Coren for T & D attachments. Modified April 1981 by Robert Coren to issue copy_meters order when assigning channel. Modified April 1981 by E. N. Kittlitz for cdte.dial_ev_chn. Modified November 1981, E. N. Kittlitz. user_table_entry conversion. Modified April 1982, E. N. Kittlitz. New AS initialization. Modified July 1982, E. N. Kittlitz. Support MCS channel (un)masking. Modified November 1982, E. N. Kittlitz. don't use masked dial-out channels. Modified January 1983, Keith Loepere for generic_destination and so priv_attach also scans for suitable channel. Modified May 1983, E. N. Kittlitz. required access class support for AIMish stys. Modified 831216, E. N. Kittlitz. fix required access class, dial_out, when mux is down. Modified 840211, Jeffrey I. Schiller fix required access class for "dial" command. Modified 84-04-05 BIM to finish channel AIM, recasting required access class. Modified 84-04-20 BIM to add tracing to debug above. Modified 1984-09-28 BIM to fix t&d attach, log release, change trace sv. Modified 1984-10-03 BIM to use fake_connect protocol for t&d failures. Modified 1984-10-04 BIM to use up_sysctl_$check_acs for tandd.acs Modified 1984-10-17 by E. Swenson to clean up error reporting and logging and, in doing so, audit some events that should be audited. Modified 1985-01-23 by E. Swenson for new A.S. auditing. Modified 1985-02-19 BIM to clear out user_name on release. Modified 1985-04-11 by E. Swenson to fix mangled log message. */ /* Parameters */ dcl P_cdtep ptr parameter; /* pointer to channel entry for console */ dcl P_dial_qualifier char (*) parameter; /* dial qualifier */ dcl P_target_person_project char (*) parameter; /* target Person.Project */ dcl P_code fixed bin (35) parameter; /* Automatic */ dcl acs_name char (32); /* for cheching .acs segs */ dcl bf fixed bin (71) based; /* overlay for event msg */ dcl buffer char (200) aligned; dcl 1 CAI structure aligned like channel_audit_info automatic; dcl cdtx fixed bin; /* used by find_cdte */ dcl chn fixed bin (71); /* event channel */ dcl code fixed bin (35); /* error code */ dcl date char (50); /* for date_time_ */ dcl desired_channel char (32); /* from dsr.channel_name if allowing starnames */ dcl dial_qualifier char (32); dcl dial_out_used_privilege bit (1) aligned; dcl 1 DSI aligned like dial_server_info automatic; /* for as_access_audit_ */ dcl find_person_project bit (1) aligned; dcl format char (100) aligned; /* for connected to system message */ dcl i fixed bin; /* counter */ dcl junk char (8) aligned; dcl mcode fixed bin (35); /* output message */ dcl added_info char (128); /* additional info for log messages */ dcl mode bit (36) aligned; dcl phone_data char (32) varying; /* from dsr.dial_out_destination */ dcl process_id bit (36) aligned init (""b); dcl process_destroyed_flag bit (1) aligned automatic; dcl process_group_id char (32) init ("?"); dcl process_ring fixed bin (3) init (7); dcl reason char (256); /* error message component */ dcl reason_code fixed bin (35); /* error code associated with reason */ dcl request_type fixed bin (17) initial (0); /* type of request, if any */ dcl requested_access_class bit (72) aligned; dcl retval fixed bin (71); /* signal to user (see "rv") */ dcl rq_person char (22); /* for looking up user */ dcl rq_project char (9); /* for looking up user */ dcl rvp ptr; /* pointer to retval */ dcl server_authorization char (100); dcl star_channel_name bit (1) aligned; /* we have a starname channel specification */ dcl suppress_listen bit (1); dcl target_person_project char (32); dcl used_privilege bit (1) aligned; dcl user_lth fixed bin; dcl user_string char (100); dcl word char (8) aligned; dcl 1 term_info like terminal_info; dcl 1 set_type_info like set_term_type_info; /* Constant */ dcl ( JUST_DIALED bit (15) aligned initial ("77770"b3), JUST_HUNGUP bit (15) aligned initial ("77771"b3), REQUEST_GRANTED bit (15) aligned initial ("77772"b3), REQUEST_DENIED bit (15) aligned initial ("77773"b3) ) internal static options (constant); dcl ME char (9) init ("dial_ctl_") static options (constant); declare ( PRIV_ATTACH init (1), DIAL_OUT init (2), DIAL_IN init (3), T_AND_D init (4) ) fixed bin internal static options (constant); dcl ATTACHMENT_TYPES (1:4) char (12) internal static options (constant) initial ("priv_attach", "dial_out", "dial_in", "t&d_attach"); dcl ( UNKNOWN_RQ initial (0), START_DIAL_ID_RQ initial (1), STOP_DIAL_ID_RQ initial (2), RELEASE_CHN_RQ initial (3), PRIV_ATTACH_CHN_RQ initial (4), TANDD_ATTACH_CHN_RQ initial (5), RELEASE_DIAL_ID_RQ initial (6), DIAL_OUT_RQ initial (7), TERMINATE_DIAL_OUT_RQ initial (8) ) fixed bin (17) internal static options (constant); dcl REQUEST_TYPES (0:8) char (20) internal static options (constant) initial ("unknown", "start dial service", "stop dial service", "release channel", "priv attach", "tandd attach", "release dial service", "dial out", "terminate dial out"); dcl ( TRUE initial ("1"b), FALSE initial ("0"b) ) bit (1) aligned internal static options (constant); /* external static */ dcl as_error_table_$dialagain fixed bin (35) external; dcl as_error_table_$dialup_error fixed bin (35) ext static; dcl as_error_table_$dial_connect_msg fixed bin (35) external; dcl as_error_table_$dialdied fixed bin (35) external; dcl as_error_table_$dialnoline fixed bin (35) external; dcl as_error_table_$dialnotup fixed bin (35) external; dcl as_error_table_$dial_sys_msg fixed bin (35) external; dcl error_table_$action_not_performed fixed bin (35) external static; dcl error_table_$ai_restricted fixed bin (35) ext static; dcl error_table_$ai_out_range fixed bin (35) static external; dcl error_table_$bad_name fixed bin (35) static external; dcl error_table_$badstar fixed bin (35) static external; dcl error_table_$dial_active fixed bin (35) static external; dcl error_table_$dial_id_busy fixed bin (35) static external; dcl error_table_$id_not_found fixed bin (35) static external; dcl error_table_$insufficient_access fixed bin (35) static external; dcl error_table_$invalid_resource_state fixed bin (35) static external; dcl error_table_$io_no_permission fixed bin (35) static external; dcl error_table_$name_not_found fixed bin (35) static external; dcl error_table_$noentry fixed bin (35) ext static; dcl error_table_$no_connection fixed bin (35) static external; dcl error_table_$no_dialok fixed bin (35) static external; dcl error_table_$order_error fixed bin (35) static external; dcl error_table_$request_not_recognized fixed bin (35) static external; dcl error_table_$request_pending fixed bin (35) external; dcl error_table_$resource_attached fixed bin (35) ext static; dcl error_table_$resource_not_free fixed bin (35) static external; dcl error_table_$resource_unavailable fixed bin (35) static external; dcl error_table_$resource_unknown fixed bin (35) static external; dcl error_table_$unable_to_check_access fixed bin (35) static external; dcl error_table_$undefined_order_request fixed bin (35) static external; dcl error_table_$unimplemented_version fixed bin (35) static external; /* Builtin */ dcl (addr, addrel, after, before, bit, fixed, float, hbound, lbound, length, low, null, rtrim, string, substr, unspec) builtin; /* Entries */ dcl aim_check_$in_range entry (bit (72) aligned, (2) bit (72) aligned) returns (bit (1) aligned); dcl aim_check_$equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl aim_check_$greater_or_equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl aim_util_$get_access_class entry (bit (72) aligned) returns (bit (72) aligned); dcl as_access_audit_$channel entry (ptr, ptr, ptr, fixed bin, ptr, char (*)); dcl as_access_audit_$dialid entry (ptr, fixed bin, ptr, char (*)); dcl as_any_other_handler_ entry (char (*), entry, label, label); dcl astty_$tty_changemode entry (ptr, char (*), fixed bin (35)); dcl astty_$tty_detach entry (ptr, fixed bin, fixed bin (35)); dcl astty_$tty_force entry (ptr, ptr, fixed bin, fixed bin (35)); dcl astty_$tty_new_proc entry (ptr, bit (36) aligned, fixed bin (35)); dcl astty_$tty_order entry (ptr, char (*), ptr, fixed bin (35)); dcl astty_$tty_state entry (ptr, fixed bin (35)); dcl asu_$asu_listen entry (ptr, fixed bin (35)); dcl asu_$find_process entry (bit (36) aligned, fixed bin, ptr); dcl asu_$format_ftp_msg entry (char (200) aligned, fixed bin, fixed bin, fixed bin) returns (char (200) aligned); dcl asu_$reset_access_class entry (pointer); dcl asu_$write_chn_message entry (ptr, fixed bin (35), char (8) aligned, fixed bin (35)); dcl check_star_name_$entry entry (char (*), fixed bin (35)); dcl convert_access_class_$to_string_short entry (bit (72) aligned, char (*), fixed bin (35)); dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned); dcl date_time_$format entry (character (*), fixed binary (71), character (*), character (*)) returns (character (250) var); dcl display_access_class_ entry (bit (72) aligned) returns (character (32) aligned); dcl device_acct_$off entry (fixed bin, char (*) aligned, ptr); dcl device_acct_$on entry (fixed bin, char (*) aligned, ptr); dcl get_process_access_class_ entry () returns (bit (72) aligned); dcl hash_$search entry (ptr, char (*), fixed bin (35), fixed bin (35)); dcl hcs_$get_user_access_modes entry (char (*), char (*), char (*), fixed bin, bit (36) aligned, bit (36) aligned, fixed bin (35)); dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl ioa_$rs entry options (variable); dcl ioa_$rsnnl entry options (variable); dcl ipc_$drain_chn entry (fixed bin (71), fixed bin (35)); dcl lg_ctl_$logout_channel entry (ptr, char (*)); dcl match_star_name_ entry (char (*), char (*), fixed bin (35)); dcl pathname_ entry (character (*), character (*)) returns (character (168)); dcl pnt_manager_$admin_get_entry entry (char (*), ptr, fixed bin (35)); dcl sys_log_ entry options (variable); /* type to operator */ dcl sys_log_$error_log entry options (variable); /* log error using error_table_ code */ dcl ttt_info_$initial_string entry (char (*), char (*) varying, fixed bin (35)); dcl ttt_info_$modes entry (char (*), char (*), fixed bin (35)); dcl uc_cleanup_network_dials_ entry (bit (36) aligned, bit (1) aligned, fixed bin (35)); dcl up_sysctl_$check_acs entry (char (*), char (*), fixed bin, bit (36) aligned, fixed bin (35)); /* Based */ dcl 1 rv based (rvp) aligned, /* overlay, for return signal */ 2 chan char (6) unaligned, /* name of tty dialing, or "contrl" */ 2 control unaligned, 3 devx_msg bit (1), /* indicates rv.chan contains a devx, not a name */ 3 error_msg bit (1), /* indicates rv.chan contains an error code, not a name */ 3 pad bit (1), 3 code bit (15); /* what happened */ /* Static */ dcl static_trace_sw bit (1) internal static init ("0"b); /* Conditions */ dcl any_other condition; %page; /* Program */ /* dial_ctl_: procedure (P_cdtep, P_dial_qualifier, P_target_person_project, P_code); */ /**** This entrypoint handles the "dial" preaccess command. On entry, P_cdtep points to the cdte of the channel requesting the dial, P_dial_qualifier is the specified dial_id, P_target_person_project, if present, is the User_id.Project_id combination. */ if as_data_$ansp = null then return; /* if not initialized */ ansp = as_data_$ansp; cdtep = P_cdtep; /* Get pointer to channel giving request */ dial_qualifier = P_dial_qualifier; /* copy dial qualifier */ target_person_project = P_target_person_project; utep = null (); /* initialize so that we don't fault */ reason_code = 0; reason = ""; if dial_qualifier = "" then do; /* didn't say who */ call ABORT_DIALIN (as_error_table_$dialnoline, ""); return; end; if static_trace_sw then call trace ("(dial_ctl_) Channel ^a Qualifier ^a ^[user ^a^]", cdte.name, dial_qualifier, (target_person_project ^= ""), target_person_project); /**** lg_ctl_ has already blessed this dial as far as the user giving the dial request and the channel AIM. cdte.current_access_class contains the access class of the dial, which must be consistent with that of the receiving process. */ /* Is this an attempt to dial the initializer? */ if dial_qualifier = "system" then do; /**** The current access class will only be invalid if the check_acs flag for dial_in is not on for this channel. */ if cdte.current_access_class_valid then if ^aim_check_$equal (cdte.current_access_class (1), get_process_access_class_ ()) then do; call ABORT_DIALIN (error_table_$ai_out_range, "Channel not system_low"); return; end; call convert_status_code_ (as_error_table_$dial_sys_msg, junk, format); call ioa_$rs (format, buffer, i, /* Acknowledge connection. Disclose channel id. */ cdte.current_terminal_type, cdte.tty_id_code, cdte.name); if cdte.service_type = FTP_SERVICE then buffer = asu_$format_ftp_msg (buffer, i, i, 230); /* generate FTP msg */ call astty_$tty_force (cdtep, addr (buffer), i, code); if cdte.state < TTY_DIALED then do; /* channel hungup */ call ABORT_DIALIN (0, "channel hungup"); return; end; P_code = 0; /* Initializer always accepts dial. */ dutp = as_data_$dutp; /* Initializer */ utep = addr (dutbl.entry (1)); /* UTE */ cdte.process = utep; cdte.in_use = NOW_LOGGED_IN; cdte.tra_vec = WAIT_DIAL_RELEASE; /* Branch to right place if hangup */ cdte.dialed_to_procid = anstbl.as_procid; cdte.dial_ev_chn = -1; /* This value should never be used */ cdte.current_service_type = MC_SERVICE; /* TDY Initializer */ /**** Notify operator */ call sys_log_ (SL_LOG_BEEP, "^a: Channel ^a dialed to Initializer ^[(^a.^a)^]", ME, cdte.name, cdte.flags.access_control.slave_dial, cdte.user_name.person, cdte.user_name.project); call DIALIN_OK (); return; end; if target_person_project ^= "" /* check for null person.project qualifier */ then do; /* resolve this dial by person-project search */ rq_person = before (target_person_project, "."); /* break up person.project */ rq_project = after (target_person_project, "."); if ^convert_aliases (rq_person, rq_project) then do; call ABORT_DIALIN (as_error_table_$dialnotup, ""); return; end; find_person_project = "1"b; end; else find_person_project = "0"b; if ^cdte.current_access_class_valid & cdte.flags.access_control.slave_dial /* we need an access class, and never got it!? */ then do; call ABORT_DIALIN (as_error_table_$dialup_error, "cdte.current_access_class_valid = ""0""b for channel at dial request time."); return; end; used_privilege = "0"b; /* set by next call if comm priv used */ /**** Implicit parameters are find_person_project, rq_person, rq_project, dial_qualifier, cdte, ute. ****/ utep = find_dialable_process (); if utep = null then do; /* not found in any user table */ call ABORT_DIALIN (as_error_table_$dialnotup, ""); return; /* User control will give us another chance */ end; mcode = as_error_table_$dial_connect_msg; /* Make up nice msg */ date = date_time_$format ("system_date_time", anstbl.current_time, "system_zone", "system_lang"); call convert_status_code_ (mcode, junk, format); /* .. */ call convert_access_class_$to_string_short (ute.process_authorization, server_authorization, code); if server_authorization = "" then call ioa_$rsnnl ("^a (^a.^a)", user_string, user_lth, ute.dial_qualifier, ute.person, ute.project); else call ioa_$rsnnl ("^a (^a.^a) (^a)", user_string, user_lth, ute.dial_qualifier, ute.person, ute.project, server_authorization); call ioa_$rs (format, buffer, i, cdte.current_terminal_type, cdte.tty_id_code, user_string, date); if cdte.service_type ^= FTP_SERVICE /* for FTP, server will print out message */ then call astty_$tty_force (cdtep, addr (buffer), i, code); /* write it out */ if cdte.state < TTY_DIALED then do; call ABORT_DIALIN (error_table_$io_no_permission, "channel hungup"); return; end; cdte.process = utep; /* Remember Owner */ cdte.dialed_to_procid = ute.proc_id; /* .. */ cdte.dial_ev_chn = ute.dial_ev_chn; /* .. */ ute.ndialed_consoles = ute.ndialed_consoles + 1; call DIALIN_OK (); /* report success */ call connect_channel_to_user (DIAL_IN, used_privilege); P_code = 0; /* we made it */ return; %page; dial_rq: entry (a_request_ptr, a_asr_sender_ptr); /**** This entry is called to handle the system-wide event channel provided for processes that wish to sign on of off as dial servers, or who wish to attach or release communications channels. */ /* parameters */ dcl (a_request_ptr, a_asr_sender_ptr) ptr parameter; dcl 1 sender_authorization aligned like aim_template; on any_other call as_any_other_handler_ (ME, NULL_PROC, REQUEST_RETURNS, REQUEST_RETURNS); call SETUP_REQUEST (code); if code ^= 0 then return; request_type = UNKNOWN_RQ; /* we'll set this later */ if static_trace_sw then call trace_request ("dial_rq"); if dial_server_request.flags.start then call start_dial_id_request; else if dial_server_request.flags.stop then call stop_dial_id_request; else if dial_server_request.flags.release_channel then call release_channel_request; else if dial_server_request.flags.privileged_attach then call privileged_attach_request; else if dial_server_request.flags.release_dial_id then call release_dial_id_request; else /* Didn't specify what was to be done. */ do; call sys_log_ (SL_LOG_SILENT, "^a: Rejected unknown request from ^a.^a. No request flags set in dial_server_request.", ME, ute.person, ute.project); call SEND_ERROR_MESSAGE_AND_REJECT (error_table_$request_not_recognized); end; goto REQUEST_RETURNS; %page; dial_out_rq: entry (a_request_ptr, a_asr_sender_ptr); /**** This entry is called in reponse to a user-initiated request to regarding an autocall (dial_out) channel. It handles dial_out requests as well as release requests. */ on any_other call as_any_other_handler_ (ME, NULL_PROC, REQUEST_RETURNS, REQUEST_RETURNS); call SETUP_REQUEST (code); if code ^= 0 then return; if dial_server_request.flags.release_channel then request_type = TERMINATE_DIAL_OUT_RQ; else request_type = DIAL_OUT_RQ; if static_trace_sw then call trace_request ("dial_out_rq"); CAI.valid = FALSE; CAI.valid.user_validation_level = TRUE; /* for auditing */ CAI.user_validation_level = process_ring; call set_desired_channel; /* check for starname, etc. */ if reason_code ^= 0 then call REJECT_CHANNEL_REQUEST (reason_code, reason); if dial_server_request.flags.release_channel then call terminate_dial_out_request (); else call dial_out_request (); goto REQUEST_RETURNS; %page; dial_term: entry (P_cdtep); /**** This entry is called by dialup_ whenever a dialed console hangs up. */ if as_data_$ansp = null then return; /* Not initialized */ ansp = as_data_$ansp; cdtep = P_cdtep; reason_code = 0; if static_trace_sw then call trace ("(dial_term) Channel ^a", cdte.name); reason = cdte.name; chn = cdte.dial_ev_chn; /* Nice local copies */ process_id = cdte.dialed_to_procid; /* ... */ if process_id = anstbl.as_procid then do; /* Slaved to initializer? */ reason = "hangup"; CAI.channel_name = cdte.name; CAI.valid = FALSE; CAI.valid.service_info = TRUE; CAI.service_info = SERVICE_TYPE (cdte.current_service_type); CAI.valid.access_class = TRUE; if cdte.dialup_flags.current_access_class_valid then CAI.access_class = cdte.current_access_class (1); else CAI.access_class = get_process_access_class_ (); CAI.valid.access_class_range = TRUE; CAI.access_class_range = cdte.access_class; utep = cdte.process; call as_access_audit_$channel (cdtep, null, utep, AS_AUDIT_CHANNEL_DETACH, addr (CAI), reason); end; else do; utep = cdte.process; /* Find owner */ if utep ^= null then do; /* Ignore if terminal did "slave" and then hung up. */ if ute.proc_id ^= cdte.dialed_to_procid then /* Race condition in logout.. note */ call sys_log_ (SL_LOG_SILENT, "dial_ctl_: Channel ^a (^a, ^a) hung up on missing process ^w", cdte.name, SERVICE_TYPE (cdte.current_service_type), display_access_class_ (cdte.current_access_class (1)), cdte.dialed_to_procid); else do; call device_acct_$off ((cdte.charge_type), cdte.name, utep); /* Stop charging for device */ call decrement_ndialed; /* reduce ate.ndialed_consoles */ call SEND_CHANNEL_MESSAGE (JUST_HUNGUP); reason = "hangup"; CAI.channel_name = cdte.name; CAI.valid = FALSE; CAI.valid.service_info = TRUE; CAI.service_info = SERVICE_TYPE (cdte.current_service_type); CAI.valid.access_class = TRUE; if cdte.dialup_flags.current_access_class_valid then CAI.access_class = cdte.current_access_class (1); else CAI.access_class = ute.process_authorization; CAI.valid.access_class_range = TRUE; CAI.access_class_range = cdte.access_class; CAI.valid.user_validation_level = TRUE; CAI.user_validation_level = process_ring; call as_access_audit_$channel (cdtep, null, utep, AS_AUDIT_CHANNEL_DETACH, addr (CAI), reason); end; end; end; call meter_dut; /* metering dialed_up_time */ if cdte.flags.access_control.slave_dial & cdte.service_type = ANS_SERVICE then /* authenticated */ call lg_ctl_$logout_channel (cdtep, "hangup"); /* logout channel */ cdte.current_service_type = cdte.service_type; /* Make channel normal again. */ cdte.dialed_to_procid = "0"b; cdte.dial_ev_chn = 0; cdte.process = null; /* Ensure the channel's current access class is reset to the CDT-specified default (either a range or single class). */ call asu_$reset_access_class (cdtep); if cdte.state ^= TTY_MASKED then call asu_$asu_listen (cdtep, code); else cdte.in_use = NOW_HUNG_UP; return; %page; dial_broom: entry (uptr, funct); /**** This entry is called whenever the master process is destroyed. */ dcl uptr ptr parameter, /* Ptr to ate of master process dying */ funct char (8) aligned parameter; /* Reason why we are sweeping */ utep = uptr; if as_data_$ansp = null then return; ansp = as_data_$ansp; reason_code = 0; reason = ""; if static_trace_sw then call trace ("(dial_broom) User ^a.^a function ^a.", ute.person, ute.project, funct); if ute.dial_qualifier ^= "" then do; /* report when a user stops serving */ DSI.server_ring = ute.dial_server_ring; DSI.dial_qualifier = ute.dial_qualifier; DSI.privileged = ute.privileged_dial_server; DSI.registered = ute.registered_dial_server; added_info = funct; call as_access_audit_$dialid (utep, AS_AUDIT_DIALID_STOP, addr (DSI), added_info); ute.dial_qualifier = ""; /* don't let any more come thru */ end; ute.registered_dial_server = "0"b; /* reset to default value */ ute.privileged_dial_server = "0"b; ute.dial_server_ring = 7; if ute.ndialed_consoles = 0 /* dont waste time searching the table */ then return; /* if there aren't going to be any entries */ if funct = "new_proc" then word = "dialgrab"; else if substr (funct, 1, 4) = "term" then word = "dialgrab"; else word = "dialhang"; if word = "dialgrab" then mcode = as_error_table_$dialagain; else mcode = as_error_table_$dialdied; if funct = "stopdial" then do; reason = "dialid shut off"; process_destroyed_flag = FALSE; /* shutoff_dials request */ end; else do; reason = word; /* for log message */ process_destroyed_flag = TRUE; end; do i = 1 to scdtp -> cdt.current_size; /* was somebody */ cdtep = addr (scdtp -> cdt.cdt_entry (i)); if cdte.in_use > NOW_FREE then if cdte.dialed_to_procid = ute.proc_id then call release_channel ("1"b, "0"b, (cdte.current_service_type = TANDD_SERVICE), reason); end; if anstbl.login_server_present then call uc_cleanup_network_dials_ (ute.proc_id, process_destroyed_flag, (0)); ute.ndialed_consoles = 0; /* we have done our job */ return; %page; REQUEST_RETURNS: /* return point for a dial_ctl_ request */ return; finish_priv_attach: entry (a_cdtep); /**** This entry is called by dialup_ when the channel which has been priv_attach'ed finally dials up. This will only be invoked when the channel was not dialed up when the priv_attach was initiated. /* parameters */ dcl a_cdtep ptr parameter; /* program */ ansp = as_data_$ansp; request_type = PRIV_ATTACH_CHN_RQ; cdtep = a_cdtep; if static_trace_sw then call trace ("(fin_priv_attach) Channel ^a", cdte.name); utep = cdte.process; /* Find Owner */ reason_code = 0; reason = cdte.name; process_id = cdte.dialed_to_procid; /* Initialize on off chance it's used */ chn = cdte.dial_ev_chn; /* ... */ if utep = null then do; /* can't happen unless bug */ woops1: call sys_log_ (SL_LOG_SILENT, "dial_ctl_: Can't find process ^12.3b", cdte.dialed_to_procid); return; end; else if ute.proc_id ^= cdte.dialed_to_procid then go to woops1; /**** Recheck the access. If the channel dialed up, and supplied an access class, it might be incompatable with the process. */ if ^aim_check_process_and_channel (utep, (cdte.dial_ctl_ring), cdte.dial_rq_privileged, PRIV_ATTACH, used_privilege) /* use ring saved in cdte. */ then do; added_info = "Access check failed after slave dialup"; call fake_connect_channel_to_user (PRIV_ATTACH, added_info); call astty_$tty_order (cdtep, "hangup", null, (0)); return; end; if cdte.service_type ^= ANS_SERVICE then do; /* no metering of login lines */ cdte.dialup_time = anstbl.current_time; cdte.n_logins = cdte.n_logins + 1; end; call set_terminal_type; call connect_channel_to_user (PRIV_ATTACH, used_privilege); return; continue_tandd_attach: entry (a_cdtep); /**** This entry is called by dialup_ when a channel which is being tandd_attach'd hangs up. The attaching process has been waiting for the line to become hung up all this time. */ request_type = TANDD_ATTACH_CHN_RQ; cdtep = a_cdtep; if static_trace_sw then call trace ("(continue_tandd_attach) Channel ^a", cdte.name); reason_code = 0; reason = cdte.name; call astty_$tty_order (cdtep, "tandd_attach", null, code); if code = -1 then /* Translate silly error code */ code = error_table_$io_no_permission; if code ^= 0 /* we'd better try to tell him now */ then do; added_info = "tandd_attach control order failed"; call fake_connect_channel_to_user (T_AND_D, added_info); call astty_$tty_order (cdtep, "hangup", null (), (0)); end; else cdte.tra_vec = WAIT_FIN_TANDD_ATTACH; /* channel should now signal dialup, */ return; /* at which point we will hand it to user */ finish_tandd_attach: entry (a_cdtep); /**** This entry is called by dialup_ when a terminal which has been tandd_attach'd simulates a dialup. */ request_type = TANDD_ATTACH_CHN_RQ; cdtep = a_cdtep; if static_trace_sw then call trace ("(finish_tandd_attach) Channel ^a", cdte.name); utep = cdte.process; /* Find Owner */ process_id = cdte.dialed_to_procid; /* Initialize on off chance it's used */ chn = cdte.dial_ev_chn; /* ... */ if utep = null then do; /* can't happen unless bug */ tandd_error: call sys_log_ (SL_LOG_SILENT, "dial_ctl_: Can't find process ^12.3b", cdte.dialed_to_procid); return; end; else if ute.proc_id ^= cdte.dialed_to_procid then go to tandd_error; call connect_channel_to_user (T_AND_D, "0"b); return; %page; finish_dial_out: entry (a_cdtep); /**** This entry is called by dialup_ when a wakeup is received indicating completion (successful or otherwise) of a dial_out control order previously issued for the channel. */ request_type = DIAL_OUT_RQ; ansp = as_data_$ansp; cdtep = a_cdtep; if static_trace_sw then call trace ("(finish_dial_out) Channel ^a", cdte.name); reason_code = 0; reason = cdte.name; utep = cdte.process; /* get ate pointer */ process_id = cdte.dialed_to_procid; /* Initialize on off chance it's used */ chn = cdte.dial_ev_chn; /* ... */ if utep = null () then do; whoops2: call sys_log_ (SL_LOG_SILENT, "dial_ctl_: Can't find process ^12.3b", cdte.dialed_to_procid); return; end; else if ute.proc_id ^= cdte.dialed_to_procid then go to whoops2; call astty_$tty_order (cdtep, "dial_out_status", null (), code); if code ^= 0 then call DIAL_OUT_CHANNEL_ERROR (); /* Doesn't return */ cdte.in_use = NOW_DIALED_OUT; /* record that channel is dialed up */ call set_terminal_type; term_info.version = terminal_info_version; call astty_$tty_order (cdtep, "terminal_info", addr (term_info), code); if code ^= 0 then call DIAL_OUT_CHANNEL_ERROR (); /* doesn't return */ cdte.current_terminal_type = term_info.term_type; /* Store info in CDTE for this channel */ cdte.tty_id_code = term_info.id; /* .. */ if cdte.flags.autobaud then /* if it can change, then save it */ cdte.baud_rate = term_info.baud_rate; cdte.n_logins = cdte.n_logins + 1; cdte.dialup_time = anstbl.current_time; call connect_channel_to_user (DIAL_OUT, dial_out_used_privilege); return; trace_on: entry; static_trace_sw = "1"b; call sys_log_ (SL_LOG, "dial_ctl_: Tracing turned on."); return; trace_off: entry; static_trace_sw = "0"b; call sys_log_ (SL_LOG, "dial_ctl_: Tracing turned off."); return; %page; start_dial_id_request: procedure (); /**** Internal procedure to handle requests to sign on as dial servers */ request_type = START_DIAL_ID_RQ; /**** Set up info for auditing record */ DSI.dial_qualifier = dial_server_request.dial_qualifier; DSI.server_ring = process_ring; DSI.privileged = dial_server_request.flags.privileged_server; DSI.registered = dial_server_request.flags.registered_server; if ^(ute.at.dialok) then call REJECT_DIALID_REQUEST (error_table_$no_dialok, "User lacks dialok attribute"); if dial_server_request.flags.privileged_server & ^(sender_authorization.privileges.comm | (process_ring = 1)) then do; call ioa_$rsnnl ("process lacks comm priv for privileged service of ^a.", reason, (0), dial_server_request.dial_qualifier); call REJECT_DIALID_REQUEST (error_table_$ai_restricted, reason); end; if ute.dial_qualifier ^= "" & /* active and not a request for the same thing? */ (ute.dial_qualifier ^= dial_server_request.dial_qualifier | ute.registered_dial_server ^= dial_server_request.registered_server) then do; /* no can do */ call ioa_$rsnnl ("process already serving ^a^[ (registered)^], can't serve ^a.", reason, (0), ute.dial_qualifier, ute.registered_dial_server, dial_server_request.dial_qualifier); call REJECT_DIALID_REQUEST (error_table_$dial_active, reason); end; if dial_server_request.flags.registered_server then do; if ^check_acs ("dial." || dial_server_request.dial_qualifier, process_group_id, process_ring) then do; call ioa_$rsnnl ("process lacks access to registered dial acs for ^a.", reason, (0), dial_server_request.dial_qualifier); if reason_code = error_table_$noentry then reason_code = error_table_$name_not_found; call REJECT_DIALID_REQUEST (reason_code, reason); end; if ^aim_check_registered_server_namedup (reason_code) then do; call ioa_$rsnnl ("another process is registered dial server for ^a.", reason, (0), dial_server_request.dial_qualifier); call REJECT_DIALID_REQUEST (reason_code, reason); end; ute.registered_dial_server = "1"b; end; else /* request is for non-registered qualifier */ ute.registered_dial_server = "0"b; ute.privileged_dial_server = dial_server_request.privileged_server; ute.dial_ev_chn = chn; /* Save dial event channel */ ute.dial_qualifier = dial_server_request.dial_qualifier; ute.dial_server_ring = process_ring; if ute.registered_dial_server then do; added_info = "(registered"; if ute.privileged_dial_server then added_info = rtrim (added_info) || " privileged"; added_info = rtrim (added_info) || ")"; end; else if ute.privileged_dial_server then added_info = "(privileged)"; else added_info = ""; call as_access_audit_$dialid (utep, AS_AUDIT_DIALID_START, addr (DSI), added_info); call SEND_CONTROL_MESSAGE (bit (fixed (ute.ndialed_consoles, 15), 15)); return; end start_dial_id_request; %page; stop_dial_id_request: procedure; /**** Request to stop serving a dial id and to disconnect all channels dialed to this process. */ request_type = STOP_DIAL_ID_RQ; DSI.dial_qualifier = dial_server_request.dial_qualifier; DSI.server_ring = ute.dial_server_ring; DSI.registered = ute.registered_dial_server; DSI.privileged = ute.privileged_dial_server; if ^(ute.at.dialok) then call REJECT_DIALID_REQUEST (error_table_$no_dialok, "User lacks dialok attribute"); if ute.dial_qualifier ^= "" then /* actively serving anything? */ if ((ute.dial_qualifier = dial_server_request.dial_qualifier) | (dial_server_request.dial_qualifier = "")) then do; call dial_broom (utep, "stopdial");/* Remove all slaves */ call SEND_CONTROL_MESSAGE (""b); end; else do; reason = "Dial id not in use by this process"; call REJECT_DIALID_REQUEST (0, reason); end; else do; reason = "No dial id in use by this process"; call REJECT_DIALID_REQUEST (0, reason); end; call SEND_CONTROL_MESSAGE (bit (fixed (ute.ndialed_consoles, 15), 15)); end stop_dial_id_request; %page; release_dial_id_request: procedure; /**** Release a dial id such that future attempts to dial a console to this dial id will fail. All consoles already dialed to this dial id, however will remain dialed. */ request_type = RELEASE_DIAL_ID_RQ; DSI.dial_qualifier = dial_server_request.dial_qualifier; DSI.server_ring = ute.dial_server_ring; DSI.privileged = ute.privileged_dial_server; DSI.registered = ute.registered_dial_server; if ^(ute.at.dialok) then call REJECT_DIALID_REQUEST (error_table_$no_dialok, "User lacks dialok attribute"); if ute.dial_qualifier ^= "" then /* actively serving anything? */ if ((ute.dial_qualifier = dial_server_request.dial_qualifier) | (dial_server_request.dial_qualifier = "")) then do; added_info = "dialid released"; if ute.ndialed_consoles ^= 0 then call ioa_$rsnnl ("^a (keeping ^d dialed console^[s^])", added_info, (0), added_info, ute.ndialed_consoles, (ute.ndialed_consoles ^= 1)); call as_access_audit_$dialid (utep, AS_AUDIT_DIALID_STOP, addr (DSI), added_info); ute.dial_qualifier = ""; /* back to default */ ute.registered_dial_server = "0"b; /* also default */ end; else do; added_info = "Dial id not in use by this process"; call REJECT_DIALID_REQUEST (0, reason); end; else do; added_info = "No dial id in use by this process"; call REJECT_DIALID_REQUEST (0, reason); end; call SEND_CONTROL_MESSAGE (bit (fixed (ute.ndialed_consoles, 15), 15)); return; end release_dial_id_request; %page; release_channel_request: procedure; /* Request to release a channel */ request_type = RELEASE_CHN_RQ; CAI.channel_name = dial_server_request.channel_name; /* for auditing */ CAI.valid = FALSE; CAI.valid.user_validation_level = TRUE; CAI.user_validation_level = process_ring; if ^(ute.at.dialok) then call REJECT_CHANNEL_REQUEST (error_table_$no_dialok, "User lacks dialok attribute"); if dial_server_request.channel_name = "" then do; /* frequent problem */ reason = "Null channel name specified"; call REJECT_CHANNEL_REQUEST (0, reason); end; call find_cdte; /* try to find channel */ if cdtep = null then do; /* Channel doesn't exist. Error code set by find_cdte. */ call ioa_$rsnnl ("Channel ^a not found.", reason, (0), dial_server_request.channel_name); call REJECT_CHANNEL_REQUEST (reason_code, reason); end; if cdte.dialed_to_procid ^= process_id then do; /* Channel not his */ reason = "Channel not attached to this process"; call REJECT_CHANNEL_REQUEST (error_table_$io_no_permission, reason); end; call decrement_ndialed; /* one less... */ if cdte.current_service_type = TANDD_SERVICE /* was this in T & D service? */ then suppress_listen = dial_server_request.flags.no_listen; /* then he's allowed to specify this */ else suppress_listen = "0"b; call release_channel ("0"b, dial_server_request.flags.no_hangup, suppress_listen, "release"); /* actual release */ call SEND_CONTROL_MESSAGE (REQUEST_GRANTED); return; end release_channel_request; %page; privileged_attach_request: procedure (); if dial_server_request.flags.tandd_attach then request_type = TANDD_ATTACH_CHN_RQ; else request_type = PRIV_ATTACH_CHN_RQ; CAI.channel_name = dial_server_request.channel_name; CAI.valid = FALSE; CAI.valid.user_validation_level = TRUE; /* for auditing */ CAI.user_validation_level = process_ring; if ^(ute.at.dialok) then call REJECT_CHANNEL_REQUEST (error_table_$no_dialok, "User lacks dialok attribute"); call set_desired_channel; if reason_code ^= 0 then call REJECT_CHANNEL_REQUEST (reason_code, reason); reason = dial_server_request.channel_name; /* assume the worst */ if dial_server_request.flags.tandd_attach then call look_for_channel (T_AND_D); /* and check access */ else call look_for_channel (PRIV_ATTACH); CAI.channel_name = cdte.name; /* update this in case starname was used */ CAI.valid.access_class = cdte.dialup_flags.current_access_class_valid; CAI.access_class = cdte.current_access_class (1); CAI.valid.access_class_range = TRUE; CAI.access_class_range = cdte.access_class; if dial_server_request.tandd_attach /* both acs's needed */ then do; call up_sysctl_$check_acs ("tandd.acs", process_group_id, (process_ring), mode, code); if code ^= 0 | ((mode & RW_ACCESS) ^= RW_ACCESS) then do; if code ^= 0 then call sys_log_$error_log (SL_LOG_SILENT, code, "dial_ctl_: Could not check access to ^a>tandd.acs for ^a.", as_data_$acsdir, process_group_id); call ioa_$rsnnl ("rw access is required to ^a", reason, (0), pathname_ (as_data_$acsdir, "tandd.acs")); call REJECT_CHANNEL_REQUEST (error_table_$insufficient_access, reason); end; end; cdte.process = utep; /* remember owner */ cdte.dial_ev_chn = chn; /* .. */ cdte.dialed_to_procid = ute.proc_id; /* .. */ cdte.dial_ctl_ring = process_ring; /* remember for FIN_PRIV_ATTACH access check. */ cdte.dial_rq_privileged = sender_authorization.privileges.comm; ute.ndialed_consoles = ute.ndialed_consoles + 1; if ^dial_server_request.tandd_attach then if cdte.service_type ^= ANS_SERVICE then /* no metering for login lines */ cdte.n_dialups = cdte.n_dialups + 1; code = 0; call SEND_CONTROL_MESSAGE (REQUEST_GRANTED); if dial_server_request.flags.tandd_attach then do; if cdte.state ^= TTY_HUNG /* have to make it stop listening */ then do; if static_trace_sw then call trace ("(priv_attach) Hanging up ^a for T&D", cdte.name); call astty_$tty_order (cdtep, "hangup", null, (0)); cdte.tra_vec = WAIT_TANDD_HANGUP; goto REQUEST_RETURNS; end; else do; if static_trace_sw then call trace ("(priv_attach) ^a hung up, tandd attaching.", cdte.name); call astty_$tty_order (cdtep, "tandd_attach", null, code); if code ^= 0 then do; call sys_log_$error_log (SL_LOG_SILENT, code, "^a: Issuing tandd_attach control order for channel ^a.", ME, cdte.name); added_info = "tandd_attach control order failed"; call fake_connect_channel_to_user (T_AND_D, added_info); call astty_$tty_order (cdtep, "hangup", null (), (0)); goto REQUEST_RETURNS; end; cdte.tra_vec = WAIT_FIN_TANDD_ATTACH; goto REQUEST_RETURNS; end; end; else do; if cdte.state = TTY_DIALED then do; if cdte.service_type ^= ANS_SERVICE then do; /* not 'slave' pre-access */ cdte.dialup_time = anstbl.current_time; cdte.n_logins = cdte.n_logins + 1; end; call set_terminal_type; call connect_channel_to_user (PRIV_ATTACH, used_privilege); /* Is dialed, give it away */ end; else cdte.tra_vec = WAIT_FIN_PRIV_ATTACH; /* Wait for it to dialup */ end; return; end privileged_attach_request; %page; dial_out_request: procedure (); /**** User request to dial out on a specified channel. */ CAI.channel_name = dial_server_request.channel_name; CAI.valid = FALSE; CAI.valid.user_validation_level = TRUE; CAI.user_validation_level = process_ring; if ^(ute.at.dialok) /* Must have the dialok attribute */ then call REJECT_CHANNEL_REQUEST (error_table_$no_dialok, "User does not have dialok attribute"); call set_requested_channel_access_class (); /* find an appropriate channel, access-class wise */ if reason_code ^= 0 then call REJECT_CHANNEL_REQUEST (reason_code, reason); dial_out_used_privilege = used_privilege; /* save the global since look_for_channel will zero it */ phone_data = rtrim (dial_server_request.dial_out_destination); call look_for_channel (DIAL_OUT); /* star scan for likely channel. It will reject request if none found. */ CAI.channel_name = cdte.name; /* update in case starname was used */ CAI.valid.access_class = cdte.dialup_flags.current_access_class_valid; CAI.access_class = cdte.current_access_class (1); CAI.valid.access_class_range = TRUE; CAI.access_class_range = cdte.access_class; /**** The one place we SPECIFY the access class with a set order! */ call set_dial_out_channel_access_class (reason_code); if reason_code ^= 0 then call REJECT_CHANNEL_REQUEST (reason_code, "set_required_access_class failed"); cdte.in_use = NOW_DIALING; /* remember what we're doing ... */ cdte.tra_vec = WAIT_DIAL_OUT; /* and what to do next */ CAI.valid.service_info = TRUE; CAI.service_info = phone_data; if dial_out_used_privilege then reason = "using comm privilege"; else reason = ""; call as_access_audit_$channel (cdtep, null, utep, AS_AUDIT_CHANNEL_DIALOUT, addr (CAI), reason); call astty_$tty_order (cdtep, "dial_out", addr (phone_data), code); /* start dialing */ if code ^= 0 then do; if code = -1 then code = error_table_$io_no_permission; call sys_log_$error_log (0, code, ME, "after dial_out order (^a for ^a.^a).", cdte.name, ute.person, ute.project); cdte.in_use = NOW_HUNG_UP; cdte.tra_vec = WAIT_SLAVE_REQUEST; call REJECT_CHANNEL_REQUEST (error_table_$order_error, "dial_out control order failed"); end; cdte.process = utep; /* looks like we can give it away... */ cdte.dial_ctl_ring = process_ring; /* record ring of dialer */ cdte.dialed_to_procid = ute.proc_id; /* .. */ cdte.dial_ev_chn = chn; /* remember IPC channel in request */ cdte.n_dialups = cdte.n_dialups + 1; /* keep track of how often we try dialing */ ute.ndialed_consoles = ute.ndialed_consoles + 1; call SEND_CONTROL_MESSAGE (REQUEST_GRANTED); return; end dial_out_request; %page; terminate_dial_out_request: procedure (); /**** User request to detach a dialed out channel. */ CAI.channel_name = dial_server_request.channel_name; CAI.valid = FALSE; CAI.valid.user_validation_level = TRUE; CAI.user_validation_level = process_ring; if ^(ute.at.dialok) /* Must have the dialok attribute */ then call REJECT_CHANNEL_REQUEST (error_table_$no_dialok, "User does not have dialok attribute"); if dial_server_request.channel_name = "" then do; reason = "Invalid channel specified"; call REJECT_CHANNEL_REQUEST (0, reason); end; call find_cdte; /* find the channel */ if cdtep = null then do; /* No such channel. Error code set by find_cdte. */ call ioa_$rsnnl ("Channel ^a does not exist.", reason, (0), dial_server_request.channel_name); call REJECT_CHANNEL_REQUEST (reason_code, reason); end; CAI.valid.access_class = cdte.dialup_flags.current_access_class_valid; CAI.access_class = cdte.current_access_class (1); CAI.valid.access_class_range = TRUE; CAI.access_class_range = cdte.access_class; if cdte.current_service_type ^= DIAL_OUT_SERVICE then do; /* Channel not a dialed out */ reason = "Channel not currently dialed out"; call REJECT_CHANNEL_REQUEST (error_table_$action_not_performed, reason); end; if cdte.dialed_to_procid ^= ute.proc_id then do; /* Channel not his */ reason = "Channel not currently dialed out for this process"; call REJECT_CHANNEL_REQUEST (error_table_$io_no_permission, reason); end; cdte.tra_vec = WAIT_DIAL_RELEASE; /* make sure we do the right thing */ cdte.dial_ev_chn = chn; /* user's dial_manager_ is blocked on this channel */ /* which MIGHT be different than cdte.dial_ev_chn */ call asu_$reset_access_class (cdtep); call astty_$tty_order (cdtep, "hangup", null, (0)); /* drop connection to channel */ call SEND_CONTROL_MESSAGE (REQUEST_GRANTED); return; end terminate_dial_out_request; %page; connect_channel_to_user: procedure (P_attachment_type, report_privilege); /**** connect_channel_to_user vs fake_connect_channel_to_user: In the fake case, we want to issue a hangup. It's simpler all around if we can just pretend that we gave the channel to the user, but don't actually tell the dim to new_proc. We do everything else, including sending the dialed-up wakeup. (The user 'has' to be prepared for a dialup wakeup resulting in io_no_permission because the channel has already hung up by the time he acts on the dialup.) */ dcl P_attachment_type fixed bin (17) parameter; dcl P_added_info char (*) parameter; dcl fake_connect bit (1) aligned; dcl report_privilege bit (1) aligned parameter; /* connect_channel_to_user: procedure (); */ fake_connect = "0"b; go to connect_join; fake_connect_channel_to_user: entry (P_attachment_type, P_added_info); fake_connect = "1"b; connect_join: if P_attachment_type = DIAL_IN then cdte.current_service_type = DIAL_SERVICE; else if P_attachment_type = T_AND_D then do; cdte.current_service_type = TANDD_SERVICE; cdte.tra_vec = WAIT_DISCARD_WAKEUPS; cdte.in_use = NOW_HUNG_UP; end; if cdte.current_service_type ^= TANDD_SERVICE then do; cdte.tra_vec = WAIT_DIAL_RELEASE; /* Catch terminal when it hangs up */ cdte.in_use = NOW_DIALED; /* record the fact that we have channel */ end; call astty_$tty_order (cdtep, "copy_meters", null (), (0)); /* Set up for auditing */ CAI.channel_name = cdte.name; CAI.valid = FALSE; CAI.valid.service_info = TRUE; CAI.service_info = ATTACHMENT_TYPES (P_attachment_type); CAI.valid.access_class = cdte.dialup_flags.current_access_class_valid; CAI.access_class = cdte.current_access_class (1); CAI.valid.access_class_range = TRUE; CAI.access_class_range = cdte.access_class; CAI.valid.user_validation_level = TRUE; CAI.user_validation_level = process_ring; if ^fake_connect then do; /* we're really giving it to the user */ call astty_$tty_new_proc (cdtep, ute.proc_id, code); /* give channel to user */ if code = 0 then do; if report_privilege then added_info = "using comm privilege"; else added_info = ""; call as_access_audit_$channel (cdtep, null, utep, AS_AUDIT_CHANNEL_ATTACH, addr (CAI), added_info); end; else call sys_log_$error_log (SL_LOG_SILENT, code, ME, "call to astty_$tty_new_proc of ^a for ^a.^a failed", cdte.name, ute.person, ute.project); end; else /* audit denied attachment */ call as_access_audit_$channel (cdtep, null, utep, -AS_AUDIT_CHANNEL_ATTACH, addr (CAI), P_added_info); /**** Start charging for attached device */ call device_acct_$on ((cdte.charge_type), cdte.name, utep); /**** Notify user */ call SEND_CHANNEL_MESSAGE (JUST_DIALED); return; end connect_channel_to_user; %page; look_for_channel: procedure (operation); /**** Internal procedure to scan cdt for channels that meet requirements such as star name match, baud desired, etc. */ dcl found bit (1) aligned; dcl found_device_available bit (1) aligned; dcl found_in_cdt bit (1) aligned; dcl found_good_access bit (1) aligned; dcl found_good_attributes bit (1) aligned; dcl operation fixed bin; cdtep = null (); found, found_device_available, found_in_cdt, found_good_access, found_good_attributes = "0"b; reason_code = 0; do i = 1 to scdtp -> cdt.current_size while (^found); cdtep = addr (scdtp -> cdt.cdt_entry (i)); found = cdte_matches_desired (); /* try for match */ found_in_cdt = found_in_cdt | found; /* remember if it were ever there */ if found then do; /* keep checking */ if dial_server_request.baud_rate ^= -1 then /* any baud_rate, or ... */ if dial_server_request.baud_rate ^= cdte.baud_rate then found = "0"b; if dial_server_request.line_type >= lbound (line_types, 1) then /* any line type, or ... */ if dial_server_request.line_type ^= cdte.line_type then found = "0"b; found_good_attributes = found_good_attributes | found; end; if found then if dial_server_request.flags.privileged_attach then found = check_priv_attach_access (); else found = check_dial_access (); found_device_available = found_device_available | found; if found then found = access_check_channel_and_process (utep, process_ring, sender_authorization.privileges.comm, operation, used_privilege); found_good_access = found_good_access | found; end; if ^found then do; /* need more codes */ cdtep = null (); /* for auditing */ if star_channel_name | reason_code = 0 then /* if non-star channel and have error code, keep it */ if ^found_in_cdt then reason_code = error_table_$resource_unknown; else if ^found_good_attributes then reason_code = error_table_$resource_unavailable; else if ^found_device_available then reason_code = error_table_$resource_unavailable; else if ^found_good_access then reason_code = error_table_$insufficient_access; else if reason_code = 0 then reason_code = error_table_$resource_unavailable; call REJECT_CHANNEL_REQUEST (reason_code, desired_channel); end; end look_for_channel; %page; set_terminal_type: procedure (); /**** Procedure to set a terminal type */ dcl code fixed bin (35); dcl tab_string char (512) var; dcl modes_string char (512); if cdte.initial_terminal_type = "" then return; if cdte.initial_terminal_type = low (length (cdte.initial_terminal_type)) then return; sttip = addr (set_type_info); set_term_type_info.version = stti_version_1; set_term_type_info.name = cdte.initial_terminal_type; string (set_term_type_info.flags) = "0"b; call astty_$tty_order (cdtep, "set_term_type", sttip, code); if code ^= 0 then return; cdte.current_terminal_type = set_term_type_info.name; call ttt_info_$initial_string (cdte.current_terminal_type, tab_string, code); if code ^= 0 then go to end_initial_string; if length (tab_string) ^= 0 then do; call astty_$tty_changemode (cdtep, "rawo", code); if code ^= 0 then go to end_initial_string; call astty_$tty_force (cdtep, addrel (addr (tab_string), 1), length (tab_string), code); end; end_initial_string: call ttt_info_$modes (cdte.current_terminal_type, modes_string, code); if code ^= 0 then return; call astty_$tty_changemode (cdtep, "force,init," || rtrim (modes_string), code); return; end set_terminal_type; %page; release_channel: procedure (master_destroyed, suppress_hangup, suppress_listen, P_reason); /**** Procedure to release a channel that was dialed to a dial server process */ dcl master_destroyed bit (1); dcl suppress_hangup bit (1); dcl suppress_listen bit (1); dcl was_tandd bit (1); dcl P_reason char (*) parameter; /* reason we are detaching channel */ if cdte.current_service_type = DIAL_SERVICE & master_destroyed then call asu_$write_chn_message (cdtep, mcode, junk, code); call astty_$tty_detach (cdtep, 0, code); /* Take channel away from user */ if code ^= 0 then call sys_log_$error_log (0, code, ME, "Attempting to detach ^a from ^a.^a.", cdte.name, ute.person, ute.project); else do; call ioa_$rsnnl ("^a ^[(without hangup)^]^[(without listen)^]", added_info, (0), P_reason, suppress_hangup, suppress_listen); CAI.channel_name = cdte.name; CAI.valid = FALSE; CAI.valid.service_info = TRUE; CAI.service_info = SERVICE_TYPE (cdte.current_service_type); CAI.valid.access_class = cdte.dialup_flags.current_access_class_valid; CAI.access_class = cdte.current_access_class (1); CAI.valid.access_class_range = TRUE; CAI.access_class_range = cdte.access_class; CAI.valid.user_validation_level = TRUE; CAI.user_validation_level = process_ring; call as_access_audit_$channel (cdtep, null, utep, AS_AUDIT_CHANNEL_DETACH, addr (CAI), added_info); end; call device_acct_$off ((cdte.charge_type), cdte.name, utep); call meter_dut (); /* meter dialed_up_time */ call asu_$reset_access_class (cdtep); /* Place back in known state */ if cdte.current_service_type = TANDD_SERVICE /* restore correct service type */ then do; if suppress_listen /* channel out of service for the moment */ then cdte.current_service_type = INACTIVE; else cdte.current_service_type = cdte.service_type; was_tandd = "1"b; end; else do; cdte.current_service_type = cdte.service_type; was_tandd = "0"b; end; cdte.dialed_to_procid = "0"b; cdte.dial_ev_chn = 0; cdte.process = null; cdte.user_name = ""; if cdte.service_type = ANS_SERVICE & ^was_tandd then do; /* if this is normally an answering service channel */ cdte.in_use = NOW_DIALED; /* treat this situation as if it were a logout -hold */ cdte.tra_vec = WAIT_GREETING_MSG; /* tell dialup_ what to do (say hello and wait for login) */ word = "device"; /* send simulated device wakeup to dialup_ */ call hcs_$wakeup (anstbl.as_procid, cdte.event, addr (word) -> bf, code); end; else if ^suppress_hangup then do; /* not A.S. channel; hang it up */ hangup_anyway: call astty_$tty_order (cdtep, "hangup", null, (0)); cdte.in_use = NOW_HUNG_UP; /* remember that we did */ call astty_$tty_state (cdtep, code); /* see if it is hung up yet */ if cdte.state > TTY_HUNG then /* not yet */ cdte.tra_vec = WAIT_HANGUP; /* wait for it; dialup_ listens after it happens */ else do; /* channel is already hung up */ call ipc_$drain_chn (cdte.event, code); /* so discard the hangup wakeup, which would just confuse dialup_ if it came along later */ if ^suppress_listen & cdte.state ^= TTY_MASKED then call asu_$asu_listen (cdtep, code); /* and do the listen immediately */ else if cdte.tra_vec = WAIT_FIN_TANDD_ATTACH /* we don't want to leave it like this */ then cdte.tra_vec = WAIT_SLAVE_REQUEST; /* good enough till the next time someone wants it */ end; end; else do; call astty_$tty_state (cdtep, code); if cdte.state = TTY_DIALED then cdte.tra_vec = WAIT_SLAVE_REQUEST; else go to hangup_anyway; end; return; end release_channel; %page; find_cdte: procedure (); do cdtx = 1 to scdtp -> cdt.current_size; cdtep = addr (scdtp -> cdt.cdt_entry (cdtx)); if cdte.name = dial_server_request.channel_name then return; end; cdtep = null (); reason = dial_server_request.channel_name; reason_code = error_table_$resource_unknown; return; end find_cdte; %page; /**** These next two answer the question of whether a channel is available for a given purpose. access_check_process_and_channel check the accessability. */ check_dial_access: proc returns (bit (1) aligned); reason_code = 0; if (cdte.twx = 0) | (cdte.current_service_type = INACTIVE) | (cdte.state = TTY_MASKED) then reason_code = error_table_$resource_unavailable; else if cdte.process = utep then reason_code = error_table_$resource_attached; else if cdte.current_service_type ^= DIAL_OUT_SERVICE then reason_code = error_table_$invalid_resource_state; else if cdte.in_use ^= NOW_HUNG_UP then reason_code = error_table_$resource_not_free; else do; if cdte.threads.mother > 0 then /* now see what mommy has been up to */ mpxep = addr (scdtp -> cdt.cdt_entry (cdte.mother).initial_command); /* find her diary */ else mpxep = addr (scdtp -> cdt.fnp_entry (-cdte.mother).mpxe); if mpxe.state ^= FNP_UP then reason_code = error_table_$resource_unavailable; /* oh, hi mom! */ end; return (reason_code = 0); end check_dial_access; check_priv_attach_access: proc returns (bit (1) aligned); reason_code = 0; if cdte.in_use = NOW_FREE then reason_code = error_table_$resource_unavailable; else if cdte.process = utep then reason_code = error_table_$resource_attached; else if cdte.process ^= null then reason_code = error_table_$resource_not_free; else if cdte.current_service_type ^= SLAVE_SERVICE & ^dial_server_request.flags.tandd_attach then reason_code = error_table_$invalid_resource_state; return (reason_code = 0); end check_priv_attach_access; %page; access_check_channel_and_process: procedure (a_utep, attach_ring, privileged, operation, a_used_privilege) returns (bit (1) aligned); declare a_utep pointer; declare a_used_privilege bit (1) aligned; declare privileged bit (1) unaligned; declare operation fixed bin; declare attach_ring fixed bin (3); if static_trace_sw then call trace ( "(access_check) Channel: ^a User: ^a.^a Utep: ^p Ring: ^d Operation: ^[PRIV_ATTACH^;DIAL_OUT^;DIAL_IN^;T_AND_D^]", cdte.name, a_utep -> ute.person, a_utep -> ute.project, a_utep, attach_ring, operation); if ^aim_check_process_and_channel (a_utep, attach_ring, privileged, operation, a_used_privilege) then do; reason_code = error_table_$ai_restricted; return ("0"b); end; if (operation = PRIV_ATTACH & cdte.flags.access_control.priv_attach) | (operation = DIAL_IN & cdte.flags.access_control.dial_server) | (operation = DIAL_OUT & cdte.flags.access_control.dial_out) | (operation = T_AND_D & cdte.flags.access_control.priv_attach) then return (check_acs ((cdte.name), make_group_id (a_utep), attach_ring)); else return ("1"b); end access_check_channel_and_process; %page; aim_check_process_and_channel: procedure (a_utep, attach_ring, privileged, operation, a_used_privilege) returns (bit (1) aligned); declare a_utep pointer; declare attach_ring fixed bin (3); declare privileged bit (1) unaligned; declare a_used_privilege bit (1) aligned; declare operation fixed bin; dcl access_class_ok bit (1) aligned automatic; if static_trace_sw then call trace ( "(aim_check) Channel: ^a User: ^a.^a Utep: ^p Ring: ^d^[ Privileged^] Operation: ^[PRIV_ATTACH^;DIAL_OUT^;DIAL_IN^;T_AND_D^]", cdte.name, a_utep -> ute.person, a_utep -> ute.project, a_utep, attach_ring, privileged, operation); a_used_privilege = "0"b; /* Make sure the current access class information is valid. */ if ^cdte.current_access_class_valid then do; call INITIALIZE_CURRENT_ACCESS_CLASS (code); if code ^= 0 then return (FALSE); /* not altogether true, however */ end; if /* tree */ (operation = DIAL_OUT) then if ^cdte.current_access_class_valid /* range */ then access_class_ok = (aim_check_$in_range (requested_access_class, cdte.access_class)); else access_class_ok = (aim_check_$equal (requested_access_class, cdte.current_access_class (1))); /* We already validated requested_a_c */ else if ^cdte.current_access_class_valid then if privileged then access_class_ok = ( aim_check_$greater_or_equal (a_utep -> ute.process_authorization_range (2), cdte.access_class (2))); else access_class_ok = (aim_check_$in_range (a_utep -> ute.process_authorization, cdte.access_class)); else if privileged then access_class_ok = ( aim_check_$greater_or_equal (a_utep -> ute.process_authorization_range (2), cdte.current_access_class (1))); else access_class_ok = (aim_check_$equal (a_utep -> ute.process_authorization, cdte.current_access_class (1))); if access_class_ok then /* ok to use this channel */ return (TRUE); else do; /* not ok, reset access class information */ call asu_$reset_access_class (cdtep); return (FALSE); end; end aim_check_process_and_channel; %page; aim_check_registered_server_namedup: procedure (code) returns (bit (1) aligned); /**** This procedure is used to enforce the AIM rules for servers. There can only be one server per dial_id per access class. This is because we have no way to register a dial_id as having AIM characteristics. A privileged server serves from system_low up to their authorization. A privileged server is defined as one established with the comm privilege enabled. If a server is privileged the fact is recorded in ute.privileged_dial_server. Since processes can (foolishly) turn off their comm privilege after becoming privileged registered servers, we can have cases where no server can serve a dial request, even though some server claims to be serving the territory. This is because both ute.privileged_dial_server & the comm privilege must be on for the dialing in channel to find the process. */ declare code fixed bin (35); declare i fixed bin; declare P ptr; do i = 1 to anstbl.current_size; /* check for user */ P = addr (anstbl.entry (i)); if consider_ute () then return ("0"b); /* found a conflict */ end; /* Now check the daemon user table */ do i = 1 to dutbl.current_size; /* check for user */ P = addr (dutbl.entry (i)); if consider_ute () then return ("0"b); end; /* Now check the absentee user table */ do i = 1 to autbl.current_size; /* check for user */ P = addr (autbl.entry (i)); if consider_ute () then return ("0"b); end; return ("1"b); consider_ute: procedure returns (bit (1) aligned); declare existing_priv_range (2) bit (72) aligned; declare proposed_priv_range (2) bit (72) aligned; existing_priv_range (1) = ""b; /* system_low */ existing_priv_range (2) = P -> ute.process_authorization; proposed_priv_range (1) = ""b; /* system_low */ proposed_priv_range (2) = unspec (sender_authorization); if P -> ute.dial_ev_chn = 0 then return ("0"b); /* no conflict */ if ^P -> ute.registered_dial_server then return ("0"b); if P -> ute.dial_qualifier ^= dial_server_request.dial_qualifier then return ("0"b); /* no conflict */ if P -> ute.privileged_dial_server /* system_low --> ute.p_a */ then do; if dial_server_request.privileged_server/* request for priv server */ then REJECT_AIM: do; code = error_table_$dial_id_busy; return ("1"b); end; else if aim_check_$in_range (unspec (sender_authorization), existing_priv_range) then go to REJECT_AIM; else return ("0"b); /* outside claimed range */ end; else do; /* existing server is single level */ if (dial_server_request.privileged_server & aim_check_$in_range (P -> ute.process_authorization, proposed_priv_range)) | (^dial_server_request.privileged_server & aim_check_$equal (P -> ute.process_authorization, unspec (sender_authorization))) then go to REJECT_AIM; end; return ("0"b); end consider_ute; end aim_check_registered_server_namedup; %page; check_acs: procedure (check_name, user_name, user_ring) returns (bit (1) aligned); /* general procedure to check access on an ACS */ dcl check_name char (*); dcl user_name char (*); dcl user_ring fixed bin (3); acs_name = check_name; reason_code = 0; acs_name = rtrim (acs_name, " ") || ".acs"; call hcs_$get_user_access_modes (as_data_$rcpdir, acs_name, user_name, (user_ring), mode, ""b, code); if code ^= 0 then do; if code = error_table_$noentry then reason_code = error_table_$insufficient_access; else reason_code = error_table_$unable_to_check_access; reason = acs_name; end; else if (mode & RW_ACCESS) ^= RW_ACCESS then reason_code = error_table_$insufficient_access; if static_trace_sw then call trace_error (reason_code, "(check_acs) ACS: ^a USER: ^a, RING: ^d", acs_name, user_name, user_ring); return (reason_code = 0); end check_acs; %page; /* internal procedures and functions for channel starname handling */ set_desired_channel: proc; /* expand dsr.channel_name */ if dial_server_request.channel_name = "" then do; /* default null string */ desired_channel = "**"; code = 2; end; else do; /* make sure it's a valid name */ desired_channel = dial_server_request.channel_name; call check_star_name_$entry (desired_channel, code); if code = error_table_$badstar then do; reason_code = error_table_$bad_name; /* badstar message doesn't scan */ reason = desired_channel; end; end; CAI.channel_name = desired_channel; /* for auditing */ star_channel_name = code ^= 0; /* any star-convention stuff? */ end set_desired_channel; %page; set_requested_channel_access_class: procedure (); used_privilege = "0"b; requested_access_class = aim_util_$get_access_class (unspec (sender_authorization)); /* until set otherwise */ if dial_server_request.flags.access_class_specified & ^aim_check_$equal (unspec (sender_authorization), dial_server_request.access_class) then do; /* User requested dial-out at privileged auth */ if ^sender_authorization.privileges.comm then do; reason_code = error_table_$insufficient_access; reason = "process lacks comm privilege for privileged dial-out"; return; end; if ^aim_check_$greater_or_equal (ute.process_authorization_range (2), dial_server_request.access_class) then do; reason_code = error_table_$ai_out_range; reason = "requested authorization is greater than maximum authorizaton"; return; end; requested_access_class = dial_server_request.access_class; used_privilege = "1"b; end; else reason_code = 0; /* no auth requested or same as process auth */ end set_requested_channel_access_class; %page; cdte_matches_desired: proc () returns (bit (1) aligned); /* check cdte channel with desired_channel */ if ^star_channel_name then /* must match exactly, then */ if cdte.name = desired_channel then return ("1"b); else if cdte.generic_destination_present then if addr (cdte.initial_command) -> generic_destination = desired_channel then return ("1"b); call match_star_name_ ((cdte.name), desired_channel, code); /* does it fit the pattern? */ if code ^= 0 then if cdte.generic_destination_present then call match_star_name_ (addr (cdte.initial_command) -> generic_destination, desired_channel, code); /* does channel_desired match a channel alias? */ return (code = 0); /* code 0 indicates match */ end cdte_matches_desired; %page; set_dial_out_channel_access_class: procedure (code); declare code fixed bin (35); code = 0; call asu_$reset_access_class (cdtep); /* since we own it, we are responsable for setting it into a reasonable state. */ if cdte.current_access_class_valid then return; call astty_$tty_order (cdtep, "set_required_access_class", addr (requested_access_class), code); if code = -1 /* Channel hung up */ then code = error_table_$io_no_permission; if code = error_table_$io_no_permission then return; /* Let caller decide what to do */ else if code ^= 0 then do; if code = error_table_$undefined_order_request then do; code = error_table_$resource_unavailable; /* mis-configured */ call sys_log_ (SL_LOG_BEEP, "dial_ctl_: Autocall channel ^a declared multi-class, but does not support set_required_access_class.", cdte.name); end; end; else do; cdte.current_access_class (*) = requested_access_class; cdte.current_access_class_valid = "1"b; end; return; end set_dial_out_channel_access_class; decrement_ndialed: procedure (); if ute.ndialed_consoles <= 0 then do; ute.ndialed_consoles = 0; call sys_log_ (SL_LOG_SILENT, "dial_ctl_: ndialed negative ^a", ute.tty_name); end; else ute.ndialed_consoles = ute.ndialed_consoles - 1; end decrement_ndialed; make_group_id: procedure (a_utep) returns (char (32)); declare a_utep pointer; declare group_id char (32); group_id = ""; call ioa_$rsnnl ("^[anonymous^s^;^a^].^a.^a", group_id, (0), (a_utep -> ute.anonymous = 1), a_utep -> ute.person, a_utep -> ute.project, a_utep -> ute.tag); return (group_id); end make_group_id; %page; meter_dut: procedure (); /* meter dialed_up_time */ if cdte.service_type ^= ANS_SERVICE then /* not 'dial' or 'slave' */ cdte.dialed_up_time = cdte.dialed_up_time + float (anstbl.current_time - cdte.dialup_time, 63) / 1e6 + .5e0; end meter_dut; %page; convert_aliases: procedure (rq_person, rq_project) returns (bit (1)); dcl rq_person char (22); dcl rq_project char (9); dcl code fixed bin (35); dcl satx fixed bin (35); call pnt_manager_$admin_get_entry (rq_person, addr (pnte), code); if code = error_table_$id_not_found then return (FALSE); else if code ^= 0 then do; call sys_log_$error_log (SL_LOG_BEEP, code, ME, "Can't find PNT entry: ^a", rq_person); return (FALSE); end; else rq_person = substr (pnte.user_id, 1, length (rq_person)); if rq_project = "" then rq_project = substr (pnte.default_project, 1, length (rq_project)); else do; call hash_$search (as_data_$sat_htp, rq_project, satx, code); if code ^= 0 then return (FALSE); satp = as_data_$satp; satep = addr (sat.project (satx)); if rq_project ^= project.project_id then if rq_project ^= project.alias then do; call sys_log_ (SL_LOG_BEEP, "^a: sat.ht has ""^a"", sat has ""^a"" at ^p", rq_project, project.project_id, satep); return (FALSE); end; rq_project = substr (project.project_id, 1, length (rq_project)); end; return (TRUE); end convert_aliases; %page; find_dialable_process: procedure returns (pointer); /**** internal procedure to scan table (answer_table, daemon_user_table, or absentee_user_table) and set utep to ptr to entry which matches all criteria for dialing. Implicit parameters are find_person_project, rq_person, rq_project, dial_qualifier, cdte, and utep. We expect that at any site where system_high > system_low that flags.access_control.slave_dial will be on. This will force lg_ctl_ to force the user typing the dial request to specify an access class in case one was not specified be the communications medium. If that flag is on, and cdte.current_access_class_valid is off, then there is a bug someplace. If that flag is off, and cdte.current_access_class_valid is off, then the user simple didn't bother to type -user on the dial request. We then require the channel range to include the process authorization, though we don't recommend this trick. */ dcl i fixed bin; dcl P ptr; ansp = as_data_$ansp; do i = 1 to anstbl.current_size; /* check for user */ P = addr (anstbl.entry (i)); if consider_ute () then return (P); end; /* Now check the daemon user table */ dutp = as_data_$dutp; do i = 1 to dutbl.current_size; /* check for user */ P = addr (dutbl.entry (i)); if consider_ute () then return (P); end; /* Now check the absentee user table */ autp = as_data_$autp; do i = 1 to autbl.current_size; /* check for user */ P = addr (autbl.entry (i)); if consider_ute () then return (P); end; return (null); /* not found */ consider_ute: procedure returns (bit (1) aligned); if P -> ute.active ^= NOW_HAS_PROCESS then return ("0"b); if static_trace_sw then if P -> ute.dial_ev_chn ^= 0 then call trace ( "(find_dialable_process) UTE: name ^a.^a qualifier ^a ^[registered_dial_server^] ^[dialok^] dial_server_ring ^d", P -> ute.person, P -> ute.project, P -> ute.dial_qualifier, P -> ute.registered_dial_server, P -> ute.at.dialok, P -> ute.dial_server_ring); if find_person_project /* see if we want to match by person-project */ then do; if P -> ute.person ^= rq_person then return ("0"b); if P -> ute.project ^= rq_project then return ("0"b); end; if ^find_person_project & ^(P -> ute.registered_dial_server) /* ^ person.project implies registered server */ then return ("0"b); if P -> ute.dial_qualifier ^= dial_qualifier then /* wrong one, or none registered */ return ("0"b); if ^(P -> ute.at.dialok) then /* Is master allowed to have dials? */ return ("0"b); if P -> ute.dial_ev_chn = 0 then /* Is master accepting dials? */ return ("0"b); /*** AIM and ACS checks as explained above */ /*** Note that dialup_ checked -user NAME against acs. */ if ^access_check_channel_and_process (P, (P -> ute.dial_server_ring), P -> ute.privileged_dial_server, DIAL_IN, ("0"b)) /* code uninteresting, since we just skip */ then return ("0"b); return ("1"b); end consider_ute; end find_dialable_process; %page; SETUP_REQUEST: procedure (code); dcl code fixed bin (35) parameter; if as_data_$ansp = null then do; code = 1; /* Not used, except to check against 0. */ return; end; ansp = as_data_$ansp; dutp = as_data_$dutp; autp = as_data_$autp; request_ptr = a_request_ptr; as_request_sender_ptr = a_asr_sender_ptr; if as_request_sender.version ^= AS_REQUEST_SENDER_VERSION_2 then do; call sys_log_ (SL_LOG, "dial_ctl_: Program error. as_request_sender.version (^d) not correct in dial request. Should be ^d.", as_request_sender.version, AS_REQUEST_SENDER_VERSION_2); code = 1; return; end; process_group_id = as_request_sender.group_id; process_id = as_request_sender.process_id; process_ring = as_request_sender.validation_level; unspec (sender_authorization) = as_request_sender.authorization; reason_code = 0; reason = ""; chn = dial_server_request.header.reply_channel; /* use this channel temporarily */ if dial_server_request.version ^= dial_server_request_version_4 then call SEND_ERROR_MESSAGE_AND_REJECT (error_table_$unimplemented_version); chn = dial_server_request.dial_control_channel; /* stop using dsr.header.reply_channel */ /**** Note that at this point, chn could be zero if it was not specified in the dial_server_request structure. We interpret this to mean that the user is not interested in any responses from us. */ call asu_$find_process (process_id, i, utep); /* locate caller's ate */ if utep = null () then do; call sys_log_ (SL_LOG_SILENT, "dial_ctl_: Can't find process ^12.3b", process_id); call SEND_CONTROL_MESSAGE (REQUEST_DENIED); goto REQUEST_RETURNS; end; cdtep = null (); /* until we find a channel */ code = 0; return; end SETUP_REQUEST; %page; DIAL_OUT_CHANNEL_ERROR: procedure (); if cdte.in_use = NOW_DIALED_OUT then do; /* check for error after dial_out */ call astty_$tty_order (cdtep, "hangup", null (), (0)); /* make sure line is hungup, ignore code */ end; if code = -1 then call sys_log_ (SL_LOG_SILENT, "dial_ctl_: Channel ^a hung up after dial_out for ^a.^a.", cdte.name, ute.person, ute.project); else if code = error_table_$request_pending | code = error_table_$undefined_order_request then call sys_log_$error_log (0, code, ME, "getting dial_out_status or tty info (^a for ^a.^a).", cdte.name, ute.person, ute.project); else call sys_log_$error_log (0, code, ME, "dial_out (^a for ^a.^a) failed.", cdte.name, ute.person, ute.project); cdte.process = null (); /* cleanup the cdte */ cdte.dialed_to_procid = (36)"0"b; cdte.dial_ev_chn = 0; call decrement_ndialed; /* reduce ate.ndialed_consoles */ cdte.in_use = NOW_HUNG_UP; /**** We now set the tra_vec so that when the hangup wakeup comes in we will go to the dial_ctl_$dial_term entry. */ cdte.tra_vec = WAIT_DIAL_RELEASE; call REJECT_CHANNEL_REQUEST (error_table_$no_connection, "error in dialing out"); end DIAL_OUT_CHANNEL_ERROR; %page; REJECT_CHANNEL_REQUEST: procedure (code, why); dcl code fixed bin (35); dcl why char (*); if code = 0 then /* default error message */ code = error_table_$action_not_performed; call convert_status_code_ (code, junk, format); reason = rtrim (format) || " " || why; CAI.valid.service_info = TRUE; CAI.service_info = REQUEST_TYPES (request_type); if (request_type = PRIV_ATTACH_CHN_RQ | request_type = TANDD_ATTACH_CHN_RQ) then call as_access_audit_$channel (cdtep, null, utep, -AS_AUDIT_CHANNEL_ATTACH, addr (CAI), reason); else if request_type = DIAL_OUT_RQ then do; CAI.valid.service_info = FALSE; call as_access_audit_$channel (cdtep, null, utep, -AS_AUDIT_CHANNEL_DIALOUT, addr (CAI), reason); end; else if (request_type = RELEASE_CHN_RQ | request_type = TERMINATE_DIAL_OUT_RQ) then call as_access_audit_$channel (cdtep, null, utep, -AS_AUDIT_CHANNEL_DETACH, addr (CAI), reason); else call sys_log_ (SL_LOG_SILENT, "dial_ctl_: Refused unknown request from ^a.^a; ^a ^a", ute.person, ute.project, format, why); call SEND_ERROR_MESSAGE_AND_REJECT (code); /* Doesn't return */ end REJECT_CHANNEL_REQUEST; %page; REJECT_DIALID_REQUEST: procedure (code, why); dcl code fixed bin (35); dcl why char (*); if code = 0 then /* default error message */ code = error_table_$action_not_performed; call convert_status_code_ (code, junk, format); reason = rtrim (format) || " " || why; if request_type = START_DIAL_ID_RQ then call as_access_audit_$dialid (utep, -AS_AUDIT_DIALID_START, addr (DSI), reason); else if request_type = STOP_DIAL_ID_RQ | request_type = RELEASE_DIAL_ID_RQ then call as_access_audit_$dialid (utep, -AS_AUDIT_DIALID_STOP, addr (DSI), reason); else call sys_log_ (SL_LOG_SILENT, "dial_ctl_: Refused unknown request from ^a.^a; ^a ^a", ute.person, ute.project, format, why); call SEND_ERROR_MESSAGE_AND_REJECT (code); /* Doesn't return */ end REJECT_DIALID_REQUEST; %page; SEND_ERROR_MESSAGE_AND_REJECT: procedure (code); /**** This internal procedure informs the requesting process of the error and then does a non-local return to abort the request. */ dcl code fixed bin (35); dcl 1 rv_message_error aligned based (addr (rv.chan)), /* how we return a full error code */ 2 error_code fixed bin (35); /* normal error code */ if chn ^= 0 then do; rvp = addr (retval); unspec (rv) = ""b; rv.error_msg = "1"b; /* Indicate return of error code to sender */ rv_message_error.error_code = code; /* set error using other overlay */ call hcs_$wakeup (process_id, chn, retval, (0)); end; goto REQUEST_RETURNS; end SEND_ERROR_MESSAGE_AND_REJECT; %page; SEND_CHANNEL_MESSAGE: procedure (message); dcl message bit (15) aligned parameter; dcl 1 rv_chan unal based (addr (rv.chan)), /* overlay 6 character rv.chan field */ 2 devx fixed bin (17) unal, 2 line_type bin (17) unal, 2 pad fixed bin (17) unal; rvp = addr (retval); unspec (rv) = ""b; rv_chan.devx = cdte.twx; rv_chan.line_type = cdte.line_type; rv.devx_msg = "1"b; rv.control.code = message; call hcs_$wakeup (cdte.dialed_to_procid, cdte.dial_ev_chn, retval, (0)); return; end SEND_CHANNEL_MESSAGE; %page; SEND_CONTROL_MESSAGE: procedure (message); dcl message bit (15) aligned parameter; if chn ^= 0 then do; rvp = addr (retval); unspec (rv) = ""b; rv.chan = "contrl"; /* Tell user this is control message */ rv.control.code = message; call hcs_$wakeup (process_id, chn, retval, (0)); end; return; end SEND_CONTROL_MESSAGE; %page; SERVICE_TYPE: procedure (type) returns (character (10) varying); dcl type fixed bin (17) unaligned; dcl type_names (9) character (10) varying initial ("as", "ftp", "mc", "slave", "dial", "dial_out", "inactive", "mpx", "tandd"); if type < lbound (type_names, 1) | type > hbound (type_names, 1) then return ("?"); else return (type_names (type)); end SERVICE_TYPE; %page; trace_request: procedure (caller); declare caller char (32); declare auth char (32) aligned; declare access_class_string char (32) aligned; auth = display_access_class_ (as_request_sender.authorization); access_class_string = display_access_class_ (dial_server_request.access_class); call trace ("(^a) group_id: ^a process_id: ^w ring: ^d auth: ^a ^[comm priv^]", caller, as_request_sender.group_id, as_request_sender.process_id, as_request_sender.validation_level, auth, addr (as_request_sender.authorization) -> aim_template.privileges.comm); call trace ( "^5xQualifier: ^a Channel: ^a Destination: ^a Baud: ^d line_type: ^d server_type: ^a Access_class: ^a", dial_server_request.dial_qualifier, dial_server_request.channel_name, dial_server_request.dial_out_destination, dial_server_request.baud_rate, dial_server_request.line_type, dial_server_request.server_type, access_class_string); call trace ( "^5x^[ start^]^[ stop^]^[ privileged_attach^]^[ release_channel^]^[ registered_server^]^[ no_hangup^]^[ release_dial_id^]^[ tandd_attach^]^[ no_listen^]^[ access_class_specified^]", dial_server_request.start, dial_server_request.stop, dial_server_request.privileged_attach, dial_server_request.release_channel, dial_server_request.registered_server, dial_server_request.no_hangup, dial_server_request.release_dial_id, dial_server_request.tandd_attach, dial_server_request.no_listen, dial_server_request.access_class_specified); return; end trace_request; trace: procedure options (variable); declare ioa_$general_rs entry (pointer, fixed binary, fixed binary, character (*), fixed binary (21), bit (1) aligned, bit (1) aligned); declare cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); declare cu_$arg_list_ptr entry returns (pointer); declare ioa_buffer char (1000); declare code_flag bit (1) aligned; declare code fixed bin (35) based (code_ptr); declare code_ptr pointer; declare (first, control) fixed bin; code_flag = "0"b; go to COMMON; trace_error: entry options (variable); code_flag = "1"b; COMMON: if code_flag then do; call cu_$arg_ptr (1, code_ptr, (0), (0)); control = 2; first = 3; end; else do; control = 1; first = 2; end; call ioa_$general_rs (cu_$arg_list_ptr (), control, first, ioa_buffer, (0), "1"b, "0"b); /* pad, but don't NL */ if code_flag then call sys_log_$error_log (SL_LOG_SILENT, code, "dial_ctl_", "^a", ioa_buffer); else call sys_log_ (SL_LOG_SILENT, "dial_ctl_: ^a", ioa_buffer); return; end trace; %page; ABORT_DIALIN: procedure (P_ec, P_reason); dcl P_ec fixed bin (35) parameter; dcl P_reason char (*) parameter; dcl action fixed bin (17); dcl code_reason char (150) varying; dcl code_reason_al char (100) aligned; if P_ec = 0 then code_reason = P_reason; else do; call convert_status_code_ (P_ec, (""), code_reason_al); code_reason = rtrim(code_reason_al); if P_reason ^= "" then do; code_reason = code_reason || ", "; code_reason = code_reason || rtrim(P_reason); end; end; if utep ^= null () then do; CAI.channel_name = cdte.name; CAI.valid = FALSE; CAI.valid.access_class = cdte.dialup_flags.current_access_class_valid; CAI.access_class = cdte.current_access_class (1); CAI.valid.access_class_range = TRUE; CAI.access_class_range = cdte.access_class; CAI.valid.user_validation_level = TRUE; CAI.user_validation_level = ute.initial_ring; if dial_qualifier = "system" then do; action = -AS_AUDIT_CHANNEL_DIAL_SYSTEM; end; else do; action = -AS_AUDIT_CHANNEL_DIALIN; CAI.valid.service_info = TRUE; CAI.service_info = dial_qualifier; end; call as_access_audit_$channel (cdtep, null, utep, action, addr (CAI), (code_reason)); end; else call sys_log_ (SL_LOG_SILENT, "DIALIN DENIED^20t^[^a.^a^;^s^s^] ^a to ^a ^[(^a)^]", cdte.flags.access_control.slave_dial, cdte.user_name.person, cdte.user_name.project, cdte.name, dial_qualifier, (code_reason ^= ""), code_reason); cdte.process = null (); cdte.dialed_to_procid = ""b; cdte.dial_ev_chn = 0; if P_ec ^= 0 then P_code = P_ec; /* export this error code */ else P_code = as_error_table_$dialnotup; /* default error message */ return; end ABORT_DIALIN; %page; DIALIN_OK: procedure (); dcl action fixed bin (17); CAI.channel_name = cdte.name; CAI.valid = FALSE; CAI.valid.access_class = TRUE; if cdte.dialup_flags.current_access_class_valid then CAI.access_class = cdte.current_access_class (1); else CAI.access_class = ute.process_authorization; CAI.valid.access_class_range = TRUE; CAI.access_class_range = cdte.access_class; CAI.valid.user_validation_level = TRUE; CAI.user_validation_level = ute.initial_ring; if dial_qualifier = "system" then do; action = AS_AUDIT_CHANNEL_DIAL_SYSTEM; end; else do; action = AS_AUDIT_CHANNEL_DIALIN; CAI.valid.service_info = TRUE; CAI.service_info = dial_qualifier; end; call as_access_audit_$channel (cdtep, null, utep, action, addr (CAI), ""); end DIALIN_OK; %page; NULL_PROC: procedure (); /**** This dummy procedure exists for as_any_other_handler_'s sake. It is a dummy cleanup handler, required by as_any_other_handler_. */ return; end NULL_PROC; %page; INITIALIZE_CURRENT_ACCESS_CLASS: procedure (P_code); /**** This procedure ensures that the cdte.current_access_class_valid bit reflects the true state of the channel, and that the current access field in the cdte is up-to-date. */ dcl P_code fixed bin (35) parameter; /* status code */ dcl 1 auto_tty_access_class structure aligned like tty_access_class automatic; P_code = 0; /* initialize */ call asu_$reset_access_class (cdtep); /* reset configured state */ if cdte.current_service_type = DIAL_OUT_SERVICE then return; if ^cdte.current_access_class_valid then do; /* see if we can do it */ unspec (auto_tty_access_class) = ""b; call astty_$tty_order (cdtep, "get_required_access_class", addr (auto_tty_access_class), P_code); if P_code = 0 & auto_tty_access_class.access_class_set then do; cdte.current_access_class_valid = TRUE; cdte.current_access_class = auto_tty_access_class.access_class; end; else if P_code = 0 then ; /* no required access class */ else if P_code = -1 /* stupid value if channel down */ then P_code = 0; else if P_code = error_table_$undefined_order_request then P_code = 0; /* of if this MUX doesn't support it */ else /* error of some kind */ call sys_log_$error_log (SL_LOG_SILENT, P_code, ME, "From get_required_access_class control order on channel ^a.", cdte.name); end; else P_code = 0; return; end INITIALIZE_CURRENT_ACCESS_CLASS; %page; /* format: off */ %page; %include absentee_user_table; %page; %include access_mode_values; %page; %include aim_template; %page; %include aim_privileges; %page; %include access_audit_bin_header; %page; %include answer_table; %page; %include as_audit_structures; %page; %include as_data_; %page; %include as_data_definitions_; %page; %include as_request_header; %page; %include as_request_sender_; %page; %include author_dcl; %page; %include cdt; %page; %include dial_server_request; %page; %include dialup_values; %page; %include daemon_user_table; %page; %include line_types; %page; %include pnt_entry; dcl 1 pnte structure aligned like pnt_entry; %page; %include sat; dcl satep ptr; %page; %include set_term_type_info; %page; %include sys_log_constants; %page; %include terminal_info; %page; %include tty_access_class; %page; %include user_attributes; %page; %include user_table_entry; %page; %include user_table_header; /* format: on */ %page; /* BEGIN MESSAGE DOCUMENTATION Message: dial_ctl_: Channel CHANNEL dialed to Initializer {(PERSON.PROJECT)} S: as (severity2) T: $run M: An additional secondary terminal has been attached to the Initializer process as a result of a dial system command. CHANNEL specifies which terminal dialed Initializer. A: If this terminal has been connected to the Initializer by an authorized operations staff member, proceed to use it by issuing an "accept" command and possibly the "substty" command. If this is an invalid attempt to connect to the system, type "drop CHANNEL" to disconnect the terminal. Message: dial_ctl_: ERROR_MESSAGE. Can't find PNT entry: PERSON_ID S: as (severity2) T: $run M: An attempt was made to find the Person Name Table entry of the PERSON_ID specified in a dial preaccess command. However, an error occurred which searching in the PNT. A: $notify_sa Message: dial_ctl_: sat.ht has PROJECT_ID, sat has OTHER_PROJECT_ID at LOC. S: as (severity2) T: $run M: The System Administrator's Table is inconsistent with the location information in its hash table. A: $notify_sa Message: dial_ctl_: Rejected unknown request from PERSON.PROJECT. No request flags set in dial_server_request. S: as (severity0) T: $run M: The user PERSON.PROJECT attempted to send an dial_server request to the Initializer, but failed to specify what type of request he/she wanted. A: $ignore Message: dial_ctl_: Channel CHANNEL (AIM_CLASS, SERV_TYPE) hung up on Initializer S: as (severity1) T: $run M: The channel CHANNEL with access class AIM_CLASS and service type SERV_TYPE hung up. It had previously been dialed to the Initializer. A: $ignore Message: dial_ctl_: Channel CHANNEL (AIM_CLASS, SERV_TYPE) hung up on missing process WWWWWWWWWWWW S: as (severity1) T: $run M: The channel CHANNEL with access class AIM_CLASS and service type SERV_TYPE hung up. It had been dialed to a process, but the system cannot determine what process it had been connected to. The process may have terminated before the hangup was detected. A: If this happens often, inform the programming staff. Message: dial_ctl_: Can't find process WWWWWWWWWWW S: as (severity0) T: $run M: An invalid signal was received by the secondary terminal manager. A: $note Message: dial_ctl_: Tracing turned on. S: as (severity1) T: $run M: A system administrator had enabled tracing of the dial_ctl_ program. Many status messages will be logged and printed on the console. A: $ignore Message: dial_ctl_: Tracing turned off S: as (severity1) T: $run M: A system administrator has disabled dial_ctl_ tracing. A: $ignore Message: dial_ctl_: ERROR_MESSAGE. Could not check access to >sc1>admin_acs>tandd.acs for PERSON.PROJECT. S: as (severity0) T: $run M: The user PERSON.PROJECT attempted to tandd_attach a communications channel. This operation is controlled by rw access to the ACS segment specified. For the reason ERROR_MESSAGE, the answering service could not check access to the segment. The user tandd_attach request was refused. A: $contact_sa Message: dial_ctl_: ERROR_MESSAGE. Issuing tandd_attach control order for channel CHAN S: as (severity0) T: $run M: The user PERSON.PROJECT attempted to tandd_attach a communications channel which failed for the reason given by ERROR_MESSAGE. The user tandd_attach request was refused. A: $contact_sa Message: dial_ctl_: Dialing channel CHANNEL (ACC_CLASS) to DESTINATION for PERSON.PROJECT {using comm privilege} S: as (severity0) T: $run M: The user PERSON.PROJECT is dialing out on dial channel CHANNEL with access class ACC_CLASS to the destination DESTINATION. If this log message ends with "using comm privilege", then the process dialing out has used the comm privilege to circumvent AIM restrictions. A: $ignore Message: dial_ctl_: ERROR_MESSAGE. after dial_out order (CHANNEL for PERSON.PROJECT) S: as (severity0) T: $run M: The user PERSON.PROJECT is attempting a dial_out of channel CHANNEL. The dial_out control order produced the error ERROR_MESSAGE. The dial_out attempt is aborted. A: $note Message: dial_ctl_: ERROR_MESSAGE. call to astty_$tty_new_proc of CHANNEL for PERSON.PROJECT failed S: as (severity0) T: $run M: An attempt to connect the channel CHANNEL to PERSON.PROJECT failed. ERROR_MESSAGE indicates why. A: $contact_sa Message: dial_ctl_: ERROR_MESSAGE. Attempting to detach CHANNEL from PERSON.PROJECT S: as (severity0) T: $run M: An attempt to disconnect channel CHANNEL from PERSON.PROJECT failed. ERROR_MESSAGE explains why. A: $note Message: dial_ctl_: Autocall channel CHANNEL declared multi-class, but does not support set_required_access_class. S: as (severity2) T: $run_ M: The autocall channel CHANNEL has been declared multi-class in the CDT, but the underlying multiplexer does not support the set_required_access_class control order. The channel should be defined as single class. The user's dial out request was refused. A: $contact_sa Message: dial_ctl_: ndialed negative CHANNEL S: as (severity0) T: $run M: The count of secondary consoles for a user is in error. A terminal is hanging up which claims to be attached to a user but his count of attached terminals is zero. A: $note Message: dial_ctl_: Program error. as_request_sender.version (N) not correct in dial request. Should be M. S: as (severity1) T: $run M: There is a mismatch in the version number used by the the programs as_request_server_ and dial_ctl_ for the as_request_sender_ structure. A: $contact Message: dial_ctl_: Channel CHANNEL hung up after dial_out for PERSON.PROJECT S: as (severity0) T: $run M: During a dial_out of channel CHANNEL by PERSON.PROJECT, the channel hung up. The dial_out attempt was aborted. A: $ignore Message: dial_ctl_: ERROR_MESSAGE. getting dial_out_status or tty info (CHANNEL for PERSON.PROJECT) S: as (severity0) T: $run M: During a dial_out of channel CHANNEL by PERSON.PROJECT, the error ERROR_MESSAGE was returned while attempting to determine if the dial_out control order succeeded or failed. A: $ignore Message: dial_ctl_: ERROR_MESSAGE. dial_out (CHANNEL for PERSON.PROJECT) failed. S: as (severity0) T: $run M: While attempting to dial_out channel CHANNEL for PERSON.PROJECT, the error ERROR_MESSAGE occured. The dial_out attempt was aborted. A: $ignore Message: dial_ctl_: Refused unknown request from PERSON.PROJECT; ERROR_MESSAGE REASON S: as (severity0) T: $run M: PERSON.PROJECT send a dial_server request to the Initializer of unknown format. It was rejected for the reasons specified in ERROR_MESSAGE and REASON. Message: DIALIN DENIED {PERSON1.PROJECT1} CHANNEL to QUALIFIER {PERSON2.PROJECT2} REASON S: as (severity0) T: $run M: A user on channel CHANNEL attempted to use the "dial" preaccess command to dial to QUALIFIER, owned by PERSON2.PROJECT2. The attempt was rejected for REASON. If the channel check_acs "slave_dial" flag was on, then PERSON1.PROJECT1 specifies the identified user on this channel. A: $note Message: DIALIN {PERSON1.PROJECT1} CHANNEL to QUALIFIER {PERSON2.PROJECT2} S: as (severity0) T: $run M: A user on channel CHANNEL has used the "dial" preaccess command to dial the dial qualifier QUALIFIER owned by PERSON2.PROJECT2. If the check_acs "slave_dial" flags was on for the channel, then PERSON1.PROJECT1 specifies the identified user. A: $ignore Message: dial_ctl_: ERROR_MESSAGE From get_required_access_class control order on channel CHANNEL. S: as (severity0) T: $run M: While attempting to determine whether the channel CHANNEL had any access class restrictions imposed on it by the hardcore, ERROR_MESSAGE was returned. The request in progress was aborted. A: $note END MESSAGE DOCUMENTATION */ end dial_ctl_;  display_connection_list.pl1 08/04/87 1525.3rew 08/04/87 1222.0 231282 /****^ ******************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * ******************************************** */ /****^ HISTORY COMMENTS: 1) change(87-04-07,Brunelle), approve(87-07-08,MCR7681), audit(87-07-22,Hartogs), install(87-08-04,MR12.1-1055): New program. 2) change(87-05-28,GDixon), approve(87-07-08,MCR7720), audit(87-07-22,Hartogs), install(87-08-04,MR12.1-1055): A) Revised to add selection control arguments and to simplify output format. 3) change(87-06-10,GDixon), approve(87-07-08,MCR7720), audit(87-07-22,Hartogs), install(87-08-04,MR12.1-1055): A) Correct error in display of aci.network_type. B) Correct length computation for aci.offset. 4) change(87-07-21,GDixon), approve(87-07-21,MCR7720), audit(87-07-22,Hartogs), install(87-08-04,MR12.1-1055): A) Correct use of magic numbers. B) Comment on why capital U is excluded in the vowel routine. END HISTORY COMMENTS */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* display_connection_list: a utility to display contents of the */ /* active_connection_list table, maintained by the connection_list_manager_ */ /* subsystem. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ display_connection_list: proc; /* AUTOMATIC */ dcl brief_sw bit(1) aligned automatic; dcl channel char(32) automatic; dcl code fixed bin(35) automatic; dcl connection bit(18); dcl entry_var entry variable; dcl offset fixed bin(18) automatic; dcl 1 owner aligned automatic, 2 id char(32), 2 person char(24), 2 project char(12), 2 tag char(1) unal, 2 tag_pad char(3) unal; dcl owner_id fixed bin(36) automatic; dcl star_type fixed bin(2); dcl 1 user aligned automatic like owner; dcl user_id fixed bin(36) automatic; /* ENTRIES */ dcl check_star_name_ entry (char(*), bit(36), fixed bin(2), fixed bin(35)); dcl hpriv_connection_list_$get_next entry (bit (18), ptr, fixed bin (35)); dcl ioa_ entry() options(variable); dcl match_star_name_ entry (char(*), char(*), fixed bin(35)); /* BUILTINS AND CONDITIONS */ dcl (addr, after, before, bit, divide, index, length, max, null, rtrim, search, substr, verify, unspec) builtin; dcl (cleanup, linkage_error) condition; /* INTERNAL STATIC */ dcl DISPLAY_CONNECTION_LIST_VERSION init("1.0") char(3) int static options(constant); dcl (FALSE init("0"b), TRUE init("1"b)) bit(1) int static options(constant); dcl ME char (23) int static options (constant) init ("display_connection_list"); /* EXTERNAL STATIC */ dcl (error_table_$bad_arg, error_table_$bad_opt, error_table_$noentry) fixed bin(35) ext static; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* INVOCATION TYPE AND ARGUMENTS: */ /* 1) Initialize variables, and establish cleanup handler. */ /* 2) Create standalone ssu_ invocation for argument processing. */ /* 3) Initialize argument handling routines. */ /* 4) Process input arguments, reporting any errors as they are encountered. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ call initialize_args(); on cleanup call cleanup_invocation(); call ssu_$standalone_invocation (sci_ptr, ME, DISPLAY_CONNECTION_LIST_VERSION, cu_$arg_list_ptr(), exit_proc, code); call check_invocation_type (ALLOW_COMMAND); call process_args(); call scan_connection_list(); /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* REVOCATION AND EXIT: */ /* This point is reached when normal processing completes successfully, */ /* or when the error$fatal routine is called to abnormally end processing. */ /* */ /* 1) Cleanup the standalone invocation. */ /* 2) Return to command processor. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ EXIT: call cleanup_invocation(); return; exit_proc: proc; go to EXIT; end exit_proc; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* ARGUMENT PROCESSING: */ /* Declare variables and subroutines needed for argument processing. */ /* */ /* CHECK INVOCATION TYPE: */ /* 1) Initialize error handling subroutines. */ /* 2) Determine whether invoked as command or af. */ /* 3) Is this type of invocation allowed? */ /* 4) Initialize af return argument, and index of current argument. */ /* */ /* SEE OTHER ARGUMENT PROCESSING PROGRAMS: */ /* get_arg, get_ctl_arg, get_opt, get_num_opt */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ dcl af_sw bit(1) aligned, /* on: active fnc*/ arg char(argl) based(argp), argl fixed bin(21), /* current arg */ argp ptr, argn fixed bin, /* arg count */ argx fixed bin, /* arg index */ num_opt fixed bin, /* numeric option*/ opt char(optl) based(optp), optl fixed bin(21), /* current option*/ optp ptr, ret char(retl) varying based(retp), retl fixed bin(21), /* af return val */ retp ptr, sci_ptr ptr; /* ssu_ info ptr */ dcl cu_$arg_list_ptr entry returns(ptr), ssu_$abort_subsystem entry() options(variable), ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin(21)), ssu_$destroy_invocation entry (ptr), ssu_$print_message entry() options(variable), ssu_$return_arg entry (ptr, fixed bin, bit(1) aligned, ptr, fixed bin(21)), ssu_$standalone_invocation entry (ptr, char(*), char(*), ptr, entry, fixed bin(35)); dcl (ALLOW_COMMAND init(1), ALLOW_AF init(2), ALLOW_COMMAND_AF init(3)) fixed bin int static options(constant); check_invocation_type: proc (allowed); dcl allowed fixed bin; dcl (error_table_$active_function, error_table_$not_act_fnc) fixed bin(35) ext static; call error$init(); call ssu_$return_arg (sci_ptr, argn, af_sw, retp, retl); if allowed = ALLOW_COMMAND & af_sw then call error$fatal (sci_ptr, error_table_$active_function); else if allowed = ALLOW_AF & ^af_sw then call error$fatal (sci_ptr, error_table_$not_act_fnc); else if allowed = ALLOW_COMMAND_AF then; if af_sw then ret = ""; argx = 0; end check_invocation_type; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* CLEANUP: */ /* 1) Destroy the ssu_ invocation (releasing temp segs obtained thru ssu_). */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ cleanup_invocation: proc; if sci_ptr ^= null then call ssu_$destroy_invocation (sci_ptr); end cleanup_invocation; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* display_connection: Display one matching connection. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ dcl 1 begin aligned automatic, 2 (connection, network, usage, user, process_id) fixed bin; dcl matching_entries fixed bin; dcl need_heading bit(1) aligned automatic; dcl 1 width aligned automatic, 2 (offset, connection, network, usage, user) fixed bin; display_connection: procedure; matching_entries = matching_entries + 1; if brief_sw then do; if need_heading then do; call ioa_ ( "^/AT^vtCONNECTION^vtNET^vtUSAGE^vtUSER^vtPROCESS ID", begin.connection, begin.network, begin.usage, begin.user, begin.process_id); need_heading = "0"b; end; call ioa_ ("^vo^vt^a^vt^a^vt^a^vt^a^vt^12.3b", width.offset, unspec(aci.offset), begin.connection, aci.connection_name, begin.network, aci.network_service_type, begin.usage, LS_USAGE_VALUES (aci.usage_type), begin.user, aci.user_group_id, begin.process_id, aci.user_process_id); end; else do; call ioa_ (""); call ioa_ ("Offset: ^6.3b^25x Usage: ^d (^a)", aci.offset, aci.usage_type, LS_USAGE_VALUES (aci.usage_type)); call ioa_ ("Connection name: ^32a Net: ^a", aci.connection_name, aci.network_service_type); call ioa_ ("Connection handle: ^w", aci.connection_handle); call ioa_ ("User name: ^32a PID: ^12.3b", aci.user_group_id, aci.user_process_id); call ioa_ ("Owner name: ^32a PID: ^12.3b", aci.owner_group_id, aci.owner_process_id); call ioa_ ("Initializer handle: ^24.3b", aci.owner_initializer_handle); call ioa_ ("Terminate event chn: ^24.3b", unspec(aci.terminate_event_channel)); call ioa_ ("Disconnect entry: ^a", aci.force_disconnect_entry); call ioa_ ("Accounting entry: ^a", aci.force_accounting_flush_entry); end; return; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ display_connection$init: entry; matching_entries = 0; need_heading = TRUE; width.offset = length("AT"); width.connection = length("CONNECTION"); width.network = length("NET"); width.usage = length("USAGE"); width.user = length("USER"); begin = 0; return; /* * * * * * * * * * * * * * * * * * * * * * * * * */ display_connection$matching_entry_count: entry returns (fixed bin); return (matching_entries); /* * * * * * * * * * * * * * * * * * * * * * * * * */ display_connection$set_widths: entry; dcl (BITS_PER_OCTAL_DIGIT init(3), GUTTER init(2), STARTING_COLUMN init(1)) fixed bin int static options(constant); width.offset = max (width.offset, divide(length(aci.offset)-index(aci.offset,"1"b)+1 + BITS_PER_OCTAL_DIGIT-1, /* round to next */ BITS_PER_OCTAL_DIGIT, 17, 0)); /* octal digit */ width.connection = max (width.connection, length(rtrim(aci.connection_name))); width.network = max (width.network, length(rtrim(aci.network_service_type))); width.usage = max (width.usage, length(LS_USAGE_VALUES(aci.usage_type))); width.user = max (width.user, length(rtrim(aci.user_group_id))); begin.connection = STARTING_COLUMN + width.offset + GUTTER; begin.network = begin.connection + width.connection + GUTTER; begin.usage = begin.network + width.network + GUTTER; begin.user = begin.usage + width.usage + GUTTER; begin.process_id = begin.user + width.user + GUTTER; return; end display_connection; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* ERROR REPORTING ROUTINES: */ /* 1) Nonfatal errors set a switch, which can be tested via error_occurred */ /* function. */ /* 2) Fatal errors abort the subsystem by calling the exit_proc, which */ /* branches to the EXIT label to exit the command. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ dcl error_occurred_sw bit(1); error: proc options (variable); dcl code fixed bin(35) based (codep), codep ptr; dcl cu_$arg_list_ptr entry returns(ptr), cu_$arg_ptr entry (fixed bin, ptr, fixed bin(21), fixed bin(35)), cu_$generate_call entry (entry, ptr); dcl CODE_ARG fixed bin int static options(constant) init(2), (FALSE init("0"b), TRUE init("1"b)) bit(1) int static options(constant); call cu_$arg_ptr (CODE_ARG, codep, 0, 0); if code = 0 then return; if code = -1 then code = 0; error_occurred_sw = TRUE; call cu_$generate_call (ssu_$print_message, cu_$arg_list_ptr()); return; error$init: entry; error_occurred_sw = FALSE; return; error$occurred: entry returns (bit(1)); return (error_occurred_sw); error$fatal: entry options(variable); call cu_$arg_ptr (CODE_ARG, codep, 0, 0); if code = 0 then return; if code = -1 then code = 0; error_occurred_sw = TRUE; call ioa_ (""); call cu_$generate_call (ssu_$abort_subsystem, cu_$arg_list_ptr()); end error; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* ARGUMENT GETTING FUNCTIONS: */ /* get_arg: Get next argument. */ /* get_arg_count: Get number of arguments. */ /* get_ctl_arg: Get next argument, which must be a control argument. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ get_arg: proc returns (bit(1)); dcl (FALSE init("0"b), TRUE init("1"b)) bit(1) int static options(constant); if argx < argn then do; argx = argx + 1; call ssu_$arg_ptr (sci_ptr, argx, argp, argl); return (TRUE); end; else return (FALSE); end get_arg; get_ctl_arg: proc returns (bit(1)); dcl index builtin; dcl (FALSE init("0"b), TRUE init("1"b)) bit(1) int static options(constant), error_table_$bad_arg fixed bin(35) ext static; if get_arg() then if index(arg, "-") = 1 then return (TRUE); else call error$fatal (sci_ptr, error_table_$bad_arg, "^a.^/A control argument was expected.", arg); return (FALSE); end get_ctl_arg; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* CONTROL ARG OPERAND GETTING FUNCTIONS: */ /* get_oct_opt: Gets next arg, treats it as an octal integer operand. */ /* get_opt: Gets next arg. */ /* */ /* Both allow the caller to specify whether the operand is required (an */ /* opt_desc is provided) or optional (opt_desc=""). */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ get_oct_opt: proc (arg_name, opt_desc) returns (bit(1)); dcl arg_name char(*), opt_desc char(*); dcl code fixed bin(35); dcl cv_oct_check_ entry (char(*), fixed bin(35)) returns(fixed bin(35)); dcl FALSE init("0"b) bit(1) int static options(constant), (error_table_$bad_arg, error_table_$noarg) fixed bin(35) ext static; if argx < argn then do; argx = argx + 1; call ssu_$arg_ptr (sci_ptr, argx, optp, optl); if verify (opt, "01234567") > 0 then go to BAD_OPT; num_opt = cv_oct_check_ (opt, code); if code ^= 0 then do; BAD_OPT: call error (sci_ptr, error_table_$bad_arg, "^a ^a ^a must be followed by a^[n^] ^a.", arg_name, opt, arg_name, vowel(opt_desc), opt_desc); return (FALSE); end; else return (TRUE); end; else if opt_desc ^= "" then do; call error (sci_ptr, error_table_$noarg, "^/^a must be followed by a^[n^] ^a.", arg_name, vowel(opt_desc), opt_desc); return (FALSE); end; else return (FALSE); end get_oct_opt; get_opt: proc (arg_name, opt_desc) returns (bit(1)); dcl arg_name char(*), opt_desc char(*); dcl (FALSE init("0"b), TRUE init("1"b)) bit(1) int static options(constant), error_table_$noarg fixed bin(35) ext static; if argx < argn then do; argx = argx + 1; call ssu_$arg_ptr (sci_ptr, argx, optp, optl); if index(opt, "-") = 1 then do; /* options cannot*/ argx = argx - 1; /* look like */ go to NO_OPT; /* control args */ end; else return (TRUE); end; else NO_OPT: if opt_desc ^= "" then do; call error (sci_ptr, error_table_$noarg, "^/^a must be followed by a^[n^] ^a.", arg_name, vowel(opt_desc), opt_desc); return (FALSE); end; return (FALSE); end get_opt; vowel: proc (str) returns (bit(1)); /* does opt_desc */ /* begin with a */ /* vowel? */ dcl str char(*), (FALSE init("0"b), TRUE init("1"b)) bit(1) int static options(constant); if search ("aeiouAEIO", substr(str,1,1)) > 0 then /* Leave out U: */ return (TRUE); /* "an User..." */ else /* is un-American*/ return (FALSE); /* This is kludgy*/ end vowel; /* but it works.*/ /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * */ group_id: procedure (arg) returns (1 like owner); dcl arg char(*); dcl 1 group aligned automatic like owner; group.id = arg; group.person = before(arg,"."); if group.person = "" then group.person = "*"; group.project = before(after(arg,"."),"."); if group.project = "" then group.project = "*"; group.tag = after(after(arg,"."),"."); if group.tag = "" then group.tag = "*"; return (group); end group_id; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* INITIALIZATION. */ /* 1) Initialize variables holding argument values. */ /* 2) Initialize ssu_ info pointer. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ initialize_args: proc; brief_sw = TRUE; user, owner, channel = ""; user_id, owner_id, offset = 0; call display_connection$init(); sci_ptr = null; end initialize_args; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* matching_entry: return TRUE if active_connection_list entry match the */ /* criteria given in input control args. Otherwise, return FALSE. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ matching_entry: procedure returns (bit(1)); dcl match bit(1); match = TRUE; if offset ^= 0 & match then match = (aci.offset = bit(offset)); if user_id ^= 0 & match then match = (aci.user_process_id = bit(user_id)); if owner_id ^= 0 & match then match = (aci.owner_process_id = bit(owner_id)); if owner.id ^= "" & match then do; if owner.person ^= "*" then match = (owner.person = before(aci.owner_group_id,".")); if owner.project ^= "*" & match then match = (owner.project = before(after(aci.owner_group_id,"."),".")); if owner.tag ^= "*" & match then match = (owner.tag = after(after(aci.owner_group_id,"."),".")); end; if user.id ^= "" & match then do; if user.person ^= "*" then match = (user.person = before(aci.user_group_id,".")); if user.project ^= "*" & match then match = (user.project = before(after(aci.user_group_id,"."),".")); if user.tag ^= "*" & match then match = (user.tag = after(after(aci.user_group_id,"."),".")); end; if channel ^= "" & match then do; call match_star_name_ ((aci.connection_name), channel, code); match = (code = 0); end; return (match); end matching_entry; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* only_one_entry_matches: returns TRUE if -at was given, because then at */ /* most one connection list entry will match. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ only_one_entry_matches: proc returns (bit(1)); return (offset ^= 0); end only_one_entry_matches; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* PROCESS ARGUMENTS */ /* 1) Match argument to ctl_arg name and operands. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ process_args: proc; CTL_ARG_LOOP: do while (get_ctl_arg ()); if arg = "-brief" | arg = "-bf" then brief_sw = TRUE; else if arg = "-long" | arg = "-lg" then brief_sw = FALSE; else if arg = "-owner" then do; if get_opt (arg, "Owner's group id") then owner = group_id (opt); end; else if arg = "-owner_id" then do; if get_oct_opt (arg, "octal process id") then owner_id = num_opt; end; else if arg = "-user" then do; if get_opt (arg, "User's group id") then user = group_id (opt); end; else if arg = "-user_id" | arg = "-pid" | arg = "-process_id" | arg = "-processid" then do; if get_oct_opt (arg, "octal process id") then user_id = num_opt; end; else if arg = "-at" | arg = "-offset" | arg = "-ofs" then do; if get_oct_opt (arg, "octal offset of connection list entry") then offset = num_opt; end; else if arg = "-channel" | arg = "-chn" then do; if get_opt (arg, "channel number") then do; channel = opt; call check_star_name_ (channel, CHECK_STAR_ENTRY_DEFAULT, star_type, code); call error (sci_ptr, code, "^a ^a", arg, opt); if star_type = STAR_TYPE_MATCHES_EVERYTHING then channel = ""; end; end; else if index (arg, "-") ^= 1 then call error (sci_ptr, error_table_$bad_arg, "^a Usage: ^a {-control_args}", arg, ME); else call error (sci_ptr, error_table_$bad_opt, "^a", arg); end CTL_ARG_LOOP; if error$occurred() then /* stop now if */ call error$fatal (sci_ptr, -1); /* ctl arg errs */ end process_args; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* scan_connection_list: Walk through connection list entries, displaying */ /* those that match the user's criteria. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ scan_connection_list: procedure; on linkage_error begin; call error$fatal (sci_ptr, -1, "Incorrect access to the hpriv_connection_list_ gate."); end; entry_var = hpriv_connection_list_$get_next; /* force linkage */ revert linkage_error; /* error now. */ unspec (aci) = ""b; /* start with return structure clean */ aci.version = ACT_INFO_VERSION_1; connection = "0"b; /* get 1st entry */ if brief_sw then do; call hpriv_connection_list_$get_next (connection, addr (aci), code); do while (code = 0); if matching_entry() then do; call display_connection$set_widths(); if only_one_entry_matches() then call display_connection(); else code = error_table_$noentry; end; connection = aci.offset; /* get next entry*/ call hpriv_connection_list_$get_next (connection, addr (aci), code); end; end; else code = error_table_$noentry; if code ^= error_table_$noentry then; else if brief_sw & only_one_entry_matches() then; else do; connection = "0"b; /* get 1st entry */ call hpriv_connection_list_$get_next (connection, addr (aci), code); do while (code = 0); if matching_entry() then do; call display_connection(); if only_one_entry_matches() then code = error_table_$noentry; end; connection = aci.offset; /* get next entry*/ call hpriv_connection_list_$get_next (connection, addr (aci), code); end; end; if code ^= error_table_$noentry then call error$fatal (sci_ptr, code, "Getting connection list entries."); if display_connection$matching_entry_count() = 0 then call error$fatal (sci_ptr, -1, "No matching connection list entries were found."); end scan_connection_list; /* * * * * * * * * * * * * * * * * * * * * * * * * */ %include active_connection_info; dcl 1 aci aligned like active_connection_info automatic; %include check_star_name; %include ls_usage_types; end display_connection_list;  ec_shift_config_change_.pl1 09/21/87 1209.1rew 09/21/87 1109.0 47619 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1982 * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(87-06-02,Parisek), approve(86-04-17,MCR7715), audit(87-08-06,Fawcett), install(87-08-11,MR12.1-1080): Establish the system_control ssu_subsystem_info_ptr so this procedure will properly work in the system control environment. 2) change(87-08-18,Parisek), approve(87-08-18,PBF7715), audit(87-09-03,Farley), install(87-09-10,MR12.1-1104): Remove unnecessary sc_subsystem_info_ references. 3) change(87-09-17,Parisek), approve(87-09-18,PBF7715), audit(87-09-18,Farley), install(87-09-21,MR12.1-1111): a. Remove reference to sc_stat_$master_sci_ptr. b. Create our own sci ptr and set sc_stat_$admin_sci_ptr equal to our sci_ptr. c. Get sc_subsystem_info_ptr based on our new sc_stat_$admin_sci_ptr value. d. Set sc_subsystem_info.real_iocb to sc_stat_$master_iocb for signal_io_. END HISTORY COMMENTS */ /* format: style4 */ ec_shift_config_change_: proc (sysdir, old, new, auto_maxu, ncpu, nkmem, nbulk); /* Procedure to execute shift_config_change.ec, passing the old and new shift, the auto_maxu switch, and the configuration parameters: cpu, mem, and bulk, with an any_other handler set up to catch any errors in the exec_com and not let them abort whatever the caller might be doing (e.g., an accounting update). Written by T. Casey, May 1978 Modified by E. N. Kittlitz, November 1982, first shot at as_check_condition_. */ dcl sysdir char (*); /* dir where shift_config_change.ec should be */ dcl (old, new, auto_maxu, ncpu, nkmem, nbulk) fixed bin; /* old and new shift, and load control parameters */ dcl as_dump_ entry (char (*)); dcl condition_ entry (char (*), entry); dcl cleanup condition; dcl call_ec_ entry options (variable); dcl hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)); dcl ioa_$rsnnl entry options (variable); dcl sc_create_sci_ entry (ptr, fixed bin (35)); dcl sc_create_sci_$destroy entry (ptr); dcl ssu_$get_info_ptr entry (ptr) returns (ptr); dcl sys_log_ entry options (variable); dcl sys_log_$error_log entry options (variable); dcl code fixed bin (35); dcl bc fixed bin (24); dcl entry_type fixed bin (2); dcl saved_admin_sci_ptr ptr; dcl sci_ptr ptr; dcl seg_type fixed bin int static options (constant) init (1); dcl (char, ltrim, rtrim, null) builtin; /* See if there is a shift_config_change.ec (there doesn't have to be) */ call hcs_$status_minf (sysdir, "shift_config_change.ec", (1), entry_type, bc, code); /* If there is, execute it after setting up an any_other handler */ sci_ptr = null; saved_admin_sci_ptr = sc_stat_$admin_sci_ptr; if code = 0 & entry_type = seg_type then do; call sc_create_sci_ (sci_ptr, code); if code ^= 0 then do; call sys_log_$error_log (SL_LOG_SILENT, code, "ec_shift_config_change_", "Failed to establish an SCI environment."); goto return_to_caller; end; on cleanup begin; sc_stat_$admin_sci_ptr = saved_admin_sci_ptr; call sc_create_sci_$destroy (sci_ptr); end; sc_stat_$admin_sci_ptr = sci_ptr; /* sc_command requires sc_stat_$admin_sci_ptr to be valid */ sc_subsystem_info_ptr = ssu_$get_info_ptr (sci_ptr); sc_subsystem_info.real_iocb = sc_stat_$master_iocb; call condition_ ("any_other", ucs); call call_ec_ (rtrim (sysdir) || ">shift_config_change", ltrim (char (old)), ltrim (char (new)), ltrim (char (auto_maxu)), ltrim (char (ncpu)), ltrim (char (nkmem)), ltrim (char (nbulk))); end; return_to_caller: if sci_ptr ^= null then do; sc_stat_$admin_sci_ptr = saved_admin_sci_ptr; call sc_create_sci_$destroy (sci_ptr); end; return; ucs: proc (mcptr, condname, coptr, infoptr, continue); dcl (mcptr, coptr, infoptr) ptr; dcl condname char (*); dcl continue bit (1); dcl msg char (120); dcl i fixed bin; dcl non_local bit (1) unaligned; dcl as_check_condition_ entry (char (*), bit (1), bit (1)); call as_check_condition_ (condname, continue, non_local); if continue | /* if not for us */ non_local then return; /* cleanup, but nothing to clean up. */ call ioa_$rsnnl ("ec_shift_config_change_: Error ^a while executing shift_config_change.ec", msg, i, condname); call sys_log_ (SL_LOG_BEEP, "^a", msg); call as_dump_ (rtrim (msg)); goto return_to_caller; end ucs; %include sys_log_constants; %page; %include sc_subsystem_info_; %page; %include sc_stat_; %page; end ec_shift_config_change_;  login_server_info_.pl1 08/04/87 1458.7rew 08/04/87 1221.9 29412 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1987 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-08-01,Coren), approve(87-07-13,MCR7737), audit(87-07-24,Brunelle), install(87-08-04,MR12.1-1055): Initially written. 2) change(87-04-26,GDixon), approve(87-07-13,MCR7737), audit(87-07-24,Brunelle), install(87-08-04,MR12.1-1055): Upgraded for change to answer_table.incl.pl1. END HISTORY COMMENTS */ /* format: style4,indattr */ login_server_info_: procedure (); /* Parameters */ dcl P_code fixed bin (35) parameter; dcl P_request_ms_dirname char (*) parameter; dcl P_request_ms_entryname char (*) parameter; dcl P_server_process_id bit (36) aligned parameter; dcl P_server_event_channel fixed bin (71) parameter; dcl P_system_control_dirname char (*) parameter; /* Automatic */ dcl code fixed bin (35) automatic; dcl event_channel fixed bin (71) automatic; /* Entries */ dcl initiate_file_ entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35)); /* Internal Static */ dcl static_answer_table_ptr ptr initial (null ()) internal static; dcl system_control_dirname char (168) initial (">system_control_1") internal static; /* External */ dcl error_table_$process_unknown fixed bin (35) ext static; /* Conditions */ dcl seg_fault_error condition; /* Builtin */ dcl null builtin; %page; /* Program */ request_info: entry (P_server_process_id, P_server_event_channel, P_request_ms_dirname, P_request_ms_entryname, P_code); if static_answer_table_ptr = null () then RETRY_ANSWER_TABLE_INITIATION: do; call initiate_file_ (system_control_dirname, "answer_table", R_ACCESS, ansp, (0), code); if code ^= 0 then goto RETURN; static_answer_table_ptr = ansp; end; else ansp = static_answer_table_ptr; on seg_fault_error begin; static_answer_table_ptr = null (); goto RETRY_ANSWER_TABLE_INITIATION; end; event_channel = anstbl.ls_request_server_event_channel; revert seg_fault_error; if event_channel = 0 then do; code = error_table_$process_unknown; /* server not active */ goto RETURN; end; P_server_process_id = anstbl.ls_request_server_process_id; P_server_event_channel = event_channel; P_request_ms_dirname = system_control_dirname; P_request_ms_entryname = "login_server_requests.ms"; code = 0; RETURN: P_code = code; return; %page; test: entry (P_system_control_dirname); /**** This entry, used for debugging, sets the pathname of the system control directory name. */ system_control_dirname = P_system_control_dirname; return; /* format: off */ %page; %include access_mode_values; %page; %include answer_table; %page; %include user_table_header; end login_server_info_;  ls_request_server.pl1 08/04/87 1521.5rew 08/04/87 1521.6 106821 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1987 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(87-03-10,GDixon), approve(87-07-02,MCR7737), audit(87-07-24,Brunelle), install(87-08-04,MR12.1-1055): Initially written. (Resolves dsa 186.) 2) change(87-07-02,GDixon), approve(87-07-02,MCR7737), audit(87-07-24,Brunelle), install(87-08-04,MR12.1-1055): Avoid signalling active_function_error condition when invoked as an active function and an error occurs. The charter of this routine is to print the error and return false in this situation. The error should NOT be printed via active_fnc_err_. END HISTORY COMMENTS */ ls_request_server: proc; dcl code fixed bin(35), operation char(5); dcl null builtin; dcl cleanup condition; dcl get_process_id_ entry() returns(bit(36)), ls_request_server_$init entry (fixed bin(35)), ls_request_server_$shutdown entry (fixed bin(35)), ls_request_server_$start entry (fixed bin(35)); dcl ME char(17) int static options(constant) init("ls_request_server"), (error_table_$action_not_performed, error_table_$bad_arg, error_table_$noarg) fixed bin(35) ext static; /* * * * * * * * * * * * * * * * * * * * * * * * * */ call DATA_init(); on cleanup call CLEANUP(); call ARGS_check (ME, "1.0", ALLOW_COMMAND_AF, exit_proc); call ARGS_process (operation); call USER_check (operation); if operation = "start" then do; call ls_request_server_$init (code); call ERR_fatal (sciP, code, "Initializating login server request server."); call ls_request_server_$start (code); call ERR_fatal (sciP, code, "Starting login server request server."); end; else if operation = "stop" then do; call ls_request_server_$shutdown (code); call ERR_fatal (sciP, code, "Stopping login server request server."); end; call ARG_set_return_value ("true"); call CLEANUP(); return; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* EXIT PROCEDURE: */ /* 1) This procedure is called by ssu_$abort_subsystem when ERR_fatal is */ /* called to report a fatal error. */ /* 2) It does a non-local goto to the EXIT label to stop execution of the */ /* command. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ exit_proc: proc; go to EXIT; end exit_proc; EXIT: call ARG_set_return_value ("false"); call CLEANUP(); return; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* ARGUMENT PROCESSING: */ /* Declare variables and subroutines needed for argument processing. */ /* */ /* SEE ARGUMENT PROCESSING PROGRAMS: */ /* ARGS_check, ARG_get */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ dcl af_sw bit(1) aligned, /* on: active fnc*/ arg char(argl) based(argp), argl fixed bin(21), /* current arg */ argp ptr, argn fixed bin, /* arg count */ argx fixed bin, /* arg index */ ret char(retl) varying based(retp), retl fixed bin(21), /* af return val */ retp ptr, sciP ptr; /* ssu_ info ptr */ dcl ssu_$abort_subsystem entry() options(variable), ssu_$arg_ptr entry (ptr, fixed bin, ptr, fixed bin(21)), ssu_$destroy_invocation entry (ptr), ssu_$print_message entry() options(variable), ssu_$return_arg entry (ptr, fixed bin, bit(1) aligned, ptr, fixed bin(21)), ssu_$standalone_invocation entry (ptr, char(*), char(*), ptr, entry, fixed bin(35)); dcl (ALLOW_COMMAND init(1), ALLOW_AF init(2), ALLOW_COMMAND_AF init(3)) fixed bin int static options(constant); /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* CHECK INVOCATION TYPE: */ /* 1) Initialize error handling subroutines. */ /* 2) Determine whether invoked as command or af. */ /* 3) Is this type of invocation allowed? */ /* 4) Initialize af return argument, and index of current argument. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ ARGS_check: proc (caller, version, allowed, exit_procedure); dcl caller char(*), version char(*), allowed fixed bin, exit_procedure entry parameter; dcl code fixed bin(35); dcl com_err_ entry() options(variable), cu_$arg_list_ptr entry returns(ptr); dcl (error_table_$active_function, error_table_$not_act_fnc) fixed bin(35) ext static; call ssu_$standalone_invocation (sciP, caller, version, cu_$arg_list_ptr(), exit_procedure, code); if code ^= 0 then do; call com_err_ (code, caller, "Error creating standalone ssu_ invocation."); call exit_procedure(); end; call ERR_init(); call ssu_$return_arg (sciP, argn, af_sw, retp, retl); if allowed = ALLOW_COMMAND & af_sw then call ERR_fatal (sciP, error_table_$active_function); else if allowed = ALLOW_AF & ^af_sw then call ERR_fatal (sciP, error_table_$not_act_fnc); else if allowed = ALLOW_COMMAND_AF then; if af_sw then ret = "false"; /* Assume failure*/ argx = 0; end ARGS_check; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* PROCESS INCOMING ARGUMENTS: */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ ARGS_process: proc (operation); dcl operation char(5); operation = ""; do while (ARG_get()); if arg = "start" then operation = arg; else if arg = "stop" then operation = arg; else call ERR (sciP, error_table_$bad_arg, arg); end; if ERR_occurred() then go to EXIT; if operation = "" then call ERR_fatal (sciP, error_table_$noarg, "^/An operation must be given. It can be start or stop."); end ARGS_process; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* ARGUMENT GETTING FUNCTIONS: */ /* ARG_get: Get next argument. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ ARG_get: proc returns (bit(1)); dcl (FALSE init("0"b), TRUE init("1"b)) bit(1) int static options(constant); if argx < argn then do; argx = argx + 1; call ssu_$arg_ptr (sciP, argx, argp, argl); return (TRUE); end; else return (FALSE); end ARG_get; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* ARG_set_return_value: */ /* 1) Set value of AF return string. Do nothing if invoked as a command. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ ARG_set_return_value: proc (value); dcl value char(*); if af_sw then ret = value; end ARG_set_return_value; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* CLEANUP: */ /* 1) Destroy the ssu_ invocation (releasing temp segs obtained thru ssu_). */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ CLEANUP: proc (); if sciP ^= null then call ssu_$destroy_invocation (sciP); end CLEANUP; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* DATA INITIALIZATION: */ /* 1) Init vars needed by cleanup handler. */ /* 2) Init vars used by argument processor. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ DATA_init: proc; sciP = null; operation = ""; end DATA_init; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* ERROR REPORTING ROUTINES: */ /* 1) Nonfatal errors set a switch, which can be tested via error_occurred */ /* function. */ /* 2) Fatal errors abort the subsystem by calling ssu_$abort_subsystem, */ /* which calls the main procedure's exit procedure, which branches to the */ /* EXIT label to exit the command. */ /* */ /* Both types of errors suppress (catch and do nothing with) the */ /* active_function_error condition signalled by ssu_$print_message and */ /* ssu_$abort_subsystem when invoked as an active function. Our program */ /* only prints error messages and returns false value; it should never allow */ /* active_function_error condition to reach the outside environment. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ dcl error_occurred_sw bit(1); ERR: proc options (variable); dcl code fixed bin(35) based (codep), codep ptr; dcl cu_$arg_list_ptr entry returns(ptr), cu_$arg_ptr entry (fixed bin, ptr, fixed bin(21), fixed bin(35)), cu_$generate_call entry (entry, ptr), ioa_ entry() options(variable); dcl CODE_ARG fixed bin int static options(constant) init(2), (FALSE init("0"b), TRUE init("1"b)) bit(1) int static options(constant); dcl active_function_error condition; call cu_$arg_ptr (CODE_ARG, codep, 0, 0); if code = 0 then return; if code = -1 then code = 0; error_occurred_sw = TRUE; on active_function_error; /* do nothing */ call cu_$generate_call (ssu_$print_message, cu_$arg_list_ptr()); return; ERR_init: entry; error_occurred_sw = FALSE; return; ERR_occurred: entry returns (bit(1)); return (error_occurred_sw); ERR_fatal: entry options(variable); call cu_$arg_ptr (CODE_ARG, codep, 0, 0); if code = 0 then return; if code = -1 then code = 0; error_occurred_sw = TRUE; call ioa_ (""); on active_function_error; /* do nothing */ call cu_$generate_call (ssu_$abort_subsystem, cu_$arg_list_ptr()); end ERR; /* * * * * * * * * * * * * * * * * * * * * * * * * */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* USER_check: */ /* 1) Make sure user of this program is running in Initializer process. */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ USER_check: proc (operation); dcl operation char(5); ansp = as_data_$ansp; if ansp = null then BAD_USER: call ERR_fatal (sciP, error_table_$action_not_performed, "^/^[Starting^;Stopping^] the ls_request_server_. This command can only be used in the Initializer process.", operation = "start"); if get_process_id_() ^= anstbl.as_procid then go to BAD_USER; end USER_check; /* * * * * * * * * * * * * * * * * * * * * * * * * */ %include answer_table; %include as_data_; %include user_table_header; end ls_request_server;  ls_request_server_.pl1 08/04/87 1521.6rew 08/04/87 1521.6 116649 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1987 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-08-01,Coren), approve(87-07-13,MCR7737), audit(87-03-09,GDixon), install(87-08-04,MR12.1-1055): Initially written. 2) change(87-03-09,GDixon), approve(87-07-13,MCR7737), audit(87-07-24,Brunelle), install(87-08-04,MR12.1-1055): A) Correct coding standard errors. B) Zero anstbl.ls_request_server_process_id when shutting down. C) Initialize connection list manager. D) Move initialization of ls_message_buffer out of ls_request_server_ and into as_init_. E) Changed Set_Mseg_Acls to put a correct ACL on the message segment. F) Corrects $shutdown deletion of event channel. 3) change(87-04-23,GDixon), approve(87-07-13,MCR7737), audit(87-07-24,Brunelle), install(87-08-04,MR12.1-1055): A) Don't diagnose error is $shutdown finds server already down. B) Upgraded for change to answer_table.incl.pl1. 4) change(87-07-14,GDixon), approve(87-07-14,MCR7737), audit(87-07-24,Brunelle), install(87-08-04,MR12.1-1055): A) Move initialization of network accounting from act_ctl_$init into ls_request_server_$init. We need network accounting ONLY when running the login server. END HISTORY COMMENTS */ /* format: style4,indattr */ ls_request_server_: procedure (); /* Parameters */ dcl P_code fixed bin (35) parameter; /* Automatic */ dcl abort_label label automatic; dcl code fixed bin (35) automatic; dcl error_message char (500) automatic; dcl request_ms_dirname char (168) automatic; dcl request_ms_entryname char (32) automatic; dcl request_ms_pathname char (168) automatic; dcl system_area_ptr ptr automatic; /* Based */ dcl system_area area based (system_area_ptr); /* External */ dcl (error_table_$action_not_performed, error_table_$already_initialized, error_table_$noentry, error_table_$null_info_ptr, error_table_$out_of_sequence) fixed bin (35) ext static; /* Entries */ dcl fs_util_$replace_acl entry (char (*), char (*), ptr, bit (1), fixed bin (35)); dcl get_group_id_ entry () returns (char (32)); dcl get_process_id_ entry () returns (bit (36)); dcl get_temp_segment_ entry (char (*), ptr, fixed bin (35)); dcl get_system_free_area_ entry () returns (ptr); dcl hpriv_connection_list_$init entry (fixed bin (35)); 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 message_segment_$close entry (fixed bin, fixed bin (35)); dcl message_segment_$create entry (char (*), char (*), fixed bin (35)); dcl message_segment_$delete entry (char (*), char (*), fixed bin (35)); dcl message_segment_$open entry (char (*), char (*), fixed bin, fixed bin (35)); dcl network_accounting_gate_$clear_table entry (char (*), fixed bin (35)); dcl network_accounting_gate_$test entry (char (*)); dcl pathname_ entry (char (*), char (*)) returns (char (168)); dcl release_temp_segment_ entry (char (*), ptr, fixed bin (35)); dcl uc_ls_rq_server_wakeup_ entry (ptr); /* Constant */ dcl FALSE bit (1) aligned initial ("0"b) internal static options (constant); dcl ME char (18) initial ("ls_request_server_") internal static options (constant); dcl NO_SYSDAEMON bit (1) initial ("1"b) internal static options (constant); dcl TRUE bit (1) aligned initial ("1"b) internal static options (constant); /* Builtin */ dcl (addr, dimension, null, unspec) builtin; /* Conditions */ dcl cleanup condition; %page; /* Program */ init: entry (P_code); abort_label = INIT_RETURN; ls_request_server_info_ptr = null (); on cleanup call Clean_Up (); /**** Test if ls_request_server_ is already running in this process. */ ansp = as_data_$ansp; if anstbl.ls_request_server_process_id = anstbl.as_procid then call Abort (SL_LOG_SILENT, error_table_$out_of_sequence, "^/ls_request_server_ is already running. To stop, type: ls_request_server stop"); /**** Clear out garbage from previous bootload */ anstbl.ls_request_server_process_id = ""b; anstbl.ls_request_server_event_channel = 0; system_area_ptr = get_system_free_area_ (); allocate ls_request_server_info in (system_area) set (ls_request_server_info_ptr); as_data_$ls_request_server_info_ptr = ls_request_server_info_ptr; unspec (ls_request_server_info) = ""b; ls_request_server_info.version = LS_REQUEST_SERVER_INFO_VERSION_1; call get_temp_segment_ (ME, ls_request_server_info.reply_ptr, code); call Abort (SL_LOG_BEEP, code, "Could not get temporary segment for ls reply messages."); ls_request_server_info.request_ms.dirname = as_data_$sysdir; ls_request_server_info.request_ms.entryname = "login_server_requests.ms"; ls_request_server_info.request_ms.index = 0; /* for now */ call Setup_Message_Segment (); call Set_Mseg_Acls (); ls_request_server_info.flags.initialized = TRUE; /* Initialize connection list manager */ call hpriv_connection_list_$init (code); if code = error_table_$already_initialized then code = 0; if code ^= 0 then call Abort (SL_LOG_BEEP, code, "Could not initialize the connection list manager."); /* Initialize network accounting. */ if as_data_$debug_flag then call network_accounting_gate_$test (as_data_$sysdir); call network_accounting_gate_$clear_table (error_message, code); if code ^= 0 then do; call Abort (SL_LOG_BEEP, code, "Error from " || error_message); end; INIT_RETURN: if code ^= 0 then call Clean_Up (); P_code = code; return; %page; start: entry (P_code); /**** This entry is called to actually start the login server request server. We do this by publishing the login server request server info in the answer table. */ abort_label = START_RETURN; code = 0; ansp = as_data_$ansp; ls_request_server_info_ptr = as_data_$ls_request_server_info_ptr; anstbl.ls_request_server_process_id = get_process_id_ (); call ipc_$create_ev_chn (anstbl.ls_request_server_event_channel, code); call Abort (SL_LOG_BEEP, code, "Creating login server request server IPC event channel"); call ipc_$decl_ev_call_chn (anstbl.ls_request_server_event_channel, uc_ls_rq_server_wakeup_, ls_request_server_info_ptr, 1 /* priority */, code); call Abort (SL_LOG_BEEP, code, "Declaring login server request server IPC channel."); START_RETURN: P_code = code; return; %page; shutdown: entry (P_code); abort_label = SHUTDOWN_RETURN; ansp = as_data_$ansp; if anstbl.ls_request_server_process_id ^= anstbl.as_procid then do; if anstbl.ls_request_server_process_id = ""b then do; code = 0; /* already down */ go to SHUTDOWN_RETURN; end; call Abort (SL_LOG_SILENT, error_table_$action_not_performed, "Server not in operation."); end; ls_request_server_info_ptr = as_data_$ls_request_server_info_ptr; if ls_request_server_info_ptr = null () then call Abort (SL_LOG_SILENT, error_table_$null_info_ptr, "Server not in operation."); ls_request_server_info.flags.initialized = FALSE; call release_temp_segment_ (ME, ls_request_server_info.reply_ptr, code); if code ^= 0 then call Log_Error (code, "Cannot release ls reply temp segment."); call message_segment_$close ( ls_request_server_info.request_ms.index, code); if code ^= 0 then call Log_Error (code, "Could not close ls request message segment."); anstbl.ls_request_server_process_id = ""b; call ipc_$delete_ev_chn (anstbl.ls_request_server_event_channel, code); if code ^= 0 then call Log_Error (code, "Could not delete request event channel."); anstbl.ls_request_server_event_channel = 0; SHUTDOWN_RETURN: P_code = code; return; %page; Setup_Message_Segment: procedure (); request_ms_dirname = ls_request_server_info.request_ms.dirname; request_ms_entryname = ls_request_server_info.request_ms.entryname; request_ms_pathname = pathname_ (request_ms_dirname, request_ms_entryname); call message_segment_$delete (request_ms_dirname, request_ms_entryname, code); if code ^= 0 then if code ^= error_table_$noentry then call Abort (SL_LOG_BEEP, code, "Deleting message segment ^a.", request_ms_pathname); call message_segment_$create (request_ms_dirname, request_ms_entryname, code); call Abort (SL_LOG_BEEP, code, "Creating message segment ^a.", request_ms_pathname); call message_segment_$open (request_ms_dirname, request_ms_entryname, ls_request_server_info.request_ms.index, code); call Abort (SL_LOG_BEEP, code, "Opening message segment ^a.", request_ms_pathname); end Setup_Message_Segment; %page; Set_Mseg_Acls: procedure (); dcl 1 ms_acl aligned, /* like general_acl */ 2 version char (8) aligned, 2 count fixed bin, 2 entries (6) like general_acl_entry; acl_ptr = addr (ms_acl); general_acl.version = GENERAL_ACL_VERSION_1; general_acl.count = dimension (ms_acl.entries, 1); general_acl.entries (1).access_name = get_group_id_ (); general_acl.entries (1).mode = MSEG_QUEUE_CREATOR_INITIAL_ACCESS; general_acl.entries (1).status_code = 0; general_acl.entries (2).access_name = "*.SysDaemon.*"; general_acl.entries (2).mode = MSEG_QUEUE_SYSDAEMON_INITIAL_ACCESS; general_acl.entries (2).status_code = 0; general_acl.entries (3).access_name = "Login_Server.Daemon.*"; general_acl.entries (3).mode = MSEG_QUEUE_USER_ACCESS; general_acl.entries (3).status_code = 0; general_acl.entries (4).access_name = "*.SysAdmin.*"; general_acl.entries (4).mode = MSEG_QUEUE_ADMIN_ACCESS; general_acl.entries (4).status_code = 0; general_acl.entries (5).access_name = "*.SysMaint.*"; general_acl.entries (5).mode = MSEG_QUEUE_ADMIN_ACCESS; general_acl.entries (5).status_code = 0; general_acl.entries (6).access_name = "*.*.*"; general_acl.entries (6).mode = MSEG_QUEUE_OTHERS_INITIAL_ACCESS; general_acl.entries (6).status_code = 0; call fs_util_$replace_acl (request_ms_dirname, request_ms_entryname, addr (general_acl), NO_SYSDAEMON, code); call Abort (SL_LOG_BEEP, code, "Replacing ACL on message segment ^a.", request_ms_pathname); return; end Set_Mseg_Acls; %page; Clean_Up: procedure (); if ls_request_server_info_ptr ^= null () then do; free ls_request_server_info; as_data_$ls_request_server_info_ptr = null (); end; return; end Clean_Up; %page; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Abort: report errors via sys_log_$general. */ /* */ /* Syntax: call Abort (severity, code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Abort: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_sev_code_msg; sl_info.caller = ME; sl_info.arg_list_ptr = cu_$arg_list_ptr (); call sys_log_$general (addr (sl_info)); code = sl_info.code; if code ^= 0 then go to abort_label; end Abort; /* * * * * * * * * * * * * * * * * * * * * * * * * * */ /* */ /* Log_Error: report error silently via sys_log_$general, but continue */ /* execution. */ /* */ /* Syntax: call Log_Error (code, ioa_ctl, args); */ /* */ /* * * * * * * * * * * * * * * * * * * * * * * * * * */ Log_Error: procedure options (variable); dcl cu_$arg_list_ptr entry returns (ptr); dcl sys_log_$general entry (ptr); sl_info = sl_info_code_msg; sl_info.caller = ME; sl_info.arg_list_ptr = cu_$arg_list_ptr (); call sys_log_$general (addr (sl_info)); end Log_Error; /* format: off */ %page; %include acl_structures; %page; %include answer_table; %page; %include as_data_; %page; %include ls_request_server_info; %page; %include mseg_access_mode_values; %page; %include sys_log_constants; %page; %include user_table_header; end ls_request_server_;  multiplexer_mgr_.pl1 10/25/89 1159.4r w 10/25/89 1005.1 673974 /****^ *********************************************************** * * * 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. * * * *********************************************************** */ /* MULTIPLEXER_MGR_ - Manages various multiplexers on behalf of the answering service */ /* Written July-August-September 1978 by Larry Johnson */ /* Modified April 1979 by Larry Johnson so that top level multiplexers need not be FNP's running MCS */ /* Modified July 1979 by C. Hornig so that they don't even need to be FNP's. */ /* Modified Dec. 1980 - Jan. 1981 by Robert Coren to separate start_mpx from listen */ /* Modified Jan. 1981 by Robert Coren to make dump_mpx while load is pending work */ /* Modified December 1981 by Benson I. Margulies for CDT tree. */ /* Modified May 1982 by E. N. Kittlitz for New AS initialization. */ /* Modified June 1982 By B. I. Margulies & E. N. Kittlitz. bug fixes. */ /* Modified June 1982 by E. N. Kittlitz. early stop_mpx bugfix. */ /* Modified August 1982 by Robert Coren to make it possible to prevent automatic reload when calling mpx_crashed. */ /* Modified November 1982 by E. N. Kittlitz. RADC ftp change. BIM fixes. don't report load failure to as_init_ on system_init call */ /* Modified January 1983 by E. N. Kittlitz. plotz load of mux with no daughters */ /* Modified August 1983 by Robert Coren. Retry load of non-hardwired mulitplexer if load fails. */ /* Modified August 1983 by Robert Coren. Keep shutdown entry from terminating amultiplexer that wasn't up to begin with. */ /* Modified 83-12-14 BIM. Add shutdown_command for a command interface. add count_mpx_users entry. no dump / reload on deconfigure crash. */ /* Modified 84-04-02 BIM. Removed reference to cdte.dim. */ /* Modified 1984-08-02 BIM for bad ref to mpxe.state in shutdown. */ /* Modified 1985-02-19, BIM: to initialize cdte.user_name to a known state */ /****^ HISTORY COMMENTS: 1) change(86-03-25,MSharpe), approve(86-07-30,MCR7690), audit(87-06-25,Parisek), install(87-08-04,MR12.1-1055): install(86-10-09,MR12.0-1181): 2) change(86-06-19,Kissel), approve(86-07-30,MCR7475), audit(86-08-04,Coren), install(86-10-09,MR12.0-1181): Changed to support the new tty event message format declared in net_event_message.incl.pl1 which replaces tty_event_message.incl.pl1. END HISTORY COMMENTS */ /* format: style4,delnl,insnl,^ifthendo */ multiplexer_mgr_: procedure; /* Arguments */ dcl arg_mpx_name char (*); /* Name of a multiplexer to load */ dcl arg_check_sw bit (1) aligned; /* Check load */ dcl arg_count fixed bin; /* for delete_fnp */ dcl arg_go_sw bit (1) aligned; /* Go after load */ dcl arg_force_sw bit (1) aligned; /* Force operation in spite of who is logged out */ dcl arg_dump_sw bit (1) aligned; /* Says whether or not to take a dump */ dcl arg_reload_sw bit (1) aligned; /* Says whether to reload after a crash */ dcl arg_state fixed bin; /* State of multiplexer */ dcl arg_code fixed bin (35); /* Automatic */ dcl arg_cdtp ptr; /* Pointer to base of cdt */ /* Automatic */ dcl code fixed bin (35); dcl i fixed bin; dcl mpx_name char (32); dcl mpx_cdtep ptr; /* Ptr to either cdte or fnpe for this mpx */ dcl mpx_display_name char (64) var; /* For error messages */ dcl name char (64); /* Name of entry called */ dcl n_users fixed bin; /* Count of users on multiplexer */ dcl devx fixed bin; /* Ring0 device-index of multiplexer */ dcl new_mpx_type fixed bin; /* Used if mpx_type is changing */ dcl entvar entry variable options (variable); dcl parent_state fixed bin; /* State of a multiplexers parent */ dcl fnp_only bit (1) init ("0"b); /* Used by stop_fnp in a special case which is limited to fnps */ dcl p ptr; dcl shutdown_dump bit (1) aligned; dcl smlep ptr; dcl up_time fixed bin; dcl mpx_was_up bit (1); dcl thread_trouble_count fixed bin; dcl muxx fixed bin; dcl x fixed bin; dcl firstx fixed bin; dcl d_limit fixed bin; dcl BAD_THREADS_LABEL label variable internal; /* Debuggers and other buggers can put versions of that in their search rules */ dcl 1 ev_msg aligned like event_call_info; declare 1 auto_condition_info aligned like condition_info; /* Based */ dcl mpx_area area (sys_info$max_seg_size) based (mpx_areap); dcl 1 stop_mpx_list_entry based (smlep) aligned, 2 mpx_name char (32) unaligned, 2 next ptr; /* Static */ dcl static_cdtp ptr int static init (null ()); /* CDT pointer saved at initialization */ dcl mpx_areap ptr int static init (null ()); /* Remember pointer to my work area */ dcl loud bit (1) int static init ("0"b); /* If set, enables some extra messages */ dcl stop_mpx_list_ptr_ ptr ext static init (null); /* list of muxes stopped by early stop_mpx command */ /* Constants */ dcl proc_name char (16) int static options (constant) init ("multiplexer_mgr_"); /* External */ dcl asu_$asu_listen entry (ptr, fixed bin (35)); dcl asu_$attach_channel entry (ptr, fixed bin (35)); dcl asu_$channel_in_use entry (ptr) returns (bit (1) aligned); dcl cdt_mgr_$find_cdt_channel entry (pointer, character (32), fixed binary, bit (1) aligned, fixed binary (35)); dcl cdt_mgr_$thread_out_cdt_channel entry (ptr, fixed bin); dcl dialup_$simulated_wakeup entry (ptr); dcl mc_tty_$simulated_wakeup entry (ptr); dcl find_condition_info_ entry (pointer, pointer, fixed binary (35)); dcl get_system_free_area_ entry () returns (ptr); dcl get_process_id_ returns (bit (36)); dcl hcs_$make_entry entry (ptr, char (*), char (*), entry, fixed bin (35)); dcl phcs_$get_devx entry (char (*), fixed bin, fixed bin (35)); dcl phcs_$tty_control entry (char (*), char (*), pointer, fixed bin (35)); dcl hphcs_$init_channel entry (fixed bin, ptr, fixed bin (35)); dcl hphcs_$init_multiplexer entry (fixed bin, fixed bin, ptr, fixed bin (35)); dcl hphcs_$shutdown_multiplexer entry (fixed bin, fixed bin (35)); dcl hphcs_$terminate_channel entry (fixed bin, fixed bin (35)); dcl hphcs_$terminate_multiplexer entry (fixed bin, fixed bin (35)); dcl hphcs_$start_multiplexer entry (fixed bin, fixed bin (35)); dcl hphcs_$stop_multiplexer entry (fixed bin, fixed bin (35)); dcl hphcs_$lct_init entry (fixed bin, fixed bin (35)); dcl sub_err_ entry () options (variable); dcl sys_log_ entry options (variable); dcl sys_log_$error_log entry options (variable); dcl iox_$err_no_operation entry; dcl mc_commands_$listen_to_ttys entry (char (*)); dcl mc_commands_$remove_tty entry (char (*), bit (1) aligned, fixed bin (35)); dcl error_table_$action_not_performed ext fixed bin (35); dcl error_table_$null_info_ptr fixed bin (35) ext static; dcl error_table_$out_of_sequence fixed bin (35) ext static; dcl sys_info$max_seg_size ext fixed bin (19); dcl sub_error_ condition; dcl (addr, clock, collate, divide, unspec, hbound, index, null, rank, rtrim, substr) builtin; test_update_mpx: entry (arg_mpx_name, arg_test_cdtp, arg_code); declare arg_test_cdtp pointer; call set_entry_name ("test_update_mpx"); mpx_name = arg_mpx_name; cdtp = arg_test_cdtp; call validate_mpx_name (muxx); /* grab this mux */ if code ^= 0 then do; arg_code = code; return; end; call update_cdt (muxx); return; /* Entry to "load" a multiplexer */ load_mpx: entry (arg_mpx_name, arg_check_sw, arg_go_sw, arg_force_sw, arg_code); call set_entry_name ("load_mpx"); RE_LOAD_MPX: mpx_name = arg_mpx_name; cdtp = static_cdtp; if cdtp = null | ^cdt.mux_mgr_system_init then go to ERROR_EARLY_CALL; BAD_THREADS_LABEL = RE_LOAD_MPX; call validate_mpx_name (muxx); /* grab this mux */ if code ^= 0 then do; arg_code = code; return; end; if loud then call sys_log_ (1, "^a: Loading ^a.^[ check^]^[ go^]^[ force^]", name, mpx_display_name, arg_check_sw, arg_go_sw, arg_force_sw); call check_parent_state (muxx); /* Must check to see if my parent is well first */ if code ^= 0 then do; call sys_log_ (1, "^a: ^a not loaded. Unable to determine the state of its parent.", name, mpx_display_name); arg_code = error_table_$action_not_performed; return; end; if parent_state ^= MPX_UP then do; call sys_log_ (1, "^a: ^a cannot be loaded because its parent multiplexer is not running.", name, mpx_display_name); arg_code = error_table_$action_not_performed; return; end; if mpxe.state = MPX_BOOT then do; /* Current bootload must finish first */ call sys_log_ (1, "^a: Initialization of ^a already in progress.", name, mpx_display_name); arg_code = error_table_$action_not_performed; return; end; if ^arg_force_sw then do; /* Be sure no one is using any of these channels */ call count_mpx_users (muxx, n_users); if n_users > 0 then do; call sys_log_ (1, "^a: User^[s^] of ^d channel^[s^] would be hung up. ^a not loaded. Use -force if necessary.", name, (n_users ^= 1), n_users, (n_users ^= 1), mpx_display_name); code = error_table_$action_not_performed; return; end; end; if mpxe.state = MPX_UP then do; call shutdown_mpx (mpx_name, "0"b, code); /* Do a force shutdown of the multiplexer */ if code ^= 0 then do; arg_code = code; return; end; end; call update_cdt (muxx); /* Perform any pending channel deletions and additions */ call find_subchannels (muxx, miip); /* Locate all subchannels of this multiplexer */ if miip = null then do; /* this is nature's way of saying FOO! */ call sys_log_ (1, "^a: ^a has no subchannels.", name, mpx_display_name); code = error_table_$action_not_performed; go to load_mpx_return; end; mpxe.current_mpx_type = new_mpx_type; mpxe.current_service_type = ACTIVE; mpxe.flags.check = arg_check_sw; /* save this info in case we retry the load */ call phcs_$get_devx (mpx_name, devx, code); if code ^= 0 then do; call sys_log_$error_log (1, code, name, "Unable to get a devx for ^a", mpx_display_name); go to load_mpx_return; end; call hphcs_$init_multiplexer (devx, mpxe.current_mpx_type, miip, code); if code ^= 0 then do; call sys_log_$error_log (1, code, name, "Unable to initialize ^a.", mpx_display_name); code = error_table_$action_not_performed; go to load_mpx_return; end; /**** mux_init_info contains exactly those channels in the sister */ /**** chain, in the same order. */ call thread_start (muxx, firstx, d_limit); i = 0; begin; declare 1 cdt_list aligned, 2 ct fixed bin init (d_limit), 2 cdteps (d_limit) ptr unaligned; do x = firstx repeat (cdt_entry (x).threads.next_sister) while (x ^= 0); i = i + 1; cdtep = addr (cdt.cdt_entry (x)); if i > d_limit | i > cdt.n_cdtes | cdte.threads.mother ^= muxx then call CDT_THREAD_DAMAGE (i, muxx, x); cdt_list.cdteps (i) = cdtep; cdte.twx = mux_init_info.devx (i); if cdte.twx = 0 then call sys_log_ (1, "^a: No devx assigned to ^a.", name, cdte.name); else if cdte.current_service_type ^= MPX_SERVICE then do; /* Init non-multiplexers */ call hphcs_$init_channel (cdte.twx, null (), code); if code ^= 0 then call sys_log_ (1, "^a: Unable to init channel ^a on ^a.", name, cdte.name, mpx_display_name) ; end; end; if i < d_limit /* ran out of daughters too soon */ then call CDT_THREAD_DAMAGE$$TOO_FEW_DAUGHTERS (i, muxx); mpxe.flags.go = arg_go_sw; mpxe.n_bootloads = mpxe.n_bootloads + 1; mpxe.state = MPX_BOOT; mpxe.time_load_start = clock (); mpxe.flags.listening = "0"b; call build_entvar ("load"); call entvar (mpx_name, cdtp, mpx_cdtep, addr (cdt_list), arg_check_sw, code); end; if code ^= 0 then do; mpxe.state = MPX_DOWN; if loud then call sys_log_$error_log (1, code, name, "Unable to load ^a.", mpx_display_name); i = 0; do x = firstx repeat (cdt_entry (x).threads.next_sister) while (x ^= 0); i = i + 1; /* safety count */ cdtep = addr (cdt.cdt_entry (x)); if i > d_limit | i > cdt.n_cdtes | cdte.mother ^= muxx then call CDT_THREAD_DAMAGE (i, muxx, x); if cdte.twx ^= 0 & cdte.current_service_type ^= MPX_SERVICE then call hphcs_$terminate_channel (cdte.twx, code); cdte.twx = 0; end; if i < d_limit /* ran out of daughters too soon */ then call CDT_THREAD_DAMAGE$$TOO_FEW_DAUGHTERS (i, muxx); call hphcs_$terminate_multiplexer (devx, code); code = error_table_$action_not_performed; go to load_mpx_return; end; i = 0; do x = firstx repeat (cdt_entry (x).threads.next_sister) while (x ^= 0); cdtep = addr (cdt.cdt_entry (x)); i = i + 1; if i > d_limit | i > cdt.n_cdtes | cdte.mother ^= muxx then call CDT_THREAD_DAMAGE (i, muxx, x); if cdte.current_service_type = MPX_SERVICE then cdte.twx = 0; end; if i < d_limit /* ran out of daughters too soon */ then call CDT_THREAD_DAMAGE$$TOO_FEW_DAUGHTERS (i, muxx); if mpxe.current_mpx_type ^= MCS_MPX /* don't do this for FNPs */ then mpxe.flags.retry_load = ^mpx_cdtep -> cdte.flags.hardwired; /* otherwise plan to reload a dialup multiplexer if load fails */ load_mpx_return: if miip ^= null () then free mux_init_info; arg_code = code; return; /* Entry to perform an orderly shutdown of a multiplexer */ /* NOT FOR EXTERNAL USE. USE COMMAND ENTRY */ shutdown_mpx: entry (arg_mpx_name, arg_dump_sw, arg_code); call set_entry_name ("shutdown_mpx"); RE_SHUTDOWN_MPX: mpx_name = arg_mpx_name; cdtp = static_cdtp; if cdtp = null | ^cdt.mux_mgr_system_init then go to ERROR_EARLY_CALL; BAD_THREADS_LABEL = RE_SHUTDOWN_MPX; call validate_mpx_name (muxx); if code ^= 0 then do; arg_code = code; return; end; if loud then call sys_log_ (1, "^a: Shutting down ^a.^[ dump^]", name, mpx_display_name, arg_dump_sw); if (mpxe.state = MPX_UP) | (mpxe.state = MPX_BOOT) then do; call phcs_$get_devx (mpx_name, devx, code); if code ^= 0 then do; arg_code = code; return; end; mpxe.state = MPX_DOWN; /* Tell dialup_ not to try to do anything useful with subchannels. */ call hphcs_$shutdown_multiplexer (devx, code); if code ^= 0 then call sys_log_$error_log (1, code, name, "Shutting down ^a.", mpx_display_name); mpx_was_up = "1"b; end; else mpx_was_up = "0"b; if arg_dump_sw then do; /* Dump required */ call build_entvar ("dump"); call entvar (mpx_name, cdtp, mpx_cdtep, code); if code ^= 0 then call sys_log_$error_log (1, code, name, "Unable to dump ^a.", mpx_display_name); end; call thread_start (muxx, firstx, d_limit); if mpx_was_up then do; i = 0; SHUTDOWN_MPX_LOOP: do x = firstx repeat (cdt.cdt_entry (x).threads.next_sister) while (x ^= 0); cdtep = addr (cdt.cdt_entry (x)); i = i + 1; if i > d_limit | i > cdt.n_cdtes | cdte.mother ^= muxx then call CDT_THREAD_DAMAGE (i, muxx, x); if cdte.current_service_type = MPX_SERVICE then do; p = addr (cdte.initial_command); if p -> mpxe.state = MPX_UP | p -> mpxe.state = MPX_BOOT then call shutdown_mpx ((cdte.name), "0"b, code); end; else if cdte.twx ^= 0 then do; call hphcs_$terminate_channel (cdte.twx, code); if code ^= 0 then call sys_log_$error_log (1, code, name, "Terminating ^a.", cdte.name); if cdte.in_use > NOW_HUNG_UP then do; unspec (net_event_message) = "0"b; /* Simulate hangup wakeup */ net_event_message.version = NET_EVENT_MESSAGE_VERSION_1; net_event_message.network_type = MCS_NETWORK_TYPE; net_event_message.handle = cdte.twx; net_event_message.type = MCS_HANGUP_MSG; ev_msg.channel_id = cdte.event; unspec (ev_msg.message) = unspec (net_event_message); ev_msg.sender = get_process_id_ (); ev_msg.origin.dev_signal = "0"b; ev_msg.origin.ring = 0; ev_msg.data_ptr = cdtep; if cdte.wakeup_handler = "0"b then call dialup_$simulated_wakeup (addr (ev_msg)); else call mc_tty_$simulated_wakeup (addr (ev_msg)); end; cdte.twx = 0; end; end SHUTDOWN_MPX_LOOP; if i < d_limit /* ran out of daughters too soon */ then call CDT_THREAD_DAMAGE$$TOO_FEW_DAUGHTERS (i, muxx); call hphcs_$terminate_multiplexer (devx, code); if code ^= 0 then call sys_log_$error_log (1, code, name, "Terminating ^a.", mpx_display_name); end; arg_code = code; return; /* Entry to dump and shutdown a multiplexer */ shutdown_mpx_command: entry (arg_mpx_name, arg_force_sw, arg_code); call set_entry_name ("shutdown_mpx_command"); shutdown_dump = "0"b; go to SHUTDOWN_DUMP_COMMON; dump_mpx: entry (arg_mpx_name, arg_force_sw, arg_code); shutdown_dump = "1"b; call set_entry_name ("dump_mpx"); SHUTDOWN_DUMP_COMMON: RE_DUMP_MPX: mpx_name = arg_mpx_name; cdtp = static_cdtp; if cdtp = null | ^cdt.mux_mgr_system_init then go to ERROR_EARLY_CALL; BAD_THREADS_LABEL = RE_DUMP_MPX; call validate_mpx_name (muxx); if code ^= 0 then do; arg_code = code; return; end; if loud then call sys_log_ (1, "^a: Dumping ^a.^[ force^]", name, mpx_display_name, arg_force_sw); if ^arg_force_sw then do; /* Be sure no one is using any of these channels */ call count_mpx_users (muxx, n_users); if n_users > 0 then do; call sys_log_ (1, "^a: User^[s^] of ^d channel^[s^] would be hung up. ^a not dumped. Use -force if necessarry.", name, (n_users ^= 1), n_users, (n_users ^= 1), mpx_display_name); arg_code = error_table_$action_not_performed; return; end; end; mpxe.flags.retry_load = "0"b; /* if this results in "load failed", don't reload */ call shutdown_mpx (mpx_name, shutdown_dump, code); arg_code = code; return; /* Entry to start a multiplexer, once it is loaded */ start_mpx: entry (arg_mpx_name, arg_force_sw, arg_code); call set_entry_name ("start_mpx"); RE_START_MPX: mpx_name = arg_mpx_name; cdtp = static_cdtp; if cdtp = null | ^cdt.mux_mgr_system_init then go to ERROR_EARLY_CALL; BAD_THREADS_LABEL = RE_START_MPX; call validate_mpx_name (muxx); if code ^= 0 then do; arg_code = code; return; end; if loud then call sys_log_ (1, "^a: Starting ^a.^[ force^]", name, mpx_display_name, arg_force_sw); if (mpxe.state ^= MPX_BOOT) & (mpxe.state ^= MPX_UP) then do; call sys_log_ (1, "^a: ^a has not been loaded, so it cant be started.", name, mpx_display_name); arg_code = error_table_$action_not_performed; return; end; if (mpxe.state = MPX_UP) & mpxe.flags.go & (mpxe.current_service_type = ACTIVE) & ^arg_force_sw then do; call sys_log_ (1, "^a: ^a is already started.", name, mpx_display_name); arg_code = error_table_$action_not_performed; return; end; mpxe.flags.go = "1"b; /* In case started with nogo */ mpxe.current_service_type = ACTIVE; if mpxe.state = MPX_BOOT then do; /* Boot in progress, can't start yet */ call sys_log_ (1, "^a: ^a is currently loading. It will be started when load completes.", name, mpx_display_name); arg_code = error_table_$action_not_performed; return; end; call phcs_$get_devx (mpx_name, devx, code); if code ^= 0 then do; call sys_log_$error_log (1, code, name, "Can't get devx for ^a.", mpx_display_name); arg_code = code; return; end; call hphcs_$start_multiplexer (devx, code); if code ^= 0 then do; call sys_log_$error_log (1, code, name, "Starting ^a.", mpx_display_name); arg_code = code; return; end; arg_code = 0; return; /* Entry to stop a multiplexer */ stop_mpx: entry (arg_mpx_name, arg_code); call set_entry_name ("stop_mpx"); RE_STOP_MPX: mpx_name = arg_mpx_name; cdtp = static_cdtp; BAD_THREADS_LABEL = RE_STOP_MPX; if cdtp = null /* Early call */ then do; call get_cdt_ptr (arg_code); if arg_code ^= 0 then return; end; if ^cdt.mux_mgr_system_init then fnp_only = "1"b; /* Allow this only for FNP's */ call validate_mpx_name (muxx); if code ^= 0 then do; arg_code = code; return; end; if loud then call sys_log_ (1, "^a: Stopping ^a", name, mpx_display_name); mpxe.current_service_type = INACTIVE; mpxe.flags.go = "0"b; if mpxe.state = MPX_UP then do; call phcs_$get_devx (mpx_name, devx, code); if code ^= 0 then do; call sys_log_$error_log (1, code, name, "Can't get devx for ^a.", mpx_display_name); arg_code = code; return; end; call hphcs_$stop_multiplexer (devx, code); if code ^= 0 then do; call sys_log_$error_log (1, code, name, "Unable to stop ^a.", mpx_display_name); arg_code = code; return; end; call sys_log_ (1, "^a: ^a is running but no longer accepting calls.", name, mpx_display_name); end; else if mpxe.state = MPX_BOOT then call sys_log_ (1, "^a: ^a is now loading, but will not be started", name, mpx_display_name); else do; /* early stop_mpx */ call sys_log_ (1, "^a: ^a will not be loaded.", name, mpx_display_name); smlep = stop_mpx_list_ptr_; do while (smlep ^= null); if stop_mpx_list_entry.mpx_name = mpx_name then go to end_early_stop_mpx; else smlep = stop_mpx_list_entry.next; end; allocate stop_mpx_list_entry; stop_mpx_list_entry.mpx_name = mpx_name; stop_mpx_list_entry.next = stop_mpx_list_ptr_; stop_mpx_list_ptr_ = smlep; end_early_stop_mpx: end; arg_code = 0; return; /* Initialize all sub-channels of a multiplexer */ /* This means list to all regular subchannels and initialize ("load") all sub-multiplexers */ listen_mpx: entry (arg_mpx_name, arg_code); dcl top_mpxep ptr; call set_entry_name ("listen_mpx"); RE_LISTEN_MPX: mpx_name = arg_mpx_name; cdtp = static_cdtp; BAD_THREADS_LABEL = RE_LISTEN_MPX; if cdtp = null | ^cdt.mux_mgr_system_init then go to ERROR_EARLY_CALL; call validate_mpx_name (muxx); if code ^= 0 then do; arg_code = code; return; end; if loud then call sys_log_ (1, "^a: Listening to ^a.", name, mpx_display_name); if mpxe.state ^= MPX_UP then do; call sys_log_ (1, "^a: ^a is not running. Unable to listen to channels.", name, mpx_display_name); arg_code = error_table_$action_not_performed; return; end; if mpxe.flags.listening /* don't have to do this again */ then do; arg_code = 0; return; end; top_mpxep = mpxep; /* save this pointer for listen switch */ call thread_start (muxx, firstx, d_limit); i = 0; do x = firstx repeat (cdt.cdt_entry (x).threads.next_sister) while (x ^= 0); cdtep = addr (cdt.cdt_entry (x)); i = i + 1; if i > d_limit | i > cdt.n_cdtes | cdte.mother ^= muxx then call CDT_THREAD_DAMAGE (i, muxx, x); if cdte.in_use > NOW_FREE then do; /* Channel may have been added/deleted during boot */ if cdte.current_service_type = ANS_SERVICE | cdte.current_service_type = SLAVE_SERVICE | cdte.current_service_type = DIAL_OUT_SERVICE | cdte.current_service_type = FTP_SERVICE then do; call asu_$attach_channel (cdtep, code); if code ^= 0 then if loud then call sys_log_$error_log (1, code, name, "asu_$attach_channel failed ^a", cdte.name); else ; else do; call asu_$asu_listen (cdtep, code); if code ^= 0 then if code ^= error_table_$action_not_performed then call sys_log_$error_log (1, code, name, "Channel ^a listen failed.", cdte.name); else if loud then call sys_log_ (1, "^a: asu_$listen_chanel failed for ^a.", cdte.name); end; end; if cdte.current_service_type = MPX_SERVICE then do; mpxep = addr (cdte.initial_command); if mpxe.current_service_type = ACTIVE then call load_mpx ((cdte.name), "0"b, "1"b, "1"b, code); end; end; end; call mc_commands_$listen_to_ttys (mpx_name); top_mpxep -> mpxe.flags.listening = "1"b; arg_code = 0; return; /* Entry to check the state of a multiplexer */ state_mpx: entry (arg_mpx_name, arg_state, arg_code); call set_entry_name ("state_mpx"); RE_STATE_MPX: mpx_name = arg_mpx_name; cdtp = static_cdtp; BAD_THREADS_LABEL = RE_STATE_MPX; if cdtp = null | ^cdt.mux_mgr_system_init then go to ERROR_EARLY_CALL; call validate_mpx_name (muxx); if code ^= 0 then arg_state = MPX_UNKNOWN; else arg_state = mpxe.state; arg_code = code; return; /* Procedure called by indivudal multiplexer handler to report that it is loaded */ mpx_loaded: entry (arg_mpx_name, arg_code); call set_entry_name ("mpx_loaded"); RE_MPX_LOADED: mpx_name = arg_mpx_name; cdtp = static_cdtp; BAD_THREADS_LABEL = RE_MPX_LOADED; call validate_mpx_name (muxx); if code ^= 0 then do; arg_code = code; return; end; mpxe.state = MPX_UP; mpxe.time_last_load = clock (); if mpxe.time_initial_load = 0 then mpxe.time_initial_load = mpxe.time_last_load; call phcs_$tty_control (mpx_name, "copy_meters", null (), (0)); /* clear out the meters */ if loud then call sys_log_ (1, "^a: Successful load reported for ^a.", name, mpx_display_name); if mpxe.flags.go then call start_mpx (mpx_name, "1"b, code); if code ^= 0 then do; arg_code = code; return; end; if cdt.flags.go then call listen_mpx (mpx_name, code); arg_code = code; return; /* Procedure called by individual multiplexer manager to report a unseccussfull load attempt */ mpx_load_failed: entry (arg_mpx_name, arg_code); call set_entry_name ("mpx_load_failed"); RE_MPX_LOAD_FAILED: mpx_name = arg_mpx_name; cdtp = static_cdtp; BAD_THREADS_LABEL = RE_MPX_LOAD_FAILED; call validate_mpx_name (muxx); if code ^= 0 then do; arg_code = code; return; end; if mpxe.state ^= MPX_BOOT then do; /* Not loading! */ call sys_log_ (1, "^a: Report load failure for ^a while not loading.", name, mpx_display_name); arg_code = error_table_$action_not_performed; return; end; if loud then call sys_log_ (1, "^a: Load of ^a failed.", name, mpx_display_name); call shutdown_mpx (mpx_name, "1"b, code); if code ^= 0 then call sys_log_$error_log (1, code, name, "Trying to shutdown ^a.", mpx_display_name); mpxe.state = MPX_DOWN; /* Now try the load again (if that's what we're supposed to do) */ if mpxe.flags.retry_load & code = 0 /* as long as the shutdown was OK */ then call load_mpx (mpx_name, (mpxe.flags.check), (mpxe.flags.go), "1"b, code); arg_code = 0; return; /* Procedure called by individual multiplexer manager to report a crash */ mpx_crashed: entry (arg_mpx_name, arg_reload_sw, arg_code); call set_entry_name ("mpx_crashed"); RE_MPX_CRASHED: mpx_name = arg_mpx_name; cdtp = static_cdtp; BAD_THREADS_LABEL = RE_MPX_CRASHED; call validate_mpx_name (muxx); if code ^= 0 then do; arg_code = code; return; end; mpxe.time_last_crash = clock (); if loud then call sys_log_ (1, "^a: Crash reported for ^a.", name, mpx_display_name); call shutdown_mpx (mpx_name, arg_reload_sw, code);/* since only FNP's have dumps, and FNPs set this to zero to mean "don't touch" */ if code ^= 0 then call sys_log_$error_log (1, code, name, "Shutting down ^a", mpx_display_name); /* Here we must decide whether or not to reload the mpx */ up_time = divide (mpxe.time_last_crash - mpxe.time_last_load, 60000000, 17, 0); /* Time it stayed up */ code = 0; if arg_reload_sw then do; if mpxe.current_service_type = INACTIVE then /* Stopped by operator */ call sys_log_ (1, "^a: ^a is stopped and will not be reloaded.", name, mpx_display_name); else if cdt.acceptable_fnp_tbf = 0 then /* No auto reloading */ call sys_log_ (1, "^a: Automatic reloading is disabled. ^a will not be reloaded.", name, mpx_display_name); else if (mpxe.n_bootloads >= 2) & (up_time < cdt.acceptable_fnp_tbf) & (mpxe.last_tbf < cdt.acceptable_fnp_tbf) then call sys_log_ (1, "^a: ^a is in apparent crash loop and will not be reloaded", name, mpx_display_name) ; else call load_mpx (mpx_name, "0"b, "1"b, "0"b, code); end; mpxe.last_tbf = up_time; /* Save for next crash */ arg_code = code; return; /* System initialization entry. Called once per bootload */ /* Its main function is to start the bootload of all configured level-1 multiplexers */ system_init: entry (arg_code); call set_entry_name ("system_init"); RE_SYSTEM_INIT: cdtp = static_cdtp; arg_code = 0; BAD_THREADS_LABEL = RE_SYSTEM_INIT; cdt.flags.go = "0"b; cdt.mux_mgr_system_init = "1"b; /* we are here, lafayette! */ /* First the FNP's */ do i = 1 to hbound (cdt.fnp_entry, 1); /* Start bootload on each fnp */ fnpep = addr (cdt.fnp_entry (i)); mpxep = addr (fnpe.mpxe); if mpxe.state = MPX_DOWN & /* If its configured */ mpxe.current_service_type = ACTIVE then do; /* And it is nornally booted */ mpx_name = substr (collate (), rank ("a") + i, 1); call load_mpx (mpx_name, "0"b, "1"b, "0"b, code); /* don't bother as_init_ with load failure */ end; end; call thread_start (0 /* ROOT */, firstx, d_limit); i = 0; do x = firstx repeat (cdt.cdt_entry (x).next_sister) while (x ^= 0); cdtep = addr (cdt.cdt_entry (x)); i = i + 1; if i > d_limit | i > cdt.n_cdtes | cdte.mother ^= 0 then call CDT_THREAD_DAMAGE (i, 0, x); mpxep = addr (cdte.initial_command); if mpxe.current_service_type = ACTIVE & mpxe.state = MPX_DOWN then do; call load_mpx ((cdte.name), "0"b, "1"b, "0"b, code); /* don't bother as_init_ with load failure */ end; end; if i < d_limit then call CDT_THREAD_DAMAGE$$TOO_FEW_DAUGHTERS (i, 0); return; /* This entry is called by as_init_ once per multics bootload. It signifys that the system is now really starting and we can listen to real channels. If any FNP's have already booted, we listen to them now, otherwise we set a switch so they will be listened to as they boot */ system_go: entry; call set_entry_name ("system_go"); cdtp = static_cdtp; cdt.flags.go = "1"b; do i = 1 to hbound (cdt.fnp_entry, 1); fnpep = addr (cdt.fnp_entry (i)); mpxep = addr (fnpe.mpxe); if mpxe.state = MPX_UP then call listen_mpx (substr (collate (), rank ("a") + i, 1), code); if fnpe.threads.daughter_count ^= 0 then call go_on_down (-i); end; call go_on_down (0); /* top level nonfnps */ return; go_on_down: procedure (muxx); declare muxx fixed bin; declare d_limit fixed bin; declare firstx fixed bin; declare x fixed bin; declare check_count fixed bin; call thread_start (muxx, firstx, d_limit); if d_limit = 0 then return; check_count = 0; do x = firstx repeat (cdt.cdt_entry (x).threads.next_sister) while (x ^= 0); cdtep = addr (cdt.cdt_entry (x)); check_count = check_count + 1; if check_count > d_limit | check_count > cdt.n_cdtes | cdte.mother ^= muxx then call CDT_THREAD_DAMAGE (check_count, muxx, x); if cdte.current_service_type = MPX_SERVICE then do; mpxep = addr (cdte.initial_command); if mpxe.state = MPX_UP then call listen_mpx ((cdte.name), code); end; if cdte.daughter ^= 0 then call go_on_down ((cdte.daughter)); /* will invalidate cdtep */ end; if check_count < d_limit then call CDT_THREAD_DAMAGE$$TOO_FEW_DAUGHTERS (i, muxx); end go_on_down; /* System initialization of all cdte entries */ init_cdt: procedure (a_code); dcl a_code fixed bin (35); dcl nchan fixed bin; dcl i fixed bin; a_code = 0; cdt.mux_mgr_system_init, cdt.flags.go = "0"b; nchan = 0; do i = 1 to hbound (cdt.fnp_entry, 1); fnpep = addr (cdt.fnp_entry (i)); mpxep = addr (fnpe.mpxe); fnpe.boot_segp = null (); fnpe.boot_ev_chan = 0; if mpxe.state ^= MPX_FREE then do; /* Is configured */ call mpxe_init (mpxep); if fnpe.mpx_type = 0 then fnpe.mpx_type = MCS_MPX; mpxe.current_mpx_type = fnpe.mpx_type; mpxe.current_service_type = fnpe.service_type; nchan = nchan + 1; end; end; on sub_err_ go to SKIP; do i = 1 to cdt.current_size; cdtep = addr (cdt.cdt_entry (i)); if cdte.in_use = CHANNEL_DELETED then do; call cdt_mgr_$thread_out_cdt_channel (cdtp, i); SKIP: cdte.in_use = NOW_FREE; end; if cdte.in_use ^= NOW_FREE then do; cdte.current_service_type = cdte.service_type; cdte.user_name = ""; cdte.in_use = NOW_HUNG_UP; if cdte.current_service_type = MPX_SERVICE then do; mpxep = addr (cdte.initial_command); call mpxe_init (mpxep); mpxe.current_mpx_type = cdte.mpx_type; mpxe.current_service_type = cdte.mpx_service; end; nchan = nchan + 1; end; cdte.event = 0; cdte.twx = 0; cdte.process = null (); cdte.dialed_to_procid = "0"b; cdte.dial_ev_chn = 0; cdte.recent_wakeup_time = 0; cdte.recent_wakeup_count = 0; end; as_data_$lct_size = nchan + cdt.spare_channel_count; revert sub_err_; return; end init_cdt; /* Initialize mpxe portion of cdte or fnpe */ mpxe_init: proc (p); dcl p ptr; p -> mpxe.state = MPX_DOWN; p -> mpxe.n_bootloads = 0; p -> mpxe.time_initial_load = 0; p -> mpxe.time_last_load = 0; p -> mpxe.time_last_crash = 0; p -> mpxe.time_load_start = 0; p -> mpxe.last_tbf = 0; p -> mpxe.current_mpx_type = 0; p -> mpxe.flags = "0"b; return; end mpxe_init; /* Procedure to validate a multiplexer name and setup some variables and pointers describing it */ validate_mpx_name: procedure (tablex); dcl tablex fixed bin; /* negative for fnp, as per cdt_mgr_ */ dcl fnp_sw bit (1) aligned; dcl msg char (128) var; if cdtp = null () then do; /* To early in initialization */ call sys_log_ (1, "^a: Command used too early in answering service initialization. ^a", name, mpx_name); code = error_table_$action_not_performed; return; end; if mpx_areap = null () then mpx_areap = get_system_free_area_ (); on sub_error_ /* cdt_mgr_ is upset */ begin; call find_condition_info_ (null, addr (auto_condition_info), (0)); sub_error_info_ptr = auto_condition_info.info_ptr; code = sub_error_info.status_code; call sys_log_ (1, code, name, "cdt_mgr_$find_cdt_channel: ^a", sub_error_info.info_string); call CDT_THREAD_DAMAGE$$BRIEF; end; call cdt_mgr_$find_cdt_channel (cdtp, mpx_name, tablex, fnp_sw, code); if code ^= 0 /* noentry is only defined problem */ then do; msg = "is not defined in the CDT."; return; end; if fnp_sw then do; fnpep = addr (cdt.fnp_entry (-tablex)); mpxep = addr (fnpe.mpxe); msg = "is not a configured FNP"; if fnpe.state = MPX_FREE then go to bad_mpx_name; mpx_display_name = "FNP " || rtrim (mpx_name); /* For error messages */ mpx_cdtep = fnpep; if mpxe.current_mpx_type = 0 then mpxe.current_mpx_type = fnpe.mpx_type; new_mpx_type = fnpe.mpx_type; /* This type never changes */ end; else do; /* Multiplexed channel */ msg = ". Command restricted to top-level multiplexers until AS initialization complete."; if fnp_only & index (mpx_name, ".") > 0 then go to bad_mpx_name; cdtep = addr (cdt.cdt_entry (tablex)); msg = "is not configured as a multiplexer."; if cdte.current_service_type ^= MPX_SERVICE then go to bad_mpx_name; mpx_display_name = "multiplexer " || rtrim (mpx_name); mpxep = addr (cdte.initial_command); mpx_cdtep = cdtep; if mpxe.current_mpx_type = 0 then /* No current type */ mpxe.current_mpx_type = cdte.mpx_type; new_mpx_type = cdte.mpx_type; /* This will be type at next load */ end; fnpep, cdtep = null (); code = 0; return; bad_mpx_name: call sys_log_ (1, "^a: Invalid multiplexer name: ""^a"" ^a", name, mpx_name, msg); code = error_table_$action_not_performed; end validate_mpx_name; /* Procedure to compute one entry variable */ build_entvar: proc (action); dcl action char (*); dcl type_name char (32) var; dcl (segname, entname) char (32); entvar = iox_$err_no_operation; /* The error default */ if mpxe.current_mpx_type < 1 | mpxe.current_mpx_type > hbound (mpx_types, 1) then return; type_name = rtrim (mpx_types (mpxe.current_mpx_type)); segname = "as_" || type_name || "_mpx_"; /* As_XXXXX_mpx_ */ entname = type_name || "_" || action; /* XXXXX_(load dump) */ call hcs_$make_entry (null (), segname, entname, entvar, code); if code = 0 then return; end build_entvar; /* Save the name of the entry called */ /* and other misc setup */ set_entry_name: proc (e); dcl e char (*); miip = null; thread_trouble_count = 0; name = proc_name || "$" || e; return; end set_entry_name; /* Get a list of all sub-channels on a multiplexor */ /* This is simply all channels that match the starname mpxname.* */ find_subchannels: proc (muxx, p); dcl muxx fixed bin; /* stock cdtx -- fixed bin <0 for fnp, >0 for cdt */ dcl firstx fixed bin; dcl d_limit fixed bin; dcl x fixed bin; dcl p ptr; dcl check_count fixed bin; call thread_start (muxx, firstx, d_limit); if d_limit = 0 then return; mii_chan_count = d_limit; allocate mux_init_info in (mpx_area) set (p); check_count = 0; do x = firstx repeat (cdt.cdt_entry (x).next_sister) while (x ^= 0); check_count = check_count + 1; if check_count > d_limit | check_count > cdt.n_cdtes /** **/ | cdt.cdt_entry (x).threads.mother ^= muxx then do; free mux_init_info; call CDT_THREAD_DAMAGE (check_count, muxx, x); end; p -> mux_init_info.name (check_count) = cdt.cdt_entry (x).name; p -> mux_init_info.devx (check_count) = 0; end; if check_count < d_limit then call CDT_THREAD_DAMAGE$$TOO_FEW_DAUGHTERS (check_count, muxx); end find_subchannels; /* Count all the users of a multiplexer */ count_mpx_users: proc (muxx, n); dcl muxx fixed bin; dcl j fixed bin; dcl n fixed bin; dcl (firstx, d_limit, check_count) fixed bin; dcl x fixed bin; n = 0; call thread_start (muxx, firstx, d_limit); if d_limit = 0 then return; check_count = 0; do x = firstx repeat (cdt.cdt_entry (x).threads.next_sister) while (x ^= 0); check_count = check_count + 1; if check_count > d_limit | check_count > cdt.n_cdtes | cdt.cdt_entry (x).mother ^= muxx then call CDT_THREAD_DAMAGE (check_count, muxx, x); if cdt.cdt_entry (x).current_service_type = MPX_SERVICE then do; /* Count users down the tree */ call count_mpx_users (x, j); n = n + j; end; else if asu_$channel_in_use (addr (cdt.cdt_entry (x))) then n = n + 1; end; if check_count < d_limit then call CDT_THREAD_DAMAGE$$TOO_FEW_DAUGHTERS (check_count, muxx); end count_mpx_users; /* Procedure to get the state of a multiplexers parent */ check_parent_state: proc (muxx); dcl muxx fixed bin; dcl tp pointer; if muxx < 0 then tp = addr (cdt.fnp_entry (-muxx).threads); else tp = addr (cdt.cdt_entry (muxx).threads); if tp -> channel_threads.mother = 0 /* top level mpx */ then do; parent_state = MPX_UP; code = 0; return; end; if tp -> channel_threads.mother < 0 then call state_mpx (substr (collate (), rank ("a") - tp -> channel_threads.mother, 1), parent_state, code); else call state_mpx ((cdt.cdt_entry (tp -> channel_threads.mother).name), parent_state, code); end check_parent_state; /* Procedure to perform pending channel additions and deletions before a multiplexer is loaded */ update_cdt: procedure (muxx); declare dx fixed bin; declare x fixed bin; declare muxx fixed bin; declare (firstx, d_limit, check_count) fixed bin; declare local_cdtep pointer; declare 1 L_CDTE aligned like cdte based (local_cdtep); declare p pointer; call thread_start (muxx, firstx, d_limit); if d_limit = 0 then return; check_count = 0; x = firstx; CONSIDER_EACH: do while (x ^= 0); /* repeat done by hand */ local_cdtep = addr (cdt.cdt_entry (x)); check_count = check_count + 1; if check_count > d_limit | check_count > cdt.n_cdtes | L_CDTE.mother ^= muxx then call CDT_THREAD_DAMAGE (check_count, muxx, x); if L_CDTE.in_use = CHANNEL_DELETED | L_CDTE.in_use = NOW_FREE /* NOW_FREE really shouldn't happen, but ... */ then do; if L_CDTE.daughter_count > 0 then call update_cdt (x); /* get the whole family */ L_CDTE.in_use = NOW_FREE; L_CDTE.twx = 0; L_CDTE.event = 0; dx = x; /** protect against deletions */ x = L_CDTE.threads.next_sister; call cdt_mgr_$thread_out_cdt_channel (cdtp, dx); end; /* deletion case */ else NON_DELETED: do; if L_CDTE.in_use = NOT_CONFIGURED then do; L_CDTE.in_use = NOW_HUNG_UP; L_CDTE.current_service_type = L_CDTE.service_type; L_CDTE.twx = 0; L_CDTE.event = 0; L_CDTE.process = null (); L_CDTE.dialed_to_procid = ""b; end; else if L_CDTE.current_service_type = MC_SERVICE then do; if L_CDTE.service_type ^= MC_SERVICE then /* And we are about to take it away */ call mc_commands_$remove_tty ((L_CDTE.name), ""b, code); /* Co-operate */ end; else if L_CDTE.current_service_type = MPX_SERVICE then do; if L_CDTE.service_type ^= MPX_SERVICE then L_CDTE.initial_command = ""; end; L_CDTE.current_service_type = L_CDTE.service_type; if L_CDTE.current_service_type = MPX_SERVICE then do; /* Get multiplexers ready */ p = addr (L_CDTE.initial_command); call mpxe_init (p); p -> mpxe.current_mpx_type = L_CDTE.mpx_type; end; if L_CDTE.daughter_count > 0 then call update_cdt (x); x = L_CDTE.threads.next_sister; end NON_DELETED; end CONSIDER_EACH; end update_cdt; thread_start: procedure (muxx, firstx, d_limit); declare firstx fixed bin; /* first cdte to examine */ declare d_limit fixed bin; /* number of daughters you should find */ declare muxx fixed bin; if muxx < 0 then do; firstx = cdt.fnp_entry (-muxx).threads.daughter; d_limit = cdt.fnp_entry (-muxx).threads.daughter_count; end; else if muxx > 0 then do; firstx = cdt.cdt_entry (muxx).threads.daughter; d_limit = cdt.cdt_entry (muxx).threads.daughter_count; end; else if muxx = 0 /* not used yet, but not a bad idea */ then do; firstx = cdt.threads.daughter; d_limit = cdt.threads.daughter_count; end; if (d_limit = 0) ^= (firstx = 0) then call CDT_THREAD_DAMAGE$$DAUGHTERS (muxx); end thread_start; get_cdt_ptr: procedure (code); declare code fixed bin (35); declare cdt_mgr_$init entry (character (*), pointer, fixed binary (35)); declare cdt_mgr_$thread entry (pointer, fixed binary (35)); cdtp, static_cdtp = null; on sub_error_ begin; call find_condition_info_ (null, addr (auto_condition_info), (0)); sub_error_info_ptr = auto_condition_info.info_ptr; cdtp = sub_error_info.info_ptr; /* message in a bottle */ call sys_log_$error_log (0, sub_error_info.status_code, name, "cdt_mgr_$init: ^a", sub_error_info.info_string); /* for now we rethread and call it a live baby */ on sub_error_ begin; call find_condition_info_ (null, addr (auto_condition_info), (0)); sub_error_info_ptr = auto_condition_info.info_ptr; call sys_log_$error_log (1, sub_error_info.status_code, name, "cdt_mgr_$thread: ^a", sub_error_info.info_string); if ^sub_error_info.default_restart /* not warning */ then do; call sys_log_ (2, "^a: CDT rethreading failed.", name); code = sub_error_info.status_code; go to RETURN; end; end; if cdtp = null then go to GIVE_UP; call sys_log_ (0, "^a: Rethreading CDT.", name); call cdt_mgr_$thread (cdtp, (0)); /* code uninteresting with handler */ call sys_log_ (0, "^a: Rethreading of CDT complete.", name); static_cdtp = cdtp; /**** * return to cdt_mgr_$init */ end; call cdt_mgr_$init (sc_stat_$sysdir, cdtp, code); if code ^= 0 then do; GIVE_UP: call sys_log_$error_log (1, code, name, "cdt_mgr_$init failed."); return; end; call init_cdt (code); if code ^= 0 then return; static_cdtp = cdtp; RETURN: return; end get_cdt_ptr; CDT_THREAD_DAMAGE: /* Code comes here when something is WRONG */ procedure (n_daughters, muxx, errorx); declare n_daughters fixed bin; declare muxx fixed bin; declare errorx fixed bin; declare cdt_mgr_$thread entry (pointer, fixed binary (35)); declare as_error_table_$repeated_cdt_damage ext static fixed bin (35); declare as_error_table_$cdt_rethreading_error ext static fixed bin (35); if muxx > 0 then call error_many (cdt.cdt_entry (muxx).name, muxx, cdt.cdt_entry (errorx).name, errorx, cdt.cdt_entry (muxx).daughter_count); else if muxx = 0 then call error_many ("Top level muxes", 0, cdt.cdt_entry (errorx).name, errorx, cdt.threads.daughter_count); else call error_many ("FNP " || substr (collate (), rank ("a") - muxx, 1), muxx, cdt.cdt_entry (errorx).name, errorx, cdt.fnp_entry (-muxx).daughter_count); go to E_COMMON; CDT_THREAD_DAMAGE$$TOO_FEW_DAUGHTERS: entry (n_daughters, muxx); if muxx > 0 then call error_few (cdt.cdt_entry (muxx).name, muxx, cdt.cdt_entry (muxx).daughter_count); else if muxx = 0 then call error_few ("Top level muxes", 0, cdt.threads.daughter_count); else call error_few ("FNP " || substr (collate (), rank ("a") - muxx, 1), muxx, cdt.fnp_entry (-muxx).daughter_count); go to E_COMMON; CDT_THREAD_DAMAGE$$DAUGHTERS: entry (muxx); if muxx > 0 then call error_none (cdt.cdt_entry (muxx).name, muxx, cdt.cdt_entry (muxx).daughter_count, cdt.cdt_entry (muxx).daughter); else if muxx = 0 then call error_none ("Top level muxes", 0, cdt.threads.daughter_count, cdt.threads.daughter); else call error_none (substr (collate (), rank ("a") - muxx, 1), muxx, cdt.fnp_entry (-muxx).daughter_count, cdt.fnp_entry (-muxx).daughter); CDT_THREAD_DAMAGE$$BRIEF: entry; E_COMMON: if thread_trouble_count > 0 /* once is all you get */ then do; call sys_log_ (1, "^a: Repeated damage to CDT threads encountered.", name); arg_code = as_error_table_$repeated_cdt_damage; go to RETURN; end; call sys_log_ (1, "^a: Threading inconsistency detected in CDT. Rethreading.", name); thread_trouble_count = 1; on sub_error_ begin; call find_condition_info_ (null, addr (auto_condition_info), (0)); sub_error_info_ptr = auto_condition_info.info_ptr; call sys_log_$error_log (1, sub_error_info.status_code, name, "cdt_mgr_$thread: ^a", sub_error_info.info_string); if ^sub_error_info.default_restart /* not just warning */ then do; call sys_log_ (1, "^a: Error while rethreading CDT.", name); call sys_log_$error_log (3, sub_error_info.status_code, name, "cdt_mgr_$thread: ^a.", sub_error_info.info_string); arg_code = as_error_table_$cdt_rethreading_error; go to RETURN; end; end; call cdt_mgr_$thread (cdtp, (0)); /* code uninteresting */ /**** IF WE GOT HERE, IT SUCCEEDED ****/ call sys_log_ (1, "^a: Rethreading complete.", name); if miip ^= null then free mux_init_info; go to BAD_THREADS_LABEL; error_many: procedure (pname, px, ename, ex, dc); declare (pname, ename) character (32) aligned; declare dc fixed bin unaligned; declare (px, ex) fixed bin; call sys_log_ (1, "^a: ^d daughters found for mux ^a(^d) at ^a(^d), but daughter count is ^d", name, n_daughters, pname, px, ename, ex, dc); return; error_few: entry (pname, px, dc); call sys_log_ (1, "^a: ^d daughters found for mux ^a(^d), but daughter count is ^d.", name, n_daughters, pname, px, dc); return; error_none: entry (pname, px, dc, d); declare d fixed bin unaligned; call sys_log_ (1, "^a: ^a(^d) has daughter count ^d, but first daughter ^d", name, pname, px, dc, d); return; end error_many; end CDT_THREAD_DAMAGE; ERROR_EARLY_CALL: begin; call sys_log_ (1, "^a: multiplexers may not be manipulated before AS initialization.", name); arg_code = error_table_$action_not_performed; return; end; RETURN: return; init: entry (arg_cdtp, arg_code); if ^sc_stat_$Multics_typed | sc_stat_$Go_typed then call sub_err_ (error_table_$out_of_sequence, "multiplexer_mgr_$init", "s"); call set_entry_name ("init"); if static_cdtp ^= null /* already done some initialization? */ then do; cdtp = static_cdtp; if cdt.mux_mgr_system_init /* really got going? */ then do; call sys_log_ (1, "^a: Shutting down initialized multiplexers prior to re-initialization.", name); call shut; /* try to stop things */ end; end; /* NOTE: shut will set static_cdtp = null */ if static_cdtp = null /* see if never initialized or just shut */ then do; call get_cdt_ptr (arg_code); if arg_code ^= 0 then return; smlep = stop_mpx_list_ptr_; /* if this is a retry, then we must */ fnp_only = "1"b; /* re-stop any muxes that were early stopped */ /* list will be null if not retry */ do while (smlep ^= null); /* for each early-stopped mux */ mpx_name = stop_mpx_list_entry.mpx_name; BAD_THREADS_LABEL = INIT_RE_STOP_MPX; /* where to go if error & good salvage */ INIT_RE_STOP_MPX: /* not a million miles away */ call validate_mpx_name (muxx); /* is it still there? */ if code ^= 0 /* qu'elle chomage */ then call sys_log_$error_log (1, code, name, "Unable to perform requested stop_mpx of ^a.", mpx_name); else do; /* ahhhhh */ mpxe.current_service_type = INACTIVE; mpxe.flags.go = "0"b; end; smlep = stop_mpx_list_entry.next; end; end; if ^as_data_$lct_initialized then do; call hphcs_$lct_init (as_data_$lct_size, arg_code); /* Perform ring0 initialization */ if arg_code ^= 0 then call sys_log_$error_log (1, arg_code, "multiplexer_mgr_$init", "From hphcs_$lct_init"); else as_data_$lct_initialized = "1"b; end; arg_cdtp = static_cdtp; arg_code = 0; return; shut: entry; declare cdt_mgr_$shut entry (pointer); if static_cdtp = null then return; cdtp = static_cdtp; call set_entry_name ("shut"); BAD_THREADS_LABEL = RE_SHUT; /* see below */ if loud then call sys_log_ (1, "^a: Shutting down all multiplexers.", name); /* First the FNP's */ do i = 1 to hbound (cdt.fnp_entry, 1); /* Start bootload on each fnp */ fnpep = addr (cdt.fnp_entry (i)); mpxep = addr (fnpe.mpxe); if mpxe.state = MPX_UP | mpxe.state = MPX_BOOT then do; /* And it is nornally booted */ mpx_name = substr (collate (), rank ("a") + i, 1); call shutdown_mpx (mpx_name, "0"b /* no dump */, code); if code ^= 0 then if loud then call sys_log_$error_log (1, code, name, "Could not shutdown FNP ^a.", mpx_name); end; end; call thread_start (0 /* ROOT */, firstx, d_limit); i = 0; do x = firstx repeat (cdt.cdt_entry (x).next_sister) while (x ^= 0); cdtep = addr (cdt.cdt_entry (x)); i = i + 1; if i > d_limit | i > cdt.n_cdtes | cdte.mother ^= 0 then call CDT_THREAD_DAMAGE (i, 0, x); mpxep = addr (cdte.initial_command); if mpxe.current_service_type = ACTIVE & mpxe.state = MPX_DOWN then do; call shutdown_mpx ((cdte.name), "0"b, code); if code ^= 0 then if loud then call sys_log_$error_log (1, code, name, "Could not shutdown ^a.", cdte.name); end; end; if i < d_limit then call CDT_THREAD_DAMAGE$$TOO_FEW_DAUGHTERS (i, 0); GIVE_UP_SHUT: cdt.mux_mgr_system_init = "0"b; call cdt_mgr_$shut (static_cdtp); static_cdtp = null; return; RE_SHUT: BAD_THREADS_LABEL = GIVE_UP_SHUT; /* only one try */ thread_trouble_count = 0; /* but go to give up rather than returning */ /* Entry to count users for reconfiguration */ count_mpx_users: entry (arg_mpx_name, arg_cdtp, arg_count, arg_code); call set_entry_name ("count_mpx_users"); mpx_name = arg_mpx_name; arg_count = 0; if arg_cdtp ^= null () then cdtp = arg_cdtp; else cdtp = static_cdtp; if cdtp = null | ^cdt.mux_mgr_system_init then do; code = error_table_$null_info_ptr; return; end; BAD_THREADS_LABEL = ABORT_COUNT; call validate_mpx_name (muxx); /* grab this mux */ if code ^= 0 then do; arg_code = code; return; end; call count_mpx_users (muxx, arg_count); return; ABORT_COUNT: arg_code = error_table_$action_not_performed; return; set_loud: entry; loud = "1"b; return; set_quiet: entry; loud = "0"b; return; %page; %include as_data_; %page; %include author_dcl; %page; %include cdt; %page; %include condition_info; %page; %include condition_info_header; %page; %include dialup_values; %page; %include event_call_info; %page; %include multiplexer_types; %page; %include mux_init_info; %page; %include net_event_message; %page; %include sc_stat_; %page; %include sub_error_info; %page; /* BEGIN MESSAGE DOCUMENTATION Message: multiplexer_mgr_$load_mpx: Loading MPX. ARGS S: as (severity1) T: $run M: A load of the multiplexer named MPX has been started. ARGS, if present, lists the control arguments given to the load_mpx command (-check, -go, and/or -force). A: $ignore Message: multiplexer_mgr_$load_mpx: MPX not loaded. Unable to determine the state of its parent. S: as (severity1) T: $run M: An attempt to load the multiplexer named MPX failed because the system was unable to determine whether its parent multiplexer was loaded. A: $inform If possible, attempt to load the parent multiplexer. Message: multiplexer_mgr_$load_mpx: MPX cannot be loaded because its parent multiplexer is not running. S: as (severity1) T: $run M: An attempt to load the multiplexer named MPX failed because its parent multiplexer was not running. A: Try to load the parent multiplexer before retrying the load of MPX. Message: multiplexer_mgr_$load_mpx: Initialization of MPX already in progress. S: as (severity1) T: $run M: An attempt to load the multiplexer named MPX failed because a previous load of MPX has not completed. A: Either allow the load currently in progress to complete, or use the dump_mpx command to abort before retrying the load. Message: multiplexer_mgr_$load_mpx: User(s) of N channel(s) would be hung up. MPX not loaded. Use -force if necessary. S: as (severity1) T: $run M: The multiplexer named MPX has N subchannels with users logged in. It can only be loaded if the -force control argument is provided to the load_mpx command. A: Either reenter the load_mpx command with the -force control argument, or wait for the users to be disconnected or logged out. Message: multiplexer_mgr_$load_mpx: MPX has no subchannels. S: as (severity1) T: $run M: The multiplexer named MPX cannot be used because it has no subchannels specified in the CDT. A: $inform_sa Message: multiplexer_mgr_$load_mpx: No devx assigned to MPX.CHAN. S: as (severity1) T: $run M: The subchannel CHAN of multiplexer MPX was not assigned a device index ("devx") when MPX was initialized. A: $inform Message: multiplexer_mgr_$load_mpx: Unable to init channel CHAN on MPX. S: as (severity1) T: $run M: The subchannel CHAN of multiplexer MPX could not be initialized. A: $inform Message: multiplexer_mgr_$shutdown_mpx: Shutting down MPX. [dump] S: as (severity1) T: $run M: If tracing is on, this message appears when a multiplexer is shut down. The string "dump" appears at the end of the message if the the shutdown is in response to a dump_mpx command, rather than a shutdown_mpx command. A: $ignore Message: multiplexer_mgr_$COMMAND: Dumping MPX. [force] S: as (severity1) T: $run M: If tracing is on, this message appears when dumping a multiplexer in response to either a dump_mpx or shutdown_mpx command (as indicated by COMMAND). The string "force" appears if the -force control argument was specified. A: $ignore Message: multiplexer_mgr_$COMMAND: User(s) of N channel(s) would be hung up. MPX not dumped. Use -force if necessary. S: as (severity1) T: $run M: The multiplexer named MPX had logged-in users on N subchannels when a dump_mpx or shutdown_mpx command (as indicated by COMMAND) was given. The multiplexer cannot be dumped or shut down unless the -force control argument is used. A: Retry the command with the -force control argument, or wait for the users to be disconnected or logged out. Message: multiplexer_mgr_$start_mpx: Starting MPX. [force] S: as (severity1) T: $run M: If tracing is on, this message appears when the multiplexer named MPX is started, either automatically after loading, or in response to an explicit start_mpx command. The string "force" appears if the -force control argument was specified. A: $ignore Message: multiplexer_mgr_$start_mpx: MPX has not been loaded, so it can't be started. S: as (severity1) T: $run M: A start_mpx command was entered for the multiplexer named MPX, but it has not been loaded. A: Load the multiplexer by using the load_mpx command. Message: multiplexer_mgr_$start_mpx: MPX is already started. S: as (severity1) T: $run M: A start_mpx command was entered for the multiplexer named MPX, but it had already been started. A: $ignore Message: multiplexer_mgr_$start_mpx: MPX is currently loading. It will be started when load completes. S: as (severity1) T: $run M: A start_mpx command was entered for the multiplexer named MPX while loading of MPX was in progress. The start_mpx command will take effect after the load is completed. A: $ignore Message: multiplexer_mgr_$stop_mpx: Stopping MPX S: as (severity1) T: $run M: If tracing is on, this message appears in response to a stop_mpx command for the multiplexer named MPX. A: $ignore Message: multiplexer_mgr_$stop_mpx: MPX is running but no longer accepting calls. S: as (severity1) T: $run M: This message acknowledges that a stop_mpx command has been successfully executed on the running multiplexer named MPX. A: $ignore Message: multiplexer_mgr_$stop_mpx: MPX is now loading, but will not be started S: as (severity1) T: $run M: This message acknowledges a stop_mpx command for the multiplexer named MPX, which is currently being loaded. A: $ignore Message: multiplexer_mgr_$stop_mpx: MPX will not be loaded. S: as (severity1) T: $run M: This message acknowledges a stop_mpx command for the multiplexer named MPX, which is currently not loaded. A: $ignore Message: multiplexer_mgr_$listen_mpx: Listening to MPX. S: as (severity1) T: $run M: If tracing is on, this message appears when starting to listen to the subchannels of the multiplexer named MPX after it has been loaded and started. A: $ignore Message: multiplexer_mgr_$listen_mpx: MPX is not running. Unable to listen to channels. S: as (severity1) T: $run M: An attempt was made to listen to the subchannels of the multiplexer named MPX, but the multiplexer was not running. This might occur if the multiplexer crashed very shortly after being loaded. A: If there is a message indicating that the multiplexer crashed shortly after loading, try to reload it. Otherwise, contact the system programming staff. Message: multiplexer_mgr_$listen_mpx: asu_$listen_chanel failed for MPX.CHAN. S: as (severity1) T: $run M: If tracing is on, this message appears if an attempt to listen to the subchannel named CHAN of the multiplexer named MPX returned a status code of error_table_$action_not_performed. An additional message from asu_$asu_listen should appear giving more information about the failure. A: $inform Message: multiplexer_mgr_mpx_loaded: Successful load reported for MPX. S: as (severity1) T: $run M: If tracing is on, this message appears when the answering service is notified that the multiplexer named MPX has been successfully loaded. A: $ignore Message: multiplexer_mgr_$mpx_load_failed: Report load failure for MPX while not loading. S: as (severity1) T: $run M: The answering service was notified that loading of the multiplexer named MPX had failed, but no load of that multiplexer was in progress at the time. A: $inform Message: multiplexer_mgr_$mpx_load_failed: Load of MPX failed. S: as (severity1) T: $run M: If tracing is on, this message appears if the answering service is notified that an attempt to load the multiplexer named MPX failed. A previous message should give more information about the failure. A: $ignore Message: multiplexer_mgr_$mpx_crashed: Crash reported for MPX. S: as (severity1) T: $run M: If tracing is on, this message appears when the answering service is notified that the multiplexer named MPX has crashed. A: $ignore Message: multiplexer_mgr_$mpx_crashed: MPX is stopped and will not be reloaded. S: as (severity1) T: $run M: The multiplexer named MPX has crashed and is not being reloaded because of a previous stop_mpx command. A: $ignore Message: multiplexer_mgr_$mpx_crashed: Automatic reloading is disabled. MPX will not be reloaded. S: as (severity1) T: $run M: The multiplexer named MPX, which has crashed, is not being reloaded because automatic reloading of multiplexers has been disabled (by setting the FNP_required_up_time field in the CMF to 0). A: If it is desired to reload the multiplexer, enter a load_mpx command. Message: multiplexer_mgr_$mpx_crashed: MPX is in apparent crash loop and will not be reloaded S: as (severity1) T: $run M: The multiplexer named MPX has crashed more than twice in the interval specified by FNP_required_up_time, and will not be automatically reloaded. A: $inform Message: multiplexer_mgr_$CMD: Command used too early in answering service initialization. MPX S: as (severity1) T: $run M: An operator command (identified by CMD) has been entered for the multiplexer named MPX before the answering service has been initialized. A: $ignore The command may have to be entered manually after answering service initialization is complete. Message: ERROR. cdt_mgr_$find_cdt_channel: INFO S: as (severity1) T: $run M: An error (identified by the status code reported in ERROR) has occurred while trying to find a multiplexer name in the CDT. Further information about the error is given in INFO. A: $inform Message: multiplexer_mgr_$validate_mpx_name: Invalid multiplexer name: MPX REASON S: as (severity1) T: $run M: The multiplexer name MPX, which has been used in an operator command, is invalid, for the reason given by REASON. A: If the name was mistyped, reenter the command. Otherwise, contact the system administrator. Message: multiplexer_mgr_$CMD: Rethreading CDT. S: as (severity0) T: $run M: In the process of performing the action requested by CMD, the CDT was found to be damaged (as indicated by a separate message); an attempt will be made to repair the damage. A: $ignore Message: multiplexer_mgr_$CMD: Rethreading of CDT complete. S: as (severity0) T: $run M: Damage to the CDT discovered in the course of executing CMD, and reported in a previous message, has been successfully repaired. A: $ignore Message: multiplexer_mgr_$CMD: CDT rethreading failed. S: as (severity2) T: $run M: An attempt to repair damage to the CDT discovered while executing CMD (and reported in a previous message) has failed. A: $inform Message: multiplexer_mgr_$CMD: Threading inconsistency detected in CDT. Rethreading. S: as (severity1) T: $run M: An inconsistency in the CDT has been discovered in the CDT while executing CMD. An attempt will be made to repair the inconsistency. A: $ignore Message: multiplexer_mgr_$CMD: Repeated damage to CDT threads encountered. S: as (severity1) T: $run M: After an attempt to repair an inconsistency to the CDT discovered while executing CMD, the CDT was still inconsistent. A: $inform Message: multiplexer_mgr_$CMD: Error while rethreading CDT. S: as (severity1) T: $run M: An error (reported by a previous message) was encountered while attempting to repair an inconsistency in the CDT discovered while executing CMD. A: $inform Message: multiplexer_mgr_$CMD: Rethreading complete. S: as (severity1) T: $run M: An inconsistency discovered in the CDT while executing CMD (and reported in a previous message) has been successfully repaired. A: $ignore Message: multiplexer_mgr_$CMD: N daughters found for mux MPX(X1)[ at CHAN(X2]), but daughter count is M S: as (severity1) T: $run M: An inconsistency in the CDT was found while executing CMD. The CDT indicates that the multiplexer named MPX, occupying entry number X1, has M subchannels, but N subchannels are threaded to it. If N > M, the Nth subchannel is CHAN, occupying entry number X2. A: $inform Message: multiplexer_mgr_$CMD: MPX(X1) has daughter count N, but first daughter X2 S: as (severity1) T: $run M: An inconsistency has been discovered in the CDT while executing CMD. The multiplexer named MPX, occupying CDT entry X1, is marked as having N subchannels, but the first subchannel entry number is X2, where either N or X2, but not both, is 0. A: $inform Message: multiplexer_mgr_$CMD: multiplexers may not be manipulated before AS initialization. S: as (severity1) T: $run M: An attempt was made to execute the command CMD before the answering service was initialized. A: $ignore It may be necessary to reenter the command after answering service initialization is complete. Message: multiplexer_mgr_$init: Shutting down initialized multiplexers prior to re-initialization. S: as (severity1) T: $run M: Multiplexer management is being reinitialized after some multiplexers had been loaded. Such multiplexers will be shut down prior to reinitialization. A: $ignore Message: multiplexer_mgr_$shut: Shutting down all multiplexers. S: as (severity1) T: $run M: If tracing is on, this message appears when multiplexers are being shut down as part of system shutdown or when an error was encountered during answering service initialization. A: $ignore Message: multiplexer_mgr_$load_mpx: ERROR. Unable to get a devx for MPX S: as (severity1) T: $run M: An error code (described by ERROR) has been returned from an attempt to find the device index ("devx") of the multiplexer named MPX. A: $inform Message: multiplexer_mgr_$load_mpx: ERROR. Unable to initialize MPX. S: as (severity1) T: $run M: An error code (described by ERROR) hs been returned from an attempt to initialize the multiplexer named MPX in ring 0. A: $inform Message: multiplexer_mgr_$load_mpx: ERROR. Unable to load MPX. S: as (severity1) T: $run M: An error (described by ERROR) has prevented the loading of the multiplexer named MPX. A: $inform Message: multiplexer_mgr_$shutdown_mpx: ERROR. Shutting down MPX. S: as (severity1) T: $run M: An error (described by ERROR) has occurred when attempting to shut down the multiplexer named MPX. A: $inform Message: multiplexer_mgr_$shutdown_mpx: ERROR. Unable to dump MPX. S: as (severity1) T: $run M: An error (described by ERROR) has occurred when attempting to dump the multiplexer named MPX. A: $inform Message: multiplexer_mgr_$shutdown_mpx: ERROR. Terminating MPX.CHAN. S: as (severity1) T: $run M: An error (described by ERROR) has occurred while terminating the subchannel CHAN of the multiplexer named MPX. A: $inform Message: multiplexer_mgr_$shutdown_mpx: ERROR. Terminating MPX. S: as (severity1) T: $run M: An error (described by ERROR) has occurred when attempting to terminate the multiplexer named MPX. A: $inform Message: multiplexer_mgr_$start_mpx: ERROR. Can't get devx for MPX. S: as (severity1) T: $run M: An error (described by ERROR) was returned from an attempt to get the device index ("devx") for the multiplexer named MPX. A: $inform Message: multiplexer_mgr_$start_mpx: ERROR. Starting MPX. S: as (severity1) T: $run M: An error (described by ERROR) occurred when attempting to start the multiplexer named MPX. A: $inform Message: multiplexer_mgr_$stop_mpx: ERROR. Can't get devx for MPX. S: as (severity1) T: $run M: An error (described by ERROR) was returned from an attempt to get the device index ("devx") for the multiplexer named MPX. A: $inform Message: multiplexer_mgr_$stop_mpx: ERROR. Unable to stop MPX. S: as (severity1) T: $run M: An error (described by ERROR) occurred when attempting to stop the multiplexer named MPX. A: $inform Message: multiplexer_mgr_$listen_mpx: ERROR. asu_$attach_channel failed MPX.CHAN S: as (severity1) T: $run M: An error was returned by asu_$attach_channel when attempting to attach the subchannel CHAN while listening to all subchannels of the multiplexer named MPX. This message only appears if tracing is on. A: $inform Message: multiplexer_mgr_$listen_mpx: ERROR. Channel MPX.CHAN listen failed. S: as (severity1) T: $run M: An attempt to listen to the subchannel CHAN of the multiplexer MPX encountered an error (described by ERROR). A: $inform Message: multiplexer_mgr_$mpx_load_failed: ERROR. Trying to shutdown MPX. S: as (severity1) T: $run M: An error (described by ERROR) occurred when attempting to shut down the multiplexer named MPX after it had failed to load. A: $inform Message: multiplexer_mgr_$mpx_crashed: ERROR. Shutting down MPX S: as (severity1) T: $run M: An error (described by ERROR) occurred when attempting to shut down the multiplexer named MPX after it had crashed. A: $inform Message: multiplexer_mgr_$CMD: ERROR. cdt_mgr_$init: INFO S: as (severity0) T: $run M: An error (described by ERROR, with additional information in INFO) occurred while trying to get a pointer to the CDT in order to execute the command named CMD. A: $inform Message: multiplexer_mgr_$CMD: ERROR. cdt_mgr_$thread: INFO S: as (severity1) T: $run M: An error (described by ERROR, with additional information in INFO) occurred while trying to repair damage to the CDT discovered while executing CMD. A: $inform Message: multiplexer_mgr_$CMD: ERROR. cdt_mgr_$init failed. S: as (severity1) T: $run M: An error (desribed by ERROR) occurred when trying to initialize the CDT in preparation for executing CMD. A: $inform Message: multiplexer_mgr_$CMD: ERROR. cdt_mgr_$thread: INFO S: as (severity3) T: $run M: An error (described by ERROR, with additional information in INFO) occurred while trying to repair damage to the CDT discovered while executing CMD; the attempt at repair will not be repeated. A: $inform Message: multiplexer_mgr_$init: ERROR. Unable to perform requested stop_mpx of MPX. S: as (severity1) T: $run M: An attempt to shut down the multiplexer named MPX, while reinitializing multiplexer management, encountered an error (described by ERROR). A: $inform Message: multiplexer_mgr_$init: ERROR. From hphcs_$lct_init S: as (severity1) T: $run M: An error (described by ERROR) was returned from hphcs_$lct_init while trying to initialize multiplexer management. A: $inform Message: multiplexer_mgr_$shut: ERROR. Could not shutdown FNP X. S: as (severity1) T: $run M: An error (described by ERROR) occurred when trying to shut down the FNP named X during system shutdown or after an error in answering service initialization. A: $inform Message: multiplexer_mgr_$shut: ERROR. Could not shutdown MPX. S: as (severity1) T: $run M: An error (described by ERROR) occurred when trying to shut down the multiplexer named MPX during system shutdown or after an error in answering service initialization. A: $inform END MESSSAGE DOCUMENTATION */ end multiplexer_mgr_;  reassign_work_classes_.pl1 07/13/88 1112.8r w 07/13/88 0938.5 133956 /****^ *********************************************************** * * * 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 */ reassign_work_classes_: proc (a_code); /* This procedure set the work_class of each process to the proper value for the current shift, and defines the set of work_classes which are to be in effect for the current shift. It is called by the Answering Service process at shift change time and whenever a new master_group_table (MGT) is installed or the operator executes the "maxu auto" command". */ /* Last modified date & reason: */ /* Coded July 8, 1975 by RE Mullen for Priority Scheduler */ /* Mod by RE Mullen, Summer '76 for Deadline Scheduler */ /* Modified May 1981, E. N. Kittlitz, assign daemons according to interactive specification */ /* Modified July 1981 by J. Bongiovanni for max_pct (governed work classes) */ /* Modified November 1981, E. N. Kittlitz. user_table_entry conversion. */ /* Modified May 1982, E. N. Kittlitz. New AS initialization. */ /****^ 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(87-03-11,GDixon), approve(87-07-13,MCR7741), audit(87-07-21,Hartogs), install(87-08-04,MR12.1-1055): Correct coding standard violations. Support AS test mode by suppressing some operations when invoked in a test AS. 3) change(87-04-26,GDixon), approve(87-07-13,MCR7741), audit(87-07-21,Hartogs), install(87-08-04,MR12.1-1055): Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1 END HISTORY COMMENTS */ dcl a_code fixed bin (35); dcl ALL_IN_ONE bit (1) aligned; /* "1"b => all processes go in first workclass */ dcl code fixed bin (35); dcl curshift fixed bin; dcl force_compromise bit (1) aligned; /* "1"b => call DEFINE_COMPROMISE if trouble */ dcl i fixed bin; dcl 1 new_wci like work_class_info aligned; dcl hphcs_$define_work_classes entry (ptr, fixed bin (35)); dcl hphcs_$set_process_work_class entry (bit (36) aligned, fixed bin, fixed bin, fixed bin (35)); dcl sys_log_ entry options (variable); dcl (default_r1 init (4000000), /* 4 seconds */ default_q1 init (500000), /* half second */ default_r2 init (32000000), /* 32 seconds */ default_q2 init (1000000)) fixed bin (35) int static options (constant); /* one second */ dcl (error_table_$action_not_performed, error_table_$bad_processid, error_table_$bad_work_class) ext static fixed bin (35); dcl (addr, null, unspec) builtin; /* END DCL */ /* First copy static pointers into automatic. */ ansp = as_data_$ansp; autp = as_data_$autp; dutp = as_data_$dutp; code = 0; /* Zero status code for now */ /* Make sure we know about this kind of MGT */ if mgt.version_indicator ^= "VERSION " then go to MAIN_RETURN; else if mgt.version < MGT_version_3 - 1 then go to MAIN_RETURN; /* Make sure priority scheduler exists. */ if mgt.switches.prio_sked_on_tape = "0"b then go to MAIN_RETURN; /* If not, forget it. */ /* Now get the current shift. */ curshift = anstbl.shift; /* Gather info about new work_classes into new_wci structure. */ /* This will be used (but not modified) by GET_WC */ /* Later new_wci will be passed to the hardcore. */ unspec (new_wci) = ""b; /* clear structure */ new_wci.version = WCI_version_3; new_wci.set_user_wc = "1"b; ALL_IN_ONE = "1"b; /* Assume no workclasses defined. */ if mgt.prio_sked_enabled then do; /* There might be some defined. */ do i = 1 to 16; mgtep = addr (mgt.entry (i)); new_wci.user_wc_defined (i) = work_class.defined (curshift); if new_wci.user_wc_defined (i) = "1"b then ALL_IN_ONE = "0"b; new_wci.user_wc_min_pct (i) = work_class.min_pct (curshift); end; if ALL_IN_ONE then do; /* No wc defined, should've been. */ call sys_log_ (2, "reassign_work_classes_: no work classes defined on current shift."); end; end; if ALL_IN_ONE then do; /* No wc defined or not to enable priosked. */ do i = 1 to 16; if i = 1 then do; new_wci.user_wc_defined (i) = "1"b;/* only first defined. */ new_wci.user_wc_min_pct (i) = 100; /* Has whole machine. */ end; else do; new_wci.user_wc_defined (i) = "0"b; new_wci.user_wc_min_pct (i) = 0; end; end; end; do i = 1 to 16; /* set at least default deadlines */ mgtep = addr (mgt.entry (i)); /* get ptr to workclass */ if mgt.version >= MGT_version_3 /* can use admin specified */ & ^ALL_IN_ONE & mgt.prio_sked_enabled & new_wci.user_wc_defined (i) then do; /* one 1/100 sec = 10000 microsec */ new_wci.resp1 (i) = 10000 * work_class.int_response (curshift); new_wci.quantum1 (i) = 10000 * work_class.int_quantum (curshift); new_wci.resp2 (i) = 10000 * work_class.response (curshift); new_wci.quantum2 (i) = 10000 * work_class.quantum (curshift); new_wci.realtime (i) = work_class.realtime (curshift); new_wci.governed (i) = (work_class.max_pct (curshift) > 0); new_wci.user_wc_max_pct (i) = work_class.max_pct (curshift); end; else do; /* use defaults */ new_wci.resp1 (i) = default_r1; new_wci.quantum1 (i) = default_q1; new_wci.resp2 (i) = default_r2; new_wci.quantum2 (i) = default_q2; new_wci.governed (i) = "0"b; new_wci.user_wc_max_pct (i) = 0; end; end; if mgt.version >= MGT_version_3 & mgt.prio_sked_enabled then do; new_wci.set_sked_mode = "1"b; new_wci.deadline_mode = mgt.deadline_mode (curshift); end; /* Compute new value of workclass for each user now logged in. */ /* Note: GET_WC will verify that the work_class will be defined. */ mgtep = addr (mgt.entry (17)); /* Initialize GET_WC's assoc mem */ do i = 1 to anstbl.current_size; utep = addr (anstbl.entry (i)); /* get ptr to answer table entry */ call GET_WC; end; do i = 1 to dutbl.current_size; utep = addr (dutbl.entry (i)); /* get ptr to daemon table entry */ call GET_WC; end; do i = 1 to autp -> autbl.current_size; utep = addr (autp -> autbl.entry (i)); /* get ptr to autbl entry */ call GET_WC; end; /* We now know that it is indeed possible to move all users to their new work_class and define a new set of work classes. There should be no furthur errors. If there are it implies either somebody else is calling the hardcore in which case this procedure can be called again and probably succeed, or something is busted in which case we can be called again and fail. */ /* Define an all-inclusive set of work classes. */ call DEFINE_COMPROMISE; /* Move all users to new work_classes */ force_compromise = "1"b; call MOVE_USERS; /* Define new set of work classes. */ if ^as_data_$debug_flag then do; call hphcs_$define_work_classes (addr (new_wci), code); if code ^= 0 then do; if new_wci.error_process_id ^= ""b then do; /* Point finger at guilty one. */ call sys_log_ (1, "reassign_work_classes_: process ^w remained in work class ^d.", new_wci.error_process_id, new_wci.error_work_class); end; end; go to MAIN_RETURN; end; /* Force hardcore to rethread with new work_class definitions extant */ force_compromise = "0"b; /* no use compromise if swc fails */ call MOVE_USERS; /* Now reflect new work classes in mgt header. */ mgt.user_wc_defined (*) = new_wci.user_wc_defined (*); mgt.user_wc_min_pct (*) = new_wci.user_wc_min_pct (*); MAIN_RETURN: /* Come here to return to caller */ a_code = code; return; /* return from main proc here if not sooner */ /* ==================================================================== */ GET_WC: proc; /* IP to set ate.work_class from ate.group & mgt */ dcl j fixed bin; dcl wc fixed bin; if ute.active >= NOW_HAS_PROCESS then do; if ute.proc_id = anstbl.as_procid then return; /* Dont bother Initializer */ if ALL_IN_ONE then do; /* Want all users in first work_class */ wc = 1; /* So be it. */ end; else do; if ute.group ^= group.group_id then do; /* do lookup if grp not same as prev. */ do j = 17 to mgt.current_size; mgtep = addr (mgt.entry (j)); if ute.group = group.group_id then go to gwc_got_grp; end; /* here we should not be */ call sys_log_ (2, "reassign_work_classes_: load control group ""^a"" not found in mgt for user ^a.^a.^a.", ute.group, ute.person, ute.project, ute.tag); go to gwc_abort; end; gwc_got_grp: if ute.queue <= 0 /* Pick up new wc from approp place */ then wc = group.int_wc (curshift); else wc = group.abs_wc (curshift); if new_wci.user_wc_defined (wc) = "0"b then do; /* Trouble */ call sys_log_ (2, "reassign_work_classes_: undefined work_class ^d required by load_control_group ^a", wc, ute.group); gwc_abort: call sys_log_ (2, "reassign_work_classes_: mgt clobbered, contact system administrator."); code = error_table_$action_not_performed; go to MAIN_RETURN; /* Abort now. */ end; end; ute.work_class = wc; /* Tell rest of Answering Service */ end; end GET_WC; /* ================================================================ */ MOVE_USERS: proc; /* Move all users with processes to new work_classes. */ do i = 1 to anstbl.current_size; utep = addr (anstbl.entry (i)); /* get ptr to answer table entry */ call SET_WC; end; do i = 1 to dutbl.current_size; utep = addr (dutbl.entry (i)); /* get ptr to daemon table entry */ call SET_WC; end; do i = 1 to autp -> autbl.current_size; utep = addr (autp -> autbl.entry (i)); /* get ptr to autbl entry */ call SET_WC; end; end MOVE_USERS; /* ========================================================== */ SET_WC: proc; /* IP to set hardcore wc from ate.work_class */ dcl wc fixed bin; dcl old_wc fixed bin; if ute.active >= NOW_HAS_PROCESS then do; /* Tell hardcore */ if ute.proc_id = anstbl.as_procid then return; /* Dont bother Initializer */ wc = ute.work_class; if ^as_data_$debug_flag then do; call hphcs_$set_process_work_class (ute.proc_id, wc, old_wc, code); if code = 0 then ; else if code = error_table_$bad_work_class then do; /* Somebody undid compromise set */ if ^force_compromise then go to MAIN_RETURN; /* have failed */ call DEFINE_COMPROMISE; /* Willing to retry this once */ call hphcs_$set_process_work_class (ute.proc_id, wc, old_wc, code); if code ^= 0 then go to MAIN_RETURN; end; else if code = error_table_$bad_processid then code = 0; /* So What. */ else /* New errcode invented? */ go to MAIN_RETURN; end; end; end SET_WC; %page; DEFINE_COMPROMISE: proc; /* IP to define all 16 work classes */ dcl dci fixed bin; dcl 1 com_wci like work_class_info aligned; unspec (com_wci) = ""b; /* clear structure */ com_wci.set_user_wc = "1"b; /* set user work classes */ com_wci.set_sked_mode = "1"b; /* Force the mode, */ com_wci.deadline_mode = "0"b; /* to percent mode for safety */ do dci = 1 to 16; com_wci.user_wc_defined (dci) = "1"b; /* all user wc will be defined */ com_wci.user_wc_min_pct (dci) = 6; /* each wc given 6% */ com_wci.resp1 (dci) = default_r1; com_wci.quantum1 (dci) = default_q1; com_wci.resp2 (dci) = default_r2; com_wci.quantum2 (dci) = default_q2; com_wci.realtime (dci) = "0"b; com_wci.governed (dci) = "0"b; com_wci.user_wc_max_pct (i) = 0; end; com_wci.version = WCI_version_3; /* set version number */ if ^as_data_$debug_flag then do; call hphcs_$define_work_classes (addr (com_wci), code); if code ^= 0 then do; /* Heads will roll. */ go to MAIN_RETURN; end; end; end DEFINE_COMPROMISE; %page; %include absentee_user_table; %page; %include answer_table; %page; %include as_data_; %page; %include as_data_definitions_; %page; %include dialup_values; %page; %include daemon_user_table; %page; %include mgt; %page; %include user_attributes; %page; %include user_table_entry; %page; %include user_table_header; %page; %include work_class_info; %page; /* BEGIN MESSAGE DOCUMENTATION Message: reassign_work_classes_: load control group "XXX" not found in mgt for user PERSON.PROJECT.TAG. .br reassign_work_classes_: mgt clobbered, contact system administrator. S: as (severity2). T: At shift change time, or after a "maxu auto" command. M: Some logged in user's load control group has apparently disappeared from the mgt. If the load control group specified in the message is valid, then the mgt has been destroyed. Otherwise, the user's answer table entry has been destroyed. All users will remain in their current work classes. A: $contact_sa Message: reassign_work_classes_: undefined work class DD required by load control group XXX .br reassign_work_classes_: mgt clobbered, contact system administrator. S: as (severity2) T: At shift change time, or after a "maxu auto" command. M: There is an inconsistency in the mgt. Probably the mgt has been destroyed. All users will remain in their current work class. A: $contact_sa Message: reassign_work_classes_: process NNN remained in work class NN S: as (severity1) T: At shift change time, or after a "maxu auto" command. M: Some privileged user has interfered with the Answering Service's attempt to define a new set of work classes. The Answering Service will automatically retry the reassignment of work classes. A: $ignore Message: reassign_work_classes_: no work classes defined on current shift. S: as (severity2) T: At shift change time, or after a "maxu auto" command. M: The table in the mgt that should define the work classes for the current shift has not been filled in. Probably a new shift has been added to the installation_parms segment, but the work classes for that shift have not been specified in the mgt. All users will be placed in a single work class. A: $ignore END MESSAGE DOCUMENTATION */ end reassign_work_classes_;  syserr_log_man_.pl1 08/05/87 0800.0r 08/04/87 1540.6 334314 /****^ *********************************************************** * * * Copyright, (C) Honeywell Information Systems Inc., 1984 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-06-05,GJohnson), approve(86-06-05,MCR7387), audit(86-06-10,Martinson), install(86-07-11,MR12.0-1092): Correct error message documentation. END HISTORY COMMENTS */ /* * SYSERR_LOG_MAN_ * * Entry points to manage automatic copying of syserr log * into ring 4 by Initializer process. * * Modification history: * 75-10-28, LJS: Rewritten to use iox_/vfile_ * 76-04-15, LJS: Modified for minor bugs * 79-02-01, T. Casey: Modified to print bad args if ring 0 rejects them * 79-05-06, T. Casey: Modified to check for message time in future when copying from LOG partition. * 81-06-15, T. Casey: Modified for MR9.0 for new wakeup priorities. * 81-11-20, E. N. Kittlitz: Modified for user_table_entry conversion. * 82-05-02, E. N. Kittlitz: New AS initialization * 82-09-14, E. N. Kittlitz: Quick fix: allow init after startup * 82-10-28, E. N. Kittlitz: Fixup ucs. * 84-10-15, W. Olin Sibert: Rewritten for new log management * 84-10-16, WOS: Changed to create >sc1>syserr_log if not there already * 84-11-11, WOS: Changed to do syserr message recovery for mc_con_rec_ * 84-11-11, WOS: Changed to do syserrlog_segdamage_scan_ work, too. * 84-12-14, WOS: Changed to be more polite about announcing thresholds * 85-02-20, EJ Sharpe: changed segdamage scan code to use real data class * instead of first word of binary. Also fix references to (write alarm)_flags masks. * 85-03-01, EJ Sharpe: fix as_copy_log to set new timer only when invoked by a timer * also insert "verify_sequence" subroutine */ /* format: style4 */ syserr_log_man_: procedure (); declare P_log_name char (*) parameter; /* OBSOLETE */ declare P_page_threshold fixed bin parameter; /* Pages outstanding */ declare P_copy_interval fixed bin (71) parameter; /* Microseconds */ declare P_recovery_flag bit (1) aligned parameter; /* For turning syserr recovery on/off */ declare P_recovery_limit fixed bin (35) parameter; /* First message we have to recover */ declare 1 copy_start aligned automatic, /* Metering info structure */ 2 time fixed bin (71), 2 vcpu fixed bin (71), 2 pf fixed bin (35); declare 1 copy_finish aligned automatic like copy_start; declare 1 static aligned internal static, /* Static info for copying */ 2 initialized bit (1) aligned init ("0"b), /* Set after parameters initialized */ 2 disabled bit (1) aligned init ("0"b), /* If true, an error occurred, and copying was disabled */ 2 channel fixed bin (71) init (0), /* Event channel for signalling copies */ 2 interval fixed bin (71) init (0), /* Number of seconds between timed copies (or zero) */ 2 threshold fixed bin init (0), /* Number of pages filled between signals from ring 0 */ 2 total_copies fixed bin (35) init (0), /* Total number of calls to $as_copy_log */ 2 null_copies fixed bin (35) init (0), /* Total number of copy attempts where the log was empty */ 2 timed_copies fixed bin (35) init (0), /* Total number of copys invoked by alarm timer */ 2 total_messages fixed bin (35) init (0), /* Total number of messages copied */ 2 meters aligned like copy_start; /* Time & PF meters for copying */ /* NOTE: This flag is declared separately, so it will not be reset if AS log copying is restarted while console recovery is active. */ declare static_recovery_flag bit (1) aligned internal static init ("0"b); declare static_recovery_limit fixed bin (35) internal static init (0); declare argl fixed bin (21); declare argp pointer; declare code fixed bin (35); declare current_log_empty bit (1) aligned; declare log_write_data_ptr pointer; declare n_args fixed bin; declare based_char8 char (8) based; declare based_ptr pointer based; declare error_table_$no_m_permission fixed bin (35) external static; declare error_table_$noentry fixed bin (35) external static; declare error_table_$notadir fixed bin (35) external static; declare log_data_$syserr_log_dir char (168) external static; declare log_data_$syserr_log_history_dir char (168) external static; declare log_data_$syserr_log_name char (32) external static; declare arg_count_ entry options (variable); declare as_any_other_handler_ entry (char (*), entry, label, label); declare as_any_other_handler_$no_cleanup entry (char (*), label); declare as_dump_ entry (char (*)); declare binary_segmsg_util_ entry (pointer) returns (char (250)); declare binary_segmsg_util_$interpret_pvname entry (pointer) returns (char (32)); declare cpu_time_and_paging_ entry (fixed bin (35), fixed bin (71), fixed bin (35)); declare cu_$arg_ptr entry (fixed bin, ptr, fixed bin (21), fixed bin (35)); declare cu_$level_get entry (fixed bin (3)); declare expand_pathname_ entry (char (*), char (*), char (*), fixed bin (35)); declare get_group_id_$tag_star entry () returns (char (32)); declare get_system_free_area_ entry () returns (ptr); declare hcs_$append_branchx entry (char (*), char (*), fixed bin (5), (3) fixed bin (3), char (*), fixed bin (1), fixed bin (1), fixed bin (24), fixed bin (35)); declare hcs_$chname_file entry (char (*), char (*), char (*), char (*), fixed bin (35)); declare hcs_$get_user_access_modes entry (char (*), char (*), char (*), fixed bin (3), bit (36) aligned, bit (36) aligned, fixed bin (35)); declare hcs_$replace_dir_acl entry (char (*), char (*), pointer, fixed bin, bit (1), fixed bin (35)); declare hcs_$replace_inacl entry (char (*), char (*), pointer, fixed bin, bit (1), fixed bin (3), fixed bin (35)); declare hcs_$status_minf entry (char (*), char (*), fixed bin (1), fixed bin (2), fixed bin (24), fixed bin (35)); declare hcs_$terminate_noname entry (pointer, fixed bin (35)); dcl initiate_file_ entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35)); declare ioa_ entry options (variable); declare ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)); declare ipc_$decl_ev_call_chn entry (fixed bin (71), entry, pointer, fixed bin, fixed bin (35)); declare ipc_$drain_chn entry (fixed bin (71), fixed bin (35)); declare ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35)); declare log_initiate_ entry (char (*), char (*), fixed bin, pointer, fixed bin (35)); declare log_list_history_$single_dir entry (char (*), char (*), pointer, fixed bin (35)); declare log_move_$message entry (pointer, pointer, pointer, fixed bin (35)); declare log_name_$name entry (char (*), fixed bin (71)) returns (char (32)); declare log_position_$next_message entry (pointer, pointer, bit (1) aligned); declare log_write_$close entry (pointer, fixed bin (35)); declare log_write_$open_for_migrate entry (char (*), char (*), bit (1) aligned, pointer, fixed bin (35)); declare mc_con_rec_$queue_log_message entry (pointer, bit (1) aligned); declare sys_log_ entry () options (variable); declare sys_log_$error_log entry () options (variable); declare syserr_log_man_$as_copy_log entry (); declare timer_manager_$alarm_wakeup entry (fixed bin (71), bit (2), fixed bin (71)); declare timer_manager_$reset_alarm_wakeup entry (fixed bin (71)); declare unique_chars_ entry (bit (*)) returns (char (15)); declare hphcs_$new_syserr_copy_init entry (fixed bin (71), fixed bin); declare hphcs_$new_syserr_info entry (fixed bin (71), bit (1) aligned); declare hphcs_$new_syserr_swap_logs entry (fixed bin (35)); declare hphcs_$new_syserr_reuse_log entry (fixed bin (35)); declare hphcs_$new_syserr_recovery entry (bit (1) aligned); declare hphcs_$new_syserr_verify_sequence entry (fixed bin (35), fixed bin (35), fixed bin (35)); declare WHOAMI char (32) internal static options (constant) init ("syserr_log_man_"); declare RELATIVE_SECONDS bit (2) internal static options (constant) init ("11"b); declare ONE_MINUTE fixed bin (35) internal static options (constant) init (60); declare ONE_DAY fixed bin (35) internal static options (constant) init (86400); declare DEFAULT_PAGE_THRESHOLD fixed bin internal static options (constant) init (10); declare DEFAULT_COPY_INTERVAL fixed bin (35) internal static options (constant) init (3600); /* One hour */ declare any_other condition; declare cleanup condition; declare (addr, binary, clock, dimension, float, mod, null, substr, unspec) builtin; %page; syserr_log_man_$as_copy_init: entry (P_log_name, P_page_threshold); /* COMPATIBILITY ENTRYPOINT: Supplies default value for time interval */ call syserr_log_man_$start_copying (P_page_threshold, (60 * 60)); return; syserr_log_man_$restart_copying: entry (); /* Entrypoint to restart after errors */ call syserr_log_man_$start_copying ((static.threshold), (static.interval)); return; syserr_log_man_$console_recovery: entry (P_recovery_flag, P_recovery_limit); /* This entrypoint, called only by mc_con_rec_, is called to turn on the syserr_log_man_ message printing/routing mechanism */ static_recovery_flag = P_recovery_flag; static_recovery_limit = P_recovery_limit; call hphcs_$new_syserr_recovery (static_recovery_flag); return; %page; syserr_log_man_$start_copying: entry (P_page_threshold, P_copy_interval); /* This entrypoint initializes the log copying mechanism, setting up the static channel name and other information */ if ^sc_stat_$Multics_typed then do; call sys_log_ (SL_LOG_BEEP, "^a: Called too early.", WHOAMI); return; end; on condition (any_other) call as_any_other_handler_$no_cleanup (WHOAMI, INIT_ERROR_EXIT); static.disabled = "1"b; /* Make it appear off */ if (static.channel ^= 0) then /* Stop it if it's happening now */ call stop_copying ("0"b); call create_ipc_channel (); call set_threshold_values (); call get_history_dir (); call verify_sequence (); static.disabled = "0"b; /* Nothing has gone wrong */ call syserr_log_man_$as_copy_log (); /* Get the copying started */ if (static.threshold ^= 0) then /* This signal comes from ring zero */ call hphcs_$new_syserr_copy_init (static.channel, static.threshold); if (static.interval ^= 0) then call timer_manager_$alarm_wakeup (static.interval, RELATIVE_SECONDS, static.channel); static.initialized = "1"b; /* OK to copy now */ INIT_ERROR_EXIT: return; %page; create_ipc_channel: procedure (); call ipc_$create_ev_chn (static.channel, code); /* Create copying event channel */ if (code ^= 0) then do; INIT_IPC_CHANNEL_ERROR: call sys_log_$error_log (SL_LOG, code, WHOAMI, "Could not create event channel.^/Automatic syserr log copying not initialized."); call as_dump_ (WHOAMI); call stop_copying ("1"b); goto INIT_ERROR_EXIT; end; call ipc_$decl_ev_call_chn (static.channel, syserr_log_man_$as_copy_log, null (), SYSERR_COPY_PRIO, code); if (code ^= 0) then goto INIT_IPC_CHANNEL_ERROR; return; end create_ipc_channel; %page; set_threshold_values: procedure (); declare threshold_comment char (40) varying; declare interval_comment char (40) varying; if (P_page_threshold > 0) & (P_page_threshold < 128) then do; static.threshold = P_page_threshold; threshold_comment = ""; end; else if (P_page_threshold = -1) then do; /* No copying */ static.threshold = 0; threshold_comment = " (disabled)"; end; else do; static.threshold = DEFAULT_PAGE_THRESHOLD; if (P_page_threshold = 0) then threshold_comment = " (default)"; else threshold_comment = " (installation_parm value invalid)"; end; if (P_copy_interval >= ONE_MINUTE) & (P_copy_interval <= ONE_DAY) then do; static.interval = P_copy_interval; interval_comment = ""; end; else if (P_copy_interval = -1) then do; /* No timers in use */ static.interval = 0; interval_comment = " (disabled)"; end; else do; static.interval = DEFAULT_COPY_INTERVAL; if (P_page_threshold = 0) then interval_comment = " (default)"; else interval_comment = " (installation_parm value invalid)"; end; call sys_log_ (SL_LOG_SILENT, "^a: Syserr thresholds: ^d page^[s^]^a, ^d second^[s^]^a", WHOAMI, static.threshold, (static.threshold ^= 1), threshold_comment, static.interval, (static.interval ^= 1), interval_comment); return; end set_threshold_values; %page; get_history_dir: procedure (); declare my_ring fixed bin (3); declare dir_type fixed bin (2); declare dir_mode bit (36) aligned; declare history_dname char (168); declare history_ename char (32); declare new_ename char (32); declare history_rings (3) fixed bin (3); declare 1 history_acl (4) aligned like directory_acl_entry; declare 1 history_inacl (4) aligned like segment_acl_entry; call expand_pathname_ (log_data_$syserr_log_history_dir, history_dname, history_ename, (0)); /* Guaranteed to work */ call cu_$level_get (my_ring); call hcs_$status_minf (history_dname, history_ename, 1, dir_type, (0), code); if (code = error_table_$noentry) then goto CREATE_HISTORY_DIR; else if (code ^= 0) then goto REPLACE_HISTORY_DIR; else if (dir_type ^= 2) then do; /* DIRECTORY */ code = error_table_$notadir; goto REPLACE_HISTORY_DIR; end; call hcs_$get_user_access_modes (history_dname, history_ename, "", my_ring, dir_mode, (""b), code); if (code ^= 0) then goto REPLACE_HISTORY_DIR; else if (dir_mode ^= SMA_ACCESS) then do; code = error_table_$no_m_permission; goto REPLACE_HISTORY_DIR; end; else return; /* All is OK: History dir exists, and we have SMA */ REPLACE_HISTORY_DIR: call sys_log_$error_log (SL_LOG, code, WHOAMI, "Could not use old syserr history dir:^3x^a>^a", history_dname, history_ename); new_ename = "syserr_log." || unique_chars_ (""b); call hcs_$chname_file (history_dname, history_ename, history_ename, new_ename, code); if (code = 0) then call sys_log_ (SL_LOG, "^a: Renamed ^a>^a to ^a", WHOAMI, history_dname, history_ename, new_ename); else call sys_log_$error_log (SL_LOG_BEEP, code, WHOAMI, "Cannot rename ^a>^a to ^a", history_dname, history_ename, new_ename); CREATE_HISTORY_DIR: history_rings (*) = my_ring; unspec (history_acl) = ""b; history_acl (1).access_name = get_group_id_$tag_star (); history_acl (1).mode = SMA_ACCESS; history_acl (2).access_name = "*.SysDaemon.*"; history_acl (2).mode = S_ACCESS; history_acl (3).access_name = "*.SysMaint.*"; history_acl (3).mode = S_ACCESS; history_acl (4).access_name = "*.SysAdmin.*"; history_acl (4).mode = S_ACCESS; unspec (history_inacl) = ""b; history_inacl (*).access_name = history_acl (*).access_name; history_inacl (*).mode = R_ACCESS; history_inacl (1).mode = RW_ACCESS; call hcs_$append_branchx (history_dname, history_ename, SMA_ACCESS_BIN, history_rings, (get_group_id_$tag_star ()), 1, 0, 0, code); if (code ^= 0) then do; call sys_log_$error_log (SL_LOG_BEEP, code, WHOAMI, "Could not create ^a>^a.^/Automatic syserr log copying not initialized.", history_dname, history_ename); call as_dump_ (WHOAMI); call stop_copying ("1"b); goto INIT_ERROR_EXIT; end; else call sys_log_ (SL_LOG, "^a: Created ^a>^a", WHOAMI, history_dname, history_ename); call hcs_$replace_dir_acl (history_dname, history_ename, addr (history_acl), dimension (history_acl, 1), "0"b, code); if (code ^= 0) then call sys_log_$error_log (SL_LOG, code, WHOAMI, "Cannot replace ACL on ^a>^a", history_dname, history_ename); call hcs_$replace_inacl (history_dname, history_ename, addr (history_inacl), dimension (history_inacl, 1), "0"b, my_ring, code); if (code ^= 0) then call sys_log_$error_log (SL_LOG, code, WHOAMI, "Cannot replace initial ACL on ^a>^a", history_dname, history_ename); return; end get_history_dir; %page; verify_sequence: procedure (); /* This procedure functions only once per bootload. It ensures that the sequence numbers in the log partition (paged ring 0 log) are larger than those already in the history log segments. (The sequence may have been reset to 1000000 due to a clearing of the partition). */ declare new_sequence_start fixed bin (35); declare bit_count fixed bin (24); declare log_idx fixed bin; declare system_area_ptr pointer; declare system_area area based (system_area_ptr); if static.initialized then /* one time only */ return; log_segment_ptr = null (); log_read_data_ptr = null (); call log_list_history_$single_dir (log_data_$syserr_log_history_dir, log_data_$syserr_log_name, log_read_data_ptr, code); if (code ^= 0) then do; call sys_log_$error_log (SL_LOG_BEEP, code, WHOAMI, "Error obtaining syserr log history."); call stop_copying ("1"b); goto INIT_ERROR_EXIT; end; if (log_read_data_ptr = null ()) then return; /* no history, any sequence OK */ if log_read_data.n_segments < 1 then goto EXIT; do log_idx = 1 to log_read_data.n_segments; call initiate_file_ (log_data_$syserr_log_history_dir, log_read_data.ename (log_idx), R_ACCESS, log_segment_ptr, bit_count, code); if code = 0 then goto log_initiated; end; /* drop through to here if we can't initiate any log segments */ call sys_log_ (SL_LOG_BEEP, "^a: Unable to open syserr log in ^a.", WHOAMI, log_data_$syserr_log_history_dir); call stop_copying ("1"b); goto ERROR_RETURN; /* arrive here when we find a log history initiated */ log_initiated: new_sequence_start = (log_idx * 100000) + log_segment.last_sequence; /* new starting point if we need to adjust sequence numbers */ /* 100000 is number we'll allow per log segment */ call hphcs_$new_syserr_verify_sequence (log_segment.last_sequence, new_sequence_start, code); if (code ^= 0) then do; call sys_log_$error_log (SL_LOG_BEEP, code, WHOAMI, "Error verifying log partition sequence numbers."); call stop_copying ("1"b); goto ERROR_RETURN; end; EXIT: system_area_ptr = get_system_free_area_ (); free log_read_data in (system_area); return; ERROR_RETURN: system_area_ptr = get_system_free_area_ (); free log_read_data in (system_area); goto INIT_ERROR_EXIT; end verify_sequence; %page; syserr_log_man_$as_copy_log: entry (); /* Entry point called either via a wakeup from ring 0 or a call from the Initializer process (as a command) */ if ^static.initialized then /* Out of sequence, Jack */ return; log_segment_ptr = null (); /* Initialize for cleanup handler */ log_write_data_ptr = null (); on condition (any_other) call as_any_other_handler_ (WHOAMI, copy_error_cleanup, COPY_FINISHED, COPY_ERROR_EXIT); on condition (cleanup) call copy_cleanup (); if static.disabled then do; /* Make sure it's disabled */ call stop_copying ("0"b); return; end; static.total_copies = static.total_copies + 1; copy_start.time = clock (); /* Set up for metering */ call cpu_time_and_paging_ (copy_start.pf, copy_start.vcpu, (0)); call copy_syserr_once (); /* If there's a leftover one waiting, copy it out */ call hphcs_$new_syserr_info ((0), current_log_empty); if current_log_empty then static.null_copies = static.null_copies + 1; /* Meter the event */ else do; /* If there's anything in the current log, */ call hphcs_$new_syserr_swap_logs (code); /* swap it with the empty one, and copy */ if (code = 0) then call copy_syserr_once (); else call sys_log_$error_log (SL_LOG, code, WHOAMI, "Attempting to swap syserr log segments."); end; call ipc_$drain_chn (static.channel, (0)); /* Drain anything that's left */ call arg_count_ (n_args); if (static.interval ^= 0) & (n_args = 1) then do; /* If timed, and got possible event_call_info, reschedule */ call cu_$arg_ptr (1, argp, argl, code); if code ^= 0 then goto COPY_FINISHED; begin; /* new frame to establish new any_other handler */ on any_other goto COPY_FINISHED; event_call_info_ptr = argp -> based_ptr; if addr (event_call_info.message) -> based_char8 = "alarm___" then do; static.timed_copies = static.timed_copies + 1; call timer_manager_$alarm_wakeup (static.interval, RELATIVE_SECONDS, static.channel); end; end; /* begin block */ end; COPY_FINISHED: call copy_cleanup (); copy_finish.time = clock (); /* Collect final metering numbers */ call cpu_time_and_paging_ (copy_finish.pf, copy_finish.vcpu, (0)); static.meters = static.meters + (copy_finish - copy_start); /* And add them in */ return; COPY_ERROR_EXIT: call copy_error_cleanup (); return; %page; copy_syserr_once: procedure (); declare log_swap_time fixed bin (71); declare old_log_name char (32); declare segment_finished bit (1) aligned; call hphcs_$new_syserr_info (log_swap_time, ("0"b)); if (log_swap_time = 0) then /* Nothing for us to copy */ return; old_log_name = log_name_$name (log_data_$syserr_log_name, log_swap_time); call log_initiate_ (log_data_$syserr_log_dir, old_log_name, 10, log_segment_ptr, code); if (code ^= 0) then do; call sys_log_$error_log (SL_LOG, code, WHOAMI, "Cannot initiate log ^a>^a", log_data_$syserr_log_dir, old_log_name); call stop_copying ("1"b); return; end; call log_write_$open_for_migrate (log_data_$syserr_log_history_dir, log_data_$syserr_log_name, "1"b, log_write_data_ptr, code); if (code ^= 0) then do; call sys_log_$error_log (SL_LOG, code, WHOAMI, "Cannot open history log ^a>^a", log_data_$syserr_log_history_dir, log_data_$syserr_log_name); call stop_copying ("1"b); return; end; segment_finished = "0"b; log_message_ptr = null (); /* Start at the first message */ do while (^segment_finished); call log_position_$next_message (log_segment_ptr, log_message_ptr, ("0"b)); if (log_message_ptr ^= null ()) then do; call route_syserr_message (); /* For our friends in the recovery room */ call log_move_$message (log_write_data_ptr, log_message_ptr, (null ()), code); if (code ^= 0) then do; call sys_log_$error_log (SL_LOG, code, WHOAMI, "Cannot migrate message #^d", log_message.sequence); call stop_copying ("1"b); return; end; static.total_messages = static.total_messages + 1; end; else segment_finished = "1"b; /* Quit if no next message */ end; call hphcs_$new_syserr_reuse_log (code); /* Return the one we just copied */ if (code ^= 0) then call sys_log_$error_log (SL_LOG, code, WHOAMI, "Calling hphcs_$new_syserr_reuse_log."); return; end copy_syserr_once; %page; route_syserr_message: procedure (); declare data_code fixed bin; /* This procedure is responsible for sending syserr messages out to another destination if console recovery is happening. It also handles special routing for messages sacred to the Answering Service, replacing the syserrlog_segdamage_scan_. */ /* Additionally, this guy could take care of all RCP messages, if only it knew how... */ if (dimension (log_message.data, 1) = 0) then /* No binary info */ goto NO_BINARY_DATA; if log_message.data_class = "syserr" then do; data_code = binary (log_message.data (1), 36); /* See whether it's one we recognize */ if (data_code < 1) | (data_code >= SB_end_of_table) then goto NO_BINARY_DATA; /* Check first for segment damage messages */ if (substr (syserr_binary_seg_damage_mask, data_code, 1)) then do; call sys_log_ (SL_LOG, "Syserr msg #^d: ^a", log_message.sequence, log_message.text); call sys_log_ (SL_LOG, "^3xSegment: ^a", binary_segmsg_util_ (addr (log_message.data (2)))); end; /* Then check for volume damage messages */ else if (substr (syserr_binary_vol_damage_mask, data_code, 1)) then do; call sys_log_ (SL_LOG, "Syserr msg #^d: ^a", log_message.sequence, log_message.text); call sys_log_ (SL_LOG, "^3xVolume: ^a", binary_segmsg_util_$interpret_pvname (addr (log_message.data (2)))); end; else goto NO_BINARY_DATA; end; else if log_message.data_class = SB_segdamage_data_class then do; call sys_log_ (SL_LOG, "Syserr msg #^d: ^a", log_message.sequence, log_message.text); call sys_log_ (SL_LOG, "^3xSegment: ^a", binary_segmsg_util_ (addr (log_message.data (1)))); end; else if log_message.data_class = SB_voldamage_data_class then do; call sys_log_ (SL_LOG, "Syserr msg #^d: ^a", log_message.sequence, log_message.text); call sys_log_ (SL_LOG, "^3xVolume: ^a", binary_segmsg_util_$interpret_pvname (addr (log_message.data (1)))); end; NO_BINARY_DATA: if ^static_recovery_flag then /* Not in recovery mode */ return; if (log_message.sequence < static_recovery_limit) then /* Not yet a message we care about */ return; if ^write_flags (mod (log_message.severity, 10)) then /* Not a printable message */ return; call mc_con_rec_$queue_log_message /* If it passes all the tests, send it back */ (log_message_ptr, (alarm_flags (mod (log_message.severity, 10)))); return; end route_syserr_message; %page; syserr_log_man_$print_meters: entry (); call ioa_ ("Syserr copy information:"); call ioa_ ("^3xTotal copies:^31t^7d (^d null) (^d timed)", static.total_copies, static.null_copies, static.timed_copies); call ioa_ ("^3xMessages copied:^31t^7d", static.total_messages); call ioa_ ("^3xCopy channel:^31t^24.3b", unspec (static.channel)); call ioa_ ("^3xCopying is:^31t^[dis^;en^]abled", static.disabled); call ioa_ ("^3xCopy interval:^31t^[^7d seconds^;[disabled]^]", (static.interval ^= 0), static.interval); call ioa_ ("^3xCopy threshold:^31t^[^7d pages^;[disabled]^]", (static.threshold ^= 0), static.threshold); call ioa_ ("^3xSyserr recovery is:^31t^[dis^;en^]abled", static_recovery_flag); call ioa_ ("^/Syserr copying meters:"); call ioa_ ("^24t Real time VCPU time Page faults"); call ioa_ ("^3xTotal:^24t^14.4f^14.4f^14.4f", seconds_per (static.meters.time, 1), seconds_per (static.meters.vcpu, 1), instances_per (static.meters.pf, 1)); call ioa_ ("^3xAve/copy:^24t^14.4f^14.4f^14.4f", seconds_per (static.meters.time, static.total_copies), seconds_per (static.meters.vcpu, static.total_copies), instances_per (static.meters.pf, static.total_copies)); call ioa_ ("^3xAve/message:^24t^14.4f^14.4f^14.4f", seconds_per (static.meters.time, static.total_messages), seconds_per (static.meters.vcpu, static.total_messages), instances_per (static.meters.pf, static.total_messages)); call ioa_ (""); return; seconds_per: procedure (P_time, P_count) returns (float bin); declare P_time fixed bin (71) parameter; declare P_instances fixed bin (35) parameter; declare P_count fixed bin (35) parameter; if (P_count = 0) then return (0.0e0); else return (float (P_time) / (1.0e6 * float (P_count))); instances_per: entry (P_instances, P_count) returns (float bin); if (P_count = 0) then return (0.0e0); else return (float (P_instances) / float (P_count)); end seconds_per; %page; copy_error_cleanup: procedure (); call stop_copying ("1"b); call copy_cleanup (); return; end copy_error_cleanup; copy_cleanup: procedure (); if (log_segment_ptr ^= null ()) then call hcs_$terminate_noname (log_segment_ptr, (0)); log_segment_ptr = null (); if (log_write_data_ptr ^= null ()) then call log_write_$close (log_write_data_ptr, (0)); log_write_data_ptr = null (); return; end copy_cleanup; %page; /* Internal procedure to disable log copying should it be necessary */ stop_copying: procedure (give_message); declare give_message bit (1) parameter; /* If ON, Put message in sys_log_ */ if give_message then call sys_log_$error_log (SL_LOG, 0, WHOAMI, "Automatic syserr log copying disabled."); call hphcs_$new_syserr_copy_init (0, 0); if (static.interval ^= 0) then call timer_manager_$reset_alarm_wakeup (static.channel); call ipc_$delete_ev_chn (static.channel, (0)); static.channel = 0; static.interval = 0; static.threshold = 0; static.disabled = "1"b; /* Mark it as turned off */ return; end stop_copying; /* format: off */ %page; %include access_mode_values; %page; %include acl_structures; %page; %include sys_log_constants; %page; %include as_data_; %page; %include as_data_definitions_; %page; %include as_wakeup_priorities; %page; %include sc_stat_; %page; %include syserr_actions; %page; %include syserr_binary_def; %page; %include log_segment; %page; %include log_message; %page; %include log_read_data; %page; %include event_call_info; %page; /* BEGIN MESSAGE DOCUMENTATION Message: Syserr msg #NNNNN: MESSAGE-TEXT .br Segment: PATHNAME .br Volume: VOLUME-NAME S: as (severity0) T: $run M: This message is a repetition of a syserr log message which reported damage to a segment or a physical volume. There will always be two such messages in sequence, a "Syserr msg. #XXX" message and either a "Volume:" or "Segment:" message. The first message is a copy of the logged syserr message of the given number; the second message identifies the volume or segment mentioned. This allows segments damaged by system action, or segments in which the physical volume salvager observed damage, to be identified unambiguously. These messages are logged in the Answering Service log at answering service startup time and every accounting update. A: Correlate volume salvager messages with previous printed volume salvager output to obtain more information about segment damage detected by the volume salvager. For those segments which are mentioned, which have not been deleted, or are not in deleted directories (the "Segment:" message says if this is the case) contact persons responsible for the ownership of that segment, and undertake recovery procedures if needed. Message: syserr_log_man_: Called too early. S: as (severity2) T: $init M: $err A: $notify Message: syserr_log_man_: Could not create event channel. Automatic syserr log copying not initialized. ERROR MESSAGE S: as (severity1) T: $init M: $err A: $notify Message: syserr_log_man_: Automatic syserr log copying disabled. S: as (severity1) T: $run M: Automatic copying of syserr messages into >sc1>syserr_log has been stopped, due to an error in the copying process. Another message will have been printed prior to this one, describing the problem. An Answering Service dump usually will have been created, as well. A: If the error is recoverable (temporary disk error, record quota overflow, etc.-- see the previous message(s) to make that decision), syserr copying can be restarted by issuing the following command in admin mode (ur using send_admin_command): .in +5 syserr_log_man_$restart_copying .in -5 If the problem persists, delete the first segment (first in the list produced by the list command) in >sc1>syserr_log, and restart copying. If the problem still persists, rename or delete >sc1>syserr_log and reboot; the directory will be re-created automatically. The display_log_segment command can be used to examine individual log segments for damage. Message: syserr_log_man_: Syserr thresholds: NNN pages (COMMENT), NNN seconds (COMMENT) S: as (severity0) T: $init M: These are the thresholds for when Answering Service syserr copying will be performed. Each value may be followed by a comment; the comment "(default)" indicates that the installation_parms value was zero, indicating that a default value is used. The comment "(disabled)" indicates that the installation_parms value was set to disable this log copying mechanism. The comment "(installation_parms value invalid)" means just that; the value in installation_parms must be updated, and meantime, a default is applied. A: $note Message: syserr_log_man_: Bad syserr_copy_interval value NNN seconds, using 3600 seconds instead. S: as (severity1) T: $init M: The syserr copy interval in installation_parms is invalid. A: Use ed_installation_parms to correct it. A default will be used until then. Message: syserr_log_man_: Could not use old syserr history dir: >sc1>syserr_log ERROR MESSAGE S: as (severity1) T: $init M: The syserr log history directory (>sc1>syserr_log) cannot be used; the reason is indicated by the error message. The system will attempt to rename it and create a new one; any existing log segments may be moved from the old directory into the new (current) one once the system comes up if the renaming is successful. A: $notify The condition causing the error should be corrected, and the system re-booted. Message: syserr_log_man_: Renamed >sc1>syserr_log to NEW-NAME S: as (severity1) T: $init M: Indicates that the history directory has been renamed after an error in attempting to use it. Old log segments can be moved from here back into >sc1>syserr_log. A: $notify Message: syserr_log_man_: Cannot rename PATHNAME to NEW-NAME. ERROR MESSAGE S: as (severity1) T: $init M: $err A: $notify Message: syserr_log_man_: Created >sc1>syserr_log S: as (severity0) T: $init M: The syserr history directory, >sc1>syserr_log, was created automatically when it was found missing during initialization. This is normal during a cold boot, but an error at all other times, since it indicates that the directory was missing. A: $notify Message: syserr_log_man_: Could not create >sc1>syserr_log. Automatic syserr log copying not initialized. ERROR MESSAGE S: as (severity1) T: $init M: The syserr history directory was found to be missing during initialization, and a new one could not be created; this probably indicates file system damage. A: $notify Message: syserr_log_man_: Cannot replace ACL on >sc1>syserr_log. ERROR MESSAGE S: as (severity1) T: $init M: $err A: $notify Message: syserr_log_man_: Cannot replace initial ACL on >sc1>syserr_log. ERROR MESSAGE S: as (severity1) T: $init M: $err A: $notify Message: syserr_log_man_: Attempting to swap syserr log segments. ERROR MESSAGE S: as (severity1) T: $init M: $err A: $notify Message: syserr_log_man_: Cannot initiate log LOG-PATHNAME. ERROR MESSAGE S: as (severity1) T: $init M: $err A: $notify Message: syserr_log_man_: Cannot open history log LOG-PATHNAME. ERROR MESSAGE S: as (severity1) T: $init M: $err A: $notify Message: syserr_log_man_: Cannot migrate message #NNNNNNN S: as (severity1) T: $init M: $err A: $notify Message: syserr_log_man_: Calling hphcs_$new_syserr_reuse_log ERROR MESSAGE S: as (severity1) T: $init M: $err A: $notify Message: syserr_log_man_: Error obtaining syserr log history. MESSAGE S: as (severity2) T: $init M: To verify syserr message sequence numbers will continue to increase despite clearing of the log partition, the AS must look at the existing log segments. However, some inconsistancy in the first history directory prevented this. (>sc1>syserr_log). A: Fix any problems and issue the command "syserr_log_man_$restart_copying" from admin mode in the initializer process. Message: syserr_log_man_: Unable to open syserr log in PATH. S: as (severity2) T: $init M: To verify syserr message sequence numbers will continue to increase despite clearing of the log partition, the AS must look at the existing log segments. However, some inconsistancy in the first history directory prevented this. (>sc1>syserr_log). A: $notify Fix any problems in the syserr log history dir and issue the command "syserr_log_man_$restart_copying" from admin mode in the initializer process. Message: syserr_log_man_: Error verifying log partition sequence numbers. S: as (severity2) T: $init M: $err There is some error in the log partition which prevents adjustment of the sequence numbers. A: $notify END MESSAGE DOCUMENTATION */ end syserr_log_man_;  operator_com_channel_cmds_.pl1 10/10/88 1513.4rew 10/07/88 1232.4 72198 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-12-05,MSharpe), approve(87-05-01,MCR7690), audit(87-05-07,Parisek), install(87-08-04,MR12.1-1055): Original coding. Moved the com_channel related commands out of admin_. 2) change(87-04-26,GDixon), approve(87-05-01,MCR7690), audit(87-05-07,Parisek), install(87-08-04,MR12.1-1055): Upgraded for change to answer_table.incl.pl1. 3) change(88-09-08,Parisek), approve(88-09-28,MCR7996), audit(88-10-05,Hunter), install(88-10-07,MR12.2-1140): Removed references to sys_log_$command_error_log entry which does not exist and changed them to sys_log_$command_error which does exist. END HISTORY COMMENTS */ /* format: style4,indattr */ operator_com_channel_cmds_: procedure (); /* The following two entry points provide commands to change the state of a tty channel, attach, and remove. Other commands which manipulate the process using the channel, ie., detach, terminate, bump, unbump, and disconnect may be found in in admin_process_commands_. */ %page; /* AUTOMATIC */ dcl action char (8) aligned; dcl action_flag bit (1) aligned; dcl action_log char (12) aligned; dcl answer char (256) init (""); dcl arg_index fixed bin (17); dcl arg_length fixed bin (21); dcl arg_list_ptr ptr; dcl arg_ptr ptr; dcl code fixed bin (35); dcl comname char (12) aligned; dcl input_channel char (32); /* channel id to look for */ /* BASED */ dcl arg char (arg_length) based (arg_ptr); /* BUILTIN */ dcl (addr, null) builtin; /* ENTRY */ dcl asu_$asu_attach entry (char (*), fixed bin (35)); dcl asu_$asu_remove entry (ptr); dcl cu_$arg_list_ptr entry () returns (ptr); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl sys_log_$command entry options (variable); dcl sys_log_$command_error entry options (variable); /* EXTERNAL */ dcl error_table_$action_not_performed fixed bin (35) ext static; %page; attach: entry options (variable); /**** This is the operator "attach" command. It allows the operator to attach a communications channel to the answering service. */ arg_list_ptr = cu_$arg_list_ptr (); comname = "attach"; action = "attach "; action_log = "attached"; action_flag = "0"b; do arg_index = 1 to 25; /* take up to 25 args */ call cu_$arg_ptr_rel (arg_index, arg_ptr, arg_length, code, arg_list_ptr); /* get one argument, channel id */ if code ^= 0 then go to ATTACH_RETURN; input_channel = arg; /* save channel id */ call asu_$asu_attach (input_channel, code); /* add channel to answer table */ if code = 0 then do; /* if no error */ call sys_log_$command (-1, "attach: ^a attached.", input_channel); action_flag = "1"b; /* one worked. */ end; else do; /* some error occurred. */ if code ^= error_table_$action_not_performed /* if asu_attach did not say what */ then call sys_log_$command_error (1, code, comname, input_channel); /* we will do so */ end; end; ATTACH_RETURN: if ^action_flag /* complain if none worked. */ then call sys_log_$command (-1, "attach: error: not done"); return; %page; remove: entry options (variable); arg_list_ptr = cu_$arg_list_ptr (); comname = "remove"; action = "remove "; /* set action code */ action_log = "removed"; action_flag = "0"b; /* none done yet */ do arg_index = 1 to 25; /* take up to 25 args */ call cu_$arg_ptr_rel (arg_index, arg_ptr, arg_length, code, arg_list_ptr); /* get one argument, channel id */ if code ^= 0 then go to REMOVE_RETURN; input_channel = arg; /* save channel id */ cdtep = FIND_CDTE (input_channel); if cdtep = null () then call sys_log_$command (-1, "remove: Channel ^a not found.", input_channel); else do; if cdte.current_service_type = MC_SERVICE then call sys_log_$command (1, "remove: Channel ^a is in use by the message coordinator and can not be removed", cdte.name); else do; call asu_$asu_remove (cdtep); /* remove it */ action_flag = "1"b; /* one worked */ call sys_log_$command (-1, "remove: ^a removed", input_channel); end; end; end; REMOVE_RETURN: if ^action_flag /* complain if none worked. */ then call sys_log_$command (-1, "remove: error: not done"); return; %page; FIND_CDTE: procedure (P_channel_name) returns (ptr); dcl P_channel_name char (*) parameter; dcl cdtep ptr automatic; dcl i fixed bin (17) automatic; do i = 1 to scdtp -> cdt.current_size; cdtep = addr (scdtp -> cdt.cdt_entry (i)); if cdtep -> cdte.in_use > NOW_FREE then if cdtep -> cdte.name = P_channel_name then return (cdtep); end; return (null ()); end FIND_CDTE; %page; %include as_data_; %page; %include as_data_definitions_; %page; %include author_dcl; %page; %include cdt; %page; %include dialup_values; %page; %include sc_stat_; %page; /* BEGIN MESSAGE DOCUMENTATION Message: attach: bad arg "AAAA" S: as (severity1). T: $response M: A bad argument was furnished with an attach command. The argument is skipped. A: Enter a corrected command. Message: remove: bad arg "AAAA" S: as (severity1). T: $response M: A bad argument was furnished with an remove command. The argument is skipped. A: Enter a corrected command. Message: attach: error: not done S: as (severity1). T: $response M: Bad arguments were given to an attach command. No action resulted. A: $tryagain Message: remove: error: not done S: as (severity1). T: $response M: Bad arguments were given to an remove command. No action resulted. A: $tryagain Message: remove: ttyXXX is in use by the message coordinator and can not be removed. S: as (severity1). T: $response M: An operator remove command specified a message coordinator channel. The channel was not removed. A: Enter a corrected command line. Use the drop command to take a channel away from the message coordinator. Message: attach: TTYxxx attached S: as (severity1). T: In response to an operator attach command. M: This is the response to an attach TTYxxx command. The device channel is now connected to the Answering Service and ready for dialups. A: $ignore Message: attach: Action not performed. ttyXXX S: as (severity1). T: In response to an operator attach command. M: This is the response to attach TTYxxx if no more room is available in the answer table for channel entries. The line is not attached. A: $contact Message: remove: ttyXXX removed S: as (severity1). T: In response to an operator remove command. M: This response to the operator command remove TTYxxx indicates the channel is no longer available for dialups. If a user was on the channel, he is bumped with no message but "hangup". Note that if a user calls in on this channel, and the modem answers, the user gets a carriage return, but no welcoming message from the system, and he cannot log in. A: Remember to busy out the modem so that no user can call the channel. END MESSAGE DOCUMENTATION */ end operator_com_channel_cmds_;  operator_mc_cmds_.pl1 07/20/88 1251.6r w 07/19/88 1536.5 451692 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-01-07,MSharpe), approve(87-07-09,MCR7690), audit(87-07-30,Parisek), install(87-08-04,MR12.1-1055): Removed the message_coordinator commands from admin_ and created this program. Added accept_vchn which accepts virtual channel names. Fixed accept to leave broadcast list alone if not specified. 2) change(87-04-07,Parisek), approve(87-07-09,MCR7690), audit(87-08-03,Beattie), install(87-08-04,MR12.1-1055): Bypass printing error message on MC terminal if code returned by mc_commands_$new_tty is error_table_$ioname_not_active. We don't care if it's not active cause if not it will become active after "accept". 3) change(87-04-26,GDixon), approve(87-07-09,MCR7690), audit(87-07-30,Parisek), install(87-08-04,MR12.1-1055): Upgraded for change to answer_table.incl.pl1. 4) change(87-06-25,Parisek), approve(87-06-25,MCR7690), audit(87-08-03,Beattie), install(87-08-04,MR12.1-1055): Created a new internal procedure for searching the answer table for DSA MC user (no proc), and send a "bump" wakeup to AS to remove the ute for the user only when "drop" or "substty" is called. 5) change(87-06-29,Parisek), approve(87-06-29,MCR7690), audit(87-08-03,Beattie), install(87-08-04,MR12.1-1055): Ignore error_table_$action_not_performed returned from asu_$bump_user if dsa channel. END HISTORY COMMENTS */ /* format: style4,indattr */ %page; operator_mc_cmds_: proc (); /* AUTOMATIC */ dcl answer char (256) init (""); dcl arg_count fixed bin (17); dcl arg_index fixed bin (17); dcl arg_length fixed bin (21); dcl arg_list_ptr ptr; dcl arg_ptr ptr; dcl attauth bit (36); /* .. privilege bits */ dcl attchan char (32); /* .. channel ID or file name */ dcl attchan1 char (32); /* .. channel ID or file name */ dcl attype char (8); /* .. attachment type (file or tty) */ dcl auth_flag bit (1) aligned; dcl bc_flag bit (1) aligned; dcl bc_list char (329) aligned; /* 10 char (32) + 9 separating commas */ dcl cdte_flag bit (1) aligned; /* 1=>attchan is defined in cdt */ dcl code fixed bin (35); dcl comname char (32) aligned; dcl dsa_flag bit (1) aligned; /* dsa channel specified */ dcl iutep ptr; /* Initializer's utep */ dcl reply_target char (32); dcl source char (8); /* Source name, used in "route" */ dcl stream char (32); /* .. stream name */ dcl target_flag bit (1) aligned; dcl vcon char (32); /* .. virtual console name */ dcl vcon1 char (32); /* .. virtual console name */ dcl virtual_dsa bit (1) aligned; /* virtual dsa channel ident */ dcl 1 CAI structure aligned like channel_audit_info automatic; /* CONSTANTS */ declare (TRUE init ("1"b), FALSE init (""b)) bit (1) aligned int static options (constant); /* BASED */ dcl arg char (arg_length) based (arg_ptr); /* BUILTIN */ dcl (addr, index, length, null, rtrim, substr) builtin; /* ENTRY */ dcl as_access_audit_$channel entry (ptr, ptr, ptr, fixed bin, ptr, char(*)); dcl asu_$bump_user entry (ptr, char (*), fixed bin (35), fixed bin); dcl cu_$arg_list_ptr entry returns (ptr); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl cu_$arg_count_rel entry (fixed bin, ptr, fixed bin (35)); dcl cv_oct_check_ entry (char (*), fixed bin (35)) returns (bit (36)); dcl get_process_access_class_ entry () returns (bit (72) aligned); dcl get_process_id_ entry () returns (bit (36)); dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, fixed bin (35)); dcl initiate_file_ entry (char (*), char (*), bit (*), ptr, fixed bin (24), fixed bin (35)); dcl ioa_$rsnnl entry options (variable); dcl mc_commands_$new_tty entry (char (*), bit (36), bit (1) aligned, ptr, fixed bin (35)); dcl mc_commands_$new_vchannel entry (char (*), bit (36), ptr, fixed bin (35)); dcl mc_commands_$set_restrict entry (char (*), char (*), fixed bin (35)); dcl mc_commands_$set_broadcast entry (char (*), char (*), fixed bin (35)); dcl mc_commands_$remove_tty entry (char (*), bit (1) aligned, fixed bin (35)); dcl mc_commands_$define entry (char (*), char (*), char (*), fixed bin (35)); dcl mc_commands_$deroute entry (char (*), char (*), char (*), fixed bin (35)); dcl mc_commands_$route entry (char (*), char (*), char (*), char (*), fixed bin (35)); dcl mc_commands_$reroute entry (char (*), char (*), char (*), char (*), char (*), fixed bin (35)); dcl mc_commands_$undefine entry (char (*), char (*), fixed bin (35)); dcl mc_commands_$redefine entry (char (*), char (*), char (*), char (*), fixed bin (35)); dcl mc_commands_$substty entry (char (*), char (*), bit (1) aligned, ptr, bit (1) aligned, fixed bin (35)); dcl sys_log_$command entry options (variable); dcl sys_log_$command_error entry options (variable); dcl terminate_file_ entry (ptr, fixed bin (24), bit (*), fixed bin (35)); /* EXTERNAL */ dcl error_table_$action_not_performed fixed bin(35) ext static; dcl error_table_$bad_arg fixed bin (35) ext; dcl error_table_$bad_channel fixed bin (35) ext; dcl error_table_$badopt fixed bin (35) ext; dcl error_table_$ioname_not_active fixed bin (35) ext; dcl error_table_$ioname_not_found fixed bin (35) ext; dcl error_table_$ionmat fixed bin (35) ext; dcl error_table_$noentry fixed bin (35) ext; %page; /* The following ten entries are used to invoke service functions of the answering service message coordinator program, which distributes messages from sources within the answering service and sources in daemon processes attached via "mrd_", to virtual consoles which in turn are connected either to real channels or to logs. */ accept: entry options (variable); /**** The operator "accept" command. It adds a new terminal to the message coordinator. */ dutp = as_data_$dutp; iutep = addr (dutbl.entry (1)); /* Initializer's utep for audit */ arg_list_ptr = cu_$arg_list_ptr (); comname = "operator_mc_cmds_: accept"; /* Set up command name for err msg */ call validate; /* locate answer table */ answer = "Usage: accept channel_id {authority} {target} {broadcast_list}"; arg_index = 1; call cu_$arg_ptr_rel (arg_index, arg_ptr, arg_length, code, arg_list_ptr); /* arg 1 is tty id */ if code ^= 0 then go to ERROR_RETURN; /* required */ attchan = arg; if attchan = "otw_" then do; answer = "This name is reserved for the system console."; code = error_table_$bad_channel; goto ERROR_RETURN; end; else if index (attchan, ".") ^= 0 then do; cdtep = null (); /* may not be a terminal */ if index (attchan, "dsa.") = 1 /* not in cdte; this test should be modified when other formats of channel names become acceptable */ then cdte_flag = ""b; else do; cdte_flag = "1"b; call check_acceptable (code); /* make sure not used by answering service */ if code ^= 0 then go to ANSWER_RETURN; /* error message will have been set up */ end; if cdtep ^= null () /* if an MCS channel ... */ then cdte.current_service_type = MC_SERVICE; /* flag as MC channel */ end; arg_index = arg_index + 1; auth_flag = "1"b; /* assume authority is supplied */ call cu_$arg_ptr_rel (arg_index, arg_ptr, arg_length, code, arg_list_ptr); if code ^= 0 then do; auth_flag = ""b; /* authority not supplied */ attauth = (36)"1"b; /* second arg, if supplied, is privilege level */ end; else if arg = "full" then attauth = (36)"1"b; /* full is the current default */ else if arg = "none" then attauth = (36)"0"b; /* output-only terminals are ok */ else if arg = "reply" then do; /* as are reply-only */ attauth = "0"b; addr (attauth) -> rcodebits.reply = "1"b; /* system_control_ checks these bits when command issured */ end; else if arg = "daemon" then do; /* also daemon-control */ attauth = "0"b; addr (attauth) -> rcodebits.reply = "1"b; addr (attauth) -> rcodebits.intercom = "1"b; addr (attauth) -> rcodebits.exec = "1"b; end; else if arg = "query" then do; /* almost zero privilege */ attauth = "0"b; addr (attauth) -> rcodebits.status = "1"b; end; else do; /* Assume octal. */ attauth = cv_oct_check_ (arg, code); if code ^= 0 then do; answer = "unknown privilege code"; go to ANSWER_RETURN; end; end; answer = "Failed to accept " || attchan || "."; /* prepare error message */ call mc_commands_$new_tty (attchan, attauth, cdte_flag, arg_ptr, code); /* grab the new tty and set it up; arg_ptr is actually superfluous here; turn_on_mc_ uses the value returned for the system console */ if code = error_table_$ionmat then do; call cu_$arg_count_rel (arg_count, arg_list_ptr, (0)); if arg_count = arg_index then do; if ^auth_flag then /* no new value supplied */ call sys_log_$command (SL_LOG, "operator_mc_cmds_: accept: ^a set to ""full"".", attchan); go to RETURN; end; code = 0; /* go ahead and reset other attributes */ end; if code = error_table_$ioname_not_active then; /* Suppress error message on MC terminal */ else if code ^= 0 then do; if code = error_table_$ioname_not_found then answer = "Channel " || attchan || "is not in Message Coordinator service."; go to ERROR_RETURN; end; arg_index = arg_index + 1; call cu_$arg_ptr_rel (arg_index, arg_ptr, arg_length, code, arg_list_ptr); /* Next argument may be reply restricter. */ if code ^= 0 then do; call AUDIT_OK (); goto RETURN; /* leave the rest alone */ end; if arg ^= "*" then do; answer = "Failed to set restriction to " || arg || "."; call mc_commands_$set_restrict (attchan, arg, code); if code ^= 0 then go to ERROR_RETURN; end; else do; answer = "Failed to reset restriction."; call mc_commands_$set_restrict (attchan, "", code); if code ^= 0 then go to ERROR_RETURN; end; arg_index = arg_index + 1; call cu_$arg_ptr_rel (arg_index, arg_ptr, arg_length, code, arg_list_ptr); /* Next argument maybe broadcast list. */ if code = 0 then do; /* optional. */ answer = "Failed to set broadcast list to " || arg || "."; call mc_commands_$set_broadcast (attchan, arg, code); if code ^= 0 then go to ERROR_RETURN; end; call AUDIT_OK (); go to RETURN; %page; accept_vchn: entry options (variable); /**** The operator "accept_vchn" command. It adds a new virtual channel to the message coordinator. Virtual channels thus defined must be manually accepted by an operator when a user attempts to use them.*/ arg_list_ptr = cu_$arg_list_ptr (); comname = "operator_mc_cmds_: accept_vchn"; /* Set up command name for err msg */ call validate; /* locate answer table */ answer = "Usage: accept_vchn channel_id -auth authority -target reply_target -bc_list input_broadcast_list"; call cu_$arg_ptr_rel (1, arg_ptr, arg_length, code, arg_list_ptr); /* arg 1 is tty id */ if code ^= 0 then go to ERROR_RETURN; /* required */ attchan = arg; /* copy arg */ if index (attchan, ".") ^= 0 then do; answer = rtrim (attchan) || ". Virtual channel names may not contain a ""."""; code = error_table_$bad_channel; goto ERROR_RETURN; end; else if attchan = "otw_" then do; answer = "This name is reserved for the system console."; code = error_table_$bad_channel; goto ERROR_RETURN; end; auth_flag, target_flag, bc_flag = ""b; reply_target, bc_list = ""; arg_index = 2; do while (arg_index <= arg_count); call cu_$arg_ptr_rel (arg_index, arg_ptr, arg_length, code, arg_list_ptr); arg_index = arg_index + 1; if arg = "-auth" | arg = "-authority" then do; auth_flag = "1"b; /* necessary arg */ call cu_$arg_ptr_rel (arg_index, arg_ptr, arg_length, code, arg_list_ptr); if code ^= 0 then goto ERROR_RETURN; arg_index = arg_index + 1; if arg = "full" then attauth = (36)"1"b; /* full is the current default */ else if arg = "none" then attauth = (36)"0"b; /* output-only terminals are ok */ else if arg = "reply" then do; /* as are reply-only */ attauth = "0"b; addr (attauth) -> rcodebits.reply = "1"b; /* system_control_ checks these bits when command issued */ end; else if arg = "daemon" then do; /* also daemon-control */ attauth = "0"b; addr (attauth) -> rcodebits.reply = "1"b; addr (attauth) -> rcodebits.intercom = "1"b; addr (attauth) -> rcodebits.exec = "1"b; end; else if arg = "query" then do; /* almost zero privilege */ attauth = "0"b; addr (attauth) -> rcodebits.status = "1"b; end; else do; /* bad arg */ code = error_table_$bad_arg; answer = "-auth may be followed by one of the following:^/ full, none, reply, daemon, query" ; go to ERROR_RETURN; end; end; else if arg = "-target" then do; call cu_$arg_ptr_rel (arg_index, arg_ptr, arg_length, code, arg_list_ptr); if code ^= 0 then goto ERROR_RETURN; target_flag = "1"b; arg_index = arg_index + 1; if arg_length > length (reply_target) then do; code = error_table_$bad_arg; answer = "Bad reply target: " || arg; goto ERROR_RETURN; end; reply_target = arg; end; else if arg = "-bc_list" | arg = "-bcl" then do; call cu_$arg_ptr_rel (arg_index, arg_ptr, arg_length, code, arg_list_ptr); if code ^= 0 then goto ERROR_RETURN; bc_flag = "1"b; arg_index = arg_index + 1; if arg_length > length (bc_list) then do; code = error_table_$bad_arg; answer = "Bad broadcast list: " || arg; goto ERROR_RETURN; end; bc_list = arg; end; else do; code = error_table_$badopt; answer = "Argument not accepted: " || arg; goto ERROR_RETURN; end; end; if ^auth_flag then attauth = (36)"1"b; answer = "Failed to accept " || attchan || "."; call mc_commands_$new_vchannel (attchan, attauth, arg_ptr, code); /* set up a new virtual channel */ if code = error_table_$ionmat then do; if ^auth_flag /* no new value supplied */ /* so report that we assumed default */ then call sys_log_$command (SL_LOG, "operator_mc_cmds_: accept_vchn: ^a set to ""full"".", attchan); if ^bc_flag & ^target_flag /* user specified nothing else to do; */ then goto RETURN; code = 0; /* go ahead and reset other attributes */ end; if code ^= 0 then go to ERROR_RETURN; if target_flag then do; if reply_target ^= "*" then do; answer = "Failed to set restriction to " || reply_target || "."; call mc_commands_$set_restrict (attchan, reply_target, code); if code ^= 0 then go to ERROR_RETURN; end; else do; answer = "Failed to reset restriction."; call mc_commands_$set_restrict (attchan, "", code); if code ^= 0 then go to ERROR_RETURN; end; end; if bc_flag then do; answer = "Failed to set broadcast list to " || rtrim(bc_list) || "."; call mc_commands_$set_broadcast (attchan, (rtrim (bc_list)), code); if code ^= 0 then go to ERROR_RETURN; end; go to RETURN; %page; /* Make entry in Message Routing Table */ route: entry options (variable); arg_list_ptr = cu_$arg_list_ptr (); comname = "operator_mc_cmds_: route"; call validate; answer = "Incorrect number of arguments."; call cu_$arg_ptr_rel (1, arg_ptr, arg_length, code, arg_list_ptr); /* Get first argument, source id */ if code ^= 0 then go to ERROR_RETURN; source = arg; /* Copy source id */ call cu_$arg_ptr_rel (2, arg_ptr, arg_length, code, arg_list_ptr); if code ^= 0 then go to ERROR_RETURN; stream = arg; /* Copy stream id */ call cu_$arg_ptr_rel (3, arg_ptr, arg_length, code, arg_list_ptr); /* get vcon */ if code ^= 0 then go to ERROR_RETURN; if substr (arg, 1, 1) = "*" then do; /* Want to ring the bell? */ attype = "alarm"; /* yes. */ vcon = substr (arg, 2); end; else do; attype = ""; vcon = arg; end; answer = "route unsuccessful."; call mc_commands_$route (source, stream, vcon, attype, code); if code ^= 0 then go to ERROR_RETURN; go to RETURN; /* Define virtual console */ define: entry options (variable); arg_list_ptr = cu_$arg_list_ptr (); comname = "operator_mc_cmds_: define"; call validate; answer = "Incorrect number of arguments."; call cu_$arg_ptr_rel (1, arg_ptr, arg_length, code, arg_list_ptr); /* first arg is vcon id */ if code ^= 0 then go to ERROR_RETURN; vcon = arg; call cu_$arg_ptr_rel (2, arg_ptr, arg_length, code, arg_list_ptr); /* get attachment type */ if code ^= 0 then go to ERROR_RETURN; attype = arg; call cu_$arg_ptr_rel (3, arg_ptr, arg_length, code, arg_list_ptr); /* get channel id */ if code ^= 0 then go to ERROR_RETURN; attchan = arg; answer = "define unsuccessful."; call mc_commands_$define (vcon, attype, attchan, code); if code ^= 0 then go to ERROR_RETURN; go to RETURN; /* Redefine destination for virtual console */ redefine: entry options (variable); arg_list_ptr = cu_$arg_list_ptr (); comname = "operator_mc_cmds_: redefine"; call validate; answer = "Incorrect number of arguments."; call cu_$arg_ptr_rel (1, arg_ptr, arg_length, code, arg_list_ptr); /* get vocn */ if code ^= 0 then go to ERROR_RETURN; vcon = arg; call cu_$arg_ptr_rel (2, arg_ptr, arg_length, code, arg_list_ptr); /* get dest */ if code ^= 0 then go to ERROR_RETURN; attchan = arg; call cu_$arg_ptr_rel (3, arg_ptr, arg_length, code, arg_list_ptr); if code ^= 0 then go to ERROR_RETURN; attype = arg; call cu_$arg_ptr_rel (4, arg_ptr, arg_length, code, arg_list_ptr); if code ^= 0 then go to ERROR_RETURN; attchan1 = arg; answer = "redefine unsuccessful."; call mc_commands_$redefine (vcon, attchan, attype, attchan1, code); if code ^= 0 then go to ERROR_RETURN; go to RETURN; /* Undefine channel from virtual console. (formerly deldest) */ undefine: entry options (variable); arg_list_ptr = cu_$arg_list_ptr (); comname = "operator_mc_cmds_: undefine"; call validate; answer = "Incorrect number of arguments."; call cu_$arg_ptr_rel (1, arg_ptr, arg_length, code, arg_list_ptr); /* get vcon */ if code ^= 0 then go to ERROR_RETURN; vcon = arg; call cu_$arg_ptr_rel (2, arg_ptr, arg_length, code, arg_list_ptr); /* get dest */ if code ^= 0 then go to ERROR_RETURN; attchan = arg; answer = "undefine unsuccessful."; call mc_commands_$undefine (vcon, attchan, code); if code ^= 0 then go to ERROR_RETURN; go to RETURN; /* Swap one destination (terminal or file) for another */ substty: entry options (variable); arg_list_ptr = cu_$arg_list_ptr (); comname = "operator_mc_cmds_: substty"; call validate; answer = "Incorrect number of arguments."; call cu_$arg_ptr_rel (1, arg_ptr, arg_length, code, arg_list_ptr); /* get channel */ if code ^= 0 then go to ERROR_RETURN; attchan1 = arg; virtual_dsa = ""b; if (index (attchan1, "dsa.") = 1) | (index (attchan1, ".") = 0) then do; dsa_flag = "1"b; if index (attchan1, ".") = 0 then virtual_dsa = "1"b; end; else dsa_flag = ""b; call cu_$arg_ptr_rel (2, arg_ptr, arg_length, code, arg_list_ptr); /* get new channel */ if code ^= 0 then go to ERROR_RETURN; attchan = arg; if attchan = attchan1 then do; /* bad idea */ answer = "cannot substty for same channel"; go to ANSWER_RETURN; end; if index (attchan, "dsa.") = 1 then cdte_flag = ""b; else if (index (attchan, ".") ^= 0) | (attchan = "otw_") then do; call check_acceptable (code); if code ^= 0 then go to ANSWER_RETURN; /* answer set up by check_acceptable */ if attchan ^= "otw_" then cdte.current_service_type = MC_SERVICE; /* mark as belonging to MC */ cdte_flag = "1"b; end; if dsa_flag then call process_dsa_ute ((attchan1)); answer = "removing channel " || attchan1; call mc_commands_$substty (attchan1, attchan, cdte_flag, arg_ptr, "1"b, code); /* arg_ptr is actually useless; it's required because turn_on_mc_ and mc_commands_$substty use it to get the value returned from mc_commands_$new_tty */ if code = error_table_$action_not_performed then do; call ioa_$rsnnl ("Channel ^a not dialed to initializer", answer, (0), attchan); goto ANSWER_RETURN; end; if code = error_table_$noentry then do; call ioa_$rsnnl ("Channel ^a not configured.", answer, (0), attchan1); goto ANSWER_RETURN; end; else if code ^= 0 then goto ERROR_RETURN; goto RETURN; %page; deroute: entry options (variable); /**** Operator "deroute" command. Deletes an entry in the Message Routing Table. */ arg_list_ptr = cu_$arg_list_ptr (); comname = "operator_mc_cmds_: deroute"; call validate; answer = "Incorrect number of arguments."; call cu_$arg_ptr_rel (1, arg_ptr, arg_length, code, arg_list_ptr); /* get source */ if code ^= 0 then go to ERROR_RETURN; source = arg; call cu_$arg_ptr_rel (2, arg_ptr, arg_length, code, arg_list_ptr); /* get stream */ if code ^= 0 then go to ERROR_RETURN; stream = arg; call cu_$arg_ptr_rel (3, arg_ptr, arg_length, code, arg_list_ptr); /* get vcon */ if code ^= 0 then go to ERROR_RETURN; vcon = arg; answer = "deroute unsuccessful."; call mc_commands_$deroute (source, stream, vcon, code); if code ^= 0 then go to ERROR_RETURN; go to RETURN; /* REROUTE - modify entry in Message Routing Table */ reroute: entry options (variable); arg_list_ptr = cu_$arg_list_ptr (); comname = "operator_mc_cmds_: reroute"; call validate; answer = "Incorrect number of arguments."; call cu_$arg_ptr_rel (1, arg_ptr, arg_length, code, arg_list_ptr); /* get source */ if code ^= 0 then go to ERROR_RETURN; source = arg; call cu_$arg_ptr_rel (2, arg_ptr, arg_length, code, arg_list_ptr); /* get stream */ if code ^= 0 then go to ERROR_RETURN; stream = arg; call cu_$arg_ptr_rel (3, arg_ptr, arg_length, code, arg_list_ptr); /* get old vcon */ if code ^= 0 then go to ERROR_RETURN; vcon = arg; call cu_$arg_ptr_rel (4, arg_ptr, arg_length, code, arg_list_ptr); /* get new vcon */ if code ^= 0 then go to ERROR_RETURN; if substr (arg, 1, 1) = "*" then do; /* ring bell? */ attype = "alarm"; vcon1 = substr (arg, 2); end; else do; /* no */ attype = ""; vcon1 = arg; end; answer = "reroute unsuccessful."; call mc_commands_$reroute (source, stream, vcon, vcon1, attype, code); if code ^= 0 then go to ERROR_RETURN; go to RETURN; %page; drop: entry options (variable); /**** Operator "drop" command. Removes a terminal from the message coordinator. */ dutp = as_data_$dutp; iutep = addr (dutbl.entry (1)); /* Initializer's utep for audit */ arg_list_ptr = cu_$arg_list_ptr (); comname = "operator_mc_cmds_: drop"; /* set up command name */ call validate; /* locate anstbl */ answer = "Incorrect number of arguments."; call cu_$arg_ptr_rel (1, arg_ptr, arg_length, code, arg_list_ptr); /* get channel */ if code ^= 0 then go to ERROR_RETURN; attchan = arg; virtual_dsa = ""b; if (index (attchan, "dsa.") = 1) | (index (attchan, ".") = 0) then do; dsa_flag = "1"b; if index (attchan, ".") = 0 then virtual_dsa = "1"b; end; else dsa_flag = ""b; cdtep = null; answer = "drop unsuccessful."; if dsa_flag then call process_dsa_ute (attchan); else call mc_commands_$remove_tty (attchan, "1"b, code); /* get rid of tty */ if code = error_table_$action_not_performed then do; call ioa_$rsnnl ("Channel ^a not dialed to initializer", answer, (0), attchan); goto ANSWER_RETURN; end; if code = error_table_$noentry then do; call ioa_$rsnnl ("Channel ^a not configured.", answer, (0), attchan); goto ANSWER_RETURN; end; if code = error_table_$ioname_not_found then do; call ioa_$rsnnl ( "Channel ^a not a message coordinator terminal.", answer, (0), attchan); goto ANSWER_RETURN; end; else if code ^= 0 then goto ERROR_RETURN; call AUDIT_OK (); go to RETURN; %page; /* THAT'S IT FOLKS! */ ERROR_RETURN: call sys_log_$command_error (SL_TYPE, code, comname, answer); go to RETURN; ANSWER_RETURN: call sys_log_$command (SL_TYPE, "^a: error: ^a", comname, answer); go to RETURN; RETURN: return; /* almost all entries exit here */ /* INTERNAL PROCEDURES */ validate: proc; if ^sc_stat_$Multics_typed then as_data_$sysdir = sc_stat_$sysdir; if as_data_$ansp = null then do; call hcs_$initiate (sysdir, "answer_table", "", 0, 0, as_data_$ansp, code); as_procid = get_process_id_ (); if as_data_$ansp = null then do; call sys_log_$command_error (SL_LOG_BEEP, code, comname, "^a>answer_table", sysdir); go to RETURN; end; end; ansp = as_data_$ansp; if whoptr = null then do; call hcs_$initiate (sysdir, "whotab", "", 0, 0, whoptr, code); if whoptr = null then call sys_log_$command_error (SL_LOG_BEEP, code, comname, "^a>whotab", sysdir); end; if ip = null then do; call hcs_$initiate (sysdir, "installation_parms", "", 0, 1, ip, code); if ip = null then call sys_log_$command_error (SL_LOG_BEEP, code, comname, "^a>installation_parms", sysdir); end; if scdtp = null then do; call hcs_$initiate (sysdir, "cdt", "", 0, 1, scdtp, code); if scdtp = null then call sys_log_$command_error (SL_LOG_BEEP, code, comname, "^a>cdt", sysdir); end; call cu_$arg_count_rel (arg_count, arg_list_ptr, (0)); /* AF invocation not an issue */ return; /* end of setup */ end validate; %page; /* Internal procedure to check that channel given as argument to operator ACCEPT and SUBSTTY commands is available. There are 3 cases: 1) The CMF specified "service: mc;" 2) The operator typed "dial system" on the terminal 3) The operator typed "slave" on the terminal All other cases are rejected. */ check_acceptable: procedure (P_code); dcl P_code fixed bin (35) parameter; P_code = 0; if attchan = "otw_" then return; /* "The" console is always cool */ cdtep = FIND_CDTE (attchan); if cdtep ^= null () then do; if cdte.current_service_type = MC_SERVICE then return; else if cdte.current_service_type = SLAVE_SERVICE then return; else if cdte.current_service_type = INACTIVE then return; /* drop sets it to INACTIVE. Allow accept to get it back */ else do; /* AS or FTP line. don't mess */ P_code = 2; answer = "channel not available"; return; end; end; P_code = 2; answer = "channel not defined in cdt."; return; end check_acceptable; %page; FIND_CDTE: procedure (P_channel_name) returns (ptr); dcl P_channel_name char (*) parameter; dcl cdtep ptr automatic; dcl i fixed bin (17) automatic; do i = 1 to scdtp -> cdt.current_size; cdtep = addr (scdtp -> cdt.cdt_entry (i)); if cdtep -> cdte.in_use > NOW_FREE then if cdtep -> cdte.name = P_channel_name then return (cdtep); end; return (null ()); end FIND_CDTE; process_dsa_ute: procedure (chan_name); dcl chan_name char (32) parm; dcl i fixed bin; dcl continue bit (1); continue = "1"b; if virtual_dsa then do; call initiate_file_ (sysdir, "mc_anstbl", R_ACCESS, mc_ansp, (0), code); if mc_ansp = null then do; call ioa_$rsnnl ("trying to access ^a>mc_anstbl", answer, (0), sysdir); goto ERROR_RETURN; end; do i = 1 to mc_anstbl.current_size while (continue); mc_atep = addr (mc_anstbl.entry (i)); if chan_name = mc_ate.virtual_tty_name then do; chan_name = mc_ate.real_tty_name; continue = ""b; end; end; call terminate_file_ (mc_ansp, 0, TERM_FILE_TERM, (0)); end; continue = "1"b; do i = 1 to anstbl.current_size while (continue); utep = addr (anstbl.entry (i)); if ute.active = NOW_LOGGED_IN then do; if chan_name = ute.tty_name then do; if comname = "operator_mc_cmds_: substty" then do; if ute.login_flags.operator then ute.login_flags.operator = ""b; else if ute.login_flags.special_pw.dial_pw then ute.login_flags.special_pw.dial_pw = ""b; end; call asu_$bump_user (utep, "", code, 0); if code = error_table_$action_not_performed then code = 0; else if code ^= 0 then do; answer = "removing user (no proc) on channel " || chan_name; goto ERROR_RETURN; end; continue = ""b; end; end; end; end process_dsa_ute; %page; AUDIT_OK: procedure (); dcl action fixed bin (17); if rtrim(comname) = "operator_mc_cmds_: attach" then action = AS_AUDIT_CHANNEL_ATTACH; else do; action = AS_AUDIT_CHANNEL_DETACH; if cdtep = null then cdtep = FIND_CDTE ((attchan)); /* Hasn't been established for drop */ end; CAI.channel_name = cdte.name; CAI.valid = FALSE; CAI.valid.service_info = FALSE; CAI.service_info = "system"; CAI.valid.access_class = TRUE; CAI.access_class = FALSE; CAI.valid.access_class_range = FALSE; CAI.access_class_range = get_process_access_class_ (); CAI.valid.user_validation_level = TRUE; CAI.user_validation_level = iutep->ute.initial_ring; call as_access_audit_$channel (cdtep, null, iutep, action, addr (CAI), ""); end AUDIT_OK; %page; %include access_audit_bin_header; %page; %include access_mode_values; %page; %include answer_table; %page; %include as_audit_structures; %page; %include as_data_; %page; %include as_data_definitions_; %page; %include author_dcl; %page; %include cdt; %page; %include daemon_user_table; %page; %include dialup_values; %page; %include login_server_messages; %page; %include mc_anstbl; %page; %include mc_restriction_codes; %page; %include sc_stat_; %page; %include sys_log_constants; %page; %include terminate_file; %page; %include user_attributes; %page; %include user_table_entry; %page; %include user_table_header; %page; /* BEGIN MESSAGE DOCUMENTATION Message: operator_mc_cmds_: COMMAND: ERROR_TABLE_MESSAGE SYSDIR>answer_table S: $as1 T: In response to an operator command, COMMAND. M: The system was unable to access the answer_table in SYSDIR. A: $inform Message: operator_mc_cmds_: COMMAND: ERROR_TABLE_MESSAGE SYSDIR>whotab S: $as1 T: In response to an operator command, COMMAND. M: The system was unable to access the whotab in SYSDIR. A: $inform Message: operator_mc_cmds_: COMMAND: ERROR_TABLE_MESSAGE SYSDIR>installation_parms S: $as1 T: In response to an operator command, COMMAND. M: The system was unable to access the installation_parms in SYSDIR. A: $inform Message: operator_mc_cmds_: COMMAND: ERROR_TABLE_MESSAGE SYSDIR>cdt S: $as1 T: In response to an operator command, COMMAND. M: The system was unable to access the cdt in SYSDIR. A: $inform Message: operator_mc_cmds_: accept: error: unknown privilege code S: $as1 T: In response to an operator accept command. M: The operator has typed accept CHANNEL PRIVILEGE but PRIVILEGE is not a known privilege code. A: $tryagain Message: operator_mc_cmds_: accept: ERROR_TABLE_MESSAGE Usage: accept channel_id {authority} {target} {broadcast_list} S: $as1 T: In response to an operator accept command. M: The operator has issued an accept command without any arguments. A: $tryagain Message: operator_mc_cmds_: accept: ERROR_TABLE_MESSAGE Failed to accept CHANNEL. S: $as1 T: In response to an operator accept command. M: The operator has issued an accept CHANNEL command, but CHANNEL cannot be accepted. A: $tryagain Message: operator_mc_cmds_: accept: CHANNEL set to "full". S: $as1 T: In response to an operator accept command. M: CHANNEL is already in use and authorization request has not changed from it's current state. A: $tryagain Message: operator_mc_cmds_: accept: ERROR_TABLE_MESSAGE Channel CHANNEL is not in Message Coordinator service. S: $as1 T: In response to an operator accept command. M: CHANNEL cannot be accepted as a message coordinator terminal. A: $tryagain Message: operator_mc_cmds_: accept: ERROR_TABLE_MESSAGE Failed to set restriction to RESTRICTION. S: $as1 T: In response to an operator accept command. M: Failed to set the reply restriction. A: $tryagain Message: operator_mc_cmds_: accept: ERROR_TABLE_MESSAGE Failed to reset restriction. S: $as1 T: In response to an operator accept command. M: Failed to reset the reply restriction. A: $tryagain Message: operator_mc_cmds_: accept: ERROR_TABLE_MESSAGE Failed to set broadcast list to BROADCAST_LIST. S: $as1 T: In response to an operator accept command. M: Failed to set the broadcast list BROADCAST_LIST. A: $tryagain Message: operator_mc_cmds_: accept: ERROR_TABLE_MESSAGE This name is reserved for the system console. S: $as1 T: In response to an operator accept command. M: Attempt to accept identifier "otw_" which is THE identifier for the master console, which is automatically accepted on bootload. A: $tryagain Message: operator_mc_cmds_: accept: channel not available S: $as1 T: In response to an operator accept command. M: Channel cannot be used as a message coordinator channel. A: $tryagain Message: operator_mc_cmds_: accept: channel not defined in cdt. S: $as1 T: In response to an operator accept command. M: Channel is not found in the system cdt and therefore cannot be used. A: $tryagain Message: operator_mc_cmds_: accept: Ioname already attached and active. accept unsuccessful. S: $as1 T: In response to an operator accept command. M: The error was returned from mc_commands_$new_tty causing the accept to abort. A: $tryagain Message: operator_mc_cmds_: accept: ERROR_TABLE_MESSAGE accept unsuccessful. S: $as1 T: In response to an operator accept command. M: The error was returned from mc_commands_$new_tty causing the accept to abort. A: $tryagain Message: operator_mc_cmds_: accept: Ioname not found. accept unsuccessful. S: $as1 T: In response to an operator accept command. M: The error was returned from mc_commands_$new_tty causing the accept to abort. Channel not found in the cdt or pre-accepted as a virtual channel. A: $tryagain Message: operator_mc_cmds_: COMMAND: ERROR_TABLE_MESSAGE Incorrect number of arguments. S: $as1 T: In response to an operator command COMMAND. M: Insufficient number of arguments supplied with the command. A: $tryagain Message: operator_mc_cmds_: drop: error: Channel CHANNEL not a message coordinator terminal. S: $as1 T: $response M: Cannot drop CHANNEL as it cannot be found attached to the message coordinator. A: $inform Message: operator_mc_cmds_: drop: error: Channel CHANNEL not configured. S: $as1 T: $response M: Channel CHANNEL is not defined in the system cdt. A: $inform Message: operator_mc_cmds_: drop: error: Channel CHANNEL not dialed to initializer. S: $as1 T: $response M: CHANNEL must be dialed to the initializer before being dropped. A: $inform Message: operator_mc_cmds_: drop: ERROR_TABLE_MESSAGE drop unsuccessful. S: $as1 T: In response to an operator drop command. M: An error was returned from mc_commands_$remove_tty causing the drop to abort. A: $tryagain Message: operator_mc_cmds_: COMMAND: ERROR_TABLE_MESSAGE removing user (no proc) on channel CHANNEL S: $as1 T: $response M: An error described by ERROR_TABLE_MESSAGE occured while attempting the operator command, COMMAND. A: $inform Message: operator_mc_cmds_: COMMAND: ERROR_TABLE_MESSAGE trying to access SYSDIR>mc_anstbl S: $as1 T: In response to an operator command, COMMAND. M: The system was not able to access the mc_anstbl in SYSDIR. A: $inform Message: operator_mc_cmds_: substty: error: cannot substty for same channel S: $as1 T: In response to an operator substty command. M: The operator has attempted to use substty to substitute a channel for itself. A: $tryagain Message: operator_mc_cmds_: substty: error: channel not available S: $as1 T: In response to an operator accept command. M: Channel cannot be used as a message coordinator channel. A: $tryagain Message: operator_mc_cmds_: substty: error: channel not defined in cdt. S: $as1 T: In response to an operator accept command. M: Channel is not found in the system cdt and therefore cannot be used. A: $tryagain Message: operator_mc_cmds_: substty: ERROR_TABLE_MESSAGE removing channel CHANNEL S: $as1 T: In response to an operator substty command. M: Unable to remove CHANNEL designated as the source of the substitution. A: $tryagain Message: operator_mc_cmds_: substty: Channel CHANNEL not dialed to initializer S: $as1 T: In response to an operator substty command. M: Channel CHANNEL was not previously dialed to the initializer and thus cannot be substituted. A: $tryagain Message: operator_mc_cmds_: substty: Channel CHANNEL not configured. S: $as1 T: In response to an operator substty command. M: Channel CHANNEL is not found in the system cdt. A: $tryagain Message: operator_mc_cmds_: substty: ERROR_TABLE_MESSAGE substty unsuccessful. S: $as1 T: In response to an operator substty command. M: An error was returned from mc_commands_$substty causing the substty to abort. A: $tryagain Message: operator_mc_cmds_: substty: Ioname not found. substty unsuccessful. S: $as1 T: In response to an operator substty command. M: An error was returned from mc_commands_$substty causing the substty to abort. Could not locate source channel in mc_anstbl. A: $tryagain Message: operator_mc_cmds_: substty: Ioname not found. substty unsuccessful. S: $as1 T: In response to an operator substty command. M: The error was returned from mc_commands_$new_tty causing the substty to abort. The target channel not found in the cdt or pre-accepted as a virtual channel. A: $tryagain Message: operator_mc_cmds_: substty: The requested action was not performed. substty unsuccessful. S: $as1 T: In response to an operator substty command. M: An error was returned from mc_commands_$substty causing the substty to abort. The target channel is in a "pending" state, which means it has not been accepted yet. A: $tryagain Message: operator_mc_cmds_: redefine: ERROR_TABLE_MESSAGE redefine unsuccessful. S: $as1 T: In response to an operator redefine command. M: An error was returned from mc_commands_$redefine causing the redefine to abort. A: $tryagain Message: operator_mc_cmds_: redefine: Ioname not found. redefine unsuccessful. S: $as1 T: In response to an operator redefine command. M: An error was returned from mc_commands_$redefine causing the redefine to abort. Could not locate VCONS in vcons_tab. A: $tryagain Message: operator_mc_cmds_: redefine: Ioname not active. redefine unsuccessful. S: $as1 T: In response to an operator redefine command. M: An error was returned from mc_commands_$redefine causing the redefine to abort. Target channel not active in the mc_anstbl. A: $tryagain Message: operator_mc_cmds_: redefine: Action not performed. redefine unsuccessful. S: $as1 T: In response to an operator redefine command. M: An error was returned from mc_commands_$redefine causing the redefine to abort. Target channel found requiring an accept in mc_anstbl. A: $tryagain Message: operator_mc_cmds_: redefine: Typename not found. redefine unsuccessful. S: $as1 T: In response to an operator redefine command. M: An error was returned from mc_commands_$redefine causing the redefine to abort. Target VCONS type not known. A: $tryagain Message: operator_mc_cmds_: redefine: Allocation could not be performed. redefine unsuccessful. S: $as1 T: In response to an operator redefine command. M: The operator has issued a redefine VCONS SOURCE STREAM VCONS command but the system could not make the new entry in the message routing table. No action was taken. A: $tryagain Message: operator_mc_cmds_: define: ERROR_TABLE_MESSAGE define unsuccessful. S: $as1 T: In response to an operator define command. M: An error was returned from mc_commands_$define causing the define to abort. A: $tryagain Message: operator_mc_cmds_: define: Ioname not found. define unsuccessful. S: $as1 T: In response to an operator define command. M: An error was returned from mc_commands_$define causing the define to abort. Could not locate VCONS in vcons_tab. A: $tryagain Message: operator_mc_cmds_: define: Ioname not active. define unsuccessful. S: $as1 T: In response to an operator define command. M: An error was returned from mc_commands_$define causing the define to abort. Target channel not active in the mc_anstbl. A: $tryagain Message: operator_mc_cmds_: define: Action not performed. define unsuccessful. S: $as1 T: In response to an operator define command. M: An error was returned from mc_commands_$define causing the define to abort. Target channel found requiring an accept in mc_anstbl. A: $tryagain Message: operator_mc_cmds_: define: Typename not found. define unsuccessful. S: $as1 T: In response to an operator define command. M: An error was returned from mc_commands_$define causing the define to abort. Target VCONS type not known. A: $tryagain Message: operator_mc_cmds_: define: There is no room to make requested allocations. S: $as1 T: In response to an operator define command. M: The operator has issued a define SOURCE STREAM VCONS command but the system could not make the new entry in the message routing table. No action was taken. A: $tryagain Message: operator_mc_cmds_: route: There is no room to make requested allocations. S: $as1 T: In response to an operator route command. M: The operator has issued a route SOURCE STREAM VCONS command but the system had no room to make the new entry in the message routing table. There may be up to 16 sources, each with 8 streams, and each stream may have up to 8 virtual consoles. No action was taken. A: $tryagain Message: operator_mc_cmds_: route: ERROR_TABLE_MESSAGE route unsuccessful. S: $as1 T: In response to an operator route command. M: An error was returned from mc_commands_$route causing the route to abort. A: $tryagain Message: operator_mc_cmds_: route: Ioname not found. route unsuccessful. S: $as1 T: In response to an operator route command. M: An error was returned from mc_commands_$route causing the route to abort. VCONS not located in vcons_tab. A: $tryagain Message: operator_mc_cmds_: undefine: ERROR_TABLE_MESSAGE undefine unsuccessful. S: $as1 T: In response to an operator undefine command. M: An error was returned from mc_commands_$undefine causing the undefine to abort. A: $tryagain Message: operator_mc_cmds_: undefine: Ioname not found. undefine unsuccessful. S: $as1 T: In response to an operator undefine command. M: An error was returned from mc_commands_$undefine causing the undefine to abort. Could not locate VCONS in vcons_tab. A: $tryagain Message: operator_mc_cmds_: reroute: ERROR_TABLE_MESSAGE reroute unsuccessful. S: $as1 T: In response to an operator reroute command. M: An error was returned from mc_commands_$reroute causing the reroute to abort. A: $tryagain Message: operator_mc_cmds_: reroute: There is no room to make requested allocations. S: $as1 T: In response to an operator reroute command. M: The operator has issued a reroute SOURCE STREAM OLD_VCONS NEW_VCONS command but the system had no room to make the new entry in the message routing table. There may be up to 16 sources, each with 8 streams, and each stream may have up to 8 virtual consoles. No action was taken. A: $tryagain Message: operator_mc_cmds_: deroute: ERROR_TABLE_MESSAGE reroute unsuccessful. S: $as1 T: In response to an operator deroute command. M: An error was returned from mc_commands_$deroute causing the deroute to abort. A: $tryagain Message: operator_mc_cmds_: deroute: There is no room to make requested allocations. S: $as1 T: In response to an operator deroute command. M: The operator has issued a deroute SOURCE STREAM VCONS command but the system had no room to make the new entry in the message routing table. There may be up to 16 sources, each with 8 streams, and each stream may have up to 8 virtual consoles. No action was taken. A: $tryagain Message: operator_mc_cmds_: accept_vchn: ERROR_TABLE_MESSAGE Usage: accept_vchn channel_id -auth authority -target reply_target -bc_list input_broadcast_list S: $as1 T: In response to an operator accept_vchn command. M: Incorrect number of arguments supplied. A: $tryagain Message: operator_mc_cmds_: accept_vchn: Incorrect IO channel specification. DOT Virtual channel names may not contain a DOT S: $as1 T: In response to an operator accept_vchn command. M: The DOT (".") character cannot be used in the virtual channel specifier. A: $tryagain Message: operator_mc_cmds_: accept_vchn: Incorrect IO channel specification. This name is reserved for the system console. S: $as1 T: In response to an operator accept_vchn command. M: The specified virtual channel name given was "otw_". This identifier cannot be used as it identifies the system console. A: $tryagain Message: operator_mc_cmds_: accept_vchn: Invalid argument -auth may be followed by one of the following: full, none, reply, daemon, query S: $as1 T: In response to an operator accept_vchn command. M: An incorrect argument to the -auth control argument was supplied. A: $tryagain Message: operator_mc_cmds_: accept_vchn: Invalid argument Bad reply target: TARGET S: $as1 T: In response to an operator accept_vchn command. M: An incorrect argument to the -reply control argument was supplied. A: $tryagain Message: operator_mc_cmds_: accept_vchn: Specified control argument is not accpeted Argument not accepted: ARGUMENT S: $as1 T: In response to an operator accept_vchn command. M: An incorrect control argument was supplied to the accept_vchn request. A: $tryagain Message: operator_mc_cmds_: accept_vchn: ERROR_TABLE_MESSAGE Failed to accept VCHANNEL S: $as1 T: In response to an operator accept_vchn command. M: Unable to pre-accept VCHANNEL as a virtual channel identifier. A: $tryagain Message: operator_mc_cmds_: accept_vchn: Invalid argument Bad broadcast list: BROADCAST_LIST S: $as1 T: In response to an operator accept_vchn command. M: Incorrect argument supplied to the -bc_list control argument. A: $tryagain Message: operator_mc_cmds_: accept_vchn: Ioname already attached and active. VCHANNEL set to full. S: $as1 T: In response to an operator accept_vchn command. M: VCHANNEL already active and authorization request is same. A: $tryagain Message: operator_mc_cmds_: accept_vchn: ERROR_TABLE_MESSAGE Failed to set restriction to REPLY_TARGET S: $as1 T: In response to an operator accept command. M: Failed to set the reply restriction for REPLY_TARGET. A: $tryagain Message: operator_mc_cmds_: accept_vchn: ERROR_TABLE_MESSAGE Failed to reset restriction. S: $as1 T: In response to an operator accept command. M: Failed to reset the reply restriction. A: $tryagain Message: operator_mc_cmds_: accept_vchn: ERROR_TABLE_MESSAGE Failed to set broadcast list to BROADCAST_LIST. S: $as1 T: In response to an operator accept command. M: Failed to set the broadcast list for BROADCAST_LIST. A: $tryagain END MESSAGE DOCUMENTATION */ end operator_mc_cmds_;  operator_process_cmds_.pl1 06/07/89 1233.5rew 06/07/89 1232.2 276678 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1985 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(85-12-05,MSharpe), approve(87-07-09,MCR7690), audit(87-05-07,Parisek), install(87-08-04,MR12.1-1055): Original coding. Moved the process-related commands out of admin_. Added functionality to these commands to recognize dsa channel names on the command line and to bump by process_id. The structure of the original programs has been heavily modified. CDD 86-03-11 - fixed bugs in bumping by PID 86-03-12 - fixed bug in reporting dsa channel name; to accept the first 6 digits of pid. 2) change(87-04-26,GDixon), approve(87-07-09,MCR7690), audit(87-05-07,Parisek), install(87-08-04,MR12.1-1055): Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1 3) change(87-05-28,Parisek), approve(87-07-09,MCR7690), audit(87-08-03,Beattie), install(87-08-04,MR12.1-1055): Correct an incorrectly formatted ioa_ control string. 4) change(87-06-29,Parisek), approve(87-06-29,MCR7690), audit(87-08-03,Beattie), install(87-08-04,MR12.1-1055): Ignore error_table_$action_not_performed returned from asu_$bump_user if dsa channel. 5) change(88-08-18,Parisek), approve(88-09-08,MCR7979), audit(88-09-08,Farley), install(88-09-09,MR12.2-1101): Bump dsa starname channels (ie, dsa.MULF.*) if code returned from match_star_name_ is zero, not non-zero (bug). If bumping based on code ^= 0 then all users will get bumped instead of the specified dsa channels. 6) change(89-04-20,Lee), approve(89-05-10,MCR8106), audit(89-05-11,Farley), install(89-06-07,MR12.3-1053): Modified to ensure arg_index and bump_by_name are initialized properly after the target specifier gets parsed and "mpx" or "fnp" was specified for the target; modified bump to not treat bump *.* as taking the action "shutdown"; no code had existed to handle "shutdown" so bump was failing. Cosmetic changes to this fix based on Paul Farley's original solution, which was developed independently. END HISTORY COMMENTS */ /* format: style4,indattr */ operator_process_cmds_: procedure (); /* The following five entry points provide commands to change the state of a tty channel and/or the process using the channel: detach, terminate, bump, unbump. The programs share common code and usage (except that only bump accepts a grace time argument). The usage is: * COMMAND PERS PROJ GRACETIME MESSAGE... * " CHANNEL " * " fnp TAG " where PERS and PROJ can be "*" indicating "all". These commands operate by sending a wakeup with the action word (bump, unbump, detach, terminat, hangup) being contained in the event message. The wakeup is handled by dialup_, which takes the action specified by the action word. The warning message, if any, is printed on the user's terminal before the wakeup is sent. If the process is not past the login stage, hcs_$wakeup is used to send the wakeup. Otherwise, asu_$bump_user is called, and that procedure sets ate.preempted = 2, prints the message, and sets an event timer to go off when the specified grace time has expired. The event message will be "alarm___" in this case, but dialup_ detects a bump by seeing that ate.preempted > 0. The unbump code in dialup_ just sets ate.preempted = 0, so that when the alarm___ goes off, dialup_ returns instead of bumping the user. The command arguments are processed as follows: #of components arg category to bump by (#of dots +1) 1 fnp or mpx mpx -- the next arg is mpx name 2 *.* name 2 dsa.{anything} first by name, if not, by dsa channel 2 {any other} first by name, if not, by tty channel 3+ dsa.{anything} by dsa channel 3+ {any other} by tty channel If the "bump" command is issued, the next argument is tested for a numeric value -- number of minutes of grace time. The rest of the arguments are strung together and displayed on the user's terminal before he's bumped. */ %page; /* AUTOMATIC */ dcl action char (8) aligned; dcl action_log char (12) aligned; dcl answer char (256) init (""); dcl arg_count fixed bin (17); dcl arg_index fixed bin (17); dcl arg_length fixed bin (21); dcl arg_list_ptr ptr; dcl arg_ptr ptr; dcl bin_pid fixed bin (35); dcl bump_by_chn_id bit (1); dcl bump_by_dsa bit (1); dcl bump_by_mpx bit (1); dcl bump_by_name bit (1); dcl bump_by_pid bit (1); dcl code fixed bin (35); dcl comname char (48) aligned varying; dcl fnp_only bit (1); dcl input_channel char (32); /* channel id to look for */ dcl input_person_id char (28); /* person id to look for */ dcl input_pid bit (36); /* proc_id to look for */ dcl input_project_id char (28); /* proj id to look for */ dcl msg_string char (256); dcl msg_string_len fixed bin; /* actual length of msg_string */ dcl mpx_name char (32); /* name of a mltiplexer */ dcl mpx_starname char (32); dcl respect_nobump bit (1); dcl grace_period fixed bin; /* BASED */ dcl arg char (arg_length) based (arg_ptr); /* BUILTIN */ dcl (addr, index, length, null, rtrim, substr, unspec) builtin; /* ENTRY */ dcl asu_$blast_user entry (ptr, char (*), char (*), fixed bin (35)); dcl asu_$bump_user entry (ptr, char (*), fixed bin (35), fixed bin); dcl asu_$unbump_user entry (ptr, fixed bin (35)); dcl asu_$terminate_user entry (ptr, fixed bin (35)); dcl asu_$detach_user entry (ptr, fixed bin (35)); dcl asu_$disconnect_user entry (ptr, fixed bin (35)); dcl cu_$arg_count_rel entry (fixed bin, ptr, fixed bin (35)); dcl cu_$arg_list_ptr entry () returns (ptr); dcl cu_$arg_ptr_rel entry (fixed bin, ptr, fixed bin (21), fixed bin (35), ptr); dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); dcl cv_oct_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); dcl get_process_id_ entry () returns (bit (36)); dcl hcs_$initiate entry (char (*), char (*), char (*), fixed bin (1), fixed bin (2), ptr, 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 match_star_name_ entry (char (*), char (*), fixed bin (35)); dcl sys_log_$command entry options (variable); dcl sys_log_$command_error entry options (variable); /* Static */ dcl error_table_$action_not_performed fixed bin (35) ext static; %page; detach: entry options (variable); /**** This entry implements the operator "detach" command. It forceably logs out a user and makes the tty unresponsive */ arg_list_ptr = cu_$arg_list_ptr (); call process_bump_args (arg_list_ptr, ""b); action = "detach"; action_log = "detached"; comname = "operator_process_cmds_: detach"; call process_bump_args (arg_list_ptr, ""b); respect_nobump = ""b; call bump_procedure (); go to RETURN; %page; terminate: entry options (variable); /**** This entry implements the operator "terminate" command. It forceably terminates the user's process and creates a new one */ arg_list_ptr = cu_$arg_list_ptr (); action = "terminat"; action_log = "terminated"; comname = "operator_process_cmds_: terminate"; call process_bump_args (arg_list_ptr, ""b); respect_nobump = ""b; call bump_procedure (); go to RETURN; %page; bump: entry options (variable); /**** This entry implements the operator "bump" command. It forceably logs out a user. */ arg_list_ptr = cu_$arg_list_ptr (); action = "bump "; action_log = "bumped"; comname = "operator_process_cmds_: bump"; call process_bump_args (arg_list_ptr, "1"b); respect_nobump = "1"b; call bump_procedure (); go to RETURN; %page; unbump: entry options (variable); /**** This entry implements the operator "unbump" command. */ arg_list_ptr = cu_$arg_list_ptr (); action = "unbump"; action_log = "unbumped"; comname = "operator_process_cmds_: unbump"; call process_bump_args (arg_list_ptr, ""b); respect_nobump = ""b; call bump_procedure (); go to RETURN; %page; disconnect: entry options (variable); /**** This entry implements the operator "disconnect" command. It causes a hangup to be simulated for the user's channel which either disconnects, or logs out the user. */ arg_list_ptr = cu_$arg_list_ptr (); action = "hangup"; action_log = "disconnected"; comname = "operator_process_cmds_: disconnect"; call process_bump_args (arg_list_ptr, ""b); respect_nobump = ""b; call bump_procedure (); go to RETURN; %page; /* THAT'S IT FOLKS! */ ERROR_RETURN: call sys_log_$command_error (SL_TYPE, code, comname, answer); go to RETURN; ANSWER_RETURN: call sys_log_$command (SL_TYPE, "^a: error: ^a", comname, answer); go to RETURN; RETURN: return; /* almost all entries exit here */ /* Internal Procedures */ %page; general_setup: proc (); if ^sc_stat_$Multics_typed then as_data_$sysdir = sc_stat_$sysdir; if as_data_$ansp = null then do; call hcs_$initiate (sysdir, "answer_table", "", 0, 0, as_data_$ansp, code); as_procid = get_process_id_ (); if as_data_$ansp = null then do; call sys_log_$command_error (SL_LOG_BEEP, code, comname, "^a>answer_table", sysdir); go to RETURN; end; end; ansp = as_data_$ansp; if whoptr = null then do; call hcs_$initiate (sysdir, "whotab", "", 0, 0, whoptr, code); if whoptr = null then call sys_log_$command_error (SL_LOG_BEEP, code, comname, "^a>whotab", sysdir); end; if ip = null then do; call hcs_$initiate (sysdir, "installation_parms", "", 0, 1, ip, code); if ip = null then call sys_log_$command_error (SL_LOG_BEEP, code, comname, "^a>installation_parms", sysdir); end; if scdtp = null then do; call hcs_$initiate (sysdir, "cdt", "", 0, 1, scdtp, code); if scdtp = null then call sys_log_$command_error (SL_LOG_BEEP, code, comname, "^a>cdt", sysdir); end; call cu_$arg_count_rel (arg_count, arg_list_ptr, (0)); /* AF invocation not an issue */ return; /* end of setup */ end general_setup; %page; build_string: proc (P_arg_list_ptr, P_argno); dcl P_arg_list_ptr pointer parameter; dcl P_argno fixed bin parameter; /* arg number to start from */ dcl argno fixed bin; argno = P_argno; answer = "Incorrect number of arguments."; call cu_$arg_ptr_rel (argno, arg_ptr, arg_length, code, P_arg_list_ptr); if code ^= 0 then go to ERROR_RETURN; msg_string = arg; msg_string_len = arg_length; build: argno = argno + 1; call cu_$arg_ptr_rel (argno, arg_ptr, arg_length, code, P_arg_list_ptr); if code ^= 0 then return; substr (msg_string, msg_string_len + 2) = arg; msg_string_len = msg_string_len + 1 + arg_length; if msg_string_len > length (msg_string) then return; go to build; end build_string; %page; process_bump_args: procedure (arg_list_ptr, grace_flag); /* Internal procedures should not call this procedure. Instead, they should call internal_bump, or a program like it, which will call us. */ dcl arg_list_ptr ptr parameter; /* pointer to our caller's argument list */ dcl grace_flag bit (1) aligned parameter; /* grace period arg allowed ? (Input) */ dcl i fixed bin (17); /* temporary */ dcl dot_index fixed bin (17); call general_setup; /* locate answer table; some housekeeping */ bump_by_chn_id, bump_by_dsa, bump_by_mpx, bump_by_pid = ""b; /* set switches ... */ bump_by_name = "1"b; /* we'll try by_name unless proven innocent! */ call cu_$arg_ptr_rel (1, arg_ptr, arg_length, code, arg_list_ptr); /* get first argument */ if code ^= 0 then do; BUMP_ETC_USAGE: call ioa_$rsnnl ("Usage: ^a (Person.Project|CHANNEL|mpx MPX|-pid PID) {TIME MESSAGE}", answer, (0), comname); go to ANSWER_RETURN; end; if substr (arg, 1, 9) = "anonymous" then do; input_person_id = substr (arg, 1, 9); if (arg_length > 10) & (index (arg, ".") = 10) then input_project_id = substr (arg, 11); else goto BUMP_ETC_USAGE; end; dot_index = index (arg, "."); if dot_index = 0 then do; /* only by mpx, fnp */ if arg = "fnp" | arg = "mpx" then do; fnp_only = (arg = "fnp"); input_person_id = arg; /* for use in error messages */ call get_mpx_name (2); /* Multiplexer name should be arg 2 */ bump_by_mpx = "1"b; input_project_id = rtrim(mpx_name); input_channel = ""; mpx_starname = rtrim (mpx_name) || ".**"; end; else if (arg = "-process_id") | (arg = "-pid") then do; call cu_$arg_ptr_rel (2, arg_ptr, arg_length, code, arg_list_ptr); /* get process_id */ if code ^= 0 then goto BUMP_ETC_USAGE; if arg_length ^= 6 & (arg_length ^= 12) then goto PID_ERR; bin_pid = cv_oct_check_ ((arg), code); /* octal number? */ if code = 0 then do; bump_by_pid = "1"b; input_pid = ""b; if arg_length = 12 then input_pid = unspec (bin_pid); else substr (input_pid, 1, 18) = substr (unspec (bin_pid), 19); end; else do; PID_ERR: answer = "Invalid process id: "|| arg || ". Use the first 6 or all 12 digits of the pid."; goto ERROR_RETURN; end; end; else do; call ioa_$rsnnl ( "Usage: ^a (Person.Project|CHANNEL|mpx MPX) {TIME MESSAGE}^/The ""Person Project"" format is obsolete.", answer, (0), comname); go to ANSWER_RETURN; end; arg_index = 3; /* grace time, or message, if any, starts with arg 3 */ bump_by_name = ""b; end; else do; input_person_id = substr (arg, 1, dot_index - 1); input_project_id = substr (arg, dot_index + 1); if index (input_project_id, ".") ^= 0 /* if more than two components ... */ then do; bump_by_name = ""b; /* it can't be by_name; */ input_channel = arg; end; /* else, first try by_name, then by tty or dsa channel */ if arg ^= "*.*" then do; input_channel = arg; if input_person_id = "dsa" /* check first component */ then bump_by_dsa = "1"b; else bump_by_chn_id = "1"b; end; arg_index = 2; end; grace_period = 0; /* zero grace */ msg_string = ""; /* blank message */ if grace_flag then do; call cu_$arg_ptr_rel (arg_index, arg_ptr, arg_length, code, arg_list_ptr); /* grace period? (minutes) */ if code = 0 then do; i = cv_dec_check_ ((arg), code); /* number? */ if code = 0 then do; /* yes. */ grace_period = i * 60; /* convert to seconds */ arg_index = arg_index + 1; /* step argument index */ end; end; end; call cu_$arg_ptr_rel (arg_index, arg_ptr, arg_length, code, arg_list_ptr); /* message? */ if code = 0 then call build_string (arg_list_ptr, arg_index); /* get any remaining args and make message */ return; end process_bump_args; %page; get_mpx_name: proc (argno); dcl argno fixed bin; call cu_$arg_ptr_rel (argno, arg_ptr, arg_length, code, arg_list_ptr); if code ^= 0 then do; if fnp_only then answer = "No FNP tag specified"; else answer = "No multiplexer specified"; go to ANSWER_RETURN; end; mpx_name = arg; if fnp_only then do; /* extra checks to be compatable with old commands */ if length (rtrim (mpx_name)) > 1 then do; bad_mpx_fnp_name: answer = "Invalid FNP tag: " || mpx_name; go to ANSWER_RETURN; end; if index ("abcdefgh", substr (mpx_name, 1, 1)) = 0 then go to bad_mpx_fnp_name; end; return; end get_mpx_name; %page; bump_procedure: proc (); dcl action_flag bit (1) aligned; dcl bin_action fixed bin (71) aligned based; dcl continue bit (1); dcl i fixed bin; action_flag = ""b; cdtep = null (); code = 0; TRY_AGAIN: continue = "1"b; if bump_by_name then do i = 1 to anstbl.current_size while (continue); utep = addr (anstbl.entry (i)); if ute.active >= NOW_LOGGED_IN then do; if input_person_id = ute.person | input_person_id = "*" then if input_project_id = ute.project | input_project_id = "*" then do; bump_by_chn_id, bump_by_dsa = ""b; /* it WAS by name after all */ call PROCESS_UTE (); if input_person_id ^= "*" & input_project_id ^= "*" then continue = "0"b; /* no need to go further */ end; end; end; else if bump_by_dsa then do i = 1 to anstbl.current_size while (continue); utep = addr (anstbl.entry (i)); if ute.active >= NOW_LOGGED_IN then do; if index (input_channel, "*") > 0 then do; call match_star_name_ ((ute.tty_name), input_channel, code); if code = 0 then call PROCESS_UTE (); end; else do; /* no stars */ if input_channel = ute.tty_name then do; call PROCESS_UTE (); continue = "0"b; /* no need to go further */ end; end; end; /* not logged in, skip it */ end; else if bump_by_pid then do i = 1 to anstbl.current_size while (continue); utep = addr (anstbl.entry (i)); if ute.active >= NOW_LOGGED_IN then do; if substr (input_pid, 1, 18) = substr (ute.proc_id, 1, 18) then do; call PROCESS_UTE (); continue = "0"b; /* no need to go further */ end; end; /* not logged in, skip it */ end; else do; /* not bumping by name or dsa */ do i = 1 to scdtp -> cdt.current_size while (continue); cdtep = addr (scdtp -> cdt.cdt_entry (i)); if bump_by_mpx then do; call match_star_name_ ((cdte.name), mpx_starname, code); if code = 0 then call PROCESS_CDTE (); end; else if cdte.name = input_channel then do; call PROCESS_CDTE (); continue = "0"b; /* no need to go further */ end; end; end; if action_flag then return; /* successful */ else if (bump_by_name & (bump_by_dsa | bump_by_chn_id)) then do; bump_by_name = ""b; go to TRY_AGAIN; /* try for a channel match this time */ end; else call sys_log_$command (SL_TYPE, "^a: no ^a signalled to ^[^12.3b^4s^;^s^[^a.^a^s^;^2s^a^]^]", comname, action, bump_by_pid, input_pid, (bump_by_name | bump_by_mpx), input_person_id, input_project_id, input_channel); return; %page; PROCESS_UTE: procedure (); /**** This procedure is used to perform the desired action on the specified ute. The action is specified via the variable "action". It is called either from bump_procedure or PROCESS_CDTE ****/ dcl chan_name char (32); answer = "Error recieved from AS."; if respect_nobump & bump_by_name then if ute.at.nobump then do; call sys_log_$command (SL_TYPE, "^a: ^[^a.^a^s^;^2s^12.3b^] has ""nobump""", comname, bump_by_name, ute.person, ute.project, ute.proc_id); if ^ute.uflags.disconnected then call asu_$blast_user (utep, "Bump attempted. " || msg_string, (""), (0)); return; end; if action = "hangup" then if ute.channel = null then return; else do; call asu_$disconnect_user (utep, code); if code ^= 0 then goto ERROR_RETURN; end; else if action = "unbump" then if ute.preempted <= 0 then return; else do; call asu_$unbump_user (utep, code); if code ^= 0 then goto ERROR_RETURN; end; else if action = "terminat" then do; call asu_$terminate_user (utep, code); if code ^= 0 then goto ERROR_RETURN; end; else if action = "detach" then do; call asu_$detach_user (utep, code); if code ^= 0 then goto ERROR_RETURN; end; else if action = "bump" then do; call asu_$bump_user (utep, msg_string, code, grace_period); if code = error_table_$action_not_performed & cdtep = null then code = 0; else if code ^= 0 then goto ERROR_RETURN; end; /**** This tells the operator what we did and sets the flag saying that we did something. */ if cdtep = null then chan_name = ute.tty_name; else chan_name = cdte.name; call sys_log_$command (SL_TYPE, "^a: ^[^12.3b^4s^;^s^[^a.^a^s^;^2s^a^]^] ^a", comname, bump_by_pid, ute.proc_id, bump_by_name, ute.person, ute.project, chan_name, action_log); action_flag = "1"b; /* remember we did one */ return; end PROCESS_UTE; PROCESS_CDTE: procedure (); /**** This procedure is called to perform the action specified by the variable "action" on the specified channel. */ utep = cdte.process; if cdte.in_use = NOW_HAS_PROCESS then call PROCESS_UTE (); else if action = "detach" then do; if cdte.current_service_type = MC_SERVICE then call sys_log_$command (SL_LOG, "operator_process_cmds_: detach: Channel ^a is in use by the message coordinator and cannot be detached", cdte.name) ; else if cdte.current_service_type = INACTIVE then call sys_log_$command (SL_LOG, "operator_process_cmds_: detach: Channel ^a is not currently active and cannot be detached"); else do; call hcs_$wakeup (as_procid, cdte.event, addr (action) -> bin_action, code); if code = 0 then do; /* tell operator we did it */ call sys_log_$command (SL_TYPE, "^a: ^a ^a", comname, cdte.name, action_log); action_flag = "1"b; /* remember we did one */ end; else call sys_log_$command_error (SL_LOG, code, comname, "From hcs_$wakeup for ^a", cdte.name); end; end; return; end PROCESS_CDTE; end bump_procedure; %page; %include as_data_; %page; %include as_data_definitions_; %page; %include answer_table; %page; %include author_dcl; %page; %include cdt; %page; %include dialup_values; %page; %include sc_stat_; %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: operator_process_cmds_: COMMAND: ERROR_TABLE_MESSAGE SYSDIR>answer_table S: $as1 T: In response to an operator command, COMMAND. M: The system was unable to access the answer_table in SYSDIR. A: $inform Message: operator_process_cmds_: COMMAND: ERROR_TABLE_MESSAGE SYSDIR>whotab S: $as1 T: In response to an operator command, COMMAND. M: The system was unable to access the whotab in SYSDIR. A: $inform Message: operator_process_cmds_: COMMAND: ERROR_TABLE_MESSAGE SYSDIR>installation_parms S: $as1 T: In response to an operator command, COMMAND. M: The system was unable to access the installation_parms in SYSDIR. A: $inform Message: operator_process_cmds_: COMMAND: ERROR_TABLE_MESSAGE SYSDIR>cdt S: $as1 T: In response to an operator command, COMMAND. M: The system was unable to access the cdt in SYSDIR. A: $inform Message: operator_process_cmds_: COMMAND: ERROR_TABLE_MESSAGE Incorrect number of arguments. S: $as1 T: In response to an operator command COMMAND. M: Insufficient number of arguments supplied with the command. A: $tryagain Message: operator_process_cmds_: COMMAND: error: Usage: COMMAND (Person.Project|CHANNEL|mpx MPX|-pid) {TIME MESSAGE} S: $as1 T: In response to an operator command COMMAND. M: Insufficient number of arguments supplied with the command. A: $tryagain Message: operator_process_cmds_: COMMAND: ERROR_TABLE_MESSAGE Invalid process id: PROCESS_ID. Use the first 6 or all 12 digits of the pid. S: $as1 T: In response to an operator command COMMAND. M: The typed length of the PROCESS_ID was incorrect. A: $tryagain Message: operator_process_cmds_: COMMAND: error: No FNP tag specified S: $as1 T: In response to an operator command COMMAND. M: Expected a FNP designator, but none typed following COMMAND. A: $tryagain Message: operator_process_cmds_: COMMAND: error: No multiplexer specified S: $as1 T: In response to an operator command COMMAND. M: Expected a multiplexer designator, but none typed following COMMAND. A: $tryagain Message: operator_process_cmds_: COMMAND: error: Invalid FNP tag: FNP S: $as1 T: In response to an operator command COMMAND. M: The FNP tag following COMMAND was more than one character in length. FNP specifiers can only be one character long (ie: a, b, c, etc.). A: $tryagain Message: operator_process_cmds_: COMMAND: ERROR_TABLE_MESSAGE Error recieved from AS. S: $as1 T: In response to an operator command COMMAND. M: Recieved an error from answering service attempting to remove the terminal user from the system answer table. User's process state will remain unchanged. A: $tryagain Message: operator_process_cmds_: COMMAND: ERROR_TABLE_MESSAGE From hcs_$wakeup for CHANNEL S: $as1 T: In response to an operator command COMMAND. M: Recieved an error from answering service when attempting to process the command COMMAND for channel CHANNEL. A: $tryagain Message: operator_process_cmds_: COMMAND: error: Usage: COMMAND (Person.Project|CHANNEL|mpx MPX) {TIME MESSAGE} The "Person Project" format is obsolete. S: $as1 T: In response to an operator command COMMAND. M: The character "." was not found on the request line and COMMAND was not followed by a process id. If argument following COMMAND is personid and projectid, the correct syntax is "Person.Project" not "Person Project". A: $tryagain Message: operator_process_cmds_: unbump: error: invalid arguments S: $as1 T: $response M: A bad argument has been typed to the unbump command. No action was taken. A: $tryagain Message: operator_process_cmds_: bump: error: invalid arguments S: $as1 T: $response M: A bad argument has been typed to the bump command. No action was taken. A: $tryagain Message: operator_process_cmds_: detach: error: invalid arguments S: $as1 T: $response M: A bad argument has been typed to the detach command. No action was taken. A: $tryagain Message: operator_process_cmds_: bump: no bump signalled to NAME PROJ S: $as1 T: $response M: An operator bump command specified a nonexistent channel name or user name and project. No action was taken on the command. A: Enter a corrected command line. This message may be printed as a result of trying to bump a user by name when he has nobump privilege. Bump him by channel name instead. Message: operator_process_cmds_: unbump: no unbump signalled to NAME PROJ S: $as1 T: $response M: An operator unbump command specified a nonexistent channel name or user name and project, or the user specified was not in a bumped state. No action was taken on the command. A: $tryagain Message: operator_process_cmds_: terminate: no terminate signalled to NAME PROJ S: $as1 T: $response M: An operator terminate command specified a nonexistent channel name or user name and project. No action was taken on the command. A: $tryagain Message: operator_process_cmds_: detach: no detach signalled to NAME PROJ S: $as1 T: $response M: An operator detach command specified a nonexistent channel name or user name and project. No action was taken on the command. A: $tryagain Message: operator_process_cmds_: detach: ERROR_MESSAGE CHANNEL S: $as1 T: $response M: The operator has issued a detach CHANNEL command and the error described by ERROR_MESSAGE occurred during the attempt to detach it. A: $tryagain Message: operator_process_cmds_: detach: CHANNEL is in use by the message coordinator and can not be detached. S: $as1 T: $response M: An operator detach command specified a message coordinator channel. The channel was not detached. A: Enter a corrected command line. Use the drop command to take a channel away from the message coordinator. Message: operator_process_cmds_: detach: Channel CHANNEL is not currently active and cannot be detached. S: $as1 T: $response M: An operator detach command specified a channel that is not attached. No action was taken. A: Enter a corrected command line Message: operator_process_cmds_: detach: NAME.PROJ detached S: $as1 T: $response M: This is the response to an operator detach command. The user affected is named. A: $ignore Message: operator_process_cmds_: terminate: NAME.PROJ terminated S: $as1 T: $response M: This is the response to an operator terminate command. The user affected is named. A: $ignore Message: operator_process_cmds_: bump: NAME.PROJ bumped S: $as1 T: $response M: This is the response to an operator bump command. The user affected is named. A: $ignore Message: operator_process_cmds_: disconnect: NAME.PROJ disconnected. S: $as1 T: $response M: This is the response to an operator disconnect command. The user affected is named. A: $ignore Message: operator_process_cmds_: unbump: NAME.PROJ unbumped S: $as1 T: $response M: This is the response to an operator unbump command. The user affected is named. A: $ignore Message: operator_process_cmds_: bump: NAME.PROJ has "nobump" S: $as1 T: $run M: This is the response to the command bump NAME PROJ if the user has the nobump privilege. The user was not bumped. A: If it is imperative to bump the user, for instance at system shutdown time, do a who to find out his channel number, then type "bump CHANNEL". END MESSAGE DOCUMENTATION */ end operator_process_cmds_;  send_ls_request_.pl1 08/04/87 1531.0rew 08/04/87 1221.9 44424 /****^ *********************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright, (C) Honeywell Information Systems Inc., 1987 * * * *********************************************************** */ /****^ HISTORY COMMENTS: 1) change(86-06-01,Coren), approve(87-07-13,MCR7737), audit(87-07-24,Brunelle), install(87-08-04,MR12.1-1055): Initially written. 2) change(87-03-10,GDixon), approve(87-07-13,MCR7737), audit(87-07-24,Brunelle), install(87-08-04,MR12.1-1055): Corrected coding standard violations. END HISTORY COMMENTS */ /* format: style4,indattr */ send_ls_request_: procedure (P_ls_request_ptr, P_ls_request_lth, P_ls_ipc_reply_ptr, P_code); /* Parameters */ dcl P_ls_request_ptr ptr parameter; dcl P_ls_request_lth fixed bin (18) parameter; dcl P_ls_ipc_reply_ptr ptr parameter; dcl P_code fixed bin (35) parameter; /* Automatic */ dcl 1 auto_event_wait_info aligned like event_wait_info automatic; dcl code fixed bin (35) automatic; dcl created_event_channel bit (1) aligned automatic; dcl event_channel fixed bin (71) automatic; dcl ls_request_lth fixed bin (18) automatic; dcl request_ms_dirname char (168) automatic; dcl request_ms_entryname char (32) automatic; dcl server_event_channel fixed bin (71) automatic; dcl server_process_id bit (36) aligned automatic; /* Entries */ dcl hcs_$wakeup entry (bit (36) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl ipc_$block entry (ptr, ptr, fixed bin (35)); dcl ipc_$create_ev_chn entry (fixed bin (71), fixed bin (35)); dcl ipc_$delete_ev_chn entry (fixed bin (71), fixed bin (35)); dcl login_server_info_$request_info entry (bit (36) aligned, fixed bin (71), char (*), char (*), fixed bin (35)); dcl message_segment_$add_file entry (char (*), char (*), ptr, fixed bin, bit (72) aligned, fixed bin (35)); /* External */ dcl error_table_$null_info_ptr fixed bin (35) ext static; dcl error_table_$smallarg fixed bin (35) ext static; dcl error_table_$unimplemented_version fixed bin (35) ext static; /* Constant */ dcl TRUE bit (1) aligned initial ("1"b) internal static options (constant); dcl FALSE bit (1) aligned initial ("0"b) internal static options (constant); /* BUILTINS */ dcl (addr, currentsize, null, unspec) builtin; /* CONDITIONS */ dcl cleanup condition; %page; /* Program */ created_event_channel = FALSE; on cleanup call Clean_Up (); ls_request_ptr = P_ls_request_ptr; ls_request_lth = P_ls_request_lth; ls_reply_message_ptr = P_ls_ipc_reply_ptr; if ls_request_ptr = null () then do; code = error_table_$null_info_ptr; goto RETURN; end; if ls_request_lth < currentsize (ls_request_header) then do; code = error_table_$smallarg; goto RETURN; end; if ls_request_header.header_version ^= LS_REQUEST_HEADER_VERSION_1 then do; code = error_table_$unimplemented_version; goto RETURN; end; call login_server_info_$request_info (server_process_id, server_event_channel, request_ms_dirname, request_ms_entryname, code); if code ^= 0 then goto RETURN; if ls_request_header.reply_event_channel = 0 then do; created_event_channel = TRUE; call ipc_$create_ev_chn (event_channel, code); if code ^= 0 then goto RETURN; ls_request_header.reply_event_channel = event_channel; end; call message_segment_$add_file (request_ms_dirname, request_ms_entryname, ls_request_ptr, ls_request_lth * 36, (""b), code); if code ^= 0 then goto RETURN; call hcs_$wakeup (server_process_id, server_event_channel, -1, code); if code ^= 0 then goto RETURN; event_wait_channel.n_channels = 1; event_wait_channel.pad = ""b; event_wait_channel.channel_id = ls_request_header.reply_event_channel; event_wait_info_ptr = addr (auto_event_wait_info); BLOCK_AGAIN: call ipc_$block (addr (event_wait_channel), event_wait_info_ptr, code); if code ^= 0 then goto RETURN; /**** For now, the formats are the same, but this might change. Fill in the ipc reply output structure. */ unspec (ls_reply_message) = unspec (event_wait_info.message); code = 0; RETURN: P_code = code; return; %page; Clean_Up: procedure (); if created_event_channel then call ipc_$delete_ev_chn (event_channel, (0)); return; end Clean_Up; /* format: off */ %page; %include event_wait_channel; %page; %include event_wait_info; %page; %include login_server_messages; end send_ls_request_; 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