ftp_dialup_.pl1 09/01/88 1339.9rew 09/01/88 1338.5 971757 /****^ ****************************************************** * * * Copyright, (C) Honeywell Bull Inc., 1987 * * * * Copyright (C) 1982 by Massachusetts Institute of * * Technology and Honeywell Information Systems Inc. * * * * Copyright (c) 1972 by Massachusetts Institute of * * Technology and Honeywell Information Systems, Inc. * * * ****************************************************** */ /* format: style4 */ ftp_dialup_: procedure (msg_ptr); /* Answering service module for FTP users ... This module performs functions for FTP users analogous to those performed by dialup_ for interactive users. Lifted from dialup_ with miscellaneous changes by Roy P. Planalp 760628 Also changed by D. M. Wells to prevent password alteration from FTP Heavily modified by Roy Planalp, summer 1976, to talk FTP language directly. Last modified by D. M. Wells, Oct. 1976, to fix ftp reply code for special sessions and to not check return code for disable_xmog order call. Modified: 15 December 1978 by G. Palter to release ATE entry when dialing to ARPANET_mail. Previous history of original dialup_: Originally coded by J. F. Ossanna Jan 1969 Recoded by Michael J. Spier and Robert C. Daley February 1969 Revised by Michael D. Schroeder, July Re-revised, converted to PL/1 and adapted to current System/User Control by Michael J. Spier, 25.12.1969, 'twixt X-mas and New-Year Modified for inactive bump & fixes THVV 9/70 Modified for new ttydim, removing many waits, 12/70 THVV Modified for efficiency, ucs handler, login args THVV Modified for garbage for consoles without poff, THVV Modified for help function THVV 11/71 Modified for dynamic changing of password, J.Phillipps 8/72 Modified 740913 by PG for generated passwords Modified 750226 by PG for Multics Communication System (MCS) Modified 750328 by PG to use printer_on and printer_off order calls. Modified 750417 by PG for new_proc -authorization Modified 750502 by PG to fix bug which left logged-out users in whotab Modified 750715 by PG & THVV for MCS Phase II Modified 751110 by PG for bug fixes & ttydim/network dim changes Modified April 1976 by T. Casey to detect fatal process error loops and process initialization failures, . and to ask for new password twice when -cpw is given, . and by P. Green to fix misc. bugs. Modified 760601 by PG to fix pw mask handling and add resetreads. Modified by D. M. Wells, Feb. 1977, to get more info about term and to fix a problem with states and dialed terminals. Modified by Robert Coren, 8/4/77, for site-settable named terminal types. Modified September 1977 by T. Casey to fix hung process bugs. Modified October 1977 by T. Casey to send term signal to process being bumped, and wait for it to destroy itself. Modified January 1978 by T. Casey and R. Coren to fix bugs in previous two modifications. Modified May 1978 by T. Casey to use parameters in installation_parms in the fatal process error loop detector, . and to try to destroy processes whose stopstop wakeups were apparently lost. Modified July 1979 by T. Casey for MR8.0 to implement the ate management strategy needed for process preservation across hangups, (but note that ftp processes are not preserved across hangups). Modified June 1981 by T. Casey for MR9.0 for new wakeup priorities, and bugfixes. Modified November 1981, E. N. Kittlitz. user_table_entry conversion. Modified December 1981, E. N. Kittlitz. changes to login_parse_. Modified January 1982, E. N. Kittlitz. eliminate edited modes fiddling. Modified May 1982, E. N. Kittlitz. New AS initialization. Modified September 1982, E. N. Kittlitz. Channel name in login banner. Modified October 1982 by J. G. Ata for RFC765 support. Modified February 1983 by E. N. Kittlitz for new Password: prompt. Modified May 1983 by E. N. Kittlitz for AIMish sty support. Modified September 1983 by J. Spencer Love to use channel access class rather than default authorization. Modified January 1983 by J. G. Ata to fix reply codes, put back answerback processing, and miscellaneous bug fixes. Modified September 1984 by J. G. Ata to install WAIT_HANGUP functionality. Modified 1984-12-13 by E. Swenson to start processes with asu_$start_process Modified 1985-04-19 by E. Swenson for signal_io_ condition. */ /****^ HISTORY COMMENTS: 1) change(85-07-29,Swenson), approve(86-08-13,MCR7512), audit(86-08-13,EJSharpe), install(86-09-08,MR12.0-1150): Modified to initialize tty_access_class structure and recompiled for tty_access_class include file change. 2) change(86-01-29,Swenson), approve(86-08-13,MCR7512), audit(86-08-13,EJSharpe), install(86-09-08,MR12.0-1150): Added display of process AIM authorization upon login. This used to be displayed by act_ctl_, but now is done by dialup_ and ftp_dialup_. 3) change(86-09-21,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-08-03,MCR7741), audit(87-07-16,Brunelle), install(87-08-04,MR12.1-1055): A) Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1. B) Note new user-signalled event for the disconnect command (disconn). Although the command cannot be used in absentee processes, if the user attempts to call terminate_process_ for a disconnection, we will instead destroy the process. 5) change(87-05-11,GDixon), approve(87-08-03,MCR7741), audit(87-07-16,Brunelle), install(87-08-04,MR12.1-1055): A) Replace freeing of UTE with call to user_table_mgr_$free. B) Use constant from dialup_values.incl.pl1 to set ute.tag. 6) change(87-05-15,GDixon), approve(87-08-03,MCR7741), audit(87-07-16,Brunelle), install(87-08-04,MR12.1-1055): A) Set ute.line_type from cdte.line_type. B) Use constants to test/set ute.preempted. 7) change(88-08-03,GDixon), approve(88-08-03,MCR7973), audit(88-08-11,Lippard), install(88-09-01,MR12.2-1096): A) Always check whether a CDTE is available before testing it to determine if using RFC765 protocol or earlier protocol. (phx20445) B) Restore saved cdte.process pointer to UTE when a NETML person ID attempts to dial to the ARPANET_mail dial ID (network mail server) and fails. This allows the user to login his own NETML process rather than getting a null pointer fault referencing cdte.process (which failed dial_ctl_ attempt set to null). (phx20444) C) Correct problem in sending special session message as a separate response, rather than as part of the greeting banner response. When a "word login MESSAGE" pre-greeting banner message is present, ftp_dialup_ was sending that message as a separate response: 120 Unattended Service. 220-Multics MR12.2: Honeywell Bull, Phoenix AZ, SysM (Channel CHAN) 220 Load = 29.4 out of 200.0 units: users = 45, 08/03/88 1400. rather than as part of the greeting banner response: 220-Unattended Service. Multics MR12.2: Honeywell Bull, Phoenix AZ, SysM (Channel CHAN) 220 Load = 29.4 out of 200.0 units: users = 45, 08/03/88 1400. Sending two responses in a row (without a response from the sending end) violates FTP protocols in RFC765. In addition, use of the 120 response code for the special message is inappropriate, since it means: 120 Service ready in nnn minutes rather than: 220 Service ready for new user FTP protocols require that the two ends alternate responses, but without this change, Multics was sending two different responses in a row. END HISTORY COMMENTS */ /* parameters */ dcl msg_ptr ptr; /* argument to event-call procedure */ /* builtins */ dcl (addr, baseno, clock, divide, float, hbound, index, lbound, length, min, null, reverse, rtrim, string, substr, translate, unspec, verify) builtin; /* entries */ dcl act_ctl_$close_account entry (ptr); dcl act_ctl_$cp entry (ptr); dcl act_ctl_$dp entry (ptr); /* charge user */ dcl act_ctl_$open_account entry (ptr); dcl aim_check_$equal entry (bit (72) aligned, bit (72) aligned) returns (bit (1) aligned); dcl as_dump_ entry (char (*)); dcl astty_$tty_abort entry (ptr, fixed bin, fixed bin (35)); /* astty_ is used for all terminal i/o */ dcl astty_$tty_changemode entry (ptr, char (*), fixed bin (35)); dcl astty_$tty_event entry (ptr, fixed bin (35)); /* cause device signals to come to caller */ dcl astty_$tty_force entry (ptr, ptr, fixed bin, fixed bin (35)); dcl astty_$tty_get_chars entry (ptr, ptr, fixed bin, fixed bin (35)); dcl astty_$tty_new_proc entry (ptr, bit (36) aligned, fixed bin (35)); /* force "uproc" to processid */ dcl astty_$tty_order entry (ptr, char (*), ptr, fixed bin (35)); dcl astty_$tty_read entry (ptr, ptr, fixed bin, fixed bin (35)); dcl astty_$tty_state entry (ptr, fixed bin (35)); dcl asu_$asu_listen entry (ptr, fixed bin (35)); /* program makes event chan & orders listen */ dcl asu_$asu_remove entry (ptr); /* completely removes tty chn from system */ dcl asu_$attach_ate entry (ptr, fixed bin (35)); dcl asu_$check_for_stopped_process entry (ptr, char (*)) returns (bit (1) aligned); dcl asu_$find_process entry (bit (36) aligned, fixed bin, ptr); dcl asu_$release_ate entry (ptr, fixed bin (35)); dcl asu_$remove_cdte entry (ptr); /* remove channel of garbaged cdte, if possible */ dcl asu_$send_term_signal entry (ptr, fixed bin) returns (bit (1) aligned); dcl asu_$start_process entry (ptr); dcl condition_ entry (char (*), entry); dcl convert_ipc_code_ entry (fixed bin (35)); dcl convert_status_code_ entry (fixed bin (35), char (8) aligned, char (100) aligned); dcl cpg_ entry (ptr, fixed bin (35)); /* utility to create process */ dcl cpu_time_and_paging_ entry (fixed bin, fixed bin (71), fixed bin); dcl date_time_ entry (fixed bin (71), char (*) aligned); /* formats date and time */ dcl device_acct_$off entry (fixed bin, char (*) aligned, ptr); dcl device_acct_$on entry (fixed bin, char (*) aligned, ptr); dcl dial_ctl_ entry (ptr, char (*), char (*), fixed bin (35)); dcl dial_ctl_$dial_broom entry (ptr, char (8) aligned); dcl dial_ctl_$dial_term entry (ptr); dcl dial_ctl_$finish_priv_attach entry (ptr); dcl dpg_ entry (ptr, char (*)); /* utility to destroy process */ dcl dpg_$finish entry (ptr); /* second half of process destruction */ dcl hcs_$wakeup entry (bit (*) aligned, fixed bin (71), fixed bin (71), fixed bin (35)); dcl (ioa_, ioa_$rs, ioa_$rsnnl) entry options (variable); 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_$unmask_ev_calls entry (fixed bin (35)); dcl lg_ctl_$login entry (ptr, char (8), char (*) varying, fixed bin (35)); dcl lg_ctl_$logout entry (ptr); dcl login_parse_ entry (ptr, fixed bin, char (*), fixed bin, fixed bin, fixed bin (35)); dcl login_parse_$password entry (ptr, fixed bin, char (*), fixed bin, fixed bin, fixed bin (35)); dcl lv_request_$cleanup_process entry (bit (36) aligned); dcl match_star_name_ entry (char (*) aligned, char (*) aligned, fixed bin (35)); dcl parse_ftp_login_line_ entry (ptr, fixed bin, ptr, char (*) aligned, fixed bin (35)); dcl rcp_sys_$unassign_process entry (bit (36) aligned, fixed bin (35)); dcl scramble_ entry (char (8)) returns (char (8)); dcl sub_err_ entry () options (variable); dcl (sys_log_, sys_log_$error_log) entry options (variable); /* error reporting program */ 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 ttt_info_$decode_answerback entry (char (*), fixed bin, char (*), char (*) aligned, fixed bin (35)); dcl ttt_info_$default_term_type entry (fixed bin, fixed bin, char (*), fixed bin (35)); dcl ttt_info_$preaccess_type entry (char (*), char (*), fixed bin (35)); dcl user_table_mgr_$free entry (ptr); /* external static */ dcl error_table_$bad_arg fixed bin (35) ext static; dcl error_table_$badstar fixed bin (35) ext static; dcl error_table_$noarg fixed bin (35) ext static; dcl error_table_$out_of_sequence fixed bin (35) ext static; dcl as_error_table_$illegal_new_proc fixed bin (35) external static; dcl as_error_table_$term_by_operator fixed bin (35) external static; dcl as_error_table_$bad_answerback fixed bin (35) external; dcl as_error_table_$illegal_signal fixed bin (35) ext; dcl as_error_table_$dialup_error fixed bin (35) ext; dcl as_error_table_$automatic_logout fixed bin (35) ext; dcl as_error_table_$greeting_msg fixed bin (35) ext; dcl as_error_table_$bad_login_word_msg fixed bin (35) ext; dcl as_error_table_$bad_login_arg_msg fixed bin (35) ext; dcl as_error_table_$no_login_arg_msg fixed bin (35) ext; dcl as_error_table_$init_err fixed bin (35) ext; dcl as_error_table_$logout_msg fixed bin (35) ext; dcl as_error_table_$logout1_msg fixed bin (35) ext; dcl as_error_table_$no_init_proc fixed bin (35) ext; dcl as_error_table_$no_io_attach fixed bin (35) ext; dcl as_error_table_$proc_term_msg fixed bin (35) ext; dcl as_error_table_$init_term_msg fixed bin (35) ext; dcl as_error_table_$proc_term_loop_msg fixed bin (35) ext; dcl as_error_table_$pw_msg fixed bin (35) ext; dcl as_error_table_$shutdown fixed bin (35) ext; dcl as_error_table_$special_session fixed bin (35) ext; dcl as_error_table_$coming_up fixed bin (35) ext; dcl as_error_table_$detach fixed bin (35) ext; dcl as_error_table_$process_create_fail fixed bin (35) ext; dcl as_error_table_$no_signal fixed bin (35) ext; dcl as_error_table_$bump_cancelled fixed bin (35) ext; dcl as_error_table_$sys_full fixed bin (35) ext; dcl as_error_table_$tty_no_room fixed bin (35) ext; dcl 1 ftp_misc_$ftp_login_responder aligned external static, 2 pathlen fixed bin (35), 2 overseer char (168) aligned; /* DECLARATION OF INTERNAL STATIC VARIABLES */ dcl static_label label int static; /* where to go on error */ dcl loudsw bit (1) aligned init ("0"b) int static; /* 1 if super-loud */ dcl NL char (1) aligned int static init (" "); dcl dum_msg fixed binary (71) int static initial (0); /* dummy ipc message */ dcl STOPstop char (8) aligned int static init ("STOPstop"); dcl STOPstop_msg fixed bin (71) based (addr (STOPstop)); dcl termstop char (8) aligned int static init ("termstop"); dcl termstop_msg fixed bin (71) based (addr (termstop)); dcl greeting_fmt char (100) aligned varying int static; /* Message format frm as_error_table_ */ dcl bad_login_word_fmt char (100) aligned varying int static; /* .. */ dcl (proc_term_fmt, init_term_fmt, proc_term_loop_fmt) char (100) aligned varying int static; dcl (logout_fmt, logout_fmt1) char (100) aligned varying int static; /* .. */ dcl pw_msg char (16) varying int static; /* "password" */ dcl ME char (11) init ("ftp_dialup_") static options (constant); /* AUTOMATIC */ dcl time fixed bin (71); dcl ftp_765 bit (1); /* On IFF we are using RFC 765 protocol */ dcl ftp_code fixed bin (17); dcl (i, j, k, lgwd) fixed bin; /* temps */ dcl user_login_word char (16); dcl (code, ignore_code) fixed bin (35); /* std status code */ dcl tcode fixed bin (35); /* errcode */ dcl (old_pf, new_pf) fixed bin; dcl (old_cpu, new_cpu) fixed bin (71); dcl (old_pp, new_pp) fixed bin; dcl (saved_atep1, saved_atep2, q, p1) ptr; /* misc pointers */ dcl say_hello bit (1); /* TRUE at login unless logout -hold -brief */ dcl just_dialed_up bit (1); /* Distinguaish between dialup and logout-hold */ dcl user_password char (8); /* password typed by user. scrambled. */ dcl jj fixed bin; /* temp for password parse */ dcl (dial_qual, dial_arg1) char (32); /* for dial command */ dcl funct char (8) aligned; /* used at "hand (8)" - event message */ dcl nc fixed bin; /* char count for read */ dcl (t1, t2) float bin; /* temps for units message */ dcl shxx char (8) aligned; /* error id */ dcl error_mess char (100) aligned; /* ... for convert_status_code */ dcl date_time char (24) aligned; /* character date and time */ dcl buff char (300) aligned; /* i-o buffer for writes */ dcl lg_err char (168) varying; /* reason user couldn't log in, ret. from lg_ctl_ */ dcl type_to_set char (32); /* terminal type to be set */ dcl (wakeup_for_channel, /* wakeup over a cdte event channel */ wakeup_for_process, /* wakeup over an ate event channel */ wakeup_from_as, /* wakeup came from answering service */ wakeup_from_ring_zero, /* wakeup came from ring zero */ wakeup_from_user /* wakeup came from user process */ ) bit (1) aligned init (""b); /* switches to keep track of where wakeup came from */ dcl tra_vec fixed bin; /* copy of either cdte.tra_vec or ate.destroy_flag */ dcl (have_ate, have_cdte) bit (1) aligned init (""b); /* "1"b if respective ptrs ^= null */ dcl (tname, tsignal_type) char (64) varying; /* for printing in trace and error messages */ dcl tanswb char (4); dcl (tstate, ttv, tinuse) fixed bin; /* copied from either cdte or ate */ dcl 1 term_info like terminal_info; /* for terminal_info order */ dcl 1 set_type_info like set_term_type_info; /* for set_term_type order */ dcl 1 TTY_ACCESS_CLASS aligned like tty_access_class; /* DECLARATION OF BASED STRUCTURES */ dcl 1 ev_msg based (msg_ptr) aligned, /* interprocess event message */ 2 ev_channel fixed bin (71), /* channel id */ 2 ev_message fixed bin (71), /* what user wants to tell me */ 2 fromproc bit (36), /* user's process id */ 2 origin, 3 dev_signal bit (18) unal, /* twx if hardcore */ 3 sender_ring bit (18) unal, /* execution ring at call to singal */ 2 data_ptr ptr; /* ptr to channel definition table entry (see asu_) */ dcl signal_type char (8) aligned based (p1); /* overlay when user signal is 8 chars */ dcl 1 bc based (addr (funct)) aligned, /* overlay for terminate_proc signal */ 2 signal_type1 char (4), /* "term" usually */ 2 code fixed bin; /* system error code */ dcl 1 new_proc_auth based (p1) aligned, /* structure from new_proc -auth */ 2 np_signal char (2) unaligned, /* "np" */ 2 authorization bit (54) unaligned; /* the new authorization */ dcl 1 based_tcode based (addr (tcode)) aligned, /* This is used to make sure that */ 2 tcode_left_half bit (18) unal, /* .. nobody is pulling a fast one */ 2 xxx bit (18) unal; /* .. because convert_status_code tends to blow up */ /* */ /* ftp_dialup_ is the procedure associated with the FTP event call channels and is called by the Wait Coordinator whenever an interrupt is signalled by one of the FTP channels to which the answering-service is currently listening. ftp_dialup_ never calls the wait_coordinator (directly nor indirectly), rather, it sets conditional-go to variable cdte.tra_vec to the label desired and returns to the wait coordinator. Upon re-invocation it transfers to that point. */ if msg_ptr = null then go to evil3; /* Has somebody messed up the pointer? */ if as_data_$ansp = null then go to evil2; /* called before initialization */ ansp = as_data_$ansp; /* Initialize */ p1 = addr (ev_msg.ev_message); /* get ptr to 72-bit data item */ static_label = exit; /* setup non-local go */ tcode = 0; /* Clear temp code. */ just_dialed_up = "0"b; /* .. */ call condition_ ("any_other", ftp_dialup_ucs); /* Set up handler for any faults. */ /* if any trouble */ anstbl.current_time = clock (); /* Read clock. */ call cpu_time_and_paging_ (old_pf, old_cpu, old_pp); /* See where the wakeup came from, and over which kind of channel (ate or cdte) */ if baseno (ev_msg.data_ptr) = baseno (scdtp) then do; /* cdte */ cdtep = ev_msg.data_ptr; /* copy pointer to cdte */ wakeup_for_channel = "1"b; /* remember which kind */ utep = cdte.process; /* will be null if not valid */ if cdte.in_use < NOW_DIALED /* it should be, that is */ & utep ^= null then do; /* trap bugs */ call sys_log_ (SL_LOG_SILENT, "^a: non-null atep (^p) for cdte (^p,^a), tv=^d,inuse=^d", ME, utep, cdtep, cdte.name, cdte.tra_vec, cdte.in_use); utep = null; end; tra_vec = cdte.tra_vec; /* copy the tra_vec we want to use */ end; /* end wakeup over channel */ else if baseno (ev_msg.data_ptr) = baseno (ansp) then do; /* ate */ utep = ev_msg.data_ptr; /* copy ptr to ate */ wakeup_for_process = "1"b; /* remember which kind */ cdtep = ute.channel; /* unpack ptr to cdte */ if cdtep ^= null then if cdte.process ^= utep then do; /* trap bugs */ call sys_log_ (SL_LOG_SILENT, "^a: re-used cdte (^p,^a) by ate ^p, destroy_flag=^d", ME, cdtep, cdte.name, utep, ute.destroy_flag); cdtep = null; if ^ute.disconnected then do; call sys_log_ (SL_LOG_SILENT, "^a: turning on disconnected flag for ate ^p", ME, utep); ute.disconnected = "1"b; end; end; /* end cdte.process not equal atep */ if ute.disconnected & cdtep ^= null then do; call sys_log_ (SL_LOG_SILENT, "^a: turning off disconnected flag for ate ^p, cdte ^p,^a", ME, utep, cdtep, cdte.name); ute.disconnected = ""b; end; tra_vec = ute.destroy_flag; /* copy the tra vec that we want to use */ end; /* end wakeup over ate channel */ else goto evil1; /* data pointer points to neither cdt nor answer table */ if cdtep ^= null then have_cdte = "1"b; /* checking switches is cheaper than testing ptrs for null */ if utep ^= null then have_ate = "1"b; if loudsw then call trace; /* now we have enough info to print trace message if wanted */ /* We know what kind of wakeup it is. Now see where it's from. */ if ev_msg.origin.sender_ring = ""b then /* from ring zero? */ wakeup_from_ring_zero = "1"b; else if ev_msg.fromproc = as_procid then /* or from answering service */ wakeup_from_as = "1"b; else do; /* either legal wakeup from user, or illegal wakeup from someone playing games or experimenting */ if have_ate then /* if we have an ate */ if ute.active = NOW_HAS_PROCESS /* with a live process */ & ute.proc_id = ev_msg.fromproc then /* and the wakeup is from that process */ wakeup_from_user = "1"b; /* then it is legal */ if ^wakeup_from_user then goto evil; /* illegal, so log it and exit */ end; /* Now, decide how to handle the wakeup. That's a function of all the above, plus the contents of the event message. */ if wakeup_from_ring_zero then goto fan_out; /* trust all wakeups from ring zero */ /* ***** The following code is OLD, and needs rethinking and perhaps rewriting */ if wakeup_from_as then do; /* I can signal myself. */ if signal_type = "device " then go to fan_out; /* software-simulated device signal */ if signal_type = "alarm___" & wakeup_for_channel then do; /* See if timeout. */ if cdte.in_use < NOW_DIALED then go to fals; /* if user is not home, ignore */ if cdte.in_use > NOW_DIALED then go to hand (8); /* if user is logged in, probably bump */ call astty_$tty_read (cdtep, addr (buff), nc, code); /* Dialed up, no process. */ if code = 0 then /* If ev call backlog, mayhave finished line */ if nc > 0 then do; /* .. any chars there? */ j = cdte.tra_vec; /* verify the computed goto */ if j < lbound (hand, 1) then go to eek; if j > hbound (hand, 1) then go to eek; go to timeout (j); /* pick up where we left off */ /* set up new timer? */ end; /* We ought to give the use a reason why we hung up */ go to listen_again; /* User didn't login in 3 minutes */ end; if tra_vec < WAIT_LOGOUT_SIG then /* If not a regular user. */ if signal_type = "termstop" then goto fals0; /* Ignore if extra */ else tra_vec = WAIT_LOGOUT_SIG; /* Make opr command into command even if login pending */ go to fan_out; /* Go bump user. */ end; /* end wakeup from answering service */ /* ***** END of OLD CODE */ /* It appears that it is ok to fall thru to fan_out, now */ /* * COMMENT OUT APPARENTLY UNNECESSARY CODE: */ /* * if cdte.tra_vec > WAIT_LOGOUT_SIG then go to hand (9); /* Nothing else if waiting logout */ /* * if cdte.tra_vec = WAIT_LOGOUT_SIG then /* also, allow process to log itself out */ /* * if ev_msg.fromproc = ate.proc_id then do; /* Assume ipc_ is secure. Our records and his must agree. */ /* * user_signal = "1"b; /* note that is from user */ /* * go to hand (8); /* Go directly to logout point. */ /* * end;/* */ /* * go to evil; /* oh, no you don't */ fan_out: /* go where tra_vec says to go */ /* Check validity of wakeup/tra_vec combination, before going anywhere */ if tra_vec = WAIT_LOGOUT_SIG /* if tra_vec says to expect a process termination signal */ | tra_vec = WAIT_LOGOUT | tra_vec = WAIT_LOGOUT_HOLD | tra_vec = WAIT_NEW_PROC then do; /* then there must be a process */ if ^have_ate then do; /* if there's no ate, there can't be a process */ call sys_log_ (SL_LOG_BEEP, "^a: Program error: null atep with per-process tra_vec value", ME); goto fals; end; end; /* end tra_vec says to expect process termination signal */ else /* but if tra_vec is anything else, wakeup must be for cdte */ if wakeup_for_process then do; /* if wakeup isn't for a channel, complain and exit */ if tra_vec = WAIT_DETACH | tra_vec = WAIT_REMOVE | tra_vec = WAIT_DELETE_CHANNEL then do;/* these can be for a process or a channel */ if ^have_cdte then do; /* but we must have a channel */ call sys_log_ (SL_LOG_BEEP, "^a: Program error: null cdtep with per-channel tra_vec value", ME); goto fals; /* fals prints all the relevant variables */ end; end; else do; /* rest of tra_vec values are restricted to per-channel wakeups */ call sys_log_ (SL_LOG_BEEP, "^a: Program error: per-process wakeup with per-channel-only tra_vec value", ME); goto fals; end; end; if wakeup_for_process then /* trap bug */ if ute.active = NOW_FREE then /* spurious wakeup for free ate */ goto fals0; /* go log and ignore it */ if tra_vec < lbound (hand, 1) /* Subscript range check. */ | tra_vec > hbound (hand, 1) then do; /* if this fails, cdt or anstbl is garbaged. */ eek: call sys_log_ (SL_LOG_BEEP, "^a: ^[CDT^;answer table^] damaged at ^[^p^s^;^s^p^], tra_vec=^d", ME, wakeup_for_channel, wakeup_for_channel, cdtep, utep, tra_vec); /* * call asu_$remove_cdte (cdtep); /* remove channel, if cdte is not so garbaged that we can't */ goto exit1; /* clean up metering and exit */ end; if have_cdte then if cdte.line_type = LINE_TELNET then /* Use "old" FTP protocol */ ftp_765 = "0"b; else ftp_765 = "1"b; /* Use "new" FTP else ftp_765 = "0"b; /* Without CDTE, use "old" FTP protocol */ go to hand (tra_vec); /* this is fast in v2pl1 */ hand (4): timeout (4): /* WAIT_LOGIN_ARGS */ hand (5): timeout (5): /* WAIT_OLD_PASSWORD */ hand (7): timeout (7): /* WAIT_NEW_PASSWORD */ hand (16): timeout (16): /* WAIT_DIAL_OUT */ hand (18): timeout (18): /* WAIT_SLAVE_REQUEST */ hand (19): timeout (19): /* WAIT_GREETING_MSG */ call sys_log_ (SL_LOG_BEEP, "^a: unexpected state ^d for channel definition table at ^p", ME, cdtep -> cdte.tra_vec, cdtep); call asu_$remove_cdte (cdtep); /* remove channel unless cdte is so messed up that we can't */ return; /* Come here when a terminal channel dials up. */ hand (1): cdte.n_dialups = cdte.n_dialups + 1; /* count number of times TTY has been dialed up */ cdte.dialup_time = anstbl.current_time; /* Note time of dialup. */ call astty_$tty_state (cdtep, code); /* make sure tty now dialed up. */ if code ^= 0 then call channel_error (code); /* go get rid of channel if any error */ if cdte.state < TTY_DIALED then go to listen_again; /* Transient wakeup. Phone is hung now, give up. */ cdte.in_use = NOW_DIALED; /* record that channel is dialed up */ call update_term_info; if cdte.line_type ^= LINE_TELNET then /* if network channel, we just got host id */ cdte.tty_id_code = "none"; /* but for other channels, we read answerback below */ if cdte.initial_terminal_type ^= "" /* if type specified in CMF */ then type_to_set = cdte.initial_terminal_type; else do; /* else figure it out from line-type/baud-rate */ call ttt_info_$default_term_type (term_info.line_type, term_info.baud_rate, type_to_set, code); if code ^= 0 then call channel_error (code); if type_to_set = "" then do; call sys_log_ (SL_LOG_BEEP, "^a: Unable to determine initial terminal type for channel ^a", ME, cdte.name); call channel_error (0); end; end; call change_type (type_to_set); /* make this into right kind of terminal */ call resetread (); /* flush any trash */ if cdte.line_type ^= LINE_TELNET /* Network channels can't return answerback. */ & ^cdte.flags.dont_read_answerback /* or they might have said not to try */ then do; call astty_$tty_order (cdtep, "wru", null, code); /* Initiate answerback read and send us a wakeup */ /* whether answerback exists or not */ if code ^= 0 then call channel_error (code); /* Now that MCS is in, expect no error */ cdte.tra_vec = WAIT_ANSWERBACK; /* and wait for it */ go to exit1; /* Wait for tty dim Wakeup */ hand (2): /* WAIT_ANSWERBACK - Got answerback wakeup */ call astty_$tty_get_chars (cdtep, addr (buff), nc, code); /* read it & see if it's there */ /* use get_chars 'cause some answerbacks don't end in a newline */ if code ^= 0 then call channel_error (code); if nc > 0 then do; /* if there is an answerback, process it */ timeout (2): /* come here if we timeout & find answerback there */ call ttt_info_$decode_answerback (substr (buff, 1, nc), (cdte.cur_line_type), type_to_set, cdte.tty_id_code, code); if code ^= 0 then do; type_to_set = ""; cdte.tty_id_code = ""; ; end; if cdte.tty_id_code = "" then cdte.tty_id_code = "none"; if type_to_set ^= "" & type_to_set ^= cdte.current_terminal_type /* answerback says different terminal type */ then do; call change_type (type_to_set); if code ^= 0 then call channel_error (code); end; call astty_$tty_order (cdtep, "store_id", addr (cdte.tty_id_code), ignore_code); call resetread (); /* flush junk from multi-line answerbacks */ end; end; /* Turn off transmogrification - this program uses ftp language */ call astty_$tty_order (cdtep, "disable_xmog", null, code); call astty_$tty_changemode (cdtep, "^ll", code); /* insure no line folding */ if code ^= 0 then call channel_error (code); /* Here is the login sequence. First, tell him it's Multics, etc. */ say_hello = "1"b; /* Always be polite to strangers. */ just_dialed_up = "1"b; /* .. */ /* Come here after a logout -hold or after a dialed terminal's master process terminates */ login: cdte.count = 1; /* we count login tries and hang up if there are too many */ if cdte.flags.ck_answerback then do; /* If we should check answerback */ call match_star_name_ (cdte.tty_id_code, cdte.answerback, code); if code ^= 0 then if code ^= error_table_$badstar /* ignore problems with starname */ then do; call sys_log_ (SL_LOG_BEEP, "^a: wrong answerback on ^a (^a); expected ""^a"", got ""^a"".", ME, cdte.name, cdte.comment, cdte.answerback, cdte.tty_id_code); /* now tell user */ call format_ecode (as_error_table_$bad_answerback, buff, i, 400, 421); call astty_$tty_force (cdtep, addr (buff), i, code); if code ^= 0 then call channel_error (code); /* handle random errors */ go to listen_again; /* hangup the terminal */ end; end; if anstbl.session = "shutdown" then do; call hello (); go to listen_again; end; else if say_hello then call hello (); /* Greeting message. */ /* If user dialup during shutdown, hang up */ time = installation_parms.login_time; call timer_manager_$alarm_wakeup (time, "11"b, cdte.event); /* limit time to log in */ if just_dialed_up then /* Is this time for initial command? */ if cdte.flags.execute_initial_command then do; /* .. is there one? */ buff = cdte.initial_command; /* Yes. Do it. */ nc = length (cdte.initial_command); go to timeout (3); /* Skip the first read call. */ end; read_login_line: cdte.tra_vec = WAIT_LOGIN_LINE; /* Set up transfer vector. */ hand (3): call astty_$tty_read (cdtep, addr (buff), nc, code); /* read the login line */ if code ^= 0 then call channel_error (code); if nc = 0 then go to exit1; /* is line in yet? */ /* At this point we have a login line. Parse it. */ timeout (3): /* come here if line read during timeout */ call interpret_ftp_cmd (buff, nc, jj, user_login_word, code); if code = 0 then go to listen_again; /* BYE or QUIT */ if code = 1 | code = 5 then go to read_login_line; if code = 2 | code = 6 then do; call print_ftp_msg ("Give USER command please. ", 504, 503); goto read_login_line; end; if code = 4 then go to handle_word; /* Arriving here we process USER cmd */ call asu_$attach_ate (cdtep, code); /* Allocate anstbl entry */ if code ^= 0 then do; call sys_log_$error_log (SL_LOG, code, ME, "attempting to allocate a user table entry for ^a", cdte.name); if code = as_error_table_$tty_no_room then do; /* if answer table is full */ call sys_log_ (SL_LOG, "^a: The answer table is full (^d entries).", ME, anstbl.max_size); code = as_error_table_$sys_full; /* don't burden user with details, just say "System full." */ end; call format_ecode (code, buff, i, 401, 421); /* 421=Service not accepting users now. */ call astty_$tty_force (cdtep, addr (buff), i, code); if code ^= 0 then call channel_error (code); goto listen_again; /* go hang up and listen - no use saying please try again */ end; utep = cdte.process; /* copy ptr to ate that we just got */ have_ate = "1"b; /* and tell everyone else that it's ok to reference the ate */ call ipc_$decl_ev_call_chn (ute.event, ftp_dialup_, utep, INT_LOGIN_PRIO, code); if code ^= 0 then do; call convert_ipc_code_ (code); call sys_log_$error_log (SL_LOG_BEEP, code, ME, "occurred attempting to declare handler for ev chn ^24.3b for ate ^p for ^a", ute.event, utep, cdte.name); call format_ecode (as_error_table_$dialup_error, buff, i, 435, 421); /* 435, 421=Log-out forced by system problem. */ call astty_$tty_force (cdtep, addr (buff), i, code); if code ^= 0 then call channel_error (code); goto listen_again; end; ute.tty_id_code = cdte.tty_id_code; ute.line_type = cdte.line_type; call parse_ftp_login_line_ (addr (substr (buff, jj, 1)), nc - jj + 1, utep, error_mess, code); if code = error_table_$noarg then do; call print_ftp_msg ("Expected argument for USER command missing. ", 502, 501); goto read_login_line; end; if code = error_table_$bad_arg then do; call print_ftp_msg ("Bad syntax for USER command. ", 501, 501); goto read_login_line; end; if code = as_error_table_$bad_login_arg_msg | code = as_error_table_$no_login_arg_msg then do; lg_err = convert_message_nnl (code); call ioa_$rs (convert_message_nnl (code), buff, j, error_mess); buff = format_msg (buff, j, i, 431, 501); call astty_$tty_force (cdtep, addr (buff), i, code); if code ^= 0 then call channel_error (code); goto try_again; end; if code ^= 0 then do; call format_ecode (code, buff, i, 431, 501); call astty_$tty_force (cdtep, addr (buff), i, code); if code ^= 0 then call channel_error (code); go to try_again; end; if ftp_765 then do; ute.init_proc = substr (ftp_misc_$ftp_login_responder.overseer, 1, length (ute.init_proc)); ute.ip_len = ftp_misc_$ftp_login_responder.pathlen; end; user_login_word = ute.login_code; /* obtain lgwd from where parser put it */ handle_word: do lgwd = lbound (as_data_login_words.words, 1) to hbound (as_data_login_words.words, 1) while (user_login_word ^= as_data_login_words.words (lgwd)); end; if anstbl.session ^= "normal " then /* Check for Special Session */ if lgwd <= 6 then /* (normal login) */ go to reject_login_word; /* ... not allowed during Special Session */ else if lgwd <= hbound (as_data_login_words.words, 1) then ; /* (preaccess command) */ else if user_login_word = anstbl.login_word /* (special session login) */ & anstbl.session ^= "shutdown" then /* and not shutdown */ lgwd = 1; /* convert to "login" */ else go to reject_login_word; /* Don't let user try to guess magic word */ else if lgwd > hbound (as_data_login_words.words, 1) then /* Normal Session. Unknown word */ go to bad_login_word; /* Tell user. Give 'em another chance */ /* Note that anonymous users cannot login during special session. */ go to login_handler (lgwd); /* Dispatch on login command. */ login_handler (9): /* "help" */ login_handler (10): /* "HELP" */ login_handler (14): /* "modes" */ login_handler (15): /* "echo" */ login_handler (16): /* "terminal_type" */ login_handler (17): /* "ttp" */ bad_login_word: /* none of these work for FTP */ call ioa_$rs (bad_login_word_fmt, buff, j, user_login_word); /* Not legal login word. Complain. */ buff = format_msg (buff, j, i, 431, 501); go to wm_join; try_again_code: buff = convert_message (code, j); buff = format_msg (buff, j, i, 500, 501); wm_join: call astty_$tty_force (cdtep, addr (buff), i, code); if code ^= 0 then call channel_error (code); call resetread (); /* flush type-ahead */ try_again: /* transfer point for repeat login attempts */ call asu_$release_ate (cdtep, code); /* If an ate was allocated, free it */ cdte.count = cdte.count + 1; /* Count errors. */ if cdte.count > installation_parms.login_tries then go to listen_again; /* Has user tried us too many times? */ go to read_login_line; /* Read another line. */ reject_login_word: if anstbl.session = "shutdown" then /* Is the system coming down? */ tcode = as_error_table_$shutdown; /* Yes, tell user */ else if anstbl.session = "init " then /* Not up yet. */ tcode = as_error_table_$coming_up; /* Tell him we will be up shortly. */ else tcode = as_error_table_$special_session; /* Go way kid you bother me */ call format_ecode (tcode, buff, i, 432, 421); call astty_$tty_force (cdtep, addr (buff), i, code); /* tell the user */ if code ^= 0 then call channel_error (code); go to listen_again; /* Hang up on the fella. */ login_handler (5): /* "ep" */ login_handler (6): /* "enterp" */ ute.anonymous = 1; /* Set anonymous-login flag. */ login_handler (1): /* "l" */ login_handler (2): /* "login" */ user_password = ""; /* Preset password to blanks */ substr (buff, 1, length (pw_msg)) = pw_msg; buff = format_msg (buff, length (pw_msg), j, 330, 331); call astty_$tty_force (cdtep, addr (buff), j, code); if code ^= 0 then call channel_error (code); cdte.tra_vec = WAIT_PASSWORD; /* Set transfer vector to come back here. */ /* Here we are waiting for the password. */ hand (6): call astty_$tty_read (cdtep, addr (buff), nc, code); /* read the password */ if code ^= 0 then call channel_error (code); if nc = 0 then go to exit1; /* wait for him */ timeout (6): /* come here if line read during timeout */ call interpret_ftp_cmd (buff, nc, jj, user_password, code); if code ^= 6 then if code = 0 then go to listen_again; else if code = 1 | code = 5 then goto hand (6); else do; /* tell him off */ call print_ftp_msg ("Give PASS command please. ", 504, 530); goto login_handler (1); end; user_password = scramble_ (user_password); /* No peeking. */ buff = ""; /* blank out unscrambled version */ /* check to see if user is NETML, if so try to dial to network mail server process */ /* if dial succedes no check of the NETML passowrd will occur */ /* In the code for successful dials, saved_atep1 is used to hold the atep for NETML which will need to be released on success. Saved_atep2 holds the atep of the process handling the dials to make the rest of the Answering Server be consistent. DO NOT CHANGE THIS CODE! */ if ute.person = "NETML" then do; /* this is really an attempt to send mail to this ARPANET site */ saved_atep1 = cdte.process; /* need for freeing later */ call dial_ctl_ (cdtep, "ARPANET_mail", "", code); /* try to dial on this registered dial qualifier */ if code = 0 then do; /* if dial worked handle as any dial */ saved_atep2 = cdte.process; /* remember new owner */ cdte.process = saved_atep1; /* dial_ctl_ sets this to server's dutep */ call asu_$release_ate (cdtep, (0)); /* release the answer table slot */ cdte.process = saved_atep2; /* fix cdte to be right */ go to dialed; end; else cdte.process = saved_atep1; /* if dial failed, we will fall through */ end; /* and try to login as USER NETML */ go to trylog; login_handler (3): /* "e" - no password needed. */ login_handler (4): /* "enter" */ ute.anonymous = 1; /* No password needed */ trylog: ute.login_flags.cpw, ute.login_flags.generate_pw, ute.login_flags.cdp, ute.login_flags.cda = "0"b; /* Not allowed to change things */ static_label = abort; /* in case error */ unspec (TTY_ACCESS_CLASS) = ""b; call astty_$tty_order (cdtep, "get_required_access_class", addr (TTY_ACCESS_CLASS), tcode); if tcode = 0 then if TTY_ACCESS_CLASS.access_class_set then do; ute.process_authorization = TTY_ACCESS_CLASS.access_class; ute.login_flags.auth_given = "1"b; end; call lock; /* interlock answer table to prevent updates */ ute.tag = TAG_INTERACTIVE; /* set instance tag */ call lg_ctl_$login (utep, user_password, lg_err, code); /* get permission to log in */ if ute.login_result ^= 0 /* did he fail */ then do; call unlock; /* Allow logins */ substr (buff, 1, length (lg_err)) = lg_err; if ute.failure_reason = 1 then buff = format_msg (buff, length (lg_err), i, 431, 530); else if ute.failure_reason = 2 | ute.failure_reason = 3 /* act_ctl_ or load_ctl_ threw him out */ then buff = format_msg (buff, length (lg_err), i, 430, 530); call astty_$tty_force (cdtep, addr (buff), i, code); /* tell user what went wrong */ if code ^= 0 then call channel_error (code); if ute.login_result = 1 then go to listen_again; /* don't allow another attempt */ else go to try_again; /* get another chance to login */ end; /* User is authorized to log in. */ call timer_manager_$reset_alarm_wakeup (cdte.event); /* Turn off egg timer on logins */ ute.n_processes = 0; /* set to 'initial process creation' */ call act_ctl_$open_account (utep); /* open and activate user's account */ cdte.n_logins = cdte.n_logins + 1; /* count number of successful logins on channel */ /* Come here to create new process on login, new_proc, or fatal error termination */ create: if cdte.charge_type > 0 then call device_acct_$on ((cdte.charge_type), cdte.name, utep); /* Charge for fancy devices */ call lock; /* interlock answer table to prevent updates */ ute.n_processes = ute.n_processes + 1; /* count number of processes in session */ ute.preempted = PREEMPT_UNBUMP_IGNORE_ALARM; /* in case we came here after operator term command */ call cpg_ (utep, code); /* Call utility to create process (calls actproc) */ if code ^= 0 then do; /* should never happen */ call sys_log_$error_log (SL_LOG_BEEP, code, ME, "when creating process for ^a.^a", ute.person, ute.project); /* Clean up after the aborted login (thank you, Steve Landry) */ ute.logout_type = "cpg"; /* act_ctl_$close_account needs a reason for the logout */ call act_ctl_$close_account (utep); /* close account and print logout message for operator */ call lg_ctl_$logout (utep); /* remove user from whotab and return his load units */ tcode = as_error_table_$process_create_fail; /* Tell user we failed. */ i = 0; /* No further message. */ cdte.tra_vec = WAIT_LOGOUT; /* .. and after destroying process, hang up */ call unlock; /* Unlock ate */ go to kill; /* Get tty back. */ end; call act_ctl_$cp (utep); /* Record the creation of the user process. */ ute.active = NOW_HAS_PROCESS; /* User now has a process. */ cdte.in_use = NOW_HAS_PROCESS; /* Indicate that there is a process. */ /* Display the message "Your authorization is ..." upon process creation or connection. */ call DISPLAY_PROCESS_AUTHORIZATION (); call astty_$tty_new_proc (cdtep, ute.proc_id, code); /* give tty to new process before it runs */ if code ^= 0 then go to abort; /* kill proc if hungup */ call asu_$start_process (utep); /* Kick the process loose from initial block state */ cdte.tra_vec = WAIT_LOGOUT_SIG; /* Set transfer vector. */ ute.destroy_flag = WAIT_LOGOUT_SIG; /* .. */ exit: static_label = exit1; /* in case fault in unlock */ call unlock; /* release answer table, permit updates */ exit1: scdtp -> cdt.realtime_in_dialup = scdtp -> cdt.realtime_in_dialup + (clock () - anstbl.current_time); call cpu_time_and_paging_ (new_pf, new_cpu, new_pp); scdtp -> cdt.pf_in_dialup = scdtp -> cdt.pf_in_dialup + (new_pf - old_pf); scdtp -> cdt.cpu_in_dialup = scdtp -> cdt.cpu_in_dialup + (new_cpu - old_cpu); scdtp -> cdt.pp_in_dialup = scdtp -> cdt.pp_in_dialup + (new_pp - old_pp); scdtp -> cdt.entries_to_dialup = scdtp -> cdt.entries_to_dialup + 1; return; /* This is the main exit. */ login_handler (7): /* "d" */ login_handler (8): /* "dial" */ call login_parse_ (addr (substr (buff, jj, 1)), nc - jj + 1, dial_qual, k, j, code); if code ^= 0 then go to try_again_code; jj = jj + j; /* Read the "dial qualifier" (machine name) */ call login_parse_ (addr (substr (buff, jj, 1)), nc - jj + 1, dial_arg1, k, j, code); if code ^= 0 then go to try_again_code; call dial_ctl_ (cdtep, dial_qual, dial_arg1, code); if code ^= 0 then do; call format_ecode (code, buff, i, 431, 451); /* construct a neat FTP message */ call astty_$tty_force (cdtep, addr (buff), i, ignore_code); if cdte.state < TTY_DIALED then go to listen_again; /* user hung up during dial */ else go to try_again; /* all other errors */ end; dialed: call timer_manager_$reset_alarm_wakeup (cdte.event); /* Success. */ cdte.tra_vec = WAIT_DIAL_RELEASE; /* Set transfer vector to reclaim channel. */ go to exit1; /* Note that cdte.in_use is still NOW_DIALED */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ login_handler (11): /* "MAP" - The Padlipsky command. */ call ttt_info_$preaccess_type ("MAP", type_to_set, code); if code ^= 0 then call channel_error (code); if type_to_set ^= "" /* if there's an appropriate type */ then call change_type (type_to_set); /* make upper case input go to lower case */ call print_ftp_msg ("MAPping will be performed. ", 200, 200); go to read_login_line; /* Try again. */ login_handler (12): /* "hello" command */ call hello (); /* Repeat greeting */ go to read_login_line; /* Let him try login now. */ /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ login_handler (13): /* "slave" command */ cdte.current_service_type = SLAVE_SERVICE; /* Set channel up to wait for Godot. */ cdte.tra_vec = WAIT_DIAL_RELEASE; /* Do something reasonable if it hangs up */ cdte.process = null; /* .. */ call timer_manager_$reset_alarm_wakeup (cdte.event); go to exit1; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * Here if a logged-in user has something happen to him * * which involves destroying his process. * * * * logout * * logout hold * * fatal error in process * * out of funds * * can't start process * * preempted * * system coming down * * standby bump * * inactive too long * * bumped/unbumped/terminated/detached by operator * * hung up phone * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ /* WAIT_LOGOUT_SIG */ hand (8): funct = signal_type; /* extract event message, tells what to do */ static_label = abort; /* in case error */ tcode = 0; /* Assume no special termination code. */ error_mess = ""; /* clear string used to hold converted status code */ if wakeup_from_user then do; do j = 1 to n_signals while (funct ^= signals (j)); /* check in as_data_ */ end; if j <= n_signals then ; /* is it known? */ else if signal_type1 = "term" | signal_type1 = "init" then do; /* these messages have error code in word 2 */ tcode = bc.code; /* extract code (xxxx) from "term"xxxx or "init"xxxx */ if tcode ^= 0 /* Validate it. We don't want to be hacked. */ then if tcode_left_half ^= baseno (null)/* Oops. Not an error_table_ code. */ then do; /* wonder what is is ... */ call ioa_$rsnnl ("Code = ^w", error_mess, i, tcode); /* lets see */ tcode = 0; /* don't try to convert_status_code_ it */ end; j = 1; /* Terminate his process. */ end; else if new_proc_auth.np_signal = "np" then /* new_proc -auth AUTH */ j = 13; /* new_proc to new authorization */ else do; /* That's all a user can signal. */ j = 1; /* Creative user tried to write own logout, and goofed. */ funct = "badsignl"; /* Or he may have tried to hack us. */ tcode = as_error_table_$illegal_signal; /* Might as well tell user. */ end; end; else do; /* Must be a system-generated event. */ do j = 1 to n_system_signals while (funct ^= system_signals (j)); end; if j <= n_system_signals then j = j + 19; /* See if it is a system signal. */ else do; /* Probably a hangup ... check it out */ if ^have_cdte then goto fals0; /* can't be hangup if no cdte */ call astty_$tty_state (cdtep, code); if code ^= 0 then call channel_error (code); /* tolerate no errors */ if cdte.state = TTY_DIALED /* not a hangup cause terminal is still there */ then go to fals0; /* ignore it (but log it first) */ j = 20; /* set jump index to hangup */ end; end; if utep ^= null then do; /* watch out for detach of tty with no process (no ate) */ if ute.preempted ^= PREEMPT_TERM_SENT then /* unless we have already done so */ ute.logout_type = signal_type1; /* remember the reason for the logout */ ute.login_flags.noprint = "0"b; /* usually print logout message. */ end; i = 0; /* message length = 0 until we build a message */ go to logout_handler (j); /* Fast dispatch. */ logout_handler (27): /* ("terminat") Operator terminated process. */ if asu_$send_term_signal (utep, j) /* send term signal if appropriate */ then goto exit1; /* if we did, wait for process to destroy itself */ tcode = as_error_table_$term_by_operator; /* Tell user why process died. */ /* Fall through into normal case. */ logout_handler (1): /* ("term"xxxx or "init"xxxx) Process termination. */ if have_cdte then call resetread (); /* abort any read ahead (let writing finish!) */ if tcode ^= 0 then do; /* If code is not zero then */ call convert_status_code_ (tcode, shxx, error_mess); /* keep message in error_mess for printing later */ call sys_log_ (SL_LOG_SILENT, "^a: process terminated ^a.^a ^a ^a", ME, ute.person, ute.project, cdte.name, shxx); tcode = 0; /* Don't print it again... */ end; if signal_type1 = "init" then do; /* fatal error during process initialization */ ute.destroy_flag = WAIT_LOGOUT; /* a new process would just get another fatal error */ call ioa_$rs (init_term_fmt, buff, i, error_mess); /* Put reason for fatal error into message: Fatal error during process initialization. */ call sys_log_ (SL_LOG, "^a: fatal error during process creation for ^a.^a ^a", ME, ute.person, ute.project, cdte.name); end; else do; /* fatal error not during initialization - but check for fatal error loop anyway, since user might be getting errors during start_up.ec */ if ute.recent_fatal_error_time + installation_parms.fatal_error_loop_seconds * 1000000 < anstbl.current_time then do; /* if previous fatal error was long ago */ ute.recent_fatal_error_time = anstbl.current_time; /* reset the fatal error loop timer */ ute.recent_fatal_error_count = 1; /* and set the counter back to 1 */ create_another_new_proc: ute.destroy_flag = WAIT_NEW_PROC; /* let user have another new process after destroying this one. */ call ioa_$rs (proc_term_fmt, buff, i, error_mess); /* put reason for fatal error into message: Fatal error. Process has terminated. New process created. */ end; else do; /* we seem to have a loop */ ute.recent_fatal_error_count = ute.recent_fatal_error_count + 1; /* count times around it */ if ute.recent_fatal_error_count < installation_parms.fatal_error_loop_count then /* if not too many */ goto create_another_new_proc; /* keep going a while longer */ ute.destroy_flag = WAIT_LOGOUT; /* too many. get out of the loop */ call ioa_$rs (proc_term_loop_fmt, buff, i, error_mess); /* put reason for fatal error into message: Fatal error. Process has terminated. You appear to be in a fatal process error loop. */ call sys_log_ (SL_LOG, "^a: terminating fatal process error loop for ^a.^a ^a", ME, ute.person, ute.project, ute.tty_name); end; end; go to kill; logout_handler (2): /* New_proc */ ute.destroy_flag = WAIT_NEW_PROC; /* Create new process after destroying process. */ ute.login_flags.noprint = "1"b; /* no message from us. */ go to kill; logout_handler (3): /* logout -hold */ ute.destroy_flag = WAIT_LOGOUT_HOLD; /* User wants to login again. */ go to kill; logout_handler (5): /* logout -bf */ ute.destroy_flag = WAIT_LOGOUT; ute.login_flags.noprint = "1"b; /* Inhibit printing of messages. */ go to kill; logout_handler (6): /* logout -hold -bf */ ute.login_flags.noprint = "1"b; /* Inhibit printing of logout message. */ ute.destroy_flag = WAIT_LOGOUT_HOLD; /* Set transfer vector to allow login */ go to kill; logout_handler (7): /* init_err */ ute.destroy_flag = WAIT_LOGOUT; tcode = as_error_table_$init_err; /* Process cannot be initialized. */ go to kill; logout_handler (8): /* no_ioatt */ ute.destroy_flag = WAIT_LOGOUT; tcode = as_error_table_$no_io_attach; /* Cannot attach process I/O streams */ go to kill; logout_handler (9): /* no_initproc */ ute.destroy_flag = WAIT_LOGOUT; tcode = as_error_table_$no_init_proc; /* Cannot locate initial procedure. */ go to kill; logout_handler (13): /* new_proc -auth AUTH */ ute.destroy_flag = WAIT_NEW_PROC; /* always get new process */ if ^have_cdte then do; /* can't new_proc -auth in a disconnected process */ tcode = as_error_table_$illegal_new_proc; goto kill; end; code = 0; if ^aim_check_$equal (ute.process_authorization, (new_proc_auth.authorization)) then do; bad_ai_np: tcode = as_error_table_$illegal_new_proc; call sys_log_$error_log (SL_LOG_SILENT, code, ME, "new_proc of ^a.a denied by AIM restriction.", ute.person, ute.project); tcode = as_error_table_$illegal_new_proc; end; go to kill; logout_handler (14): /* termsgnl */ /* ate.preempted says what to do here: -1 user unbumped after term signal sent 0 user unbumped; ignore alarm___ 1 value internally used in load_ctl_ 2 user bumped; when alarm___ comes in, send term signal 3 term signal sent; destroy process if termsgnl, alarm___, or cpulimit signals come in 4 user bumped; process sick, so destroy without sending term signal 5 trm_ signal sent, termsgnl received; (if still 3, we never got the termsgnl). */ call timer_manager_$reset_alarm_wakeup (ute.event); /* turn off realtime limit */ if ute.preempted = PREEMPT_UNBUMP then do; /* unbumped just a little late */ tcode = as_error_table_$bump_cancelled; /* apologize */ goto logout_handler (1); /* give the guy a new process */ end; else if ute.preempted = PREEMPT_TERM_SENT then do;/* sent term signal, expecting termsgnl */ ute.preempted = PREEMPT_TERMSGNL_RECEIVED; /* remember that we're no longer waiting for termsgnl */ goto logout_handler (ute.logout_index); /* go finish what we started to do */ end; else do; /* unexpected termsgnl */ call sys_log_ (SL_LOG_SILENT, "^a: Unexpected termsgnl for ^a.^a ^a", ME, ute.person, ute.project, ute.tty_name); /* tell sysprogs */ tcode = as_error_table_$illegal_signal; /* complain to user */ goto logout_handler (1); /* but give the guy a new process */ end; /* User may not signal any of the functions below */ logout_handler (20): /* hangup */ if asu_$send_term_signal (utep, j) then /* send a term signal if appropriate */ goto exit1; /* if we did, wait for process to destroy itself */ ute.destroy_flag = WAIT_LOGOUT; goto kill; logout_handler (21): /* Shutdown */ if asu_$send_term_signal (utep, j) then /* send term signal if appropriate */ goto exit1; /* if we did, wait for process to destroy itself */ ute.destroy_flag = WAIT_LOGOUT; tcode = as_error_table_$shutdown; /* Multics is shutting down. */ go to kill; logout_handler (22): /* bump */ if asu_$send_term_signal (utep, j) then /* send term signal if appropriate */ goto exit1; /* if we did, wait for process to destroy itself */ ute.destroy_flag = WAIT_LOGOUT; tcode = as_error_table_$automatic_logout; /* Automatic logout. */ go to kill; logout_handler (23): /* alarm___ */ /* alarm___ can occur as a result of several conditions. Also, we can come here from the termsgnl handler if we sent term in response to alarm___. Sort it all out here. ***** CHECK FOR LEFT OVER ALARM AFTER PROCESS HAS BEEN DESTROYED */ if funct = "alarm___" then do; /* if really alarm rather than termsgnl */ if ute.preempted <= PREEMPT_UNBUMP_IGNORE_ALARM then /* if user has been unbumped */ goto exit1; /* go away quietly */ else if asu_$send_term_signal (utep, j) then /* send term signal if appropriate */ goto exit1; /* if we did, wait for process to destroy itself */ else if ute.preempted = PREEMPT_TERM_SENT then do; /* sent term and process failed to respond */ ignored_term: /* come here if cpu timer runs out after term sent */ call sys_log_ (SL_LOG, "^a: process ignored term signal ^a.^a ^a", ME, ute.person, ute.project, ute.tty_name); if ute.logout_index = 23 then /* if original objective was bump after X minutes */ goto bump_or_shut; /* go do it */ else goto logout_handler (ute.logout_index); /* go finish what we started to do */ end; end; bump_or_shut: ute.destroy_flag = WAIT_LOGOUT; if anstbl.session = "shutdown" then tcode = as_error_table_$shutdown; else tcode = as_error_table_$automatic_logout; /* Three minutes' grace expired. */ go to kill; logout_handler (24): /* detach */ if cdte.in_use < NOW_LOGGED_IN then /* operator detach. someone on line? */ tcode = as_error_table_$detach; /* No. Automatic detach. */ else do; /* Yes. Must destroy user. Automatic logout. */ if asu_$send_term_signal (utep, j) then /* send term signal if appropriate */ goto exit1; /* if we did, wait for process to destroy itself */ tcode = as_error_table_$automatic_logout; end; if have_ate then ute.destroy_flag = WAIT_DETACH; /* After proc is destroyed, leave phone hung. */ else cdte.tra_vec = WAIT_DETACH; /* if no process, use cdte to remember what to do */ go to kill; logout_handler (25): /* ("unbump") is operator cancelling a bump? */ if ute.preempted = PREEMPT_TERM_SENT then /* if term signal sent before unbump */ ute.preempted = PREEMPT_UNBUMP; /* remember that it happened */ else ute.preempted = PREEMPT_UNBUMP_IGNORE_ALARM; /* else just cancel the bump */ go to exit1; logout_handler (26): /* "stopstop" Check for out-of-sequence signals. */ call sys_log_ (SL_LOG_SILENT, "^a: premature stopstop for ^a.^a ^a", ME, ute.person, ute.project, cdte.name); call hcs_$wakeup (anstbl.as_procid, ute.event, termstop_msg, code); call hcs_$wakeup (anstbl.as_procid, ute.event, STOPstop_msg, code); go to exit1; logout_handler (28): /* "termstop" */ tcode = as_error_table_$no_signal; /* Process terminated without signalling asnwering service. */ ute.destroy_flag = WAIT_LOGOUT; goto kill; logout_handler (29): /* cpulimit: Process used too much cpu time after term sent */ if ute.preempted ^= PREEMPT_TERM_SENT then goto fals; /* if not expecting termsgnl, ignore this */ call timer_manager_$reset_alarm_wakeup (ute.event); /* turn off realtime timer */ goto ignored_term; /* go complain and kill process */ logout_handler (4): /* Standard logout. */ logout_handler (10): /* Disconnect command. Treat as logout. */ logout_handler (11): /* Unused. Treat as logout. */ logout_handler (12): /* Unused. Treat as logout. */ logout_handler (15): /* Unused. Treat as logout. */ logout_handler (16): /* Unused. Treat as logout. */ logout_handler (17): /* Unused. Treat as logout. */ logout_handler (18): /* Unused. Treat as logout. */ logout_handler (19): /* Unused. Treat as logout. */ ute.destroy_flag = WAIT_LOGOUT; kill: if have_ate then do; /* if there is an answer table entry for this channel */ if ute.preempted = PREEMPT_TERM_SENT then do;/* if we were waiting for termsgnl and never got it */ call sys_log_ (SL_LOG_SILENT, "^a: process did not respond properly to trm_ signal. ^a.^a ^a", ME, ute.person, ute.project, ute.tty_name); if ute.logout_index ^= 27 then /* if original objective was other than terminate */ if ute.destroy_flag = WAIT_NEW_PROC then /* if response was f.p.e or newproc */ /* don't allow tricky user to get out of being bumped */ if ute.logout_index = 24 then /* put back the original objective */ ute.destroy_flag = WAIT_DETACH; else ute.destroy_flag = WAIT_LOGOUT; end; if ute.active = NOW_HAS_PROCESS then do; /* if user has a process then destroy it */ call dial_ctl_$dial_broom (utep, funct);/* clean out attached consoles */ call rcp_sys_$unassign_process (ute.proc_id, ignore_code); if ute.lvs_attached then call lv_request_$cleanup_process (ute.proc_id); call dpg_ (utep, (funct)); end; if have_cdte then /* if we have a cdte also */ cdte.tra_vec = ute.destroy_flag; /* tell cdte what we're about to do to the ate */ end; /* end have ate */ if have_cdte then do; /* if we have a cdte */ call grab_tty; /* Take over the typewriter */ if tcode ^= 0 then do; if ftp_765 then ftp_code = 421; else do; if tcode = as_error_table_$automatic_logout then ftp_code = 434; else if tcode = as_error_table_$shutdown then ftp_code = 436; else if tcode = as_error_table_$detach then ftp_code = 434; else ftp_code = 435; end; if i > 0 then do; lg_err = convert_message_nnl (tcode); buff = lg_err || NL || buff; i = length (lg_err) + i + 1; buff = format_msg (buff, i, j, ftp_code, ftp_code); call astty_$tty_force (cdtep, addr (buff), j, ignore_code); /* give the user the termination msg */ end; else do; call format_ecode (tcode, buff, i, ftp_code, ftp_code); call astty_$tty_force (cdtep, addr (buff), i, ignore_code); end; end; if cdte.charge_type > 0 then if have_ate then if utep ^= null then /* don't try to turn off charging if no user owns device */ call device_acct_$off ((cdte.charge_type), cdte.name, utep); i = 0; /* Don't print twice. */ if cdte.in_use < NOW_LOGGED_IN then goto process_destroyed; /* if no process to destroy, don't try */ if cdte.in_use = NOW_LOGGED_IN then go to process_stopped; /* Do we need to wait for a process to die? */ if cdte.in_use > NOW_LOGGED_IN then goto exit1; /* wait for process to be stopped by ring zero */ end; /* end have cdte */ /* If we get here, we don't have a cdte */ if ute.active = NOW_LOGGED_IN then goto process_stopped; if ute.active > NOW_LOGGED_IN then goto exit1; /* wait for ring zero to stop process */ /* If we get here, there's a bug */ call sys_log_ (SL_LOG_BEEP, "^a: cdtep = null and ate.active = ^d for ^p", ME, ute.active, utep); goto exit1; /* what else should we do? */ /* Return here when the process has had a chance to run and destroy itself. Call accounting to log him out completely, get his channel back, type nice messages. */ /* WAIT_(LOGOUT LOGOUT_HOLD DETACH NEW_PROC REMOVE DELETE_CHANNEL) */ hand (9): hand (10): hand (11): hand (12): hand (13): hand (20): if wakeup_from_user then go to fals0; /* User cannot send this. */ if signal_type ^= "STOPstop" then if signal_type ^= "stopstop" then do; /* we're waiting for a stopstop, and this isn't one */ if signal_type = "device " then goto fals0; /* worse-than-useless signal from network */ if asu_$check_for_stopped_process (utep, ME) then /* if process is stopped */ goto process_stopped; /* the stopstop wakeup must have been lost */ else goto fals0; /* process not stopped; log and ignore this wakeup */ end; process_stopped: call dpg_$finish (utep); call act_ctl_$dp (utep); ute.active = NOW_LOGGED_IN; /* No process any more. */ if have_cdte then cdte.in_use = NOW_LOGGED_IN; i = 0; if ute.destroy_flag ^= WAIT_NEW_PROC then do; /* Unless a new_proc, log him out. */ call act_ctl_$close_account (utep); /* Close account and print logged out msg to opr */ call lg_ctl_$logout (utep); if ^have_cdte then goto process_destroyed; /* if no cdte, skip the following channel stuff */ if cdte.tra_vec = WAIT_DELETE_CHANNEL then do; /* channel was deleted by CDT installation */ cdte.in_use = CHANNEL_DELETED; /* but we had to keep it long enough to destroy the process */ cdte.tra_vec = WAIT_HANGUP; /* ignore all wakeups */ cdte.current_service_type = INACTIVE; /* INACTIVE */ goto exit1; /* now we can mark it deleted and get out */ end; if cdte.tra_vec = WAIT_REMOVE then do; /* we hung up the channel before destroying the process */ cdte.in_use = NOW_HUNG_UP; /* line will be ignored until ATTACHed or CDT installed */ go to exit1; /* we quit before trying to print message, listen, etc. */ end; if ^ute.login_flags.noprint then do; /* If logout message will be needed. */ i = float (ute.cpu_usage, 63) / 1e6 + .5e0; /* convert usec to sec, rounded */ j = divide (i, 60, 17, 0); /* j= number of usage minutes */ i = i - j * 60; /* i= mod (usage, minutes) */ t1 = float (ute.mem_usage, 63) / 1e3; /* Get memory usage. */ call date_time_ (anstbl.current_time, date_time); if j > 0 then /* Use different message if there were minutes. */ call ioa_$rs (logout_fmt, buff, i, ute.person, ute.project, date_time, j, i, t1, ute.session_cost); else call ioa_$rs (logout_fmt1, buff, i, ute.person, ute.project, date_time, i, t1, ute.session_cost); end; end; process_destroyed: if ^have_cdte then do; /* if no cdte, we just destroyed a disconnected process */ call unlock; /* so clean up the way listen_again (below) does */ call user_table_mgr_$free (utep); /* imitate a little bit of asu_$release_ate */ goto exit1; /* and then get out quickly */ end; call astty_$tty_state (cdtep, code); /* Verify that user has not hung up. */ if code ^= 0 then go to cleanup_hangup; /* random error */ if cdte.state < TTY_DIALED then go to cleanup_hangup; /* Is tty hung up already? */ if i > 0 then /* Do we have logout message? */ if ^ute.login_flags.noprint then do; /* User want messages? */ buff = format_msg (buff, i, j, 231, 221); call astty_$tty_force (cdtep, addr (buff), j, code); /* write logout message */ if code ^= 0 then go to cleanup_hangup; end; call update_term_info (); if cdte.tra_vec = WAIT_LOGOUT_HOLD then do; /* Was logout hold, type "users" message. */ call timer_manager_$reset_alarm_wakeup (cdte.event); if ute.login_flags.noprint then say_hello = "0"b; else say_hello = "1"b; just_dialed_up = "0"b; call asu_$release_ate (cdtep, code); /* Free the ATE. New one will be made if necessary. */ utep = null; have_ate = "0"b; cdte.in_use = NOW_DIALED; go to login; end; else if cdte.tra_vec = WAIT_NEW_PROC then go to create; /* Make new process as result of term or new_proc */ cdte.in_use = NOW_DIALED; /* user has been logged out */ /* Hang up the terminal, and set up to listen for next dialup (unless detach) */ listen_again: timeout (1): timeout (8): timeout (9): timeout (10): timeout (11): timeout (12): timeout (13): timeout (14): timeout (15): call unlock; /* release answer table, permit updates */ call asu_$release_ate (cdtep, code); /* Free the answer table entry. */ utep = null; have_ate = "0"b; call timer_manager_$reset_alarm_wakeup (cdte.event); call ipc_$drain_chn (cdte.event, code); /* .. he's got no future */ if cdte.state = TTY_DIALED then do; /* If he's still there, get rid of him */ call astty_$tty_order (cdtep, "hangup", null, ignore_code); /* also clears modes & flags in ttydim */ cdte.in_use = NOW_HUNG_UP; /* keep our records straight */ end; if cdte.in_use > NOW_LISTENING then do; /* TRAP BUG where state and in_use get inconsistent */ call sys_log_ (SL_LOG_SILENT, "^a: cdte ^p (^a) state ^d in use ^d - notify system programmer", ME, cdtep, cdte.name, cdte.state, cdte.in_use); cdte.in_use = NOW_HUNG_UP; /* to avoid losing the channel */ end; cdte.dialed_up_time = cdte.dialed_up_time + /* Compute running total, in seconds */ float (anstbl.current_time - cdte.dialup_time, 63) / 1e6 + .5e0; if cdte.tra_vec ^= WAIT_DETACH then /* Done if operator wants this tty made free. */ call asu_$asu_listen (cdtep, code); /* Turn channel on again. Reset CDTE. */ go to exit1; /* Come here if cannot write fatal process error message, or if user hangs up during a new_proc */ cleanup_hangup: if cdte.tra_vec = WAIT_NEW_PROC then do; /* were we going to give a new process? */ call act_ctl_$close_account (utep); /* close account & log logout */ call lg_ctl_$logout (utep); /* remove user from whotab */ end; call astty_$tty_order (cdtep, "hangup", null (), ignore_code); /* be certain that actual state of channel */ cdte.in_use = NOW_HUNG_UP; /* and record of state in cdte, are consistent */ if code = 0 then go to listen_again; /* just a hangup, do normal reset */ call channel_error (code); /* some other error, bomb out */ /* Come here in case of fault during login or logout. */ abort: static_label = exit; /* so as not to loop */ if utep = null then go to listen_again; /* not much to do */ funct = "ucs "; ute.destroy_flag = WAIT_LOGOUT_HOLD; /* pretend logout hold */ if have_cdte then cdte.tra_vec = WAIT_LOGOUT_HOLD; /* make cdte tra_vec equal the one in ate */ ute.logout_type = "ucs "; ute.login_flags.noprint = "0"b; tcode = as_error_table_$dialup_error; i = 0; /* Buff is empty */ go to kill; /* * * * * * * * * * * * * * * * * * * * * * * * * * * * * */ evil3: call sys_log_ (SL_LOG_BEEP, "^a: called with null message ptr", ME); return; /* metering was not turned on */ evil2: call sys_log_ (SL_LOG_BEEP, "^a: called while ansp = null", ME); return; /* metering was not turned on */ evil1: call sys_log_ (SL_LOG_BEEP, "^a: called with bad ptr ^p by ^w", ME, ev_msg.data_ptr, ev_msg.fromproc); return; /* metering was not turned on */ evil: call asu_$find_process (ev_msg.fromproc, i, q); /* find out who sent signal */ if q ^= null then do; call get_trace_info; call sys_log_ (SL_LOG_BEEP, "^a: ignored ^a from ^a.^a for ^a st=^d,inuse=^d,tv=^d", ME, tsignal_type, q -> ute.person, q -> ute.project, tname, tstate, tinuse, ttv); goto exit1; /* metering was turned on so go turn it off */ end; /* can't find process; fall thru and print a different message */ fals: i = SL_LOG_BEEP; /* print with alarm */ falsi: call get_trace_info; call sys_log_ (i, "^a: ignored ^a for ^a st=^d,inuse=^d,tv=^d", ME, tsignal_type, tname, tstate, tinuse, ttv); goto exit1; /* metering was turned on, so go turn it off */ fals0: i = SL_LOG_SILENT; /* just log */ goto falsi; /* Come here when a channel (terminal) that has been requested by a user process finally dials up. TTYDIM won't let us connect it to user unless it is actually dialed up. */ hand (14): /* WAIT_FIN_PRIV_ATTACH */ call astty_$tty_state (cdtep, code); /* get current state of channel */ if cdte.state ^= TTY_DIALED then goto exit1; /* wait for correct event */ call dial_ctl_$finish_priv_attach (cdtep); /* do the work */ go to exit1; /* Next section of code takes care of dialed consoles' events */ hand (15): /* WAIT_DIAL_RELEASE */ call astty_$tty_state (cdtep, code); if cdte.state ^= TTY_HUNG then goto exit1; /* wait for correct event */ call dial_ctl_$dial_term (cdtep); /* Reset CDTE and tell master */ goto exit1; %page; /**** This code handles waiting for the hangup event to occur. When */ /**** it does, we will listen to the channel. */ hand (17): /* WAIT_HANGUP */ call astty_$tty_state (cdtep, code); /* get current state of channel */ if cdte.state > TTY_HUNG then go to exit1; /* wait for correct event */ if ^sc_stat_$shutdown_typed /* if we're not shutting down */ & cdte.in_use ^= CHANNEL_DELETED /* or being deconfigured */ & (cdte.current_service_type = FTP_SERVICE | /* and this is still live */ cdte.current_service_type = SLAVE_SERVICE) then if cdte.state ^= TTY_MASKED then call asu_$asu_listen (cdtep, code); /* ready for use, reconnect to channel */ /**** This will swallow all wakeups from channel from now on */ go to exit1; /* INTERNAL PROCEDURES */ interpret_ftp_cmd: proc (P_line, P_ll, P_cursor, P_lgwd, P_code); dcl P_line char (*) aligned, P_ll fixed bin, P_cursor fixed bin, P_lgwd char (*), P_code fixed bin (35); /* meanings of this code: 0 user gave BYE or QUIT cmd 1 user gave 'null' cmd (something allowed before login) 2 gave illegal cmd 3 USER cmd 4 other login/preaccess cmd (XATT, XMAP) 5 MAIL/MLFL 6 PASS Roy Planalp, 760819 */ dcl cursor fixed bin; dcl cmd char (4); dcl password char (8); dcl size fixed bin; dcl cmdno fixed bin; dcl code fixed bin; dcl lpcode fixed bin (35); dcl n_ftp_cmds fixed bin int static options (constant) init (14); dcl ftp_cmd (14) char (4) aligned int static options (constant) init ( "NOOP", "BYE ", "STAT", "BYTE", "TYPE", "STRU", "MODE", "USER", "XMAP", "XATT", "MAIL", "MLFL", "PASS", "QUIT"); call login_parse_ (addr (P_line), P_ll, cmd, size, cursor, lpcode); if lpcode ^= 0 & lpcode ^= error_table_$noarg then go to lp_error; if lpcode = error_table_$noarg then do; /* Null string sent */ P_code = 1; return; end; if (size < 1) | (size > 4) then go to illegal_cmd;/* Should never be < 1 */ cmd = translate (cmd, "ABCDEFGHIJKLMNOPQRSTUVWXYZ", "abcdefghijklmnopqrstuvwxyz"); do cmdno = 1 to n_ftp_cmds while (cmd ^= ftp_cmd (cmdno)); end; if cmdno > n_ftp_cmds then go to illegal_cmd; go to handle (cmdno); /* dispatch on cmd */ handle (1): /* NOOP */ buff = "NOOP command received "; i = 22; code = 200; go to null_return; handle (14): if ^ftp_765 then goto illegal_cmd; /* Illegal for "old" FTP */ goto quit_common; handle (2): if ftp_765 then goto illegal_cmd; /* Illegal for "new FTP */ quit_common: buff = "Disconnect requested. "; i = 22; if ftp_765 then code = 221; else code = 231; go to hang_return; handle (3): /* STAT */ call login_parse_ (addr (substr (P_line, cursor, 1)), P_ll - cursor + 1, cmd, size, cursor, lpcode); if lpcode ^= 0 & lpcode ^= error_table_$noarg then go to lp_error; if size > 0 then do; buff = "You must login before getting file status. "; i = 43; if ftp_765 then code = 530; else code = 504; go to null_return; end; else do; buff = "Connected to Multics answering service. Please log in. "; i = 56; if ftp_765 then code = 211; else code = 100; go to null_return; end; handle (4): /* BYTE */ if ftp_765 then /* Illegal for "new" FTP */ goto illegal_cmd; call login_parse_ (addr (substr (P_line, cursor, 1)), P_ll - cursor + 1, cmd, size, cursor, lpcode); if cmd = "8" then do; buff = "Default BYTE 8 still in effect. "; i = 32; code = 200; go to null_return; end; else do; buff = "Unable to alter BYTEsize before login. "; i = 39; code = 504; go to null_return; end; handle (5): /* TYPE */ call login_parse_ (addr (substr (P_line, cursor, 1)), P_ll - cursor + 1, cmd, size, cursor, lpcode); if cmd = "A" | cmd = "a" then do; buff = "Default TYPE ASCII still in effect. "; i = 36; code = 200; go to null_return; end; else do; buff = "Unable to change Representation TYPE before login. "; i = 51; if ftp_765 then code = 530; else code = 504; go to null_return; end; handle (6): /* STRU */ call login_parse_ (addr (substr (P_line, cursor, 1)), P_ll - cursor + 1, cmd, size, cursor, lpcode); if cmd = "F" | cmd = "f" then do; buff = "Default STRUcture File still in effect. "; i = 39; code = 200; go to null_return; end; else do; buff = "Unable to change STRUcture before login. "; i = 41; if ftp_765 then code = 530; else code = 504; goto null_return; end; handle (7): /* MODE */ call login_parse_ (addr (substr (P_line, cursor, 1)), P_ll - cursor + 1, cmd, size, cursor, lpcode); if cmd = "S" | cmd = "s" then do; buff = "Default Transfer MODE Stream still in effect. "; i = 46; code = 200; goto null_return; end; else do; buff = "Unable to change Transfer MODE before login. "; i = 45; if ftp_765 then code = 530; else code = 504; goto null_return; end; handle (8): /* USER */ P_cursor = cursor; /* accept this cmd as is, */ P_code = 3; /* let parse_ftp_login_line_ figure it out */ return; handle (9): P_cursor = cursor; P_lgwd = "MAP"; P_code = 4; return; handle (10): /* XATT */ P_cursor = cursor; P_lgwd = "dial"; P_code = 4; return; handle (11): /* MAIL, MLFL */ handle (12): if ftp_765 then goto illegal_cmd; /* Illegal for "new" FTP */ buff = "Please use USER NETML (PASS NETML) to send mail. "; i = 49; code = 504; P_code = 5; go to return_common; handle (13): /* PASS */ call login_parse_$password (addr (substr (P_line, cursor, 1)), P_ll - cursor + 1, password, size, cursor, lpcode); P_lgwd = password; /* never mind that code */ P_code = 6; return; lp_error: buff = convert_message (lpcode, i); go to illegal_cmd_join; illegal_cmd: buff = "Command not understood, please login. "; i = 38; illegal_cmd_join: P_code = 1; code = 500; call resetread (); go to return_common; hang_return: P_code = 0; go to return_common; null_return: P_code = 1; return_common: buff = format_msg (buff, i, i, code, code); call astty_$tty_force (cdtep, addr (buff), i, tcode); if tcode ^= 0 then call channel_error (tcode); return; end interpret_ftp_cmd; /* Internal procedure to assign a channel back to the answering service so we can talk to it. It must always work, so we ignore any codes which might indicate errors or hangups */ grab_tty: proc; call astty_$tty_order (cdtep, "quit_disable", null, ignore_code); call astty_$tty_event (cdtep, ignore_code); /* Set read terminations to come to me */ end grab_tty; hello: proc (); t1 = anstbl.n_units / 10.0e0; /* format load message */ t2 = anstbl.max_units / 10.0e0; /* ... */ call date_time_ (anstbl.current_time, date_time); call ioa_$rs (greeting_fmt, buff, j, whotab.sysid, installation_parms.installation_id, cdte.name, t1, t2, anstbl.n_users, date_time); if anstbl.message_lng ^= 0 & anstbl.session = "shutdown" then do; /* print shutdown message rather than greeting banner */ buff = anstbl.special_message; buff = format_msg (buff, anstbl.message_lng, i, 401, 421); end; else if anstbl.message_lng ^= 0 & anstbl.session = "special" then do; /* prefix greeting banner with special session message. */ buff = substr(anstbl.special_message,1,anstbl.message_lng) || substr(buff,1,j); buff = format_msg (buff, length(rtrim(buff)), i, 030, 120); end; else if anstbl.message_lng ^= 0 /* prefix greeting banner with extra login message */ then do; /* eg, "Unattended Service" */ buff = substr(anstbl.special_message,1,anstbl.message_lng) || substr(buff,1,j); buff = format_msg (buff, length(rtrim(buff)), i, 300, 220); end; else buff = format_msg (buff, j, i, 300, 220); /* just format greeting banner */ call astty_$tty_force (cdtep, addr (buff), i, code); /* write message */ if code ^= 0 then call channel_error (code); /* any trouble? */ end hello; change_type: proc (new_type); dcl new_type char (*); set_type_info.version = stti_version_1; set_type_info.name = new_type; string (set_type_info.flags) = "0"b; call astty_$tty_order (cdtep, "set_term_type", addr (set_type_info), code); if code ^= 0 then call channel_error (code); cdte.current_terminal_type = new_type; /* Set new type */ end change_type; update_term_info: procedure (); term_info.version = terminal_info_version; call astty_$tty_order (cdtep, "terminal_info", addr (term_info), code); if code ^= 0 then call channel_error (code); /* Get the info that's available. */ cdte.current_terminal_type = term_info.term_type; /* Store info in CDTE for this channel */ cdte.tty_id_code = term_info.id; /* .. */ cdte.cur_line_type = term_info.line_type; /* .. */ cdte.baud_rate = term_info.baud_rate; /* .. */ return; end update_term_info; lock: procedure; ute.lock_value = ute.lock_value + 1; anstbl.lock_count = anstbl.lock_count + 1; return; end lock; unlock: procedure; if utep ^= null /* Might unlock when not needed. */ then anstbl.lock_count = anstbl.lock_count - ute.lock_value; if anstbl.lock_count < 0 then anstbl.lock_count = 0; if anstbl.lock_count = 0 then do; code = 0; do while (code = 0); call ipc_$unmask_ev_calls (code); if code = 0 then call ioa_ ("^RError detected in ftp_dialup_: ^B event calls were masked"); end; end; if utep ^= null then ute.lock_value = 0; if ((anstbl.lock_count = 0) & (anstbl.update_pending = "1"b)) then do; anstbl.update_pending = "0"b; /* reset update-pending flag */ call hcs_$wakeup (as_procid, anstbl.update_channel, dum_msg, code); /* trigger dormant update procedure */ end; return; end unlock; convert_message: procedure (P_status_code, P_len) returns (char (100) aligned); /* parameter */ declare P_status_code fixed binary (35) parameter, P_len fixed bin; /* automatic */ declare short character (8) aligned automatic, long character (100) aligned automatic; /* program */ call convert_status_code_ (P_status_code, short, long); P_len = length (long) + 1 - verify (reverse (long), " "); if P_len = length (long) + 1 then do; P_len = 1; return (NL); end; else do; P_len = P_len + 1; return (substr (long, 1, P_len - 1) || NL); end; end convert_message; convert_message_nnl: procedure (p_status_code) returns (char (100) varying); /* parameter */ declare p_status_code fixed binary (35) parameter; /* automatic */ declare short character (8) aligned automatic, long character (100) aligned automatic; /* program */ call convert_status_code_ (p_status_code, short, long); return (rtrim (long, " ")); end convert_message_nnl; format_ftp_output: proc (P_message, P_msg_lng, P_new_lng, P_ftp_code) returns (char (300) aligned); dcl P_message char (*) aligned, P_msg_lng fixed bin, P_new_lng fixed bin, P_ftp_code char (4) aligned; dcl build_string char (300) varying, i fixed bin, temp fixed bin; build_string = P_ftp_code; if P_msg_lng = 0 then do; /* caller had nothing to say */ build_string = build_string || NL; P_new_lng = 5; return (build_string); end; i = 1; temp = index (substr (P_message, i, P_msg_lng - i + 1), NL); do while ((temp ^= P_msg_lng - i + 1) & (temp ^= 0)); /* while we are not at the last line in the message */ substr (build_string, 4, 1) = "-"; /* indicate this is a multiple line msg */ build_string = build_string || (4)" "; build_string = build_string || substr (P_message, i, temp); i = i + temp; temp = index (substr (P_message, i, P_msg_lng - i + 1), NL); end; if substr (build_string, 4, 1) = "-" then do; build_string = build_string || P_ftp_code; /* multiple concatenations are inefficient */ build_string = build_string || substr (P_message, i, P_msg_lng - i + 1); /* so build it up piece by piece */ end; else build_string = build_string || substr (P_message, i, P_msg_lng - i + 1); P_new_lng = length (build_string); return (build_string); end format_ftp_output; format_ecode: proc (P_code, P_bufr, P_lng, P_old_ftp_code, P_new_ftp_code); dcl P_code fixed bin (35), P_bufr char (*) aligned, P_lng fixed bin, P_old_ftp_code fixed bin, P_new_ftp_code fixed bin; dcl len fixed bin, result picture "999b"; P_bufr = convert_message (P_code, len); if ftp_765 then result = min (999, P_new_ftp_code); else result = min (999, P_old_ftp_code); P_bufr = format_ftp_output (P_bufr, len, P_lng, (result)); return; end format_ecode; format_msg: proc (P_bufr, P_in_lng, P_lng, P_old_ftp_code, P_new_ftp_code) returns (char (300) aligned); dcl P_bufr char (*) aligned, P_lng fixed bin, P_new_ftp_code fixed bin, P_old_ftp_code fixed bin, P_in_lng fixed bin; dcl result picture "999b"; if ftp_765 then result = min (999, P_new_ftp_code); else result = min (999, P_old_ftp_code); return (format_ftp_output (P_bufr, P_in_lng, P_lng, (result))); end format_msg; print_ftp_msg: procedure (P_msg, P_old_ftp_code, P_new_ftp_code); dcl P_msg char (*) aligned, P_new_ftp_code fixed bin, P_old_ftp_code fixed bin; dcl temp_buff char (300) aligned, tb_len fixed bin; temp_buff = format_msg (P_msg, length (P_msg), tb_len, P_old_ftp_code, P_new_ftp_code); call astty_$tty_force (cdtep, addr (temp_buff), tb_len, code); if code ^= 0 then call channel_error (code); return; end print_ftp_msg; resetread: procedure (); dcl temp_code fixed binary (35); call astty_$tty_abort (cdtep, 1, temp_code); if temp_code ^= 0 then call channel_error (temp_code); return; end resetread; /* Come here if any call to astty_ returns a non-zero code */ channel_error: procedure (p_code); dcl p_code fixed binary (35) parameter; if p_code = -1 then if cdte.state < TTY_DIALED then do; /* code = -1 means "it hung up" */ cdte.in_use = NOW_HUNG_UP; /* keep cdte consistent */ go to listen_again; end; /* as_tty_ uses -1 to mean "tty hung up" */ call sys_log_$error_log (SL_LOG_BEEP, p_code, ME, "tty_dim error, removing channel ^a ^a", cdte.name, cdte.comment); call unlock; /* release answer table, permit updates */ call asu_$release_ate (cdtep, code); /* Free the ATE */ utep = null; call timer_manager_$reset_alarm_wakeup (cdte.event); call asu_$asu_remove (cdtep); go to exit1; end channel_error; trace: procedure; if loud_select_sw then /* trace only specified channel(s) */ if loud_select_channel ^= /* if specified string is not equal to */ substr (cdte.name, 1, length (loud_select_channel)) /* the beginning of this channel's name */ then return; /* then don't trace it */ call get_trace_info; call sys_log_ (SL_LOG, "^a: trace event ^a ^a ^w ^p st=^d,inuse=^d,tv=^d", ME, tname, /* channel name */ tsignal_type, /* what was signalled */ ev_msg.fromproc, /* signalling processid */ ev_msg.data_ptr, /* ptr to cdte or ate */ tstate, tinuse, ttv); /* line state, entry state, wait point */ end trace; /* -------------------- */ get_trace_info: proc; /* format information for printing, either in trace or error message */ dcl i fixed bin; dcl o_sw bit (1); /* says whether to print msg in octal or character */ dcl char8 char (8); /* First, format the contents of the wakeup message, in ASCII, octal, or both */ char8 = "........"; o_sw = "0"b; /* assume character */ do i = 1 to length (signal_type); /* check each character */ if unspec (substr (signal_type, i, 1)) < "040"b3 | unspec (substr (signal_type, i, 1)) > "176"b3 then o_sw = "1"b; /* if nonprinting char, remember to print in octal */ else substr (char8, i, 1) = substr (signal_type, i, 1); /* copy printing char into ASCII string */ end; call ioa_$rsnnl ("^[""^a""^x^;^s^]^[(^w ^w)^;^2s^]", tsignal_type, (0), (char8 ^= "........"), char8, o_sw, substr (unspec (signal_type), 1, 36), substr (unspec (signal_type), 37, 36)); /* Then get state information from either the cdte or ate (whichever we have) or maybe both */ if wakeup_for_channel then do; /* if wakeup came in over a cdte channel */ tname = rtrim (cdte.name); if have_ate then tname = tname || " (" || rtrim (ute.person) || "." || rtrim (ute.project) || ")"; tanswb = cdte.tty_id_code; tstate = cdte.state; ttv = cdte.tra_vec; tinuse = cdte.in_use; end; else if wakeup_for_process then do; /* or, if it came in over an ate channel */ tname = rtrim (ute.person) || "." || rtrim (ute.project); /* construct an informative name */ if have_cdte then do; /* if we have a cdte, get more debugging info */ tname = tname || " (" || rtrim (cdte.name) || ")"; tstate = cdte.state; end; else tstate = 0; /* no channel state info in ate */ tanswb = ute.tty_id_code; /* a copy of cdte.tty_id_code */ ttv = ute.destroy_flag; /* a copy of cdte.tra_vec */ tinuse = ute.active; /* a copy of cdte.in_use */ end; else do; /* should never happen, but be cautious */ tname = "???"; tanswb = ""; tstate, tinuse, ttv = 0; end; return; end get_trace_info; init: entry; /* do this as often as we're asked */ if ^sc_stat_$Multics_typed then call sub_err_ (error_table_$out_of_sequence, "ftp_dialup_$init", "s"); greeting_fmt = convert_message_nnl (as_error_table_$greeting_msg); bad_login_word_fmt = convert_message_nnl (as_error_table_$bad_login_word_msg); proc_term_fmt = convert_message_nnl (as_error_table_$proc_term_msg); init_term_fmt = convert_message_nnl (as_error_table_$init_term_msg); proc_term_loop_fmt = convert_message_nnl (as_error_table_$proc_term_loop_msg); logout_fmt = convert_message_nnl (as_error_table_$logout_msg); logout_fmt1 = convert_message_nnl (as_error_table_$logout1_msg); pw_msg = convert_message_nnl (as_error_table_$pw_msg); call ioa_$rs ((pw_msg), pw_msg, i); return; ftp_dial_loud: entry; dcl cu_$arg_count entry returns (fixed bin); dcl cu_$arg_ptr entry (fixed bin, ptr, fixed bin, fixed bin (35)); dcl argp ptr, argl fixed bin, arg char (argl) based (argp); dcl loud_select_sw bit (1) aligned int static init (""b); dcl loud_select_channel char (32) varying int static init (""); loudsw = "1"b; if cu_$arg_count () = 0 then /* if no argument, trace all channels */ loud_select_sw = ""b; else do; /* trace the specified channel(s) */ loud_select_sw = "1"b; call cu_$arg_ptr (1, argp, argl, code); loud_select_channel = arg; /* can be something like "a.h1" */ end; return; ftp_dial_soft: entry; loudsw = "0"b; return; /* This internal procedure is the default handler for errors encountered during ftp_dialup_ */ ftp_dialup_ucs: proc (mcptr, condname, coptr, infoptr, continue); dcl mcptr ptr parameter; dcl condname char (*) parameter; dcl coptr ptr parameter; dcl infoptr ptr parameter; dcl continue bit (1) parameter; dcl errm char (120); dcl erri fixed bin; dcl non_local_exit bit (1); dcl as_check_condition_ entry (char (*), bit (1), bit (1)); call as_check_condition_ (condname, continue, non_local_exit); if continue | non_local_exit then return; call get_trace_info; /* get info out of either ate or cdte */ call ioa_$rsnnl ("^a: Error ^a ^a ""^a"" st=^d,inuse^=d,tv=^d", ME, errm, erri, condname, tname, tanswb, tstate, tinuse, ttv); call as_dump_ (errm); go to static_label; end ftp_dialup_ucs; %page; DISPLAY_PROCESS_AUTHORIZATION: procedure (); /* This procedure displays the "Your authorization is ..." message on the interactive user's terminal upon process creation and reconnection. */ dcl authorization_string char (200) automatic; dcl buff_lth fixed bin; /* length of string to display */ dcl code fixed bin (35) automatic; dcl format char (100) aligned automatic; dcl convert_access_class_$to_string entry (bit (72) aligned, char (*), fixed bin (35)); dcl as_error_table_$login_auth_msg fixed bin (35) ext static; dcl error_table_$smallarg fixed bin (35) ext static; call convert_access_class_$to_string (ute.process_authorization, authorization_string, code); if code ^= 0 then if code = error_table_$smallarg then ; /* we'll use what we can */ else authorization_string = "Unknown"; if authorization_string ^= "" then do; call convert_status_code_ (as_error_table_$login_auth_msg, (""), format); if format ^= "" then do; call ioa_$rs (format, buff, buff_lth, authorization_string); buff = format_msg (buff, buff_lth, buff_lth, 231, 221); call astty_$tty_force ((ute.channel), addr (buff), buff_lth, (0)); end; end; end DISPLAY_PROCESS_AUTHORIZATION; /* format: on */ %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 dialup_values; %page; %include installation_parms; %page; %include line_types; %page; %include sc_stat_; %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; %page; %include whotab; /* format: on */ %page; /* BEGIN MESSAGE DOCUMENTATION Message: ftp_dialup_: non-null atep (UTEP) for cdte (CDTEP,CHANNEL), tv=TRAVEC,inuse=INUSE S: $as0 T: $run M: A wakeup occurred for CHANNEL whose user table entry pointer (UTEP) was non-null. A test on the above information determined that the state of the channel to be inconsistant. The system will null the UTEP pointer in the CDT for the above channel. A: $contact Message: ftp_dialup_: re-used cdte (CDTEP,CHANNEL) by ate UTEP, destroy_flag=DDDD S: $as0 T: $run M: An ate wakeup occurred which pointed to a CDTEP that was already in use by another process. A: $inform Message: ftp_dialup_: re-used cdte (CDTEP,CHANNEL) by ate UTEP, destroy_flag=DDDD S: $as0 T: $run M: An ate wakeup occurred which pointed to a CDTEP that was already in use by another process. A: $inform Message: ftp_dialup_: turning off disconnected flag for ate UTEP, cdte CDTEP,CHANNEL S: $as0 T: $run M: If processing an ate wakeup, the CHANNEL is known and the process is disconnected, the disconnected flag for the ate will be turned off. A: $inform Message: ftp_dialup_: Program error: null atep with per-process tra_vec value S: $as2 T: $run M: A system programming error in the answering service has occurred as a wakeup occurred when tra_vec indicated to expect a process termination but the ate pointer was null. A: $inform Message: ftp_dialup_: Program error: null cdtep with per-channel tra_vec value S: $as2 T: $run M: A wakeup was received when the tra_vec value indicated a channel operation was required but the cdtep was null. This is considered to be a programming error. A: $inform Message: ftp_dialup_: Program error: per-process wakeup with per-channel-only tra_vec value S: $as2 T: $run M: A process wakeup occurred when the tra_vec value indicated it should be a channel wakeup. This is considered a programing error. A: $inform Message: ftp_dialup_: CDT damaged at CDTEP, tra_vec=TTTT S: $as2 T: $run M: The tra_vec value was found to be invalid for a channel wakeup. Damage to the CDT is indicated. A: $inform Message: ftp_dialup_: answer table damaged at UTEP, tra_vec=TTTT S: $as2 T: $run M: The tra_vec value was found to be invalid for an answer table wakeup. Damage to the answer table is indicated. A: $inform Message: ftp_dialup_: unexpected state SSSS for channel definition table at CDTEP S: $as2 T: $run M: $err A: $inform Message: ftp_dialup_: Unable to determine initial terminal type for channel CHANNEL S: $as2 T: $run M: Unable to determine the default terminal type based on line-type/baud-rate in the TTT. The channel has been removed from known channels. A: $inform Message: ftp_dialup_: wrong answerback on CHANNEL (COMMENT); expected "ID1", got "ID2". S: $as2 T: $run M: A terminal attempted to connect on CHANNEL (whose CDT comment is COMMENT) that is restricted to a specific answerback and did not return the expected value. ID1 is the answerback expected; ID2 is the answerback actually received. The terminal is hung up. A: $ignore Message: ftp_dialup_: ERROR_MESSAGE attempting to allocate a user table entry for CHANNEL S: $as1 T: $run M: An ERROR_MESSAGE was returned from a call to asu_$attach_ate which allocates a user table entry. A: $inform Message: ftp_dialup_: The answer table is full (MAX entries). S: $as1 T: $run M: The system answer table is full and has MAX entries. No more users will be able to login. A: $inform Message: ftp_dialup_: ERROR_MESSAGE occurred attempting to declare handler for ev chn EVENT_CHN for ate UTEP for CDT_CHANNEL S: $as2 T: $run M: An ERROR_MESSAGE was returned when an attempt was made to declare an event call channel for new process (UTEP) on EVENT_CHN attached to CDT_CHANNEL. A: $inform Message: ftp_dialup_: ERROR_MESSAGE when creating process for PERSON.PROJECT S: $as2 T: $run M: An ERROR_MESSAGE was returned and the system was unable to create a user process for PERSON.PROJECT. A: If possible, get in touch with the user. (He got a message to contact you.) Ask him to try again and to tell you of any peculiarities of his login. Note all particulars and contact the programming staff. Message: ftp_dialup_: process terminated PERSON.PROJECT CHANNEL TERM_MESSAGE S: $as0 T: $run M: The process for PERSON.PROJECT on CHANNEL was terminated abnormally due to reason in TERM_MESSAGE. A: $ignore Message: ftp_dialup_: fatal error during process creation for PERSON.PROJECT CHANNEL S: $as1 T: $run M: A fatal error occurred during process creation for PERSON.PROJECT on CHANNEL. Reason is given in previous log entry. This may be due to a user error: incorrect segments in the user's home directory or bad login arguments can cause this problem. A: $ignore Message: ftp_dialup_: terminating fatal process error loop for PERSON.PROJECT CHANNEL S: $as1 T: $run M: The process for PERSON.PROJECT on CHANNEL has taken too many fatal process errors. This is governed by fatal_error_loop_seconds and fatal_error_loop_count in the installation_parms. The user will not get a new process. The channel will not be hungup but will get a message indicating this condition. This message may be due to a user error. A: $ignore Message: ftp_dialup_: ERROR_MESSAGE new_proc of PERSON.PROJECT denied by channel AIM restriction. S: $as0 T: $run M: A user attempted to issue a new_proc an specify an AIM authorization which is not allowed by the terminal channel in use. A: $ignore Message: ftp_dialup_: Unexpected termsgnl for PERSON.PROJECT CHANNEL (preempted=DDDD). S: $as0 T: $run M: A "termsgnl" wakeup was received for the PERSON.PROJECT process on CHANNEL whose ute.preempted value DDDD did not indicate one was allowed. This is considered to be a program error. User will be given a new process. A: $inform Message: ftp_dialup_: process ignored term signal PERSON.PROJECT CHANNEL S: $as1 T: $run M: The PERSON.PROJECT process on CHANNEL had been sent a trm_ signal but the process did not respond to it. The process will be handled as was intended to be; bumped, logged out, etc. A: $ignore Message: ftp_dialup_: premature stopstop for PERSON.PROJECT CHANNEL S: $as0 T: $run M: $err A: $inform Message: ftp_dialup_: process did not respond properly to trm_ signal. PERSON.PROJECT CHANNEL S: $as0 T: $run M: The PERSON.PROJECT process on CHANNEL was being terminated and had been sent the trm_ signal but it did not respond. User process will be bumped, logged out or new_proced. It is possible that the user can cause this message. A: $ignore Message: ftp_dialup_: cdtep = null and ate.active = DDDD for UTEP S: $as2 T: $run M: $err A: $inform Message: ftp_dialup_: cdte CDTEP (CHANNEL) state M in use N - notify system programmer", S: $as0 T: $run M: $err A: $contact Message: ftp_dialup_: called with null message ptr S: $as2 T: $run M: A programming error in the interprocess communication system, the network software, or the Answering Service itself has occurred. An invalid message pointer has been passed to the Answering Service. The system ignores the message and attempts to continue. This message may be the result of an incorrect library installation. A: Shut down the system and perform a bootload operation. Inform the system programming staff. Message: ftp_dialup_: called while ansp = null S: $as2 T: $run M: A programming error in the Answering Service or an incorrect library installation has caused the Answering Service to be called before being initialized. The system will ignore the error and attempt to continue. A: Shut down the system and perform a bootload operation. Message: ftp_dialup_: called with bad ptr EVENT_MSG_PTR by WWWWWWWWWWWW S: $as2 T: $run M: A programming error in the interprocess communication system, the network software, or the Answering Service itself has occurred. An invalid message pointer has been passed to the Answering Service. The system ignores the message and attempts to continue. This message may be the result of an incorrect library installation. A: Shut down the system and perform a bootload operation. Message: ftp_dialup_: ignored SSSS from PERSON.PROJECT for CHANNEL state=DDDD,inuse=UUUU,tv=TTTT S: $as2 T: $run M: A spurious signal SSSS from user PERSON.PROJECT has arrived for CHANNEL. The state of the channel is DDD, inuse is UUUU and tra_vec is TTTT. A: This may be some user trying to disrupt the system. Do a who and save it for the programming staff. Message: ftp_dialup_: ERROR_MESSAGE tty_dim error, removing channel CHANNEL COMMENT S: $as2 T: $run M: An ERROR_MESSAGE caused the CHANNEL to be unusable. The CHANNEL with COMMENT will be removed from service. A: You may try to attach the channel. If that fails, notify the system programmers. If the channel is to be left detached, busy out the modem. Message: ftp_dialup_: trace event CHANNEL FFFFFFFF WWWWWWWWWWWW RRRRRRDDDDDD SS XXXX st N wp M S: $as1 T: $run M: This is trace output. When ftp_dialup_$ftp_dial_loud is called, these messages are printed out for every signal concerning a device channel. FFFFFFFF is the function being performed. WWWWWWWWWWWW is the sending process ID. RRRRRR is the ring origin of the signal. DDDDDD is the device signal information. The pointer SS XXXX locates the answer table entry for CHANNEL. The channel state is N and the wait point (transaction vector) is M. A: $ignore To turn these messages off, type ftp_dialup_$ftp_dial_soft while in admin mode. END MESSAGE DOCUMENTATION */ end ftp_dialup_;  ftp_misc_.alm 10/07/88 1420.1rew 10/07/88 1419.2 9252 " ***************************************************** " * * " * Copyright, (C) Honeywell Bull Inc., 1988 * " * * " * Copyright (C) 1982 by Massachusetts Institute of * " * Technology and Honeywell Information Systems Inc. * " * * " ***************************************************** " HISTORY COMMENTS: " 1) change(88-09-19,Fawcett), approve(88-10-05,MCR8010), " audit(88-10-06,Parisek), install(88-10-07,MR12.2-1149): " Change from an absolute path name for the overseer to just entry " name. This allows the overseer to be found via the search rules. " END HISTORY COMMENTS name ftp_misc_ " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " " segdef ftp_login_responder ftp_login_responder: dec 24 aci "tcp_ftp_server_overseer_",168 end  parse_ftp_login_line_.pl1 07/13/88 1235.8r w 07/13/88 0938.8 103680 /****^ *********************************************************** * * * 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 */ parse_ftp_login_line_: proc (lp, ll, ate_p, errarg, code); /* This routine is called by ftp_dialup_ to parse the USER command. The strategy here is to not allow some of the control arguments a regular user could use and also to set certain values in the answer table to defaults for ftp users, and to set other ones using special ftp control arguments. Stolen from parse_login_line_ by Roy Planalp, 760819 Last modified by D. M. Wells, Oct. 1976, to fix problem caused by using person.project form and including ctl args Modified November 1981, E. N. Kittlitz. user_table_entry conversion. Modified January 1982, E. N. Kittlitz. login_parse_ changes, as_data_ conversion. */ /****^ HISTORY COMMENTS: 1) change(87-04-26,GDixon), approve(87-08-03,MCR7741), audit(87-07-16,Brunelle), install(87-08-04,MR12.1-1055): Upgraded for change to answer_table.incl.pl1 and user_table_entry.incl.pl1 END HISTORY COMMENTS */ /* Contributors to original parse_login_line_: Modified 740807 by PG for -authorization and -change_default_authorization Modified 740913 by PG for -generate_password Modified 750429 by PG for new dial facility Modified 750714 by THVV for -modes and -terminal_type Modified 751024 by T. Casey for -subsystem. Modified 760601 by PG to handle pw masks properly. */ /* parameters */ dcl lp ptr, /* Pointer to input line buffer. */ ll fixed bin, /* Length of line. */ ate_p ptr, /* Pointer to answer table entry. */ errarg char (*) aligned, /* If an error occurs , what went wrong. */ code fixed bin (35); /* Error code. */ /* automatic */ dcl i fixed bin; /* temporary */ dcl authorization bit (72) aligned; /* binary authorization */ dcl authorization_string char (150); /* character representation of auth. */ dcl j fixed bin; /* Return from login_parse_: relative cursor */ dcl jj fixed bin; /* Absolute cursor */ dcl arg char (24); /* Single argument to login. */ dcl prev_arg char (24); /* Previous arg, for error message */ dcl k fixed bin; /* Length of argument. */ dcl char64 char (64); /* temporary */ dcl npo bit (1); /* user gave -no_process_overseer arg */ /* based */ dcl ch (ll) char (1) unal based (lp); /* Image of buffer */ /* internal static initial */ dcl (true bit (1) aligned init ("1"b), false bit (1) aligned init ("0"b) ) internal static options (constant); /* entries */ dcl convert_authorization_$from_string entry (bit (72) aligned, char (*), fixed bin (35)); dcl login_parse_ entry (ptr, fixed bin, char (*), fixed bin, fixed bin, fixed bin (35)); dcl cv_dec_check_ entry (char (*), fixed bin (35)) returns (fixed bin (35)); /* external static */ dcl as_error_table_$no_login_arg_msg fixed bin (35) ext static; dcl as_error_table_$bad_login_arg_msg fixed bin (35) ext static; dcl as_error_table_$long_ip_ss_args fixed bin (35) ext static; dcl error_table_$bad_arg fixed bin (35) ext static; dcl error_table_$noarg fixed bin (35) ext static; dcl 1 ftp_misc_$ftp_login_responder aligned external static, 2 pathlen fixed bin (35), /* no. chars in path */ 2 overseer char (168) aligned; /* the path */ dcl 1 as_data_$login_args ext aligned, 2 n_login_args fixed bin (35), 2 pad fixed bin (35), 2 login_args (38) char (24); dcl as_data_$max_user_ring fixed bin (35) ext; /* builtins */ dcl (addr, hbound, index, null, substr) builtin; %page; /* ================================================== */ code = 0; /* Assume no error will happen. */ utep = ate_p; /* Copy argument */ ute.login_flags.auth_given = "0"b; /* whether -auth was specified */ ute.at.bumping = "1"b; /* Default is bumping ON, unless -np */ ute.login_code = "login"; /* dft login word */ npo = false; /* dft user gets ftp_server initproc */ ute.at.brief = true; /* and no login messages */ char64 = ""; call login_parse_ (lp, ll, char64, k, j, code); /* Get person ID */ if code ^= 0 then /* Personid must be given */ return; if k > 32 then do; code = error_table_$bad_arg; /* bad syntax */ return; end; jj = index (substr (char64, 1, j), "."); if jj = 0 then do; ute.person = substr (char64, 1, j); end; else do; ute.person = substr (char64, 1, jj - 1); ute.project = substr (char64, jj + 1, j - jj); end; if ute.person = "NETML" then npo = true; /* special kludge for netmail (his dft initproc works for ftp) */ jj = 0; arg = ""; /* set up for prev_arg */ nxarg: jj = jj + j; /* Advance cursor. */ prev_arg = arg; call login_parse_ (addr (ch (jj)), ll - jj + 1, arg, k, j, code); /* Pick off next argument. */ if code = error_table_$noarg then do; code = 0; go to exit; /* use defaults */ end; if substr (arg, 1, 1) ^= "-" then go to badarg; /* Not a control arg */ do k = 1 to as_data_$login_args.n_login_args while (arg ^= as_data_$login_args.login_args (k)); end; /* Look up argument in table. */ if k > as_data_$login_args.n_login_args /* Fuss if unknown argument. */ then if arg = "-word" /* special ftp arg */ then go to word_handler; else if arg = "-no_process_overseer" | arg = "-npo" /* .. */ then go to npo_handler; else do; badarg: code = as_error_table_$bad_login_arg_msg; /* Return error to ftp_dialup_ */ errarg = arg; /* Tell user what we barf on */ return; end; if k > hbound (arg_handler, 1) then go to badarg; /* as_data_ is newer than we are! */ go to arg_handler (k); /* Dispatch on argument. */ arg_handler (3): /* -hd */ arg_handler (4): /* -home_dir */ jj = jj + j; /* Advance parse pointer. */ call login_parse_ (addr (ch (jj)), ll - jj + 1, ute.home_dir, k, j, code); if code ^= 0 then go to lp_error; if substr (ute.home_dir, 1, 1) ^= ">" then go to badarg; /* Must be absolute path. */ go to nxarg; arg_handler (5): /* -po */ arg_handler (6): /* -process_overseer */ jj = jj + j; call login_parse_ (addr (ch (jj)), ll - jj + 1, char64, i, j, code); if code ^= 0 then go to lp_error; if ute.uflags.ss_given then do; /* if -subsystem given already, save it */ authorization_string = substr (ute.init_proc, ute.ip_len + 1, ute.ss_len); /* borrow a vacant string */ if i + ute.ss_len > 64 then do; /* if sum of both strings too long */ code = as_error_table_$long_ip_ss_args; errarg = char64; return; /* let user try again */ end; end; substr (ute.init_proc, 1, i) = substr (char64, 1, i); ute.ip_len = i; ute.uflags.ip_given = "1"b; npo = true; if ute.uflags.ss_given then /* if -ss was already given, put it back at end of string */ substr (ute.init_proc, i + 1, ute.ss_len) = substr (authorization_string, 1, ute.ss_len); go to nxarg; arg_handler (11): /* -nw */ arg_handler (12): /* -no_warning */ ute.at.no_warning = true; ute.ur_at.no_warning = true; go to nxarg; arg_handler (13): /* -np */ arg_handler (14): /* -no_preempt */ ute.at.bumping = false; ute.ur_at.bumping = true; go to nxarg; arg_handler (15): /* -force */ ute.at.guaranteed_login = true; ute.ur_at.guaranteed_login = true; go to nxarg; arg_handler (37): /* -rg */ arg_handler (38): /* -ring */ jj = jj + j; call login_parse_ (addr (ch (jj)), ll - jj + 1, arg, k, j, code); if code ^= 0 then go to lp_error; ute.initial_ring = cv_dec_check_ (arg, code); /* Convert ring to integer. */ if code ^= 0 then go to badarg; /* Check value. */ if ute.initial_ring <= 0 then go to badarg; /* Aw, c'mon. */ if ute.initial_ring > as_data_$max_user_ring then go to badarg; go to nxarg; arg_handler (25): /* -om */ arg_handler (26): /* -outer_module */ jj = jj + j; call login_parse_ (addr (ch (jj)), ll - jj + 1, ute.outer_module, k, j, code); if code ^= 0 then go to lp_error; go to nxarg; arg_handler (27): /* -auth */ arg_handler (28): /* -authorization */ jj = jj + j; call login_parse_ (addr (ch (jj)), ll - jj + 1, authorization_string, k, j, code); if code ^= 0 then go to lp_error; call convert_authorization_$from_string (authorization, (authorization_string), code); if code ^= 0 then do; errarg = ""; return; end; ute.login_flags.auth_given = true; ute.process_authorization = authorization; go to nxarg; arg_handler (1): /* -bf */ arg_handler (2): /* -brief */ arg_handler (7): /* -npf */ arg_handler (8): /* -no_print_off */ arg_handler (9): /* -pf */ arg_handler (10): /* -print_off */ arg_handler (19): /* -ns */ arg_handler (20): /* -no_start_up */ arg_handler (21): /* -cpw */ arg_handler (22): /* -change_password */ arg_handler (23): /* -cdp */ arg_handler (24): /* -change_default_project */ arg_handler (29): /* -cda */ arg_handler (30): /* -change_default_auth */ arg_handler (31): /* -gpw */ arg_handler (32): /* -generate_password */ arg_handler (33): /* -ttp */ arg_handler (34): /* -terminal_type */ arg_handler (16): /* -md */ arg_handler (17): /* -mode */ arg_handler (18): /* -modes */ go to badarg; arg_handler (35): /* -ss */ arg_handler (36): /* -subsystem */ jj = jj + j; call login_parse_ (addr (ch (jj)), ll - jj + 1, char64, i, j, code); if code ^= 0 then go to lp_error; if i + ute.ip_len > 64 then do; /* -ss arg and -po arg add up to > 64 chars */ code = as_error_table_$long_ip_ss_args; errarg = char64; return; /* let user try again */ end; substr (ute.init_proc, ute.ip_len + 1, i) = substr (char64, 1, i); /* copy subsystem in after initproc */ ute.ss_len = i; /* remember its length */ ute.uflags.ss_given = "1"b; /* and remember that it was given */ goto nxarg; npo_handler: npo = true; go to nxarg; word_handler: jj = jj + j; call login_parse_ (addr (ch (jj)), ll - jj + 1, ute.login_code, k, j, code); if code ^= 0 then go to lp_error; go to nxarg; lp_error: if code = error_table_$noarg then do; code = as_error_table_$no_login_arg_msg; errarg = prev_arg; end; else errarg = arg; /* most likely blanks */ return; /* return with error */ /* Come here when we run out of arguments. */ exit: if ^npo then do; /* note that we don't yet handle case of this po and specified ss */ ute.init_proc = substr (ftp_misc_$ftp_login_responder.overseer, 1, ftp_misc_$ftp_login_responder.pathlen); /* ftp users have special default initproc */ ute.uflags.ip_given = "1"b; ute.ip_len = ftp_misc_$ftp_login_responder.pathlen; end; %page; %include answer_table; %page; %include user_attributes; %page; %include user_table_entry; %page; %include user_table_header; end parse_ftp_login_line_; 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