Trailing-Edge
-
PDP-10 Archives
-
BB-M081T-SM
-
exec/exec1.mac
There are 47 other files named exec1.mac in the archive. Click here to see a list.
; Edit= 4426 to EXEC1.MAC on 18-Apr-89 by GSCOTT
;Fix typeo in previous edit.
; Edit= 4425 to EXEC1.MAC on 14-Mar-89 by GSCOTT
;Rewrite ATTACH command to allow user to pick a job to attach to if more than
;one candidate job. Also allow ETYPE's %L to take an AC argument.
; Edit= 4420 to EXEC1.MAC on 16-Feb-89 by GSCOTT
;Make ETYPE's %W say "never" for a zero date, then clean up login message code
;in EXEC0 and EXEC1.
; Edit= 4419 to EXEC1.MAC on 9-Feb-89 by GSCOTT
;INFORMATION JOB command should show network origin. %L now will output this.
; Edit= 4415 to EXEC1.MAC on 22-Dec-88 by RASPUZZI
;Be more forgiving to those poor souls who do not know the minimum password
;length during the login process.
; Edit= 4414 to EXEC1.MAC on 20-Dec-88 by RASPUZZI
;Keep clever users from not changing their expired passwords and make the code
;in REPWD more fool proof for those morons who can't change passwords when
;they are told to.
; Edit= 4412 to EXEC1.MAC on 13-Dec-88 by RASPUZZI
;Add new commands, features and support for security enhancements.
; Edit= 4411 to EXEC1.MAC on 25-Aug-88 by RASPUZZI, for SPR #22255
;Prevent routine MESMES from trashing the first entry in MWATDR.
; UPD ID= 4137, RIP:<7.EXEC>EXEC1.MAC.16, 7-Apr-88 15:20:18 by RASPUZZI
;TCO 7.1269 - Don't mislead users into believing that '*' is a valid answer
; when parsing a node name for a (^E)SEND USER when USER is
; logged into multiple nodes.
; UPD ID= 4107, RIP:<7.EXEC>EXEC1.MAC.15, 7-Mar-88 18:20:12 by GSCOTT
;TCO 7.1255 - Update copyright notice.
; UPD ID= 4089, RIP:<7.EXEC>EXEC1.MAC.14, 19-Jan-88 14:29:47 by RASPUZZI
;TCO 7.1187 - Fix header English for TTMSG% (^ESEND only) when doing
; send to local node and terminal number is given (add "to"
; in front of destination line.
; UPD ID= 4086, RIP:<7.EXEC>EXEC1.MAC.13, 15-Jan-88 14:39:49 by EVANS
;TCO 7.1182 - Answer Grump 141 by not allowing user to ask to KEEP
; a negative number of versions.
;TCO 7.1178 - Implement DELETE subcommands.
; UPD ID= 4084, RIP:<7.EXEC>EXEC1.MAC.12, 18-Dec-87 10:24:03 by RASPUZZI
;TCO 7.1166 - Add help text in VALNOD for parsing *.
; UPD ID= 81, RIP:<7.EXEC>EXEC1.MAC.11, 10-Dec-87 14:57:15 by RASPUZZI
;TCO 7.1160 - Again, say "?Invalid user" if arbitrary string is parsed
; and the parse was garbage (empty ATMBUF checked in this case).
; This will produce a more meaningful error message for the
; user.
; UPD ID= 80, RIP:<7.EXEC>EXEC1.MAC.10, 1-Dec-87 15:05:45 by RASPUZZI
;TCO 7.1153 - Say "?Invalid user" if arbitrary string parsed for SEND on
; local node because arbitrary string cannot be a local user.
; UPD ID= 67, RIP:<7.EXEC>EXEC1.MAC.9, 13-Nov-87 12:50:22 by RASPUZZI
;More of TCO 7.1135 - I forgot that user names can only be 39 characters
; long.
; UPD ID= 66, RIP:<7.EXEC>EXEC1.MAC.8, 13-Nov-87 11:43:31 by RASPUZZI
;TCO 7.1135 - Have SEND parse arbitrary string so that cluster SENDs
; will work when a username is given that is not valid on
; the local system.
; UPD ID= 60, RIP:<7.EXEC>EXEC1.MAC.7, 30-Oct-87 11:29:24 by RASPUZZI
;TCO 7.1106 - Make sure to choose a terminal for the user if the specified
; send victim is only logged into one terminal on a remote node.
; UPD ID= 58, RIP:<7.EXEC>EXEC1.MAC.6, 29-Oct-87 15:57:37 by RASPUZZI
;TCO 7.1101 - Ignore JSYS error in REMLIN.
; UPD ID= 39, RIP:<7.EXEC>EXEC1.MAC.5, 22-Oct-87 11:03:25 by RASPUZZI
;TCO 7.1076 - Add code to support cluster sends. Have LINCHK call REMLIN
; when /NODE is given to get remote TTY of user. Modify the
; SENDA routine to make a slightly different header for WHEELs
; doing TTMSG%'s.
; UPD ID= 25, RIP:<7.EXEC>EXEC1.MAC.4, 23-Sep-87 15:50:31 by MCCOLLUM
;TCO 7.1063 - Fix up EXPUNGE, CONNECT and [END-]ACCESS to display STRX10
; UPD ID= 7, RIP:<7.EXEC>EXEC1.MAC.3, 21-Jul-87 14:51:53 by EVANS
; TCO 7.1025 - Prevent funny numbers of pages freed on EXPUNGE.
; *** Edit 3067 to EXEC1.MAC by GSCOTT on 12-May-87
; LOGIN command should set session remark before logging in. Requires monitor
; edit 7477 be installed before this EXEC.
; *** Edit 3054 to EXEC1.MAC by RASPUZZI on 21-Nov-86
; Prevent double prompts from happening after a terminal has given ADVICE. This
; is done by using CFIBF% after restoring the TTY mode.
; *** Edit 3050 to EXEC1.MAC by EVANS on 29-Oct-86, for SPR #00092
; Reset STATSW to zero to prevent mulitply defined symbols when linking with
; distributed PCL and MIC modules; remove the STAT code so we don't do the
; statistics.
; *** Edit 3049 to EXEC1.MAC by EVANS on 28-Oct-86
; Prevent bogus error message on DELETE with EXPUNGE subcommand.
; *** Edit 3045 to EXEC1.MAC by EVANS on 12-Aug-86, for SPR #21270
; Make the EXEC check for STRX09 when coming back from DELDF% on an EXPUNGE. If
; found, do not continue looping thru all directories on the structure. RE
; monitor edit 7351.
; *** Edit 3040 to EXEC1.MAC by EVANS on 24-Jun-86, for SPR #21170
; Implement MAIL-WATCHing based on directory number, as users can now send mail
; to non-username directories on POBOX:
; *** Edit 3023 to EXEC1.MAC by WAGNER on 26-Nov-85, for SPR #20947
; Make DELETE command know about offline files by setting G1%IIN for
; consideration of invisible files. GTJFN changed to require this bit being
; set.
; Edit 3016 to EXEC1.MAC by EVANS on 15-Oct-85 (TCO none)
; Change error message to account for unmounted structure in case user attempts
; to expunge such a structure. (RE: 6.1 monitor edit 7117)
; Edit 3011 to EXEC1.MAC by SANTIAGO on 15-Aug-85
; more TCO 6.1.1519 - make code less gross
; Edit 3010 to EXEC1.MAC by SANTIAGO on 13-Aug-85 (TCO 6-1-1519 )
; Make ADVISE work if Wheel is trying to advise user with TERMINAL INHIBIT
; UPD ID= 244, SNARK:<6.1.EXEC>EXEC1.MAC.25, 10-Jun-85 09:09:49 by SANTIAGO
;TCO 6.1.1430 - Make DISCARD command see invisible files
; UPD ID= 217, SNARK:<6.1.EXEC>EXEC1.MAC.24, 10-Jun-85 08:42:20 by DMCDANIEL
; UPD ID= 201, SNARK:<6.1.EXEC>EXEC1.MAC.23, 24-May-85 14:13:14 by EVANS
;TCO 6.1.1404 - Add command editor stuff.
; UPD ID= 193, SNARK:<6.1.EXEC>EXEC1.MAC.22, 10-May-85 15:45:16 by EVANS
;TCO 6.1.1362 - Save TAKLEN when begin LOGOUT process, and test against it
; (SAVTAK) when TAKE encountered in LOGOUT.CMD.
; UPD ID= 161, SNARK:<6.1.EXEC>EXEC1.MAC.21, 3-May-85 08:29:16 by DMCDANIEL
;Update copyrights for 6.1.
; UPD ID= 153, SNARK:<6.1.EXEC>EXEC1.MAC.20, 2-May-85 11:15:23 by PRATT
;TCO 6.1.1353 - Handle GNJFN errors better
; UPD ID= 147, SNARK:<6.1.EXEC>EXEC1.MAC.19, 15-Mar-85 16:19:41 by EVANS
;Yet more TCO 6.1.1027 - Require confirm of LOGOUT when not logged-in.
; UPD ID= 145, SNARK:<6.1.EXEC>EXEC1.MAC.18, 15-Mar-85 13:22:55 by PRATT
;TCO 6.1.1068 - Change CAIGE to CAMGE in .BLANK
; UPD ID= 140, SNARK:<6.1.EXEC>EXEC1.MAC.17, 14-Mar-85 16:18:14 by SANTIAGO
;Still more TCO 6.1.1261 - Put previous patch in proper place.
; UPD ID= 139, SNARK:<6.1.EXEC>EXEC1.MAC.16, 14-Mar-85 15:40:41 by SANTIAGO
;More TCO 6.1.1261 - Don't bother checking for over quota if GTDAL% fails
; UPD ID= 134, SNARK:<6.1.EXEC>EXEC1.MAC.15, 13-Mar-85 17:06:21 by SANTIAGO
;TCO 6.1.1261 - Fix LOGOUT when GETAB% capabilities are off.
; UPD ID= 131, SNARK:<6.1.EXEC>EXEC1.MAC.14, 7-Mar-85 08:46:15 by PRATT
;TCO 6.1.1240 - If never logged in before, output Last Login Never
; UPD ID= 127, SNARK:<6.1.EXEC>EXEC1.MAC.13, 7-Feb-85 09:38:15 by PRATT
;TCO 6.1.1179 - Remove output filespec on TAKE, use LOG-FILE instead.
; UPD ID= 122, SNARK:<6.1.EXEC>EXEC1.MAC.12, 9-Jan-85 14:04:52 by EVANS
;TCO 6.1.1123 - Change confusing error message if SENDer gives wrong term #.
; UPD ID= 103, SNARK:<6.1.EXEC>EXEC1.MAC.11, 11-Dec-84 15:21:25 by MOSER
;TCO 6.1.1077 - ADD STAT STUFF
; UPD ID= 101, SNARK:<6.1.EXEC>EXEC1.MAC.10, 10-Dec-84 13:39:21 by EVANS
;More TCO 6.1.1027 - In case user redefines SYSTEM:, set GJ%PHY for GTJFN so
; system logicals ONLY will be considered.
; UPD ID= 93, SNARK:<6.1.EXEC>EXEC1.MAC.9, 15-Nov-84 13:33:50 by EVANS
;Still more TCO 6.1.1027 - Account for case of "TAKE" at end of LOGOUT.CMD
; UPD ID= 52, SNARK:<6.1.EXEC>EXEC1.MAC.8, 5-Nov-84 15:18:04 by MCCOLLUM
;TCO 6.1.1025 - Fix up call to MFSET in .RENAM
; UPD ID= 49, SNARK:<6.1.EXEC>EXEC1.MAC.7, 1-Nov-84 12:58:14 by PRATT
;More TCO 6.1.1027 - LOGO n has an unecessary CONFIRM
; UPD ID= 38, SNARK:<6.1.EXEC>EXEC1.MAC.6, 26-Oct-84 13:35:43 by EVANS
;TCO 6.1.1027 - Add LOGOUT.CMD; SYSTEM: and user flavors, with /FAST option.
; UPD ID= 36, SNARK:<6.1.EXEC>EXEC1.MAC.5, 20-Oct-84 12:08:33 by PRATT
;More TCO 6.1.1014 - Verify the selected line to match requested username
; UPD ID= 26, SNARK:<6.1.EXEC>EXEC1.MAC.4, 1-Oct-84 22:40:56 by PRATT
;TCO 6.1.1019 - Allow some commands set CM%NSF (no suffix) for devices
; UPD ID= 5, SNARK:<6.1.EXEC>EXEC1.MAC.3, 28-Sep-84 18:44:58 by PRATT
;TCO 6.1.1014 - Allow usernames to be typed as an argument to SEND
; UPD ID= 4, SNARK:<6.1.EXEC>EXEC1.MAC.2, 28-Sep-84 18:34:47 by PRATT
;TCO 6.1.1013 - Add recognition to the DEFINE command
; UPD ID= 442, SNARK:<6.EXEC>EXEC1.MAC.48, 26-Sep-84 15:07:59 by MCCOLLUM
;TCO 6.2228 - Add entry point RTFLG1 to RTTFLG so caller can supply line #.
; UPD ID= 392, SNARK:<6.EXEC>EXEC1.MAC.47, 28-Feb-84 08:23:59 by PRATT
;TCO 6.1956 - Check the SMON Exec flags before allowing /FAST
; UPD ID= 378, SNARK:<6.EXEC>EXEC1.MAC.46, 18-Jan-84 16:34:30 by PRATT
;More TCO 6.1796 - Use Q1 and Q2 in .RESYS, not just Q1
; UPD ID= 377, SNARK:<6.EXEC>EXEC1.MAC.45, 18-Jan-84 15:58:50 by PRATT
;TCO 6.1940 - Rewrite TCO 6.1857
; UPD ID= 371, SNARK:<6.EXEC>EXEC1.MAC.44, 5-Jan-84 10:16:00 by PRATT
;TCO 6.1923 - If detached and using .PRIIN, bypass the the DVCHR in PUSHIO
; UPD ID= 368, SNARK:<6.EXEC>EXEC1.MAC.43, 28-Dec-83 16:35:16 by PRATT
;More TCO 6.1796 - Add REFUSE USER-MESSAGES
; UPD ID= 364, SNARK:<6.EXEC>EXEC1.MAC.42, 27-Dec-83 10:14:00 by TSANG
;More for TCO 6.1857 - Need for CONFIRMATION.
; UPD ID= 363, SNARK:<6.EXEC>EXEC1.MAC.41, 19-Dec-83 12:14:02 by TSANG
;TCO 6.1857 - LOGOUT of another job give the victim's name and ask for confirm.
; UPD ID= 334, SNARK:<6.EXEC>EXEC1.MAC.40, 20-Nov-83 19:38:27 by PRATT
;TCO 6.1870 - Get rid of code which is under NONEWF. Remove NEWF's.
; UPD ID= 330, SNARK:<6.EXEC>EXEC1.MAC.38, 18-Nov-83 14:33:13 by TSANG
;More TCO 6.1837
; UPD ID= 329, SNARK:<6.EXEC>EXEC1.MAC.37, 17-Nov-83 17:25:46 by PRATT
;More TCO 6.1796 - New RECV/REFUSE code to prepare for USER-MESSAGE option
; UPD ID= 327, SNARK:<6.EXEC>EXEC1.MAC.36, 17-Nov-83 13:59:48 by PRATT
;TCO 6.1796 - [Set] Terminal [no] Receive Advice/Links/System-messages
; UPD ID= 322, SNARK:<6.EXEC>EXEC1.MAC.35, 10-Nov-83 14:10:47 by TSANG
;TCO 6.1837 - Set flag bit for .DELET .DISCA and remove from .RENAM
; UPD ID= 318, SNARK:<6.EXEC>EXEC1.MAC.34, 8-Nov-83 13:48:35 by PRATT
;TCO 6.1847 - Fast LOGIN code
; UPD ID= 305, SNARK:<6.EXEC>EXEC1.MAC.33, 8-Aug-83 11:24:04 by TSANG
;TCO 6.1760 - Set flag bit for .RENAM
; UPD ID= 285, SNARK:<6.EXEC>EXEC1.MAC.32, 13-May-83 00:03:01 by PAETZOLD
;TCP 6.1656 - Zero SNDPTC in .USEND after the TRVAR
; UPD ID= 264, SNARK:<6.EXEC>EXEC1.MAC.31, 8-Apr-83 13:53:41 by TSANG
;TCO 6.1580 - Provide ERJMP CJERR after RPCAP and EPCAP JSYS call
; UPD ID= 255, SNARK:<6.EXEC>EXEC1.MAC.30, 28-Jan-83 14:19:27 by DONAHUE
;TCO 6.1437 - Add CONFIRM to routine TKLOG
; UPD ID= 234, SNARK:<6.EXEC>EXEC1.MAC.29, 15-Jan-83 19:23:40 by CHALL
;TCO 6.1464 - UPDATE COPYRIGHT NOTICE
; UPD ID= 215, SNARK:<6.EXEC>EXEC1.MAC.28, 10-Jan-83 14:10:07 by LOMARTIRE
;TCO 6.1449 - New entry routine TRYGTS for getting a jfn for SYSJOB.COMMANDS
; UPD ID= 192, SNARK:<6.EXEC>EXEC1.MAC.27, 11-Nov-82 21:49:38 by CHALL
;TCO 6.1366 .TALK- REPLACE REFERENCES TO "MAIL" WITH A SUGGESTION TO RUN MAIL
; UPD ID= 170, SNARK:<6.EXEC>EXEC1.MAC.25, 30-Sep-82 20:15:35 by CHALL
;TCO 6.1288 PASWD1- TURN ON ECHOING AFTER READING PASSWORD ON A HDX T'L
;TCO 6.1286 .USEND- ADD SEND COMMAND (LIKE ^ESEND, NOT ENABLED)
; UPD ID= 154, SNARK:<6.EXEC>EXEC1.MAC.22, 28-Aug-82 18:27:19 by PAETZOLD
;More TCO 6.1240 - Get last login time from login jsys and not gtdir
; UPD ID= 165, SNARK:<6.EXEC>EXEC1.MAC.23, 28-Sep-82 10:21:17 by TSANG
;TCO 6.1250 - SET BREAK MASK FOR PARSING A PASSWORD IN WORDX.
; UPD ID= 154, SNARK:<6.EXEC>EXEC1.MAC.22, 28-Aug-82 18:27:19 by PAETZOLD
;More TCO 6.1240 - Get last login time from login jsys and not gtdir
; UPD ID= 152, SNARK:<6.EXEC>EXEC1.MAC.20, 28-Aug-82 11:53:36 by PAETZOLD
;TCO 6.1240 - Output date and time of last login when logging in
; UPD ID= 133, SNARK:<6.EXEC>EXEC1.MAC.19, 4-Aug-82 17:11:37 by LEACHE
;TCO 6.1209 - Fix invocations of ETYPE
; UPD ID= 130, SNARK:<6.EXEC>EXEC1.MAC.17, 22-Jul-82 00:01:39 by WALLACE
;TCO 6.1190 - Modify PDLFRE, the routine which gives pages freed for
; the DELETE command, to output pages freed only if EXPUNGE is
; explicitly requested and to say nothing if directory allocation grows
; during execution of the command. As before, always output zero pages
; freed for non multiple directory devices.
; UPD ID= 128, SNARK:<6.EXEC>EXEC1.MAC.16, 25-Jun-82 20:36:14 by CHALL
;TCO 6.1178 .PUSH- LOOK FOR "DEFAULT-EXEC:", THEN "SYSTEM:EXEC.EXE"
; UPD ID= 127, SNARK:<6.EXEC>EXEC1.MAC.15, 12-Jun-82 12:09:21 by CHALL
;TCO 6.1165 CANARC- SET CF%NS (NO SUBCOMMANDS) FOR CALL TO SPECFN
; UPD ID= 123, SNARK:<6.EXEC>EXEC1.MAC.14, 24-Apr-82 12:25:04 by CHALL
;TCO 6.1101 CONSOLIDATE STUFF ABOUT TERMINALS (BLNKTB) IN EXECCA
;TCO 6.1100 .SEND- RE-CAST THE ^ESEND CODE
; UPD ID= 104, SNARK:<6.EXEC>EXEC1.MAC.13, 22-Jan-82 16:42:48 by CHALL
;TCO 5.1698 .TKLOG- ADD NEW SUBCOMMAND TO TAKE: LOG-FILE
; UPD ID= 103, SNARK:<6.EXEC>EXEC1.MAC.12, 15-Jan-82 16:32:12 by CHALL
;TCO 5.1668 .CLOSE- ADD HELP MESSAGE TO OCTX LUUO
; UPD ID= 85, SNARK:<6.EXEC>EXEC1.MAC.11, 8-Jan-82 15:45:33 by CHALL
;TCO 6.1052 - UPDATE COPYRIGHT NOTICE AND DELETE PRE-V4.1 EDIT HISTORY
; UPD ID= 66, SNARK:<6.EXEC>EXEC1.MAC.9, 10-Oct-81 20:06:43 by CHALL
;TCO 5.1563 .CONNE- ADD "STRUCTURE NOT MOUNTED" TO CONNECT ERROR MESSAGE
; UPD ID= 25, SNARK:<6.EXEC>EXEC1.MAC.7, 17-Aug-81 10:33:14 by CHALL
;TCO 5.1454 CHANGE NAME FROM XDEF TO EXECDE
; UPD ID= 14, SNARK:<6.EXEC>EXEC1.MAC.6, 21-Jul-81 12:30:56 by MURPHY
;TCO 5.1427 - GET RID OF SYSTEM MAIL BEFORE PUSH
; UPD ID= 12, SNARK:<6.EXEC>EXEC1.MAC.5, 20-Jul-81 11:18:33 by CHALL
;TCO 5.1420 - DETSND: HAVE SEND * SAY IT'S GOING TO ALL
; UPD ID= 2247, SNARK:<5.EXEC>EXEC1.MAC.3, 23-Jun-81 15:36:48 by LEACHE
;TCO 5.1379
;Make CANCEL ARCHIVE fail if FB%ARC set (collection run-1 started)
;<HELLIWELL.EXEC.5>EXEC1.MAC.1, 13-May-81 19:58:46, EDIT BY HELLIWELL
;REMOVE .CLEAR ROUTINE (NOW UNUSED)
;<4.EXEC>EXEC1.MAC.1, 10-May-80 16:42:52, Edit by DK32
;Programmable Command Language, SPR 13716
; UPD ID= 1511, SNARK:<5.EXEC>EXEC1.MAC.16, 2-Feb-81 18:10:30 by ELFSTROM
;change stroage to storage in error message for KEEPOV:
; UPD ID= 1321, SNARK:<5.EXEC>EXEC1.MAC.15, 1-Dec-80 16:00:47 by OSMAN
;Use SETENT instead of SEVEC
; UPD ID= 1307, SNARK:<5.EXEC>EXEC1.MAC.14, 24-Nov-80 12:13:52 by DONAHUE
;TCO 5.1191 - Allow UNDELETE to see invisible files (in case one got deleted)
; UPD ID= 1305, SNARK:<5.EXEC>EXEC1.MAC.13, 21-Nov-80 14:22:52 by DONAHUE
;TCO 5.1201 - Set GJ%ACC when getting JFN on LOGIN.CMD
; UPD ID= 1106, SNARK:<5.EXEC>EXEC1.MAC.12, 2-Oct-80 09:55:40 by OSMAN
;tco 5.1163 - Put CONFIRM in ^ESEND command
; UPD ID= 1024, SNARK:<5.EXEC>EXEC1.MAC.11, 17-Sep-80 10:35:57 by OSMAN
;tco 5.1148 - Make DISABLE/RUN equivalent capwise to RUN/DISABLE/START
; UPD ID= 853, SNARK:<5.EXEC>EXEC1.MAC.10, 10-Aug-80 15:20:07 by OSMAN
;tco 5.1129 - Add symbolic address and expression support
;tco 5.1128 - More correct error on "SET ENTRY 2000 2000"
; UPD ID= 832, SNARK:<5.EXEC>EXEC1.MAC.9, 4-Aug-80 12:57:35 by LYONS
; Fix typo in last fix
; UPD ID= 830, SNARK:<5.EXEC>EXEC1.MAC.8, 4-Aug-80 12:37:05 by LYONS
; Allow BLANK command to work for tty types over 18
; UPD ID= 592, SNARK:<5.EXEC>EXEC1.MAC.7, 3-Jun-80 09:33:31 by OSMAN
;tco 5.1057 - Allow ENABLE, DISABLE, and PUSH under BUILD
;<5.EXEC>EXEC1.MAC.6, 30-May-80 16:44:41, EDIT BY MURPHY
;PUT NEW ALERT AND MAIL WATCH UNDER NEWF
; UPD ID= 531, SNARK:<5.EXEC>EXEC1.MAC.5, 20-May-80 14:55:12 by MURPHY
;CHANGE SOME XTND TO NEWF OR MFRK
; UPD ID= 493, SNARK:<5.EXEC>EXEC1.MAC.4, 30-Apr-80 14:34:40 by OSMAN
; UPD ID= 492, SNARK:<4.1.EXEC>EXEC1.MAC.19, 30-Apr-80 09:55:25 by OSMAN
;Fix confirmation on TAKE subcommands
; UPD ID= 458, SNARK:<4.1.EXEC>EXEC1.MAC.13, 22-Apr-80 16:42:22 by OSMAN
;tco 4.1.1146 - Make CTRL/Q during advice work.
;tco 4.1.1145 - Make ADVISE smarter about "line not active"
;<4.1.EXEC>EXEC1.MAC.12, 8-Apr-80 14:18:46, EDIT BY OSMAN
;tco 4.1.1140 - Remove "(MESSAGE)" guidewords on ^ESEND
; UPD ID= 342, SNARK:<4.1.EXEC>EXEC1.MAC.11, 19-Mar-80 14:59:24 by TOMCZAK
;TCO# 4.1.1117 Clean up some password parsing problems (add PASFLD and a flag)
;<4.1.EXEC>EXEC1.MAC.3, 20-Nov-79 10:02:38, EDIT BY OSMAN
;TCO 4.1.1023 - Fix TAKE stuff
;<4.1.EXEC>EXEC1.MAC.2, 9-Nov-79 09:22:17, EDIT BY OSMAN
;tco 4.1.1011 - Don't allow ^C between LOGIN jsys and setting up CUSRNO
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1976, 1988.
; ALL RIGHTS RESERVED.
;
; THIS SOFTWARE IS FURNISHED UNDER A LICENSE AND MAY BE USED AND COPIED
; ONLY IN ACCORDANCE WITH THE TERMS OF SUCH LICENSE AND WITH THE
; INCLUSION OF THE ABOVE COPYRIGHT NOTICE. THIS SOFTWARE OR ANY OTHER
; COPIES THEREOF MAY NOT BE PROVIDED OR OTHERWISE MADE AVAILABLE TO ANY
; OTHER PERSON. NO TITLE TO AND OWNERSHIP OF THE SOFTWARE IS HEREBY
; TRANSFERRED.
;
; THE INFORMATION IN THIS SOFTWARE IS SUBJECT TO CHANGE WITHOUT NOTICE
; AND SHOULD NOT BE CONSTRUED AS A COMMITMENT BY DIGITAL EQUIPMENT
; CORPORATION.
;
; DIGITAL ASSUMES NO RESPONSIBILITY FOR THE USE OR RELIABILITY OF ITS
; SOFTWARE ON EQUIPMENT THAT IS NOT SUPPLIED BY DIGITAL.
;TOPS20 'EXECUTIVE' COMMAND LANGUAGE
SEARCH EXECDE
TTITLE EXEC1
EXTERN MAXCI,INFLEN ;[7.1076]
;THIS FILE CONTAINS
;LOTS OF COMMANDS...
;ARCHIVE <Files>
;F2 - DON'T FLUSH FILE CONTENTS
.ARCHI::NOISE <FILES>
TLZ Z,F2 ;DEFAULT IS NOT TO RETAIN CONTENTS
MOVE A,[XWD -1,0] ;NO DEFAULT NAMES
HRLI B,-3 ;DEFAULT VERSION IS *
HRRI B,(GJ%OLD+GJ%IFG+GJ%PHY+GJ%XTN+GJ%FNS)
CALL SPECFN
JRST ARCHI1
JRST ARCHI2 ;DO IT
ARCHI1: SUBCOM $ARCHI
ARCHI2: SETOM TYPGRP ;ALWAYS TYPE NAME
MOVE A,COJFN
MOVEM A,OUTDSG
MOVE A,JBUFP
MOVEM A,.JBUFP
MOVX C,.ARSET ;WITH NO FLAGS
TLNE Z,F2 ;WANT TO RETAIN FILE CONTENTS?
TXO C,AR%NDL ;RIGHT, FLAG THAT ON THE CALL
PUSH P,C ;SAVE DISPOSITION BITS ETC
ARCHI3: CALL RLJFNS
CALL NXFILE
JRST ARCHI9
CALL TYPIF
CALL MFINP ;GET 2ND JFN
JRST ARCHI9 ;FAILED
MOVX B,.ARRAR ;FUNCTION CODE TO USE (PLS ARCHIVE)
MOVE C,0(P) ;AND BITS
ARCF
ERJMP [ETYPE < %?%%_>
JRST ARCHI9]
HRLI A,.FBCTL
MOVX B,FB%INV ;MAKE THE FILE INVISIBLE TOO
MOVX C,FB%INV
TLNN Z,F2 ;RETAIN CONTENTS?
CHFDB
ERJMP [ETYPE < %?%%_>
JRST .+1]
TYPE < [Requested]
>
ARCHI9: SKIPE INIFH1 ;DONE THEM ALL?
JRST ARCHI3 ;NO, LOOP
SETZM .JBUFP
ADJSP P,-1 ;FLAGS NO LONGER USEFUL
RET
;TABLES ETC. TO ARCHIVE
$ARCHI: TABLE
T RETAIN,,.ARFL
TEND
.ARFL: NOISE <DISK CONTENTS>
CONFIRM
TLO Z,F2
RET
;LET (LOGICAL NAME) -- (AS) --
EDEFIN::TLO Z,F2
NOISE <SYSTEM LOGICAL NAME>
JRST .ASSO
.DEFIN::TRVAR <SAVBPT>
TLZ Z,F2
NOISE <LOGICAL NAME>
.ASSO: STARX <
Logical name to define or delete,
or "*" to delete all>
JRST .ASSO1 ;NOT "DEFINE *"
PUSH P,[0] ;PUSH 0 TO INDICATE ALL
JRST .ASSO2 ;AND EAT TERMINATOR
.ASSO1: HRROI B,[ASCIZ/Logical name to define or delete/]
CALL STRN ;GET THE NAME
CMERRX
CALL BUFFF ;GET POINTER TO NAME
PUSH P,A ;SAVE POINTER
.ASSO2: SKIPN (P) ;ALL?
JRST .ASS3B ;YES, SEPARATE ROUTINE
NOISE <AS>
MOVE B,SBLOCK+.CMPTR ;GET POINTER TO COMMAND BUFFER
MOVEM B,SAVBPT ;SAVE IT
CALL PARSTX ;CHECK THE STRING, IS IT COMPLETE ?
JRST .ASS2B ;NO, USE RECOGNITION
; .. ;FALL THRU INTO NORMAL .CMTXT
;HERE TO READ THE WHOLE STRING AT ONCE, NO RECOGNITION NEEDED
CRRX <Definition list or null to delete>
CAIA ;NOT JUST "DEFINE FOO<CR>"
JRST .ASSO9 ;YES, JUST "DEFINE FOO<CR>"
LINEX <Definition list> ;READ DEFINITION LINE
CMERRX ;NOT ANYTHING LEGAL AFTER "DEFINE" !
CALL BUFFF ;GET POINTER TO DEFINITION STRING
CONFIRM
JRST .ASSO3 ;GO JOIN COMMON CODE
;HERE TO READ THE STRING USING RECOGNITION
.ASS2B: DEXTX <> ;CLEAR GTJFN BLOCK
MOVX B,GJ%NEW!GJ%OLD!GJ%IFG
MOVEM B,CJFNBK+.GJGEN
MOVEI B,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /,/]>,,,[
FLDDB. .CMFIL,CM%SDH,,<Definition list or null to delete>,,[
FLDDB. .CMCFM,CM%SDH]]]
CALL FLDSKP ;GET SOME INPUT
JFCL ;IGNORE THE ERROR RIGHT NOW, CHECK IT LATER
LDB C,[331100,,(C)] ;SEE WHICH WAS TYPED
CAIN C,.CMCFM ;GOT A CONFIRM ?
IFSKP.
TXNN A,CM%NOP ;NO - NO PARSE ?
IFSKP.
DEXTX <> ;CLEAR GTJFN BLOCK
MOVX A,GJ%OFG ;WE WANT SPEC, DON'T CARE IF EXISTS ANYMORE
IORM A,CJFNBK+.GJGEN
FILEX <> ;TRY TO READ THE FILESPEC
CMERRX ;COULDN'T, THIS LINE HAS REAL PROBLEMS
ENDIF.
JRST .ASS2B ;HAVEN'T GOTTEN EOL YET
ENDIF. ;GOT END OF LINE
MOVE A,SAVBPT ;GET POINTER TO CURRENT STRING
CALL BUFFS ;GET POINTER TO DEFINITION STRING
; .. ;JOIN COMMON CODE
;HERE FOR COMMON CODE FOR CREATING THE LOGICAL NAME
.ASSO3: MOVE C,A ;NEW POINTER IN C
MOVEI A,.CLNJB
TLNE Z,F2 ;SYSTEM?
MOVEI A,.CLNSY ;YES
.ASSO4: TLNE Z,F2 ;SYSTEM?
CALL FCONF ;YES, FORCE FURTHER CONFIRMATION
MOVE B,(P) ;GET LOGICAL NAME
PUSH P,A ;REMEMBER ATTEMPTED FUNCTION IN CASE ERROR
CRLNM
JRST ASSONO ;COULDN'T DO IT
POP P,(P)
POP P,(P) ;FIX STACK
RET
;HERE TO CHECK FOR COMPLETE COMMAND
PARSTX: MOVE C,SBLOCK+.CMPTR ;GET THE POINTER
PARST1: ILDB A,C ;GET THE NEXT CHARACTER
JUMPE A,R ;NULL MEANS COMMAND HASN'T COMPLETED
CAIE A,14 ;FORMFEED COUNTS AS END OF LINE
CAIN A,12 ;LINEFEED?
RETSKP ;YES - AT END
CAIE A,15 ;CARRIAGE RETURN?
JRST PARST1 ;NEITHER, HAVEN'T REACHED END YET
RETSKP ;YES - AT END
;HERE WHEN LOGICAL NAME MANIPULATION FAILED
ASSONO: CAIE A,CRLNX1
CALL CJERRE ;UNKNOWN ERROR
POP P,A ;NOW WE KNOW "NAME UNDEFINED"
CAIE A,.CLNJ1 ;TRYING TO DELETE ONE JOB NAME?
CAIN A,.CLNS1 ;OR TRYING TO DELETE ONE SYSTEM NAME?
CAIA ;YES
CALL CJERRE ;NO, TYPE MONITOR MESSAGE
POP P,A ;GET POINTER TO NAME WE COULDN'T DELETE
ETYPE <%%Logical name %1M: was not defined
>
RET ;NON-FATAL ERROR IF DELETING NON-EXISTENT LOGICAL NAME
.ASSO9: MOVEI A,.CLNJ1 ;DELETE
TLNE Z,F2
MOVEI A,.CLNS1
JRST .ASSO4
.ASS3B: CRRX <Confirm to delete all logical names>
CMERRX
MOVEI A,.CLNJA ;DELETE ALL
TLNE Z,F2 ;SYSTEM?
MOVEI A,.CLNSA
TLNE Z,F2 ;SYSTEM?
PROMPT <[Confirm to delete all SYSTEM logical names]>
TLNN Z,F2
PROMPT <[Confirm to delete ALL logical names]>
CALL FCONFA
CRLNM
CALL CJERR
POP P,B
RET
;ATTACH command
;ATTACH (USER) user (JOB #) job
;Password:
;[4425] AC usage in this command:
; Z/ F1 is clear if ATTACH command, set if UNATTACH command.
; Q1/ target user number
; Q2/ target job number
; Q3/ line number of target job
.ATTAC:: ;ENTRY FOR COMMAND, NEXT TAG IS FROM UNATTACH
IFNBATCH <[ERROR <ATTACH illegal from BATCH job>]>
ATTAU1: ;UNATTACH command comes here
;DECODE ARGUMENTS
TRVAR <<APBUF,20>,<AT1,2>> ;[4425] Storage for later use
NOISE <USER>
CALL USERN ;INPUT USER (DIRECTORY) NAME
CMERRX ;FAILED, PRINT REASON
TXNE A,RC%DIR ;Files only?
ERROR <That's a FILES-ONLY directory name>
MOVEM C,Q1 ;[4425] Save user number attaching to
NOISE <JOB #>
DECX <Job number if more than one job under that name> ;[4425]
CAIA ;NON-DECIMAL NUMBER TYPED
JRST ATTNUM ;NUMBER TYPED, GO PROCESS IT
CONFIRM ;REQUIRE CONFIRMATION OF COMMAND
; JRST ATTAC5 ;[4425] Go default a value
;ATTACH...
;[4425] No job number given, try to find a job to attach to. Call a routine to
;get all of the jobs logged into this username on this system.
ATTAC5: MOVE B,Q1 ;[4425] Load usernumber to find
CALL FNDUSR ;[4425] (B/) Fill BUF0 with job,,tty
;[4425] Table is filled with job,,terminal entries. Loop through the table
;returned to us to find any or all jobs that could be selected today.
SOSG A,BUF0 ;[4425] Sub header word from count and load it
ERROR <No jobs logged in under %5R> ;[4425] No users logged in
SETZB B,C ;[4425] Zero candidates
DO. ;[4425] Loop to discover how many possible jobs
HLRZ D,BUF0(A) ;[4425] Load job number of the job
SKIPE D ;[4425] Job 0 is never (un)attached
CAMN D,JOBNO ;[4425] Always skip our job
IFSKP. ;[4425] If not our job and not job 0
HRRE D,BUF0(A) ;[4425] Get the terminal number of that job
IFL. D ;[4425] If the job is detached
TLNE Z,F1 ;[4425] Unattach command?
IFSKP. ;[4425] Nope, attach command
SKIPN B ;[4425] Any previous candidate?
SKIPA B,BUF0(A) ;[4425] Nope, this is the one
SETO B, ;[4425] Yes, indicate multiple candidate jobs
ENDIF. ;[4425] End of detached job check
ELSE. ;[4425] Otherwise that job is not detached
SKIPN C ;[4425] Any previous attached job candidate?
SKIPA C,BUF0(A) ;[4425] No previous attached job, remember job
SETO C, ;[4425] Indicate multiple jobs seen
ENDIF. ;[4425] End of attached job checks
ENDIF. ;[4425] End of "it's not my job" code
SOJG A,TOP. ;[4425] Loop for all jobs in the table
OD. ;[4425] End of loop through all jobs
;[4425] Fall through to check results
;ATTACH...
;[4425] If an UNATTACH command and only one candidate attached job, use it. If
;multiple candidate jobs, ask which one. If no candidate jobs to unattach,
;give an error message.
TLNN Z,F1 ;[4425] Unattach command?
IFSKP. ;[4425] Yes, unattach command
IFG. C ;[4425] Any single attached job candidate?
HLRZ Q2,C ;[4425] Load job number
HRRE Q3,C ;[4425] and terminal number
JRST ATTAC7 ;[4425] Yes, use that one for unattaching
ENDIF. ;[4425] So no single attached job
JUMPL C,ATTAC6 ;[4425] If multiple attached jobs jump
CAMN Q1,CUSRNO ;[4425] One of ours?
ERROR <No other attached jobs logged in under %5R> ;[4425] Yes
ERROR <No attached jobs logged in under %5R> ;[4425] No
ENDIF. ;[4425] End of unattach command code
;[4425] Now for the case of the ATTACH command. If there is one detached
;candidate job, use it. If there is one candidate attached job, use it. If
;there is more than one target job, list them amd prompt for the job number to
;attach to. If there are no candidate give an error message.
IFG. B ;[4425] Any detached job to use?
HLRZ Q2,B ;[4425] Load job number
HRRE Q3,B ;[4425] and terminal number (-1 for detached)
JRST ATTAC7 ;[4425] Yes, use that one
ENDIF. ;[4425] No detached job to use
IFG. C ;[4425] Any single attached job candidate?
HLRZ Q2,C ;[4425] Load job number
HRRE Q3,C ;[4425] and terminal number
JUMPE B,ATTAC7 ;[4425] Yes, use that one only if no det jobs
ENDIF. ;[4425] So no single attached job
JUMPL C,ATTAC6 ;[4425] If multiple attached jobs jump
JUMPL B,ATTAC6 ;[4425] Attach, if multiple detached jobs jump
CAMN Q1,CUSRNO ;[4425] Trying to attach to another of my jobs?
ERROR <No other jobs logged in under %5R> ;[4425] Yes
ERROR <No jobs logged in under %5R> ;[4425] No
;ATTACH...
;[4425] Here when we have multiple target job possibilities, list them. Do not
;list a job in the table if (1) it is job zero (2) it is our job or (3) if it
;is an unattach command and job is detached.
ATTAC6: MOVN Q3,BUF0 ;[4425] Load -count
HRLZ Q3,Q3 ;[4425] and make it -count,,0
SETZ B, ;[4425] Clear job number of first one displayed
DO. ;[4425] Loop to output jobs that are candidates
HLRZ D,BUF0+1(Q3) ;[4425] Load the job number
SKIPE D ;[4425] If job 0
CAMN D,JOBNO ;[4425] and not our job
IFSKP. ;[4425] It's not my job (or job 0)
HRRE C,BUF0+1(Q3) ;[4425] Load the terminal number
SKIPGE C ;[4425] Is job detached?
TLNN Z,F1 ;[4425] Yes, is this an unattach command?
IFNSK. ;[4425] We need to output this job
GTB .JOBPN ;[4425] (D/A) Get program name of that job
SKIPN A ;[4425] Anything there?
MOVX A,<SIXBIT/?/> ;[4425] Say what?
TXO C,.TTDES ;[4425] Make terminal designator from that
ETYPE < Job %4Q, %3L, %1'%%_> ;[4425] Output info to terminal
SKIPN B ;[4425] Any job number to default yet?
MOVE B,D ;[4425] Nope, use first one
ENDIF. ;[4425] End of need to display job code
ENDIF. ;[4425] End of "it's not my job or job 0" code
AOBJN Q3,TOP. ;[4425] Loop for all of them
OD. ;[4425] End of loop for all of them
;[4425] Select a job if none selected and more than one target job found.
PROMPT <Job: > ;[4425] Prompt for job number
HRROI A,APBUF ;[4425] Get pointer for default string
MOVEM A,CMDEF ;[4425] Save pointer to default
MOVEI C,^D10 ;[4425] In octal
NOUT ;[4425] Create default string
ERJMP .+1 ;[4425] Won't fail
DECX <Job number> ;[4425] Get the job number for attach
CMERRX ;[4425] Bomb if not a number
; JRST ATTNUM ;[4425] Now B/ job number to use
;ATTACH...
;[4425] Here after the job number has been input to confirm the command.
ATTNUM: CONFIRM ;[4425] Confirm after job number input
MOVEM B,Q2 ;[4425] Save target job number
;Check that user given job number is in legal range of jobs for this system.
SETO D, ;[4425] We want the size of the table
GTB .JOBRT ;[4425] (D/A) Get max job as length of table
MOVN A,A ;[4425] Length comes back negative
SUBI A,1 ;[4425] So value comes out right in error
CAML A,Q2 ;[4425] Length must be greater than given job
SKIPG D,Q2 ;[4425] Move given job to D, no job 0 attach
ERROR <Job number must be between 1 and %1Q> ;[4425] Owie job number
;Make sure given job is logged in with matching username.
GTB .JOBRT ;[4425] (D/A) Runtime negative if no such job
JUMPL A,[UERR[ASCIZ /No job %4Q/]] ;[4425] Job not active apparently
GTB .JOBTT ;[4425] (D/A) Line or 777777 if detached in lh
HLREM A,Q3 ;[4425] Store attached line number for later
CALL USERNO ;[4425] (D/A) Get user owning target job
JUMPE A,[UERR [ASCIZ /Job %4Q not logged in/]] ;[4425] Not logged in!
CAME A,Q1 ;[4425] Do the user numbers match?
ERROR <Job %4Q not logged in under %5R> ;[4425] Nope, give gripe
; JRST ATTAC7 ;[4425] We know the target job, get to work
;ATTACH...
;Here with
; Q1/ target user number
; Q2/ target job number
; Q3/ target's currently attached terminal number
;Check for self
ATTAC7: CAME Q2,JOBNO ;[4425] Doing it to ourselves?
IFSKP. ;[4425] Yes
TLNN Z,F1 ;[4425] Attach or unattach?
ERROR <Cannot ATTACH to self> ;[4425] Maybe it was attach
ERROR <Cannot UNATTACH self> ;[4425] Uh, I guess unattach
ENDIF. ;[4425] End of self check
;Check for already attached
IFGE. Q3 ;[4425] If the job is not detached
HRROI B,APBUF ;Redirect output to our buffer
MOVEM B,COJFN ; by pointing herre
MOVEI A,.TTDES(Q3) ;[4425] Load designator for that line
ETYPE < [Job %6Q attached to %1L, confirm]> ;[4425] Make prompt
CALL FIXIO ;(/) Resume normal output
UPROMP APBUF ;Prompt user for confirmation
CALL FCONFA ;(/) Call routine to get confirm
ENDIF. ;[4425] End of "job not detached" code
;ATTACH...
;We have a legal target job, execute the ATACH JSYS now
MOVE A,Q2 ;[4425] Load job to attach to
MOVEI C,0 ;No password pointer for first try
MOVE B,Q1 ;[4425] Load user to attach to
TLNN Z,F1 ;If not losing this job (UNATTACH command)
SKIPN CUSRNO ; or not logged in,
CAIA ; then say nothing
ETYPE < Detaching job %J
> ;Otherwise tell me you are saying good bye
TLNE Z,F1 ;Unattach?
TXO A,AT%NAT ;[4425] Yes, tell ATACH this is an UNATTACH
DMOVEM A,AT1 ;[4425] Save args in case redo necessary
ATACH ;Try to do it without password
ERJMP .+2 ;Failed, maybe we need a password
JRST ATGOOD ;Succeeded
CAIE A,ATACX4 ;Was the error due to a password problem?
JRST ATNG ;No, some other error
CALL PASLIN ;(/A) Password not given but required, get it
MOVE C,A ;Store new password pointer for ATACH
DMOVE A,AT1 ;Get args saved before the first ATACH
ATACH ;Try the attach again
ERJMP ATNG ;[4425] It really didn't work
ATGOOD: JRST CMDIN4 ;ATACH RETURNS +2 IF LOGGED IN--THIS JOB
; STILL ATTACHED IF 'UNATTACH' JUST DONE.
;[4425] Here if attach failure
ATNG: TLNN Z,F1 ;[4425] UNATTACH command?
ETYPE <?ATTACH failure, still attached to job %J
> ;[4425] Only output message if ATTACH command
CALL CJERRE ;[4425] Give JSYS error and return
;ATTACH...
;[4425] Local routine called to get list of jobs logged in to this username.
;Jobs are returned in BUF0 in standard INFO JSYS format. The first word is a
;word count including that word. Following that word are a number of words
;containing <job,,tty> for each job on the system. Sets up BUF0 as INFO would
;have if INFO JSYS failed.
;Call with B/ user number to get information on
;Return +1 always with BUF0 set up.
FNDUSN==BUF0+760 ;[4425] Place to make username stirng
FNDUSI==BUF0+772 ;[4425] Place to make INFO JSYS block
FNDUSR: SETZM FNDUSN ;[4425] Make sure nothing there if failure
HRROI A,FNDUSN ;[4425] Point to storage for username
DIRST% ;[4425] Get that changed into a string
ERJMP .+1 ;[4425] Ignore errors for now
MOVX A,<.INJOB,,.INAC2+1> ;[4425] Load function,,size of block
MOVEM A,.INFUN+FNDUSI ;[4425] Save function and size
SETOM .INCID+FNDUSI ;[4425] Local system
HRROI A,FNDUSN ;[4425] Point to username to get jobs for
MOVEM A,.INAC1+FNDUSI ;[4425] Save as byte pointer to username
MOVEI A,BUF0 ;[4425] Point to place to store block
MOVEM A,.INAC2+FNDUSI ;[4425] and save that for INFO
MOVEI A,FNDUSI ;[4425] Point to block
INFO% ;[4425] Get the information from the monitor
IFNJE. ;[4425] If that worked
RET ;[4425] return now
ENDIF. ;[4425] So, the INFO JSYS failed, eh?
SETZM BUF0 ;[4425] First make the header word zero
SETO D, ;[4425] We want the size of the table
GTB .JOBRT ;[4425] JOBRT table is a good one to pick
HRLZ D,A ;[4425] Set up XWD -jobs,,0
DO. ;[4425] Loop through all known jobs
CALL USERNO ;[4425] (D/A) Get the user number for a job
CAME A,Q1 ;[4425] Match?
IFSKP. ;[4425] Yes
AOS C,BUF0 ;[4425] Count this job as found
HRLM D,BUF0(C) ;[4425] Store the job number that matched
GTB .JOBTT ;[4425] (D/A) Get the terminal number for job
HLRM A,BUF0(C) ;[4425] and save that too
ENDIF. ;[4425] That's all we need to do
AOBJN D,TOP. ;[4425] Continue for all jobs on system
OD. ;[4425] End of loop for all jobs on system
AOS BUF0 ;[4425] Count the header word
RET ;[4425] End of this routine
;BREAK (LINKS)
BREAK0: CONFIRM
BREK0A: MOVEI B,-1 ;SET TO BREAK ALL LINKS
;(FALL INTO BREAK1)
;BREAK1 breaks links from specific terminal.
;
;Accepts: B/ terminal number or 777777 for all
BREAK1::MOVE A,[TL%CRO!TL%COR+.CTTRM] ;BREAK TO AND FROM LINKS
TLINK
CALL JERR
RET
;BREAK (LINKS WITH) - FANCIER FORM OF BREAK COMMAND
.BREAK::NOISE <LINKS WITH>
STKVAR <BYUNO>
MOVEI B,[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ "*"]>,<User name, line number, or CR for all>,<*>,[
FLDDB. .CMUSR,CM%SDH,,,,[
FLDDB. .CMNUM,CM%SDH,10,,,[
FLDDB. .CMCFM,CM%SDH,,,,]]]]
CALL FLDSKP ;PARSE THIS MESS
CMERRX
LDB C,[POINT 9,0(C),8] ;FIGURE OUT WHAT WAS TYPED
CAIN C,.CMCFM ;JUST CR?
JRST BREK0A ;YES - DO ALL
CAIN C,.CMTOK ;WAS IT "*"
JRST BREAK0 ;YES - CONFIRM AND DO ALL
CONFIRM ;MUST BE USER NAME OR LINE #
CAIN C,.CMNUM ;LINE NUMBER?
JRST .BYEBY ;YES - CONFIRM, BREAK, AND RETURN
MOVEM B,BYUNO ;SAVE USER #
TLZ Z,F1!F2 ;INIT FLAGS
HLLZ D,JOBRT ;-# OF JOBS AS AOBJN CNTR
.BYE2: CALL USERNO ;GET USER # OF JOB IN D
CAME A,BYUNO ;IS IT THE ONE WE WANT?
JRST .BYE3 ;NO
TLO Z,F2 ;FOUND ONE
GTB .JOBTT ;GET TTY # FOR JOB
JUMPL A,.BYE3 ;JUMP IF DETACHED
TLO Z,F1 ;ACTUALLY OK TO BREAK LINK
HLRZ B,A ;LINE # TO RHS
CALL .BYEBY ;BREAK A LINK
.BYE3: AOBJN D,.BYE2 ;LOOP THRU ALL JOBS
TLNE Z,F1 ;DID ANY?
RET ;YUP - DONE
TLNE Z,F2 ;WHAT KIND OF LOSAGE?
ERROR <User has detached jobs only>
ERROR <User not logged in>
.BYEBY: TXO B,.TTDES ;MAKE INTO TERMINAL DESC.
CALLRET BREAK1 ;BREAK THE LINK AND RETURN
;CANCEL (Request type) ARCHIVE - arrive here from EXECQU
CANARC::NOISE <FOR FILES>
MOVE A,[XWD -1,0]
HRLI B,-3 ;ALL GENERATIONS
HRRI B,(GJ%OLD+GJ%IFG+GJ%PHY+GJ%XTN+GJ%FNS+CF%NS)
TXO Z,IGINV ;FIND INVISIBLE FILES
CALL SPECFN
JRST CERR ;NO "STUFF,"
SETOM TYPGRP
MOVE A,COJFN
MOVEM A,OUTDSG
MOVE A,JBUFP
MOVEM A,.JBUFP ;SET JFN STACK FENCE
CANAR1: CALL RLJFNS ;RELEASE UNNEEDED JFNS
CALL NXFILE ;STEP TO NEXT FILE
JRST CANAR2
HRRZ A,@INIFH1 ;GET THE JFN WITH NO BITS
MOVE B,[1,,.FBBBT] ;GET WORD WITH REQUEST BIT
MOVEI C,C
GTFDB ;GET IT NOW
ERJMP CANAR3 ;SKIP THIS ONE
TXNN C,AR%RAR ;REQUESTED?
JRST CANAR3 ;NO, SKIP THIS FILE
HRRZ A,@INIFH1 ;GET THE JFN WITH NO BITS
MOVE B,[1,,.FBCTL] ;GET FDB FLAG WORD
MOVEI C,C
GTFDB ;GET IT NOW
ERJMP CANAR3 ;SKIP THIS ONE
TXNE C,FB%ARC ;DOES THE FILE CURRENTLY HAVE ARCHIVE STATUS?
;EG, HAS COLLECTION RUN-1 ALREADY STARTED?
JRST [TYPE <?File has archive status: >
CALL TYPIF ;DISPLAY OFFENDING FILE
TYPE <
>
JRST CANAR3] ;TRY FOR NEXT FILE
CALL TYPIF ;TYPE NAME OF FILE
CALL MFINP ;GET A SECOND JFN
JRST [ETYPE < %?
>
JRST CANAR2] ;FAILED FOR SOME REASON
MOVEI B,.ARRAR ;REQUEST ARCHIVE
MOVEI C,.ARCLR ;CLEAR THE REQUEST
ARCF
ERJMP [ETYPE < %?
>
JRST CANAR2]
HRLI A,.FBCTL
MOVX B,FB%INV
SETZ C, ;MAKE FILE VISIBLE AGAIN
CHFDB
ERJMP [ETYPE < %?
>
JRST .+1] ;SAY OK IF JUST MAKING VISIBLE FAILED
CALL TYPOK
CANAR2: SKIPE INIFH1
JRST CANAR1
RET
CANAR3: CALL GNFIL ;ADVANCE TO NEXT GUY
SETZM INIFH1 ;NONE LEFT
JRST CANAR2 ;AND GO ON
;END-ACCESS (DIRECTORY) <NAME> --
.ENDAC::TLO Z,F2+F3 ;F2 MEANS ACCESS OR END-ACCESS, F3 MEANS END-ACCESS
JRST CONNX ;JOIN COMMON CODE
;ACCESS (DIRECTORY) <NAME> --
.ACCES::TLO Z,F2 ;F2 ON MEANS "ACCESS", OFF MEANS "CONNECT"
TLZ Z,F3 ;F2 MEANS ACCESS
JRST CONNX ;JOIN COMMON CODE
;CONNECT (TO DIRECTORY) <NAME> --
.CONNE::TLZ Z,F2+F3 ;OFF MEANS "CONNECT", ON MEANS "ACCESS"
CONNX: TRVAR <ACDNUM,ACPASS,ACJNUM,OLDCON> ;KEEP ACDNUM,ACPASS,ACJNUM CONSECUTIVE AND IN ORDER!!
SETZM ACPASS ;NO PASSWORD ASSUMED THIS TIME
SETOM ACJNUM ;USE OUR OWN JOB NUMBER
NOISE <TO DIRECTORY>
TLNE Z,F2 ;WANT DEFAULTING?
TLOA Z,F1 ;NO (ACCESS, END ACCESS)
TLZ Z,F1 ;YES (CONNECT)
CALL DIRNAM ;INPUT & CHECK DIRECTORY NAME
JRST CJERRE ;[7.1063]Failed. Print error and quit
MOVEM C,ACDNUM ;REMEMBER DIRECTORY NUMBER
CONFIRM
TLNE Z,F2 ;CONNECT?
JRST NOCONN ;NO, SO NO OVER QUOTA REPORTING
GJINF ;GET CONNECTED DIRECTORY
MOVEM B,OLDCON ;REMEMBER OLD ONE
CALL CHKDAL ;CHECK CURRENT DIRECTORY BEFORE LEAVING
NOCONN: SETZM ACPASS ;FIRST TRY WITHOUT PASSWORD
CALL DOACC ;DO THE JSYS
TLNE Z,F2 ;CONNECT?
JRST CMDIN4 ;NO, ACCESS, SO NO OVER QUOTA REPORT
GJINF ;GET CONNECTED DIRECTORY NOW
CAME B,OLDCON ;DON'T GIVE SAME REPORT TWICE!
CALL CHKDAL ;CHECK NEW DIRECTORY
JRST CMDIN4
;ROUTINE TO DO JSYS FOR ACCESS, END-ACCESS, CONNECT
DOACC: MOVE A,[AC%CON+3] ;SAY "CONNECT"+"3 WORDS IN INFO BLOCK"
TLNE Z,F2 ;"ACCESS"?
TXC A,AC%CON+AC%OWN ;YES, TURN OFF CONNECT AND ON ACCESS
TLNE Z,F3 ;END-ACCESS?
TXC A,AC%OWN+AC%REM ;YES, TURN OFF "ACCESS", TURN ON "END-ACCESS"
MOVEI B,ACDNUM ;WHERE THE BLOCK IS.
ACCES
ERCAL ACCHK ;FAILED
RET ;SUCCEEDED
;CHECK FOR FAILING END-ACCESS AND USER WASN'T ACCESSING THE DIRECTORY
ACCHK: CALL %GETER ;GET ERROR CODE FOR FAILING ACCES JSYS
MOVE A,ERCOD
CAIE A,ACESX6 ;"DIRECTORY ISN'T BEING ACCESSED" ERROR?
JRST ACNOP ;NO, MAYBE PASSWORD NOT GIVEN BUT REQUIRED
MOVE A,ACDNUM ;GET DIRECTORY NUMBER REFERRED TO
ETYPE <%%Directory %1R wasn't being ACCESSed
>
JRST CMDIN4 ;GIVE SUCCESS RETURN FOR COMMAND
;CONNECT OR ACCESS FAILED. SEE IF PASSWORD NOT GIVEN, BUT REQUIRED.
;IF SO, PROMPT FOR IT AND TRY AGAIN. IF NOT, PRINT SYSTEM ERROR.
ACNOP: CAIE A,ACESX3 ;"?PASSWORD IS REQUIRED"?
JRST CJERRE ;NO, OTHER ERROR. PRINT ERROR MESSAGE.
CALL PASLIN ;YES, GET PASSWORD ON NEW LINE.
MOVEM A,ACPASS ;STORE NEW PASSWORD POINTER
JRST DOACC ;TRY THE JSYS AGAIN
;"COPY" IS IN X2CMD.MAC.
;DAYTIME
;THIS AND ALL ONE-WORD COMMANDS ARE CONFIRMED BEFORE DISPATCH.
.DAYTI::PRINT " "
MOVE A,COJFN ;DESTINATION
SETOB B,C ;SAY CURRENT DATE AND TIME, SUPER-VERBOSE FORMAT
ODTIM
ETYPE <%_>
RET
;DELETE <FILE GROUP>
.DELET::TRVAR <EXMFLG,NEWDIR,INIFHO,<DELBUF,FILWDS>,KEPNUM,KEPJNM,DELDIR,DELPGS,DELJFN,BEFDAT,LRGSIZ,SMLSIZ,SNCDAT>
TRO Z,F4
SETZM KEPNUM ;ASSUME NOT KEEP
NOISE <FILES>
MOVE A,[XWD -1,0] ;NO DEFAULT NAMES
HRLI B,-3 ;DEFAULT VERSION IS *
HRRI B,(GJ%OLD!GJ%NS!GJ%IFG!1B14!1B15!1B16) ;OLD FILE, NO SEARCH, *'S AND COMMA OK
PUSH P,Z ;[3023]SAVE FLAGS
TXO Z,IGINV ;[3023]FIND INVISIBLE FILES
CALL SPECFN ;[3023]DO PARSE ONLY
JRST [ POP P,A ;[3023]ERROR, GET FLAGS BACK
TXZ Z,IGINV ;[3023]AND SET IGINV AS BEFORE
TXNE A,IGINV ;[3023]
TXO Z,IGINV ;[3023]
JRST DELET1] ;[3023]
POP P,A ;[3023]SUCCESS, RESTORE FLAGS
TXZ Z,IGINV ;[3023]
TXNE A,IGINV ;[3023]
TXO Z,IGINV ;[3023]
TDZ Z,[F5!F2!F3!F4!F7!F8!F9!F10!1B18] ;[7.1178]CAN'T BE EXPUNGE IF NO SUBCOMMAND
JRST DELET2
DELET1: TDZ Z,[F5!F2!F3!F4!F7!F8!F9!F10!1B18] ;[7.1178]CLEAR FLAGS
SUBCOM $DELET
DELET2: SETOM TYPGRP ;ALWAYS TYPE NAME
MOVE A,COJFN
MOVEM A,OUTDSG ;FOR NXFILE TYPEOUT
MOVE A,JBUFP ;SAVE THESE JFNS
MOVEM A,.JBUFP
SETZM DELDIR ;NO DIRECTORY INITIALIZED YET
SETOM EXMFLG ;FORCE DIRECTORY TO BE EXAMINED
SKIPE KEPNUM ;DELETING ALL VERSIONS?
JRST KEEPDL ;NO, SPECIAL CODE
DELET3: CALL RLJFNS ;RELEASE ALL TEMPORARY JFNS
CALL NXFILE ;CHECK FOR SPECIAL TERM
JRST [ SETOM EXMFLG ;BAD JFN STEPPED TO NEXT, REMEMBER TO EXAMINE IT
JRST DTDEL2]
SKIPE EXMFLG ;ARE WE SUPPOSED TO EXAMINE THIS DIRECTORY?
JRST [ CALL GETDNM ;YES, SEE WHAT NUMBER IT IS
CALL DELINI ;ESTABLISH THIS DIRECTORY AS CURRENT
SETZM EXMFLG ;SAY NO MORE EXAMINATION NEEDED YET
JRST .+1]
;[7.1178]
;Find out if we have any date/time/size constraints.
TXNN Z,F7 ;[7.1178] looking for file date "before" some time?
JRST DELET4 ;[7.1178] no.
CALL GETDAT ;[7.1178] ( /C)Yes. Get last write date for this JFN
CAML C,BEFDAT ;[7.1178] Written before target date?
JRST NXTJFN ;[7.1178] No. Out of the running.
DELET4: TXNN Z,F8 ;[7.1178] See if "since" wanted
JRST DELET5 ;[7.1178] No. Move along.
CALL GETDAT ;[7.1178] ( /C)Yes. Get last write date for this JFN
CAMG C,SNCDAT ;[7.1178] Written since target date?
JRST NXTJFN ;[7.1178] No. Out of the running
DELET5: TXNN Z,F9 ;[7.1178] See if "larger" wanted
JRST DELET6 ;[7.1178] no
CALL GETSIZ ;[7.1178] ( /C)Yes. get file size
CAMG C,LRGSIZ ;[7.1178] File larger than target?
JRST NXTJFN ;[7.1178] No. Out.
DELET6: TXNN Z,F10 ;[7.1178] Yes. Do we want "smaller"?
JRST DODEL ;[7.1178] No.
CALL GETSIZ ;[7.1178] ( /C) Get size
CAMGE C,SMLSIZ ;[7.1178] Smaller than target?
JRST DODEL ;[7.1178] Yes.
NXTJFN: MOVE A,INIFH1 ;[7.1178] Before stepping to next file
MOVEM A,INIFHO ;[7.1178] Remember which JFN we're on
CALL MFINP0 ;[7.1178] Get second JFN on current file in AC1
JRST DTDEL2 ;[7.1178] error
JRST DODEL3 ;[7.1178] finish stepping along
DODEL: CALL TYPIF ;TYPE FILENAME (RETURNS JFN IN A)
MOVE A,INIFH1 ;BEFORE STEPPING TO NEXT FILE
MOVEM A,INIFHO ;REMEMBER WHICH JFN WE'RE ON
CALL MFINP0 ;GET SECOND JFN ON CURRENT FILE, RETURN IN A
JRST DTDEL2 ;ERROR, MESSAGE ALREADY PRINTED
MOVEM A,DELJFN ;SAVE JFN
HRRZ A,A ;GET JFN
TLNE Z,F5
TXO A,DF%ARC ;ALLOW ARCHIVED FILES
TLNE Z,F2
TXO A,DF%EXP ;EXPUNGE FILE
TLNE Z,F3
TXO A,DF%FGT ;FORGET FILE
TLNE Z,F4
TXO A,DF%DIR ;ZAP DIRECTORY
TRNE Z,1B18 ;CONTENTS ONLY?
TXO A,DF%CNO
DELF
JRST [ TYPE < >
CALL $ERSTR ;PRINT ERROR MESSAGE
ETYPE <%_>
JRST DTDEL2]
CALL TYPOK
MOVE A,DELJFN ;GET FLAGS
DODEL3: MOVE B,INIFHO ;[7.1178]GET OLD JFN POINTER
CAMN B,INIFH1 ;IF DIFFERENT JFN NOW, REPORT MIGHT BE DUE
TXNE A,GN%STR!GN%DIR ;DID DIRECTORY JUST CHANGE?
SETOM EXMFLG ;NEW JFN OR DIRECTORY CHANGED, REMEMBER TO EXAMINE DIRECTORY
DTDEL2: SKIPE INIFH1 ;DID WE USE UP ALL THE JFNS?
JRST DELET3 ;NO, GO CHECK NEXT JFN
CALLRET PDLFRE ;REPORT ABOUT FINAL DIRECTORY AND RETURN
;ROUTINE USED BY DELETE TO PRINT NUMBER OF PAGES FREED IF EXPUNGE SUBCOMMAND
;WAS USED, OR IF SOME PAGES HAVE BEEN FREED
PDLFRE: SKIPE A,DELDIR ;GET CURRENT DIRECTORY NUMBER - ANY?
TLNN Z,F2 ;OR EXPUNGE REQUESTED?
RET ;NO - NO NEED TO SAY ANYTHING ABOUT FREE PAGES
JUMPN Q2,PDLFR2 ;JUMP IF MULTIPLE DIRECTORY DEVICE
SETZ A, ;ELSE SAY NO PAGES FREED
PDLFR1: MOVE C,DELDIR ;TELL TYPFRE WHICH DIRECTORY TO PRINT
CALLRET TYPFRE ;PRINT RESULTS
PDLFR2: GTDAL% ;CHECK ALLOCATION:
MOVE A,DELPGS ;GET ORIGINAL ALLOCATION
SUB A,B ;TAKE DIFFERENCE
JUMPGE A,PDLFR1 ;CONTINUE IF THERE'S A DIFFERENCE
RET ;ELSE JUST RETURN
;GETDAT - Uses current JFN to find last write date of file. Returns it in AC3.
GETDAT: HRRZ A,@INIFH1 ;[7.1178] Get JFN
MOVE B,[1,,.FBWRT] ;[7.1178] Last write date
MOVEI C,C ;[7.1178] Put it here
GTFDB
ERJMP .+1
RET
;GETSIZ - Uses current JFN to find size of file. Returns it in AC3.
GETSIZ: HRRZ A,@INIFH1 ;[7.1178] Get JFN
MOVE B,[1,,.FBBYV] ;[7.1178] Last write date
MOVEI C,D ;[7.1178] Put it here
GTFDB
ERJMP .+1
HRRZ C,D ;[7.1178] Get right half - page count
RET
;DELINI TAKES DIRECTORY NUMBER IN A AND INITIALIZES DATA TO WORK ON THAT
;DIRECTORY
DELINI: MOVEM A,NEWDIR ;SET NEW DIRECTORY WE'RE WORKING ON
CAMN A,DELDIR ;IS NEW ONE THE SAME AS THE OLD ONE?
RET ;YES, SO DON'T RESET COUNTS OR TRY TO PRINT
SKIPE DELDIR ;WAS THERE A PREVIOUS DIRECTORY?
CALL PDLFRE ;YES, PRINT ITS RESULTS
MOVE A,NEWDIR ;SET UP NEW ONE AS CURRENT
MOVEM A,DELDIR ;REMEMBER DIRECTORY NUMBER
CAIE Q2,0 ;DON'T GET ALLOCATION FOR NON-DIRECTORY DEVICE
GTDAL ;GET ALLOCATION
MOVEM B,DELPGS ;SAVE PAGES IN USE
RET
;GETDNM DECIDES WHAT DIRECTORY NUMBER WE'RE WORKING ON
GETDNM: HRRZ A,@INIFH1 ;GET JFN
SETOM Q2 ;ASSUME MULTIPLE DIRECTORY DEVICE
CALL DIRQ ;SKIP IF DIRECTORY DEVICE
MOVEI Q2,0 ;NOT A MULTIPLE DIRECTORY DEVICE
JUMPE Q2,R ;SKIP DIRECTORY NAME STUFF IF NOT MULTIPLE DIRECTORY DEVICE
HRRZ B,@INIFH1 ;JFN TO B
LDF C,1B2+1B5+JS%PAF ;GET PUNCTUATED STRUCTURE AND DIRECTORY
HRROI A,DELBUF ;WHERE TO PUT IT
JFNS
MOVSI A,(RC%EMO) ;LITERAL MATCH
HRROI B,DELBUF ;STRING
RCDIR ;GET DIR #
HRROI B,DELBUF ;FOR ERROR MESSAGE
TLNE A,(RC%AMB+RC%NOM)
ERROR <No such directory - %2M>
MOVE A,C ;RETURN DIRECTORY NUMBER IN A
RET
;DIRQ SKIPS IFF THE CURRENT JFN IS A MULTIPLE DIRECTORY DEVICE
DIRQ: HRRZ A,@INIFH1 ;GET RID OF FLAGS
DVCHR ;GET DEVICE CHARACTERISTICS
ERCAL JERR ;UNEXPECTED FAILURE
TXNE B,DV%MDD ;SKIP IF NON-DIRECTORY DEVICE
RETSKP ;WE'LL SKIP, BECAUSE IT'S A DIRECTORY DEVICE
RET
$DELET: TABLE
T ARCHIVE,,..ARCH
T BEFORE,,..BE4 ;[7.1178]
T CONTENTS-ONLY,,.CNOLY
T DIRECTORY,,..DIR
T EXPUNGE,,..EXP
T FORGET,,..FORG
T KEEP,,..KEEP
T LARGER,,.LARGR ;[7.1178]
T SINCE,,.SINCE ;[7.1178]
T SMALLER,,.SMALR ;[7.1178]
TEND
..ARCH: NOISE <FILES INCLUDED>
CONFIRM
TLO Z,F5
RET
;[[7.1178]]
..BE4: NOISE <DATE AND TIME>
DTPX <
Only files written earlier than specified date and time will be deleted>
CMERRX <Invalid BEFORE subcommand>
CONFIRM
SKIPE KEPNUM
ERROR <Can't "KEEP" and "BEFORE" at the same time>
MOVEM B,BEFDAT
TXO Z,F7 ;[7.1178] set flag that says "BEFORE"
RET
.CNOLY: CONFIRM
SKIPE KEPNUM
ERROR <Can't "KEEP" and "CONTENTS-ONLY" at the same time>
TRO Z,1B18
RET
..EXP: NOISE <AFTER DELETING>
CONFIRM
SKIPE KEPNUM
ERROR <Can't "KEEP" and "EXPUNGE" at the same time>
TLO Z,F2 ;FLAG EXPUNGE
RET
..FORG: NOISE <WITHOUT DEASSIGNING DISK ADDRESSES>
CONFIRM
SKIPE KEPNUM
ERROR <Can't "KEEP" and "FORGET" at the same time>
MOVX B,WHLU+OPRU
CALL PRVCK
ERROR <WHEEL or OPERATOR capability required>
TLO Z,F3
RET
..KEEP: DEFX <1> ;DEFAULT IS "1"
DECX <Number of generations>
CMERRX ;NO DECIMAL NUMBER SUPPLIED
CAIN B,1
NOISE <GENERATION>
CAIE B,1
NOISE <GENERATIONS>
CONFIRM
SKIPG B ;[7.1182]
ERROR <Number of generations may not be 0 or negative number> ;[7.1182]
TLNE Z,F3
ERROR <Can't "KEEP" and "FORGET" at the same time>
TLNE Z,F2
ERROR <Can't "KEEP" and "EXPUNGE" at the same time>
TRNE Z,1B18
ERROR <Can't "KEEP" and "CONTENTS-ONLY" at the same time>
MOVEM B,KEPNUM
RET
;[[7.1178]]
.LARGR: NOISE <THAN>
DECX <Only files larger than specified decimal number of pages will be deleted>
CMERRX <Invalid LARGER subcommand>
CONFIRM
SKIPE KEPNUM
ERROR <Can't "KEEP" and "LARGER" at the same time>
MOVEM B,LRGSIZ ;[7.1178] save target size
TXO Z,F9 ;[7.1178] Say "LARGER" seen
RET
;[7.1178]
.SINCE: NOISE <DATE AND TIME>
DTPX <
Only files written more recently than specified date and time will be deleted>
CMERRX <Invalid SINCE subcommand>
CONFIRM
SKIPE KEPNUM
ERROR <Can't "KEEP" and "BEFORE" at the same time>
MOVEM B,SNCDAT
TXO Z,F8 ;[7.1178] set flag that says "SINCE"
RET
;[7.1178]
.SMALR: NOISE <THAN>
DECX <Only files smaller than specified decimal number of pages will be deleted>
CMERRX <Invalid SMALLER subcommand>
CONFIRM
SKIPE KEPNUM
ERROR <Can't "KEEP" and "SMALLER" at the same time>
MOVEM B,SMLSIZ ;[7.1178]Save target size
TXO Z,F10 ;[7.1178]Say "SMALLER" subcommand given
RET
..DIR: NOISE <AND "FORGET" FILE SPACE>
CONFIRM
MOVX B,WHLU+OPRU
CALL PRVCK ;MUST HAVE PRIVS FOR THIS FCN
ERROR <WHEEL or OPERATOR capability required>
SKIPN KEPNUM
TLZE Z,F2!F3
TYPE <% KEEP or EXPUNGE or FORGET subcommand ignored>
SETZM KEPNUM ;ZERO THIS
TLO Z,F4 ;SET FLAG FOR ZAP DIRECTORY
RET
;PRUNE NUMBER OF GENERATIONS
;SOME BUFFER DEFINITIONS
VERBUF==BUF0 ;PUT TABLE AT BUF0
VRTBLN==<BUFL-BUF0>/2 ;USE 1/2 THE SPACE FOR STRING POINTERS,
;THE OTHER 1/2 FOR STRINGS
VERSTR==VERBUF+VRTBLN ;START OF STRING SPACE
VEREND==BUFL+1000-5 ;5 WORDS FOR OVERFLOW
KEEPDL: CALL RLJFNS ;RELEASE ANY TEMPORARY JFNS
CALL NXFILE ;CHECK FOR NON-EX TERMS
JRST KEEPDE ;END CHECK
HRROI A,DELBUF ;GET POINTER TO STRING BUFFER
HRRZ B,@INIFH1 ;GET JFN
LDF C,2B2+2B5+1B8+1B11+1B35 ;DEV, DIR, NAME, EXT
JFNS ;SAVE NAME OF FILE
ERCAL JERRE
MOVE A,[POINT 7,VERSTR] ;INIT POINTER TO VERSION STRING SPACE
MOVEM A,KEPJNM ;SAVE HERE
MOVSI Q1,-VRTBLN ;AOBJN PTR TO VER STRING PTR TABLE
LDF D,1B14+1B35 ;GENERATION + PUNCTUATION
KEEPD1: MOVE A,KEPJNM ;GET VERSION POINTER
TLNE Z,F5 ;ALLOWED TO DELETE ARCHIVE STUFF?
JRST KEEPD8 ;YES, BYPASS CHECKS
HRRZ A,@INIFH1 ;GET CURRENT JFN
MOVE B,[1,,.FBCTL] ;GET CONTROL BITS
MOVEI C,C
GTFDB
ERJMP .+1
TXNE C,FB%ARC ;NOT DELETABLE?
JRST KEEPD9 ;NO, PASS OVER IT
HRRZ A,@INIFH1
MOVE B,[1,,.FBBK0]
MOVEI C,C
GTFDB
ERJMP .+1
TXNE C,AR%RAR ;REQUESTED ARCHIVE?
JRST KEEPD9 ;YES, PASS OVER IT
KEEPD8: MOVE A,KEPJNM ;GET VERSION POINTER
HRRZ B,A
CAIL B,VEREND ;BUFFER SPACE FULL?
JRST KEEPOV ;YES
MOVEM A,VERBUF(Q1) ;SAVE IN TABLE
HRRZ B,@INIFH1
MOVE C,D ;GET DISPOSITION
JFNS ;INTO VERSION STRING SPACE
ERCAL JERRE
SETZ C,
IDPB C,A ;TERMINATE STRING
MOVEM A,KEPJNM ;STORE UPDATED STRING POINTER
KEEPD9: MOVE A,@INIFH1
TLNE A,770000 ;SKIP GNJFN IF NO STARS
CALL GNJFS ;STEP TO NEXT FILE
JRST KEEPD3
TLNE A,(1B14+1B15+1B16) ;DIR, NAME, EXT CHANGED?
JRST KEEPD2 ;YES, FINISH THIS FILE
JUMPN C,KEEPD1 ;IF NONE FOUND
LDF D,1B14 ;GENERATION WITHOUT PUNCT.
AOBJN Q1,KEEPD1 ;INCREMENT VERSION PTR AND LOOP BACK
KEEPOV: TYPE <%Too many generations for internal storage, will not print generations
>
CALL KEEPPN ;PRINT NAME
CALL KEEPDO ;DO DELETE (RETURNS # DELETED IN A)
SKIPL A
ETYPE < [%1Q generations deleted]
>
MOVE A,@INIFH1
TLNE A,770000
KEEPD4: CALL GNJFS ;STEP TO NEXT
JRST [ AOS A,INIFH1
CAMLE A,INIFH2 ;OFF END?
SETZM INIFH1 ;YES, INDICATE SUCH
JRST KEEPDE]
TLNN A,(1B14+1B15+1B16)
JRST KEEPD4
JRST KEEPDE
KEEPD3: AOS A,INIFH1
CAMLE A,INIFH2
SETZM INIFH1
KEEPD2: MOVEI A,1(Q1) ;GET NUMBER OF VERSIONS
SUB A,KEPNUM ;GET NUMBER TO DELETE
JUMPLE A,KEEPDE ;JUMP IF NONE
CALL KEEPPN ;PRINT NAME
MOVNI A,1(Q1) ;GET -NUMBER OF VERSIONS
ADD A,KEPNUM ;GET NUMBER TO DELETE
HRLZ Q1,A ;MAKE AOBJN PTR
KEEPD5: MOVE A,VERBUF(Q1)
ETYPE <%1M>
AOBJN Q1,[PRINT "," ;PRINT THEM ALL
JRST KEEPD5]
CALL KEEPDO ;DO DELNF
JUMPL A,KEEPDE ;ERROR?
CALL TYPOK ;TYPE [OK]
KEEPDE: SKIPE INIFH1
JRST KEEPDL
JRST DTDEL2
KEEPPN: PRINT " "
HRROI A,DELBUF ;GET NAME POINTER
ETYPE <%1M> ;TYPE IT
RET
KEEPDO: MOVSI A,(GJ%OLD+GJ%PHY+GJ%SHT)
HRROI B,DELBUF ;GET FILE VERSION 0 (HIGHEST)
CALL GTJFS ;GET AND STACK JFN
JRST KEEPE1 ;GTJFN FAILED
MOVE B,KEPNUM ;NUMBER TO KEEP
TLNE Z,F5 ;ARCHIVE ALLOWED?
TXO A,DF%ARC ;YES, SAY SO.
DELNF
JRST KEEPE2
MOVE A,B ;RETURN NUMBER IN A
RET
KEEPE2: TYPE < >
CAIA
KEEPE1: TYPE < GTJFN failure for highest generation
?>
CALL $ERSTR
TYPE <
>
SETO A,
RET
;DISCARD (TAPE INFORMATION FOR FILES) <FILES>
.DISCA::NOISE <TAPE INFORMATION FOR FILES>
TRO Z,F2 ;SET THE FLAG
TXO Z,IGINV ;LET IT SEE INVISIBLE FILES
MOVE A,[XWD -1,0] ;NO DEFAULT NAMES
HRRZI B,(GJ%OLD+GJ%IFG+GJ%PHY+GJ%XTN+GJ%FNS+CF%NS) ;NO SUBCOMMANDS
CALL SPECFN
JRST CERR ;DON'T ALLOW "STUFF,"
SETOM TYPGRP ;ALWAYS TYPE THE NAME
MOVE A,COJFN
MOVEM A,OUTDSG ;WHERE OUTPUT GOES
MOVE A,JBUFP
MOVEM A,.JBUFP
DISCA1: CALL RLJFNS ;RELEASE STRAY JFN'S
CALL NXFILE ;STEP TO NEXT FILE IN GROUP
JRST DISCA2 ;NO MORE IN THIS GROUP
CALL TYPIF ;DO NAME
CALL MFINP ;GET A SECOND JFN
JRST DISCA2 ;FAILED?
MOVX B,.ARDIS ;FUNCTION CODE FOR THE DISCARD
MOVX C,AR%CR1+AR%CR2 ;DO BOTH TAPES
ARCF
ERJMP DISCA9 ;FAILED...
CALL TYPOK ;TELL THE USER IT'S DONE
DISCA2: SKIPE INIFH1 ;DONE THEM ALL?
JRST DISCA1 ;NO, CONTINUE THE PROCESS
RET
DISCA9: ETYPE < %?
>
JRST DISCA2
;EXPUNGE (ALL DELETED FILES)
.EXPUN::TRVAR <EXPNST,EXPNFL,EXPDIR,OLDALC>
GJINF
MOVEM B,EXPDIR ;DEFAULT IS CONNECTED DIR
NOISE <DIRECTORY>
CALL CURNMS ;READ DIRECTORY NAME ALLOWING STARS
JRST CJERRE ;[7.1063]Failed. Print error and quit
MOVEM A,EXPNFL ;SAVE THE FLAGS RETURNED
MOVEM B,EXPNST ;SAVE THE POINTER TO THE DIR NAME STRING
MOVEM C,EXPDIR ;SAVE DIRECTORY NUMBER
CALL %EXPUN ;CHECK SUBCOMMANDS
EXPUN1: CALL EXPDO ;GO EXPUNGE THIS DIRECTORY
IFNSK. ;[7.1063]If error...
CAIE B,STRX09 ;[7.1063]Is structure not mounted?
CAIN B,STRX10 ;[7.1063]Or is structure offline?
RET ;[7.1063]Yes, then don't continue
JRST EXPUN2 ;[7.1063]Some other error, keep going
ENDIF. ;[7.1063]
CALL TYPFRE ;[3049] [7.1025] A,C/ NOW TELL PAGES FREED
EXPUN2: MOVE A,EXPDIR ;[7.1025] NOW STEP THE DIRECTORY NAME
MOVE B,EXPNST ;GET POINTER TO THE USER NAME STRING
MOVE C,EXPNFL ;GET THE FLAGS
TXNE C,RC%WLD ;WILD CARDS TYPED?
CALL STPDIR ;YES, GO STEP THE DIR NUMBER
RET ;NO MORE TO BE DONE
MOVEM A,EXPDIR ;SAVE THE NEW DIRECTORY NUMBER
JRST EXPUN1 ;LOOP BACK FOR REST OF DIRS
;ROUTINE TO DO THE EXPUNGING
;ACCEPTS IN EXPDIR/ DIR NUMBER
;WARNING: THIS IS NOT A GENERAL ROUTINE. TO MAKE IT ONE, HAVE IT
;ACCEPT THE DIR IN A INSTEAD OF EXPDIR, SINCE EXPDIR IS LOCAL TO THE
;EXPUNGE COMMAND
EXPDO: MOVE A,EXPDIR
GTDAL
MOVEM B,OLDALC
MOVE B,EXPDIR
HLLZ A,Q1 ;GET BITS FROM ARGS
DELDF
ERJMP [TYPE <% > ;HANDLE ERROR
CALL %GETER ;GET ERROR CODE
MOVE A,ERCOD
MOVE B,A ;[3045] SAVE ERROR CODE
CALL $ERSTR ;PRINT IT
MOVE A,EXPDIR ;GET DIR NUMBER
ETYPE < - %1R%%_> ;TERMINATE ERROR MESSAGE
RET] ;AND RETURN
MOVE A,EXPDIR
GTDAL
MOVE A,OLDALC
SUB A,B
MOVE C,EXPDIR ;GET THE DIR NUMBER TO BE OUTPUT
RETSKP ;[3049] RETURN AND CALL TYPFRE - NO LONGER FALL THRU
;TYPFRE TAKES NUMBER OF PAGES FREED IN A, DIR NUMBER IN C, AND PRINTS
;MESSAGE SAYING HOW MANY PAGES FREED
TYPFRE::MOVEI B,[ASCIZ " %3R [%1Q"]
SKIPN A ;ANYTHING?
MOVEI B,[ASCIZ " %3R [No"]
UETYPE (B) ;PRINT FIRST PART
TYPE < page> ;BUILD CORRECT GRAMMAR
CAIE A,1 ;ONLY ONE?
PRINT "s" ;NO - THEN PLURAL
TYPE < freed]
>
RET ;[3045] [3049] ALWAYS RETURN +1 FROM TYPFRE
;ROUTINE TO GET EXPUNGE SUBCOMMANDS
%EXPUN: SETZ Q1, ;CLEAR BITS
CALL SPRTR
SUBCOM $EXPUN ;SUBCOMMANDS, READ 'EM
RET
$EXPUN: TABLE
T DELETE,,.TEXP
T PURGE,,.NXEXP
T REBUILD,,.REBLD
TEND
.TEXP: NOISE <TEMPORARY FILES>
CONFIRM
TXO Q1,DD%DTF
RET
.NXEXP: NOISE <NOT COMPLETELY CREATED FILES>
CONFIRM
TXO Q1,DD%DNF
RET
.REBLD: NOISE <SYMBOL TABLE>
CONFIRM
TXO Q1,DD%RST
RET
;COMMENT (END WITH ^Z)
.REMAR::NOISE (MODE)
CONFIRM ;GET COMMAND CONFIRMATION
TYPE <Type remark. End with CTRL/Z.
>
STKVAR <<CMTXTB,10>>
SETZM .RDBFP+CMTXTB ;SAY NO BACKUP POINTER
SETZM .RDRTY+CMTXTB ;SAY NO ^R POINTER
COM1: MOVEI A,.RDBRK ;THIS MANY WORDS IN TEXTI BLOCK
MOVEM A,.RDCWB+CMTXTB
MOVX A,RD%JFN ;SAY WE'RE GIVING JFNS
MOVEM A,.RDFLG+CMTXTB
HRL A,CIJFN ;INPUT STREAM
HRR A,COJFN ;EDITING STREAM
MOVEM A,.RDIOJ+CMTXTB
HRROI A,BUF0 ;USE BUFFER SPACE FOR INPUT
MOVEM A,.RDDBP+CMTXTB
MOVX A,<BUFEND-BUF0+1>*5;THIS MANY CHARACTERS AVAILABLE IN BUFFER
MOVEM A,.RDDBC+CMTXTB
MOVEI A,[EXP 1B<3*8+2>,0,0,0] ;ONLY BREAK ON ^Z
MOVEM A,.RDBRK+CMTXTB ;SET UP BREAK MASK
MOVEI A,CMTXTB ;POINT TO BLOCK
TEXTI ;INPUT SOME OF THE COMMENT
ERCAL CJERRE ;FAILED, GO SEE WHY
MOVE A,.RDFLG+CMTXTB ;GET RESULTS
TXNE A,RD%BTM ;^Z TYPED YET?
JRST UNMAP ;YES, CLEAN UP AND RETURN
JRST COM1 ;NOT YET, READ MORE
.CLOSE::NOISE <JFN>
CRRX <Octal JFN number or blank for all>
CAIA ;NOT JUST "CLOSE<CR>"
JRST SHUT
OCTX <Octal JFN number> ;SEE IF OCTAL NUMBER
CMERRX ;NOT OCTAL NUMBER EITHER!
CONFIRM
PUSH P,B ;SAVE THE JFN
CALL CLOPAT ;GO UNMAP THE FILES IF PA1050 THERE
POP P,A ;PUT JFN IN A
CAIG A,MAXJFN ;ERROR IF THE JFN IS NOT WITHIN BOUNDS
SKIPG A
ERROR <Illegal JFN number>
CALL JFNREL
ERROR <JFN not in use>
RET
;ENTER HERE WITH JFN TO RELEASE IN A
JFNREL: TDZA D,D ;NO SPECIAL BITS
JFNRLA::LDF D,CZ%ABT ;CLOSE WITH ABORT
HRRZ A,A ;CLEAR LHS
GTSTS
TXNN B,GS%NAM ;ANYTHING IN THIS JFN?
RET ;NO, RETURN
ETYPE < %1P %1S > ;TYPE JFN AND NAME
CAIN A,.PRIIN ;PRIMARY INPUT?
JRST NRLPRI ;YES
CAIN A,.PRIOU ;PRIMARY OUTPUT?
JRST NRLPRO
CALL NOTIO ;MAKE SURE JFN ISN'T BEING USED FOR EXEC COMMAND INPUT OR OUTPUT
JRST NRLEX ;NAUGHTY, NAUGHTY, TRYING TO CLOSE COMMAND JFN!
TXNN B,GS%OPN ;OPEN?
JRST [ RLJFN
JRST JFNER1
JRST JFNOK1]
HLL A,D ;USE BITS IN D
CLOSF
JRST JFNER2
JFNOK1: GTSTS
TXNE B,GS%NAM ;NAME STILL THERE?
JRST JFNOK2
TYPE < [OK]
>
RETSKP
NRLPRI: TYPE < Primary input not closed
>
RETSKP
NRLPRO: TYPE < Primary output not closed
>
RETSKP
;USER TRIED TO CLOSE COMMAND JFN. SEE WHETHER INPUT OR OUTPUT TO
;GIVE FANCY MESSAGE.
NRLEX: TXNE B,GS%WRF ;OPEN FOR WRITE?
JRST NRLEXO ;YES, ASSUME OUTPUT JFN
JRST NRLEXI ;NO, ASSUME INPUT
NRLEXI: TYPE < EXEC command input not closed
>
RETSKP
NRLEXO: TYPE < EXEC command output not closed
>
RETSKP
JFNOK2: TXNE B,GS%OPN
TYPE < Can't close file
>
TXNN B,GS%OPN
TYPE < Can't release JFN
>
RETSKP
JFNER1: TYPE < Can't release JFN - >
CAIA
JFNER2: TYPE < Can't close file - >
CALL $ERSTR ;PRINT ERROR IN A
ETYPE <%_>
RETSKP
SHUT: CALL CLOPAT ;GO UNMAP THE PA1050 OPEN FILES
MOVEI A,MAXJFN ;START WITH LARGEST TO BE LIKE FILSTAT
SHUT1: PUSH P,A
CALL JFNREL ;RELEASE JFN
JFCL ;IGNORE NOTHING THERE
POP P,A
SOJG A,SHUT1
RET
;ADVISE (TERMINAL/USER)
.ADVIS::TLO Z,F2 ;FLAG ADVISE
NOISE <USER>
JRST LINK0
.JILEN==.JILNO+1 ;ROOM FOR ALL JOB INFO WE MAY NEED
;TALK (TERMINAL/USER)
.TALK:: TLZ Z,F2
NOISE <TO>
LINK0: TRVAR <DOLNKF,<JIBUF,.JILEN>,<LDBUF,3>,TFRAME,ADVJFN,ADVJNM,DIRNO>
MOVEM P,TFRAME ;SAVE BEGINNING OF POSSIBITITES
USERX <User name or terminal number>
JRST LTTY ;NOT USER NAME, SEE IF TERMINAL NUMBER TYPED
CONFIRM
MOVEM B,DIRNO ;SAVE USER NUMBER
TLZ Z,F1 ;NO DETACHED JOBS SEEN YET
MOVEM P,TFRAME ;SAVE BEG OF ARGS
HLLZ D,JOBRT ;MAKE AOBJN PTR
LINK3: MOVEI B,(D) ;GET JOB NUMBER BY ITSELF
CAME B,JOBNO ;LOOKING AT MY OWN JOB?
SKIPN B ;OR JOB 0?
JRST LINK6 ;YES, SKIP IT
CALL USERNO ;GET USER NUMBER
CAME A,DIRNO
JRST LINK6 ;WRONG GUY
GTB .JOBTT
TLO Z,F1 ;FLAG DETACHED JOB SEEN
JUMPL A,LINK6 ;AND SKIP IT IF DETACHED
HLRZS A
PUSH P,A ;SAVE TTY# (1ST WORD OF A POSSIBILITY)
GTB .JOBPN ;GET PROGRAM NAME
PUSH P,A ;SAVE SUBSYSTEM NAME (2ND WRD OF POSS.)
LINK6: AOBJN D,LINK3 ;MAY HAVE MORE JOBS
CAMN P,TFRAME ;FOUND ANY?
JRST [ TLNE Z,F1
ERROR <User has detached jobs only
Send mail to the user instead>
MOVE A,CUSRNO ;GET MY USER NUMBER
CAMN A,DIRNO ;LOOKED FOR MY OWN JOBS?
JRST LINKNS ;YES, SAY CAN'T DO MYSELF
ERROR <User is not logged in
Send mail to the user instead>]
POP P,A ;SUBSYSTEM NAME
POP P,B ;TTY#
CAMN P,TFRAME ;ONLY ONE POSSIBILITY?
JRST [ MOVE A,B ;YES, USE IT
TLO Z,F3 ;NO CONFIRM NEEDED
JRST LINK11]
LINK7: MOVE C,B ;SAVE FOR POSSIBLE DEFAULT
SKIPN A ;[4425] Any subsys name?
MOVX A,<SIXBIT/?/> ;[4425] Nope, say something at least
TXO B,.TTDES ;[4425] Make terminal designator
ETYPE < %2L, %1'%%_> ;[4425] Print line and what's running
CAMN P,TFRAME ;DONE ALL?
JRST LINK9 ;YES
POP P,A
POP P,B
JRST LINK7
LINK9: PROMPT <TTY: >
HRROI A,LDBUF ;GET POINTER FOR DEFAULT STRING
MOVEM A,CMDEF ;SAVE POINTER TO DEFAULT
MOVE B,C ;GET DEFAULT TTY # (FIRST ONE ON LIST)
MOVEI C,8 ;IN OCTAL
NOUT ;CREATE DEFAULT STRING
CALL JERR ;SHOULDN'T FAIL
OCTX <Terminal number>
CMERRX ;NON-OCTAL NUMBER TYPED
JRST LINK10
LTTY: OCTX ;USER NAME NOT TYPED, SEE IF TERMINAL NUMBER
CMERRX <User name or terminal number required>
LINK10: CONFIRM
LINK11: PUSH P,B ;SAVE TTY#
GJINF ;GET JOB INFORMATION
TLNN Z,F2 ;SKIP CHECK IF ADVISING
CAME D,0(P) ;IS TTY# IDENTICAL TO MY TTY NUMBER ?
SKIPA
LINKNS: ERROR <Cannot talk to self>
HLRE B,TTYJOB ;GET NEG SIZE OF TABLE
MOVMS B
POP P,A ;TTY#
CAIGE A,0(B)
CAIGE A,0
ERROR <Nonexistent terminal number>
TLNN Z,F3
MOVE P,TFRAME
PUSH P,A
SETZ D,
GTB .PTYPA
MOVE D,A
POP P,A
CAIGE A,(D) ;PTY?
JRST NOPTYL ;NO
PUSH P,D ;MAYBE. CHECK FOR ABOVE LAST PTY
HLRZ D,D ;NUMBER OF PTYS
ADD D,0(P) ;LAST PLUS ONE
POP P,0(P) ;CLEAR STACK
CAIL A,(D) ;ABOVE PTY'S?
JRST NOPTYL ;YES. NVT OR SOMETHING ELSE
PROMPT < [Pseudo-terminal, confirm]>
CALL FCONFA
NOPTYL: TLNE Z,F2
JRST ADVISE ;GO GIVE ADVISE
MOVEI B,.TTDES(A) ;FORM TTY DESIGNATOR
MOVE A,[1B2+1B3+.CTTRM] ;TO AND FROM CONTROLLING TTY
TLINK
ERROR <Refused, Send mail to the user instead>
RET
;CODE TO GIVE ADVISE - CHECK TERMINAL PRINT JOB INFO
ADVISE: MOVEM A,ADVTNM
MOVX B,WHLU!OPRU
CALL PRVCK
CAIA
JRST ADVIS1 ;SKIP CHECK IF PRIVILEGED
TRO A,.TTDES
RFMOD
ERJMP [CALL TX1SKP ;FAILED, SEE IF FOR LINE NOT ACTIVE
CALL JERRE ;STRANGE ERROR, REPORT IT
JRST ADVIS1] ;NOTHING ON LINE, THAT'S O.K.
TRNN B,TT%AAD
ERROR <Destination not receiving advice>
ADVIS1: SETO D,
GTB .TTYJO
MOVNS A,A
CAMGE A,ADVTNM
ERROR <Illegal terminal number>
MOVNI A,1
MOVE B,[-1,,C]
MOVEI C,.JITNO
GETJI
CALL JERR
CAMN C,ADVTNM
ERROR <Cannot advise self>
TYPE < Escape character is <CTRL>E, type <CTRL>^? for help
>
MOVE D,ADVTNM
GTB .TTYJO
HLRZ B,A
CAIN B,-1
JRST [ TYPE < No job on terminal.
>
JRST CONNECT]
CAIN B,-2
JRST [ TYPE < Terminal being assigned.
>
JRST CONNECT]
TRZE B,400000
TYPE < Not controlling terminal.
>
MOVEM B,ADVJNM
PRINT " "
MOVE A,ADVJNM
MOVEI B,JIBUF ;GET ADDRESS OF BUFFER
HRLI B,-.JILEN ;SPECIFY LENGTH
MOVEI C,0
GETJI
CALL JERR
SKIPN B,.JIUNO+JIBUF
JRST [ TYPE <Not logged in>
JRST NOLOGD]
ETYPE <%2R>
NOLOGD: MOVE B,.JIDNO+JIBUF
CAMN B,.JILNO+JIBUF
JRST NOCOND
UETYPE [ASCIZ /, %2R/]
NOCOND: MOVE B,ADVJNM
ETYPE < Job %2Q>
PRINT " "
SKIPN A,.JIPNM+JIBUF
MOVE A,.JISNM+JIBUF
CALL SIXPRT
ETYPE <%_>
;CODE TO GIVE ADVISE - MAKE CONNECTION, LOOP SENDING CHARACTERS
CONNEC: SETOM DOLNKF ;SAY TLINK NEEDED
MOVE B,ADVTNM ;GET TERMINAL NUMBER
TRO B,.TTDES ;SET UP TERMINAL NUMBER FOR STI
MOVEM B,ADVTNM
CALL CHKLNK ;TRY TO ESTABLISH LINK FIRST
MOVEI A,.FHSLF
RPCAP
MOVEI A,.FHJOB
MOVX B,1B<ADVESC> ;ONLY THE ADVICE ESCAPE CHARACTER DOESN'T GET SENT TO THE REMOTE JOB
TXNE C,SC%CTC ;CAN'T SET JOB TIW IF NO ^C PRIV
STIW
MOVE A,[ADVESC,,^D24] ;CONTROL-E IS USED TO GET OUT
ATI
SETOM ADVFLG ;FLAG IN ADVISE CODE
TLZ Z,F3 ;NOT IN COMMENT NOW
LDF A,GJ%SHT ;SHORT FORM GTJFN
HRROI B,[ASCIZ /TTY:/] ;WE NEED BINARY CHANNEL. THIS IS SO
;IF THINGS LIKE "TER RA" OR "TER NO RA"
;ARE "SENT" TO REMOTE JOB, THEY HAVE
;EFFECT
CALL GTJFS ;GET HANDLE ON TTY FOR BINARY COMMUNICATION
CALL CJERRE ;FAILURE, PRINT ERROR AND RETURN
MOVE B,[100000,,OF%RD] ;OPEN THE JFN FOR READ
OPENF
ERCAL CJERRE ;FAILED
MOVEM A,ADVJFN ;REMEMBER THE ADVISE JFN
MOVEI A,.CTTRM ;CONTROLLING TERMINAL
RFMOD ;GET CURRENT SETTING OF PAGE MODE
MOVE C,B ;GET A COPY OF IT
ANDX C,TT%PGM ;KEEP ONLY PAGE MODE
MOVEM C,SAVPGM ;REMEMBER CORRECT SETTING
TXZ B,TT%PGM ;TURN OFF PAGING SO WE CAN SEND CTRL/Q TO REMOTE TERMINAL
STPAR
ADVLOP: MOVE A,ADVJFN
TLNE Z,F3 ;COMMENT?
MOVE A,CIJFN ;YES, USE REGULAR ECHOING TTY CHANNEL
BIN
MOVE C,B ;PUT CHARACTER IN C
ANDI C,177 ;STRIP TO 7 BITS FOR IDENTIFICATION
CAIN C,"^"-100 ;^^ ?
JRST SNCTRL ;YES, SEND CONTROL CODE
ADVLP1: TLNE Z,F3 ;COMMENT?
JRST ADVLOP ;YES, DON'T SEND CHAR
MOVE A,ADVTNM
STI
ERJMP [SKIPL DOLNKF ;HAVE WE SUCCESSFULLY LINKED YET?
JRST ILISTI ;YES, SO ANALYZE ERROR
PRINT .CHBEL ;NO, SO ECHO A BELL TO TYPIST
JRST .+1] ;GO WAIT FOR TLINK TO SUCCEED (WAIT FOR USER TO TYPE ^C)
ADVLP2: CALL CHKLK1 ;SEE IF TLINK NEEDED (MAYBE OTHER JOB WENT AWAY, WHICH BREAKS LINK)
JRST ADVLOP ;GO GET NEXT CHARACTER
;TX1SKP sees if the last error was due to line being not active.
;
;Returns+1: other error
; +2: TTYX01 was last error
TX1SKP: CALL DGETER ;GET REASON
CAIE A,TTYX01 ;IS LINE NOT ACTIVE?
RET ;OTHER ERROR
RETSKP ;LINE IS NOT ACTIVE
;CHKLNK ATTEMPTS TO ESTABLISH LINKS IF THEY'RE NOT ALREADY ESTABLISHED.
CHKLNK: TLZ Z,F4 ;Assume everything's gonna go OK.
CHKLK1: MOVE B,ADVTNM
MOVE A,[1B2+1B3+.CTTRM] ;TO AND FROM CONTROLLING TTY
TLINK
ERJMPR [CAIN A,TTYX01 ;Failed because Line not active?
JRST CONN1 ; yes, ignore for now
CAIN A,TTMSX2 ;Was it because user has TERMINAL INHIBIT?
TLNE Z,F4 ;Yes, is this the second try?
JRST CJERRE ; yes, or not INHIBIT. Tell user what happened
JRST LKFAIL ] ;Let's try to link once more if we're WHEEL
AOSN DOLNKF ;GIVE ANNOUNCEMENT FIRST TIME
TYPE < [Advising]
>
CONN1: RET
LKFAIL: MOVX A,.FHSLF ;User has INHIBIT set, try to turn it off
RPCAP%
ERJMP INHERR ; shouldn't fail
TXNN C,<SC%WHL!SC%OPR> ;Do we have privs?
JRST CJERRE ; no, tell user we couldn't link and why
MOVE A,ADVTNM ;Get destination terminal number
MOVEI B,.MORTF
MTOPR% ;Read user's terminal inhibit word
ERJMP INHERR ;Couldn't, let user know we tried anyway.
MOVEI B,.MOSTF
TXZ C,MO%NTM ;Reset his TERMINAL INHIBIT bit
MTOPR%
ERJMP INHERR ;Couldn't
TLO Z,F4 ;Remember this is the second attempt
JRST CHKLK1 ;Try, try again!
INHERR: ERROR <Could not advise TTY, couldn't turn off TERMINAL INHIBIT status>
ILISTI: SETOM DOLNKF ;REMEMBER TO RETRY LINK IF WE RECOVER
CALL %GETER
MOVE A,ERCOD
CAIN A,IOX33 ;INPUT BUFFER IS FULL?
JRST ADVLP2 ;RIGHT, ASSUME USER HEARD BELL
CAIN A,TTYX01 ;LINE BECAME INACTIVE AND USER ISN'T A WHEEL?
JRST IS1 ;WHAT A CROCK, STI SHOULD BE FIXED IN MONITOR
;TO MERELY WORK ON INACTIVE LINE. ^C SHOULD
;START JOB, AND OTHER CHARACTERS SHOULD BEEP
;JUST AS THOUGH REAL TYPIST WERE THERE.
CAIE A,DEVX2
CAIN A,DESX2
CAIA
JRST CJERR
IS1: TYPE <
[Destination refused advice]
>
JRST ADVDON
SNCTRL: BIN
MOVE C,B ;GET 7-BIT VERSION OF CHARACTER
ANDI C,177
CAIN C,"("
JRST STCOMM
CAIN C,")"
JRST ENCOMM
CAIN C,"+"
JRST RELINK
CAIN C,"?"
JRST TYPADV
CAIL C,141
CAILE C,172
CAIA ;NOT LOWER CASE LETTER
TRZ B,40 ;LOWER CASE, MAKE UPPER CASE
TRZ B,300 ;MAKE INTO A CONTROL (A BECOMES CTRL/A ETC.)
JRST ADVLP1
;START COMMENT
STCOMM: TYPE <^^(> ;ECHO CHARACTER HE TYPED
TLO Z,F3 ;FLAG NOT TO SEND CHARS
JRST ADVLOP
;END COMMENT
ENCOMM: TLZ Z,F3 ;FLAG TO SEND CHARS AGAIN
JRST ADVLOP
TYPADV: UTYPE [ASCIZ /
CMND EFFECT
---- ------
<CTRL>E Quit
<CTRL>^+ Relink to remote terminal
<CTRL>^( Start comment
<CTRL>^) End comment
<CTRL>^? Type this list
<CTRL>^<CHAR> Send <CTRL><CHAR>
/]
JRST ADVLOP
RELINK: MOVE A,[1B2+1B3+.CTTRM] ;TO AND FROM CONTROLLING TTY
MOVE B,ADVTNM
TLINK ;PUT HIS OUTPUT ON OUR TERMINAL
JRST [ TYPE <
TLINK failure
>
JRST ADVLOP]
TYPE < [Advising]
>
JRST ADVLOP
ESCPSI::SKIPN ADVFLG
DEBRK ;JUST IN CASE
ADVDON: CALL ICLEAR ;DISMISS INTERRUPT TO .+1
CALL DOATI ;FIX ^C AND ^E (DO HERE SO ^C WORKS IF REMOTE IS XOFFED)
CALL FIXON ;FIX PAGE MODE
ADVMES::TYPE <
[Advice terminated]
>
TLNE Z,F4 ;Did we set user's terminal to NO INHIBIT?
JRST [ MOVE A,ADVTNM ; Yes, set it back to INHIBIT
MOVX B,.MORTF
MTOPR% ;Read terminal inhibit word
ERJMP CJERRE ; Shouldn't fail
MOVX B,.MOSTF
TXO C,MO%NTM ;Set TERMINAL INHIBIT bit, leave else the same.
MTOPR% ;Do it
ERJMP CJERRE
JRST .+1 ]
MOVEI Q1,ETTYMD
CALL LTTYMD ;RESTORE TTY MODES
MOVE B,ADVTNM ;GET TERMINAL WE WERE ADVISING
CALL BREAK1 ;BREAK LINKS
SETZM ADVFLG
MOVE A,ADVJFN ;GET SPECIAL JFN AGAIN
CLOSF ;RELEASE IT
ERCAL CJERRE ;SHOULDN'T FAIL
MOVEI A,.PRIIN ;[3054] Clear input buffer after TTY mode change
CFIBF% ;[3054]
ERJMP .+1 ;[3054] Don't care about errors
JRST ERRET ;ERROR RETURN TO TTY MODES RESET
;"LIST" IS WITH "TYPE" BELOW.
;LOGIN COMMAND
;LOGIN (USER) NAME (ACCOUNT) ACCOUNT (SESSION-REMARK) REMARK
;PASSWORD: PASSWORD
.LOGIN::TRVAR <LERRF,LPASP,LOGNO,RCBITS,<LDBLK,GTDLN>,LACCT,LASNLD> ;[4419][4412]
SKIPE CUSRNO
ERROR <You are already logged in>
;DECODE ARGUMENTS
;FIRST ARGUMENT: USER NAME
NOISE <USER> ;SEE COMMENTS ON "SPECEOL" ABOUT "NOISE"
SETZM LERRF ;NO ERROR YET
SETZM FSTLGN ;CLEAR FAST LOGIN FLAG
CALL FSTUSR ;READ USER NAME OR /FAST
JRST [ MOVEM A,LERRF ;FAILED, REMEMBER
MOVEI B,[FLDDB. .CMUSR,CM%PO] ;TRY TO READ PARSE-ONLY NAME
CALL FLDSKP
CMERRX ;IF THAT FAILS, GIVE UP
JRST .+1]
SETOM CEBPTR ;DON'T SAVE THE LOGIN COMMAND FOR COMMAND EDITOR
MOVEM A,RCBITS ;SAVE INFO RETURNED BY "RCDIR"
MOVEM C,LOGNO ;SAVE DIRECTORY NUMBER
CALL NOECHO ;NOISE STUFF WAITS FOR A CHARACTER!
NOISE (PASSWORD)
CALL PASFLD ;READ THE PASSWORD
MOVEM A,LPASP ;REMEMBER POINTER TO PASSWORD
NOISE <ACCOUNT>
MOVEI A,0 ;NO SPECIAL BITS FOR RCDIR
MOVE B,LOGNO ;USER NUMBER
SKIPE LERRF ;USER NAME CORRECT?
JRST LOGIN1 ;NO, SO DON'T TRY TO SET UP ACCOUNT DEFAULT
RCDIR ;GET LOGGED-IN DIRECTORY NUMBER
MOVE A,C ;PUT DIR NUMBER INTO A
MOVE B,LPASP ;GET POINTER TO PASSWORD
MOVEI C,LDBLK ;GET ADDRESS TO USE FOR CRDIR BLOCK
CALL GETDRP ;GET ACCOUNT FOR DEFAULT
JRST LOGIN1 ;FAILED, ASSUME NO DEFAULT
MOVEM A,CMDEF ;USE DEFAULT ACCOUNT AS DEFAULT FOR FIELD
ILDB A,A ;GET FIRST CHARACTER
CAIN A,0
LOGIN1: SETZM CMDEF ;NO DEFAULT
CALL ACCT ;INPUT AND DECODE ACCT # (USES A)
MOVEM A,LACCT ;SAVE FOR LOGIN JSYS
NOISE (SESSION-REMARK)
CALL GSR ;GET SESSION-REMARK
MOVE Q1,A ;SAVE POINTER TO SESSION-REMARK
CONFIRM ;CONFIRM THE WHOLE COMMAND
;LOGIN...
;ALL ARGS DECODED, NOW LOG THE GUY IN
GTAD ;SET UP MAIL WATCH INTERVAL HERE
ADDI A,^D910 ; FOR +5 MINS
MOVEM A,MWATCT ; IN CASE "MESMES" NEVER CALLED
SETOM MESMSF ;SAY TYPE "YOU HAVE A MESSAGE" IF APPROPRIATE,
;EVEN AFTER ^C'S
SKIPE A,LERRF ;ERROR ALREADY?
ERROR <%1?> ;YES, PRINT MESSAGE INSTEAD OF TRYING TO LOG IN
CALL PIOFF ;^C BETWEEN LOGIN AND CUSRNO SETUP WOULD BE EMBARRASING
MOVE A,Q1 ;[3067] Pointer to session remark string
CALL SSR ;[3067] Set the session-remark before LOGIN
MOVE C,LACCT ;ACCT # OR PTR THERETO
MOVE B,LPASP ;PASSWORD PTR
MOVE A,LOGNO ;USER #
MOVE D,C ;GET ACCT STRING
ILDB D,D ;LOOK AT FINAL ACCOUNT
SKIPN D ;HAVE ONE?
SETZM C ;NO. USE NOTHING
MOVEI D,0 ;RESERVE D FOR FUTURE FLAGS
SETZM .CDNLD+LDBLK ;[4412] Clear this
SETZM .CDPED+LDBLK ;[4412] And this
SETZM .CDFPA+LDBLK ;[4412] And this
LOGIN
JRST [ CAIN A,LGINX1
ERROR <Illegal account>
CAIN A,LGINX4
ERROR <Incorrect password>
CALL CJERRE] ;GNRL JSYS ERR RET ROUTINE (XSUBRS.MAC).
MOVEM B,LASNLD ;[4412] Hold onto this for a second
MOVEI B,LDBLK ;GET THE LOGIN DATA BLOCK
MOVEM A,.CDLLD(B) ;SAVE LOGIN DATE AND TIME IN CASE NON WHEEL
MOVEM A,LOGDAT ;[4412] Save date of login
MOVE A,LASNLD ;[4412] Now get last non-interactive login
MOVEM A,.CDNLD(B) ;[4412] And save it
MOVEM C,.CDPED(B) ;[4412] Save password expiration date and time
MOVEM D,.CDFPA(B) ;[4412] Save password fail counts
SETOM SYSMF ;SET FLAG SO SYSTEM MESSAGES WILL GET PRINTED
MOVE B,LOGNO ;WHAT "RCUSR" RETURNED
MOVEM B,CUSRNO ;STORE USER NUMBER
GJINF ;GET LOGGED-IN DIRECTORY NUMBER
MOVEM B,LIDNO ;SAVE IT.
CALL PION ;ALLOW ^C NOW THAT CUSRNO IS SET UP
;LOGIN...
;THE AUTOLOGOUT FOR USE TO GET KILLED HERE, NOW WE MUST KILL OFF THE
;PENDING TIMER CLOCK
MOVE A,[.FHSLF,,.TIMBF] ;DELETE ALL ENTRIES BEFORE GIVEN TIME
MOVE B,[377777,,-1] ;TIME WAY OUT IN THE BOONIES (WON'T
;CLOBBER ANY RUNTIME LIMIT SETTING
SETZ C,
TIMER
JFCL ;DON'T CARE IF NONE PENDING
;Type "Job n on TTYn origin(type) date-time", and last login dates.
MOVE A,.CDLLD+LDBLK ;[4420] Get last interactive login date-time
ETYPE < Job %J on %L %D %E
Last interactive login %1W
> ;[4420] Output usual stuff on TTY
SETO A, ;[4412] This job
HRROI B,A ;[4412] Put last non-interactive time in 1
MOVEI C,.JINLD ;[4412] This is the function
GETJI% ;[4412] Retrieve it
ERJMP NOPEXP ;[4420] If not there, monitor doesn't give it
MOVE A,.CDNLD+LDBLK ;[4420] Get last non-interactive login date
ETYPE < Last non-interactive login %1W
> ;[4420] Output last d-t of non-interactive
;[4420] Output login failures if any, as returned by LOGIN JSYS.
HLRZ B,.CDFPA+LDBLK ;[4420] Any password failures?
IFN. B ;[4412] Are there any?
ETYPE <%% %2Q interactive login failure>
CAIE B,1 ;[4412] Singular?
ETYPE <s> ;[4412] No, say so
ETYPE < since last succesful login
> ;[4412] Be wordy
ENDIF. ;[4412]
HRRZ B,.CDFPA+LDBLK ;[4420] Get non-interactive failures
IFN. B ;[4412] Are there any?
ETYPE <%% %2Q non-interactive login failure>
CAIE B,1 ;[4412] Are we singular?
ETYPE <s> ;[4412] Nope
ETYPE < since last succesful login
> ;[4412]
ENDIF.
;LOGIN...
;[4420] Check password expiration and get new password if current one expired.
MOVEI A,.SFPEX ;[4412] Password expiration turned on?
TMON% ;[4412] Check to see
ERJMP NOPEXP ;[4412] If not in here, then bypass this code
JUMPE B,NOPEXP ;[4420] If not enabled don't bother user
MOVE B,.CDPED+LDBLK ;[4420] Get password expiration date and time
JUMPE B,NOPEXP ;[4412] If no password expiration, continue
JUMPG B,PWECHK ;[4420] Check password expiration if a date
;[4420] Password has expired. Ask for a new one.
ETYPE <
?Your password has expired. Please change your password now.
> ;[4420]
HRROI A,BUF0 ;[4412] Put username here
MOVE B,LIDNO ;[4412] Get logged in directory
DIRST% ;[4412] Put directory string in here
ERJMP .+1 ;[4412]
REPWD: SETZM LDBLK ;[4412] Zero out first word
HRLZI A,LDBLK ;[4412] And now for the source
HRRI A,1+LDBLK ;[4412] Get destination
BLT A,.CDFPA+LDBLK ;[4412] And zero out everything
MOVEI A,[ASCIZ /Old password: /] ;[4412] Prompt for old password
CALL PASSX ;[4412] (A/A) Input the current password
PUSH P,A ;[4412] Save pointer to it here
MOVEI A,[ASCIZ /New password: /] ;[4412] Get new one
CALL PASSX ;[4412] (A/A) Read password
MOVEM A,.CDPSW+LDBLK ;[4412] Save pointer to new password string
MOVEI A,[ASCIZ /Retype new password: /] ;[4412]
CALL PASSX ;[4412] (A/A) Read new password again
MOVE B,.CDPSW+LDBLK ;[4412] Get first attempt at typing it
STCMP% ;[4412] Make sure they're the same
ERJMP .+1 ;[4412]
IFN. A ;[4412] Are they?
POP P,A ;[4412] Restore this
ETYPE <?The two copies of the new password weren't the same> ;[4420]
JRST REPWD ;[4412] Have the user try again
ENDIF. ;[4420] Typed in passwords not the same
;LOGIN...
MOVE A,(P) ;[4414] Get pointer to old password back
MOVE B,.CDPSW+LDBLK ;[4414] And get the one to the new password
STCMP% ;[4414] Are they the same?
ERJMP .+1 ;[4414] Let's be safe
IFE. A ;[4414] Are they the same?
POP P,A ;[4414] Make the stack normal again
ETYPE <?The new password is the same as the old password. Try again.%_> ;[4414]
JRST REPWD ;[4414] And have the user give it another shot
ENDIF. ;[4414]
HRROI A,BUF0 ;[4412] Get directory string again
MOVEI B,LDBLK ;[4412] And get argument block
TXO B,CD%PSW ;[4412] Say we just want to set this
MOVEI C,.CDFPA ;[4412] Length of argument block
MOVEM C,.CDLEN+LDBLK ;[4412] Put it in argument block
POP P,C ;[4412] Get old password string back
CRDIR% ;[4412] Try to change it
IFJER. ;[4414] If error,
ETYPE <?Could not change password - %?. Try again.%_> ;[4414]
MOVEI A,.SFMPL ;[4415] Get minimum password length
TMON% ;[4415] Well
ERJMP REPWD ;[4415] If this fails, don't say anything
JUMPE B,REPWD ;[4415] System manager has not set a minimum password length
ETYPE <Your new password must be at least %2Q character> ;[4415]
CAIE B,1 ;[4415] Only 1 character minimum?
ETYPE <s> ;[4415] No, smart system manager
ETYPE < long.%_> ;[4415]
JRST REPWD ;[4414] And go try again
ENDIF. ;[4414]
JRST NOPEXP ;[4412] Password changed, continue below
;LOGIN...
;Here to check to see if password is within a week of expiring
PWECHK: GTAD% ;[4420][4412] Get current date and time
SUB B,A ;[4412] Find the difference
HLRZS B ;[4412] Just get days
CAILE B,7 ;[4412] Within a week?
IFSKP. ;[4412] If so,
MOVE B,.CDPED+LDBLK ;[4412] Get password expiration date and time
ETYPE < Warning: Your password expires on %2W
> ;[4412] Let user know what is happening
ENDIF. ;[4412]
;Here when all password-expiration work is done.
NOPEXP: MOVE B,RCBITS ;[4412] WHAT RCUSR RETURNED
TXNE B,RC%RLM ;B2 SAYS ALWAYS PRINT LOGIN MESSAGE
SETZM LOGDAT ;SET DATE TO 0 TO FORCE PRINTING
;GET DEFAULT EXEC INPUT FILE
SETOM LOGINI ;SET FLAG TO DO "TAKE INITIAL-LOGIN-TYPIN.TXT"
;AT NEXT OPPORTUNITY.
RET
;SIMULATE "TAKE" COMMAND OF FILSPEC (STRING POINTER IN B)
;SKIPS IFF SUCCEEDS IN SETTING UP STREAM
;COME TO TAKSYS FOR SETTING UP DIRECTORY/FILENAME STRING FOR SYSTEM: COMMAND FILES
;TAKEIN SETS UP FOR USER'S COMMAND FILES
TAKSYS::STKVAR <<TAKBUF,FILWDS>,SPB>
MOVEM B, SPB ;SAVE THE FILENAME STRING
HRROI A, TAKBUF ;PUT STRING HERE
SETZ C,
SOUT
ERJMP CJERR ;SHOULDN'T FAIL
MOVEI C,(GJ%PHY) ;ALLOW SYSTEM-WIDE LOGICALS ONLY
JRST TAKEI2
TAKEIN::STKVAR <<TAKBUF,FILWDS>,SPB>
MOVEM B,SPB ;SAVE STRING POINTER
MOVE B,LIDNO ;GET LOGGED-IN DIRECTORY NUMBER
HRROI A,TAKBUF ;GET STRING SPACE POINTER
CAMN B,[-1] ;DEFAULT?
JRST TAKEI1 ;YES, SKIP DIR
DIRST ;STORE DIR STRING
CALL JERR ;WE JUST SCANNED IT?!
TAKEI1: MOVE B,A
MOVE A,SPB
SETZ C, ;READ TO NULL
SIN ;APPEND TO STRING
TAKEI2: HRROI B,TAKBUF ;GET POINTER TO BEGINNING
CALL TRYGTL ;TRY TO FIND IT.
JRST TAKIN2 ;NO SUCH FILE, GO AWAY QUIETLY
MOVE B,[70000,,OF%RD]
OPENF
JRST [ HRROI B,TAKBUF ;GET POINTER FOR ERROR MESSAGE
LERROR <Can't read %2M%%_%%1?>
HRRZ A,JBUFP
HRRZ A,(A) ;GET SAVED JFN
RLJFN ;RELEASE IT
CALL JERR
HRRZ A,JBUFP
SETOM (A)
RET]
HRL A,A ;PUT INPUT JFN IN LEFT HALF
HRR A,COJFN ;USE SAME OUTPUT AS WERE USING
MOVE B,TAKDEF ;USE DEFAULT SETTINGS
CALL PUSHIO ;SAVE OLD IO STREAM, START NEW ONE
RETSKP ;DOUBLE RETURN WHEN SUCCESSFUL
TAKIN2: RET ;FAILED, TAKE SINGLE RETURN
;SPECEOL
;SUBROUTINE TO HANDLE EOL AS FIELD TERMINATOR IN THE MIDDLE OF A COMMAND
; IN THE SPECIAL MANNER REQUIRED FOR "LOGIN".
;CR NORMALLY TERMINATES COMMAND, DEFAULTING ANY FOLLOWING FIELDS.
;BUT IF P2=EOL AND THIS SUBROUTINE IS CALLED AND A "NOISE"
; MACRO FOLLOWS THE CALL, THE FOLLOWING NOISE WORD IS TYPED
; (AS AFTER ALT MODE), PARENTHESIZED TEXT IS IGNORED (AS AFTER SPACE),
; AND FIELD IS INPUT NORMALLY, NOT DEFAULTED.
;THIS UNWRITTEN ROUTINE SHOULD SOMEHOW ALLOW CARRIAGE RETURN
;IN THE MIDDLE OF COMMANDS, SUCH THAT THE GUIDE WORDS FOR THE NEXT
;FIELD COME OUT ON THE NEW LINE, AS THOUGH THE CR WAS $. BEWARE
;OF THE FOLLOWING PITFALLS OF THIS:
;1) ON REPARSE, GUIDEWORDS ARE ALREADY IN BUFFER, SO SOMEHOW
; REPARSED CR SHOULD DO NOTHING. NOTE THAT REPARSED $ IS
; NONEXISTANT, AS $ CAUSES ACTION BUT DOESN'T STAY IN
; BUFFER. YOU CAN'T AFFORD NOT TO LEAVE CR IN BUFFER,
; BECAUSE ^R AND RUBOUT WON'T WORK CORRECTLY, ESPECIALLY
; ON SCREEN TERMINALS.
;2) IF THE CR PROVOKED GUIDEWORDS ARE IMPLEMENTED AS PROMPTS,
; RUBBING OUT WON'T WORK. USER WILL JUST GET A DING.
;3) MOST DESIRABLY, CR IN THE MIDDLE OF COMMANDS SHOULD WORK
; FOR ALL COMMANDS, NOT JUST SPECIAL ONES LIKE LOGIN,ATTACH.
; THIS CREATES A PROBLEM WITH CASES WHERE A FIELD HAS A
; DEFAULT VALUE. CONSIDER THE AMBIGUITY UPON SEEING
; CR: DOES THE CR MEAN DEFAULT THE FIELD VALUE, OR
; TYPE THE GUIDEWORDS. FOR INSTANCE, SHOULD "DIRECTORY<CR>"
; TYPE "(OF FILES)", OR DEFAULT THE FILE SPEC TO *.* AND
; TAKE OFF?
RET
;USERN
;INPUT USER NAME SUBR
;USED BY "LOGIN" AND "ATTACH".
;RETURNS RCUSR'S RETURNED INFO IN A,B,C.
;SKIPS, BUT NOT IF BAD NAME TYPED, IN WHICH CASE A CONTAINS ERROR CODE
USERN: USERX <User name>
USERNR: JRST [ CALL %GETER ;FAILED, FIND OUT WHY
MOVE A,ERCOD ;RETURN ERROR IN A
RET]
REGUSR: CALL BUFFF ;BUFFER IT RIGHT FOR JSYS, PUT PTR IN A
MOVE B,A
MOVSI A,(RC%EMO) ;SAYS NO RECOGNITION
RCUSR ;STRING TO DIRECTORY # TRANSLATION
RETSKP
;READ USER NAME OR /FAST FOR LOGIN COMMAND
FSTUSR: MOVX A,.SFXEC ;GET EXEC FLAGS WORD
TMON ;GET THE WORD
ERJMP USERN ;.SFXEC PROBABLY NOT IN MONITOR
TXNE B,XC%FST ;ARE FAST LOGINS ALLOWED ?
JRST USERN ;NO. ONLY EXCEPT USER NAME
MOVEI B,[FLDDB. .CMUSR,CM%SDH,,<User name>,,[
FLDDB. .CMSWI,CM%SDH!CM%DPP,FASTAB,</FAST to get to command level quickly after LOGIN>,<FAST>]]
CALL FLDSKP ;PARSE THIS MESS
JRST [CAIN B,NPXNOM ;GOT A SWITCH OR KEYWORD ERROR ?
CMERRX ;YES. BLOW UP FROM BAD SWITCH
JRST USERNR] ;NO. USER NAME ERROR
LDB C,[POINT 9,0(C),8] ;FIGURE OUT WHAT WAS TYPED
CAIN C,.CMUSR ;USER NAME ?
JRST REGUSR ;YES - CONVERT TO USER #
SETOM FSTLGN ;FLAG THE FAST LOGIN
NOISE (USER)
CALL USERN ;NOW GET USER NAME
RET ;FAILED
RETSKP
FASTAB: TABLE
[ASCIZ/FAST/],,0
TEND
;ACCT
;ROUTINE TO INPUT ACCOUNT STRING, RETURNS SUITABLE ARG
;FOR LOGIN OR CACCT JSYS.
;USED IN ACCOUNT, CHANGE, LOGIN COMMANDS.
ACCT:: ACCTX <Account name>
CMERRX
JRST BUFFF ;STRING CASE. SAVE IN BUFFER.
;PASWD
;SUBROUTINE TO INPUT PASSWORD FOR "LOGIN", "ATTACH", AND "CONNECT".
;HANDLES HALF AND FULL DUPLEX CASES.
;BUFFERS IT FOR USE AS A JSYS ARGUMENT AND RETURNS BYTE PTR IN A.
PASLIN::MOVEI A,[ASCIZ /Password: /]
PASSX:: MOVEI C,1
SETOM CEBPTR ;DON'T SAVE PASSWORD FOR COMMAND EDITOR
CALL NOECHO ;PROMPT TYPER LOOKS AT ONE INPUT CHARACTER SO TURN OFF ECHOING FIRST
UPROMPT @A ;TYPE PROMPT
CALL PASWD ;SPR 13716
CONFIRM ;SPR 13716
RET ;SPR 13716
PASFLD::TDZ C,C ;FOR A PASSWORD FIELD, NO CRLF WANTED (IE LOGIN)
PASWD:: CALL NOECHO ;MAKE SURE ECHOING OFF
CALL CHKPTY ;SKIP IF NOT A PTY
JRST PASWDF ;PTY - HANDLE FULL DUPLEX CASE ONLY
MOVE A,CIJFN
RFMOD ;READ TTY MODE
TRNE B,1B32 ;SKIP IF FULL DUPLEX
JRST PASWD1
;FULL DUPLEX CASE
;DON'T ECHO PASSWORD FIELD, DO ECHO TERMINATOR
PASWDF: CALL INPPAS ;INPUT THE PASSWORD
CALL DOECHO ;NOW WE WANT ECHOING ON
CALL GETTER ;GET THE TERMINATING CHARACTER
CAIE A,.CHCRT ;END OF LINE?
CAIN A,.CHLFD
CAIA ;YES
JRST PSWDF1 ;NO
MOVE A,CIJFN ;YES, SEE IF IT GOT ECHOED
RFPOS
TRNE B,-1 ;ARE WE AT COLUMN 1?
ETYPE <%_> ;NO, TYPE A CRLF
PSWDF1: CALLRET BUFFF ;BUFFER PASSWORD AND CHECK IT IF POSSIBLE
;PASWD...
;HALF DUPLEX CASE
;USE SEPARATE LINE, TYPE MASK FIRST
PASWD1: TYPE <
>
UPROMPT [BYTE (7)130,130,130,130,130,130,130,130,130,15
BYTE (7)127,127,127,127,127,127,127,127,127,15
BYTE (7)115,115,115,115,115,115,115,115,115,15
BYTE (7)15,15,0]
;PASSWORD MASK, OVERLAYED X, W, M, AND GARBAGE
CALL INPPAS ;INPUT THE PASSWORD
CALL DOECHO ;MAKE SURE ECHOING IS TURNED ON NOW
PRINT CR ;SET TO OVERPRINT SAME LINE
TYPE <Thank you ... >
ETYPE <%_>
ETYPE <%_>
CALLRET BUFFF ;BUFFER AND MAYBE CHECK PASSWORD
;ROUTINE TO INPUT THE PASSWORD
INPPAS: JUMPE C,INPP1 ;DO THIS ONLY IF CRLF IS NEEDED
STKVAR <SAVFLG,SAVPTR>
MOVE A,CMFLG
MOVEM A,SAVFLG ;SAVE FLAGS IN CASE REPARSE IS NEEDED
MOVE A,CMPTR
MOVEM A,SAVPTR
CRRX <Password> ;HAVE TO TRY CR SO COMND DOESN'T RETYPE "PASSWORD:" IF HE TYPES NULL PASSWORD
JRST INPP1 ;NOT NULL PASSWORD
MOVE A,SAVFLG ;UNPARSE THE CARRIAGE RETURN
MOVEM A,CMFLG ;CALLERS WILL PARSE CONFIRM AFTER PASSWORD
MOVE A,CMPTR ;SEE WHERE WE ARE ON LINE NOW
MOVE B,SAVPTR ;SEE WHERE WE WERE AT BEGINNING OF LINE
MOVEM B,CMPTR ;RESET FIELD POINTER TO BEGINNING OF LINE
CALL SUBBP ;GET NUMBER OF CHARACTERS WE WANT TO BACK UP
ADDM A,CMINC ;INCREASE NUMBER OF UNPARSED CHARACTERS
ADDM A,CMCNT ;SHOW INCREASE IN SPACE LEFT
SETZM ATMBUF ;DENOTE NULL PASSWORD
RET
INPP1: MOVE Q3,[ASCIZ /PSWD/] ;SET FLAG IN Q3
WORDX <Password> ;READ NON-NULL PASSWORD
CMERRX
RET
;MESMES
;SUBROUTINE TO TYPE "YOU HAVE A MESSAGE" IF FLAG "MESMSF" IS ON AND
;THERE IS A MESSAGE FILE IN CONNECTED DIRECTORY.
;USED IN LOGIN, MAIN LOOP. CLOBBERS A,B,C.
MESMES::SKIPN CUSRNO
JRST MESMS9 ;IGNORE IF NOT LOGGED IN
SKIPE BATCHF ;DON'T CHECK FOR MESSAGES IN BATCH (TO SAVE TIME)
JRST MESMS9 ;YES, SKIP MESSAGES
CALL CHKDAL ;NOTE OVER ALLOCATION IN PRESENT FIRST
HRLOI B,377777 ;SET INF COUNT FOR US
MOVEM B,MWATN0
MOVE B,POBXNO ;[3040] SET UP FOR MAIL CHECK FOR THIS USER
CALL MALCHK ;DO MAIL CHECK
JRST MESMS9 ;NO MAIL
TYPE < You have >
TLNN B,77 ;CHECK NETWORK MAIL FLAG
TYPE <net >
ETYPE <mail %1\%%_%>
MOVE A,COJFN
DOBE ;WAIT FOR IT TO REALLY PRINT
GTAD ;SET UP NEXT LOOK TIME
ADDI A,^D910 ; FOR +5 MINS
MOVEM A,MWATCT
MESMS9: SETZM MESMSF ;CLEAR FLAG SO IT WONT BE REPEATED
RET
;CHKPTY - SKIPS IF NOT RUNNING ON PSEUDO-TELETYPE
CHKPTY::PUSH P,A
PUSH P,B
PUSH P,C
PUSH P,D
SETZ D,
GTB .PTYPA ;GET PSEUDO TTY PARMS
HRRZ D,A ;SAVE FIRST PTY NUMBER
PUSH P,D ;FIRST PTY ON STACK
HLRZ A,A ;NUMBER OF PTY'S
ADDI D,(A) ;LAST PTY NUMBER PLUS ONE
MOVNI A,1
MOVE B,[XWD -1,C] ;1 WORD INTO C
MOVEI C,.JITNO ;READ TERMINAL NUMBER
GETJI
CALL JERR
POP P,A ;RESTORE FIRST PTY NUMBER
CAML C,A ;ARE WE A PTY? (DET IS -1)
CAML C,D
AOS -4(P) ;NO, SKIP
POP P,D
POP P,C
POP P,B
POP P,A
RET
;TRYGTJ
;TAKES: B: POINTER TO STRING FOR GTJFN
;RETS: +1: NO SUCH FILE
; +2: JFN IN A
;USED IN "MESS", AND IN "LOGIN" WITH REGARD TO PRIVATE MESSAGES.
TRYGTS::PUSH P,B ;THIS IS CALLED FROM CTRL/E-SPEAK
PUSH P,A
MOVSI A,(GJ%FOU!GJ%SHT!GJ%PHY)
JRST TRYGT1
TRYGTO::PUSH P,B
PUSH P,A
MOVSI A,(GJ%FOU!GJ%SHT)
JRST TRYGT1
TRGTV1::PUSH P,B
PUSH P,A
MOVE A,[GJ%OLD!GJ%SHT+1] ;OLD FILE, SHORT CALL, VERSION 1
JRST TRYGT1
TRYGTL: PUSH P,B
PUSH P,A
MOVSI A,(GJ%OLD!GJ%SHT!GJ%ACC) ;OLD FILE, SHORT, NO ACCESS
CAIN C,(GJ%PHY) ;WANT SYSTEM LOGICALS ONLY?
MOVSI A,(GJ%OLD!GJ%SHT!GJ%ACC!GJ%PHY) ; YES, TELL GTJFN
SETZ C, ;RESET FOR USER CASE
JRST TRYGT1
TRYGTJ::PUSH P,B
PUSH P,A
MOVSI A,(GJ%OLD!GJ%SHT) ;OLD FILE ONLY AND SHORT FORM
TRYGT1: CALL GTJFS ;ASSIGN JFN USING STRING POINTER IN B
JRST [ POP P,A ;LOSE, ERROR RETURN
JRST TRYG9]
SUB P,[XWD 1,1] ;FORGET SAVED A
AOS -1(P) ;SKIP
TRYG9: POP P,B
RET
;LOGOUT
.LOGOU::SKIPE LGORET ;ARE WE ALREADY TAKING LOGOUT.CMD?
JRST ERRFIN ;YES. CAN'T SAY "LOGOUT" IN LOGOUT.CMD (MUCH LOOPING)
MOVE A, TAKLEN ;WE NEED TO GET OUR CURRENT I/O (TAKE FILE) LEVEL
MOVEM A, SAVTAK ;AND SAVE IT FOR LATER
SETZM FSTOUT ;INIT FAST LOGOUT FLAG
SKIPN CUSRNO ;LOGGED IN?
IFNSK.
CONFIRM ;REQUIRE CONFIRM
JRST LOGOU1
ENDIF.
MOVEI B,[FLDDB. .CMNUM,CM%SDH,12, <Job number, to log out another job >,,[
FLDDB. .CMCFM,CM%SDH,,<Carriage return, to log out this job >,,[
FLDDB. .CMSWI,CM%SDH!CM%DPP,FLOTAB,</FAST to log out this job quickly >, <FAST>]]]
CALL FLDSKP
CMERRX
LDB C,[POINT 9,0(C),8]
CAIN C,.CMSWI ;GOT A SWITCH?
JRST LGOFS1 ;YES,SET UP FOR FAST LOGOUT
CAIN C, .CMCFM ;CARRIAGE RETURN?
JRST LOGOU1 ;YES, LOG OUT THIS JOB
MOVE A,B ;PUT JOB NUMBER IN A
JRST ..LOGO ;GO LOG OUT REMOTE JOB
LOGOU1: XTND,<
CALL BLANK1 ;CLEAR SCREEN
CALL DWNPNT ;TELL USER WHEN SYSTEM WILL GO DOWN
>
SKIPN CUSRNO
JRST LOGOU2
SKIPE FSTOUT ;USER WANT FAST LOGOUT?
JRST LGOFST ;YES, BYPASS .CMD FILES
;SEE IF THERE'S A SYSTEM:LOGOUT.CMD, THEN TRY FOR USER'S LOGOUT.CMD
SETOM LGORET ;SET THE "TAKING LOGOUT.CMD" FLAG
HRROI B, [ASCIZ/SYSTEM:LOGOUT.CMD/]
CALL TAKSYS ;SEE IF IT'S THERE
CAIA ;PROBABLY NO SUCH FILE
CALL CMDOUT ;IT'S THERE, GO DO IT
HRROI B, [ASCIZ "LOGOUT.CMD"]
CALL TAKEIN ;SEE IF USER'S LOGOUT.CMD IS THERE
CAIA ;GUESS THEY DON'T HAVE ONE
CALL CMDOUT ;IT'S THERE - GO DO IT
SETZM LGORET ;DONE WITH LOGOUT.CMD FILES - RESET THE FLAG
LGOFST: GJINF ;GET CONNECTED DIRECTORY NUMBER
CAMN B,LIDNO ;DIFFERENT FROM LOGGED-IN ONE?
JRST LOGOU3 ;NO SO DON'T BOTHER EXPUNGING CONNECTED DIR
LDF A,DD%DTF ;FLUSH TEMPORARY FILES
DELDF ;EXPUNG CONNECTED DIR
ERJMP [TYPE <%Warning -- EXPUNGE failed, continuing...>
ETYPE <%_>
JRST .+1]
CALL CHKDAL ;NOW CHECK IT
LOGOU3: MOVE B,LIDNO ;GET LOGGED-IN DIRECTORY NUMBER
LDF A,DD%DTF ;FLUSH TEMPORARY FILES ALSO
DELDF
ERJMP [TYPE <%Warning -- EXPUNGE failed, continuing...>
ETYPE <%_>
JRST .+1]
MOVE A,LIDNO
GTDAL ;GET USAGE/ALLOCATION
ERJMP [TYPE <%Warning -- Disk allocation info not available...>
ETYPE <%_>
JRST LOGOU2]
JUMPE B,LOGOU2 ;CAN'T BE OVER IF USAGE=0
SUB B,C ;SUBTRACT PERMANENT ALLOCATION FROM USAGE
JUMPLE B,LOGOU2 ;EXCEEDED?
ETYPE < <%N> Over permanent storage allocation by %2Q page(s).
>
LOGOU2: TLO Z,LOGOFF ;SAY LOGGING OUT (TELLS ERROR AND ^C
;ROUTINES TO SAY "NOT LOGGED OUT AFTER ALL").
MOVE A,COJFN
DOBE ;WAIT TO GIVE HIM MAXIMUM CHANCE TO ^C.
;SET MAP TO "USER"
SETO A, ;SAY IT'S SUICIDE
LGOUT
CALL CJERR
;DOESN'T RETURN ON SUCCESS
;HERE TO SET UP IF /FAST SWITCH SEEN - USER DOESN'T WANT LOGOUT.CMD FILES TAKEN
LGOFS1: CONFIRM
SETOM FSTOUT ;SET THE "FAST LOGOUT" FLAG
JRST LOGOU1 ;AND CONTINUE LOGOUT PROCESS
FLOTAB: TABLE
[ASCIZ/FAST/],,0
TEND
;"MERGE" IS WITH "GET" ABOVE.
;'PUSH' = 'PUSH EXEC' (FORMERLY 'EXEC')
;STARTS AN EXEC IN INFERIOR FORK SEPARATE FROM 'FORK'
.PUSH:: NOISE (COMMAND LEVEL)
CONFIRM
HRROI B,[ASCIZ /DEFAULT-EXEC:/]
CALL TRYGTJ ;LOOK FOR THE DEFAULT EXEC; STACK THE JFN
JRST [ HRROI B,[GETSAVE(<SYSTEM:EXEC.>)]
CALL TRYGTJ ;FAILED - JUST GET SYSTEM EXEC
ERROR <EXEC not found>
JRST .+1]
PUSH P,A
MOVSI A,(1B1) ;XMIT CAPS
CFORK
CALL CJERR
MOVEM A,EFORK
POP P,A
HRL A,EFORK
CALL DOGET ;DO THE GET
CALL CJERRE ;FAILED
MOVE A,EFORK
SETZ B,
SFRKV
ERJMP CJERRE
WFORK
RFSTS
MOVE C,A
MOVE A,EFORK
SETZM EFORK
KFORK
CAME C,[1B0+2B17]
CAMN C,[2B17] ;VOLUNTARY TERMINATION IS NORMAL
RET
ERROR <PUSH terminated abnormally - Fork status = %3O, PC = %2P>
;'POP' = 'POP EXEC' - POP TO HIGHER LEVEL EXEC
.POP:: NOISE (COMMAND LEVEL)
CONFIRM
CALL INFER ;TEST FOR EXISTENCE OF SUPERIOR FORK
ERROR <No higher command level>
JRST QUIT2 ;GO DO HALTF, ETC.
;QUIT: EXIT TO SUPERIOR EXEC OR OTHER PROGRAM.
;IF TOP-LEVEL FORK, LEGAL ONLY FOR ENABLED WHEELS OR OPERS.
.QUIT:: CALL INFER ;SKIP IF INFERIOR
JRST [ MOVX B,WHLU+OPRU
SKIPE PRVENF
CALL PRVCK
ERROR <Not legal in top-level EXEC>
JRST .+1]
QUIT2: MOVE A,SAVT20 ;GET STATE BEFORE WE RAN
CALL SETMOD ;RESTORE IT
MOVE A,SAVNAM ;GET SAVED PROGRAM NAME
SETNM ;RESTORE IT
HALTF
JRST REE ;IN CASE OF RETURN FROM MINI-EXEC
;INFERIORNESS TEST SUBROUTINE: SKIP IF THIS FORK HAS A SUPERIOR
;USED IN LOGOUT, QUIT, ^E EDDT.
INFER:: ATSAVE
MOVEI 1,.FHTOP ;SAY TOP FORK
SETZ 2, ;SAY NO HANDLES OR STATUS
MOVEI 3,1(P) ;SAY BUILD STRUCTURE ON STACK
HRLI 3,-4 ;BUT 4 WORDS MAX
ADD P,[4,,4] ;MAKE ROOM ON STACK
GFRKS ;GET 'STRUCTURE' OF TOP FORK
CALL [ CAIE 1,GFKSX1 ;RAN OUT OF SPACE?
JRST JERR ;NO, STRANGE
RET] ;YES, WE EXPECT THAT
HRRZ 1,1(3) ;GET HANDLE OF TOP FORK
SUB P,[4,,4] ;CLEAR STACK
CAIN 1,.FHSLF ;IS IT SELF?
RET ;YES, WE ARE TOP AND HAVE NO SUPERIOR
RETSKP ;NO, WE ARE AN INFERIOR
;RECEIVE and REFUSE (LINKS/ADVICE/SYSTEM-MESSAGES)
; Can also get here from [SET] TERMINAL [NO] RECEIVE ...
; If so, F1 is on (see .TERNO routine) if the user typed NO.
; If F1 is on, do a REFUSE since the user typed NO RECEIVE.
.RECEI::TLNE Z,F1 ;DID USER SAY "NO RECEIVE" ?
SKIPA ;YES, IMPLIED REFUSE
TLZA Z,F4 ;SAY RECEIVE CMD AND SKIP .REFUS
.REFUS::TLO Z,F4 ;IF REFUSE, SAY SO.
SETZB Q1,Q2 ;ACCUMULATE LINKS/ADVICE BITS HERE
KEYWD $LNADV
T LINKS,,.RELNK
JRST CERR
CALL (P3)
CONFIRM ;GET CONFIRMATION
RECREF: TLZE Z,F2 ;USE MTOPR OR TLINK ?
JRST .REMTO ;MTOPR
MOVE A,Q1 ;GET THE BITS
HRRI A,.CTTRM
TLINK
CALL JERR
JRST CMDIN4
;Common code for REFUSE
.REMTO: MOVE B,Q1 ;GET THE FUNCTION
MOVE C,Q2 ;GET THE VALUE
MOVEI A,.CTTRM
MTOPR ;DO IT
ERCAL CJERRE ;COULDN'T
RET
;Here to get terminal flags. RTFLG1 can be called with a terminal number in A.
RTTFLG::MOVEI A,.CTTRM
RTFLG1::MOVEI B,.MORTF ;READ TERMINAL FLAGS
MTOPR ;DO IT
ERJMP R
RETSKP
$LNADV: TABLE
T ADVICE,,.READV
T LINKS,,.RELNK
T SYSTEM-MESSAGES,,.RESYS
T USER-MESSAGES,,.REUSR
TEND
;User-messages
.REUSR: CALL RTTFLG ;RETURN EXISTING TERMINAL FLAGS
JRST [CONFIRM
ERROR <The USER-MESSAGES function is not implemented>]
MOVE Q2,C
TXZ Q2,MO%NUM ;SET RECEIVE USER MESSAGES
TLNE Z,F4 ;BUT SHOULD IT REALLY BE REFUSE ?
TXO Q2,MO%NUM ;YES. TURN BIT ON.
TLO Z,F2 ;FLAG THE NEED TO USE MTOPR, NOT TLINK
MOVEI Q1,.MOSTF ;FUNCTION CODE FOR SETTING TERMINAL FLAGS
RET
;System-messages
.RESYS: MOVEI Q1,.MOSNT ;FUNCTION CODE FOR CONTROLLING MESSAGES
MOVEI Q2,.MOSMY ;SET RECEIVE BY DEFAULT
TLNE Z,F4 ;BUT SHOULD IT REALLY BE REFUSE ?
MOVEI Q2,.MOSMN ;YES
TLO Z,F2 ;FLAG THE NEED TO USE MTOPR, NOT TLINK
RET
;Advice
.READV: TLO Q1,(TL%STA) ;ADVISE "ENABLE" BIT
TLNE Z,F4 ;RECEIVE?
RET ;NO - ENABLE BIT AND "ADVICE" OFF
TLO Q1,(TL%SAB!TL%AAD!TL%ABS) ;ENABLE BITS AND "ADVICE AND LINKS" ON
NOISE <AND LINKS>
RET
;Links
.RELNK: TLO Q1,(TL%SAB) ;LINK "ENABLE" BIT
TLNE Z,F4 ;RECEIVE ?
JRST [NOISE <AND ADVICE> ;NO. REFUSE, SO ADVICE IS IMPLICIT
RET]
TLO Q1,(TL%ABS) ;YES. ENABLE BIT AND "LINK" BIT ON
RET
;RENAME (EXISTING FILE) <NAME> (TO BE) <NAME>
.RENAM::SETOM TYPGRP ;TYPE ALL FILES
NOISE <EXISTING FILE>
CALL INFGNS ;GET INPUT FILE GROUP WITH NO SEARCH
NOISE <TO BE>
CALL MFOUT ;GET MULTI FILE OUTPUT TERM
CONFIRM
HLRZ A,JBUFP
CAIL A,-2 ;WILL NEED 2 MORE FOR PROCESSING
ERROR <Too many JFNs in command>
MOVE A,JBUFP
MOVEM A,.JBUFP ;SAVE THESE JFNS
RENAM1: CALL RLJFNS ;RELEASE ALL TEMPORARY JFNS
CALL NXFILE ;CHECK FOR NON-EX FILE TERM
JRST RENAM2
CALL TYPIF ;TYPE INPUT NAME IF GROUP
SETZM A ;NOT COPYING FILES
CALL MFSET ;SET UP OUTPUT TERM
JRST [ CALL GNFIL ;ERROR, MESSAGE ALREADY PRINTED
SETZM INIFH1 ;CLEAR WHEN NO MORE
JRST RENAM2]
CALL MFINP ;GET SECOND JFN ON INPUT JFN
JRST RENAM2
HRRZ B,OUTDSG ;GET OUTPUT DESCRIPTOR
RNAMF ;RENAME FILE
ERJMP [LERROR <%1?> ;TELL USER WHY IT FAILED
JRST RENAM2] ;GO ON TO NEXT FILE
CALL TYPOK
RENAM2: SKIPE INIFH1 ;DID LAST GNFIL HIT END?
JRST RENAM1 ;NO
RET
;REQUEST A FILE BE RETRIEVED FROM OFFLINE STORAGE
.RETRI::STKVAR <NRETR>
NOISE <FILES>
MOVE A,[XWD -1,0] ;NO DEFAULT NAMES
HRLI B,0 ;DEFAULT VERSION IS 0
HRRI B,(GJ%OLD+GJ%IFG+GJ%NS+1B15+1B16+CF%NS)
TXO Z,IGINV ;FIND INVISIBLE FILES
CALL SPECFN
JRST CERR ;NO "STUFF,"
TXZ Z,IGINV
RETRI2: SETOM TYPGRP ;ALWAYS TYPE NAME
MOVE A,COJFN
MOVEM A,OUTDSG
MOVE A,JBUFP
MOVEM A,.JBUFP
SETZM NRETR ;KEEP TRACK OF HOW MANY RETRIEVED
RETRI3: CALL RLJFNS
CALL NXFILE
JRST RETRI4
CALL MFINP ;GET 2ND JFN
JRST RETRI4 ;FAILED
MOVE B,[1,,.FBCTL]
MOVEI C,C ;FIND OUT IF FILE IS OFFLINE
GTFDB
ERJMP RETRI4 ;SKIP FILE IF CAN'T FIND OUT
TXNN C,FB%OFF ;IS IT OFFLINE?
JRST RETRI4 ;NO, CAN'T POSSIBLEY RETRIEVE IT
ETYPE < %1S> ;TYPE FILE NAME - SHOULD USE TYPIF
;BUT NXFILE MAY HAVE STEPPED US OFF
;THE END CAUSING TYPIF TO LOSE BIG
MOVEI B,.ARRFR ;REQUEST TO RETRIEVE IT
SETZ C, ;NO FLAGS
ARCF
ERJMP [ETYPE < %?
>
JRST RETRI4]
CALL TYPOK
AOS NRETR ;REMEMBER HOW MANY
RETRI4: SKIPE INIFH1 ;DONE THEM ALL?
JRST RETRI3 ;NO, LOOP
SKIPN NRETR ;DON'T BE TOO QUIET IF NOTHING DONE
ETYPE <%%No files found for retrieving%_>
RET
;SEND (MESSAGE) TO SPECIFIC USER ON THE SYSTEM (UNPRIVILEGED)
.USEND::SKIPE PRVENF ;ENABLED?
JRST .SEND ;YES - BEHAVE THE SAME AS ^ESEND
NOISE (TO)
MOVEI B,[FLDDB. .CMSWI,CM%SDH,NODTAB,</NODE to send to a remote system>,,[
FLDDB. .CMUSR,CM%SDH,,<User name or Terminal number>,,[
FLDDB. .CMNUM,CM%SDH,8,,,[
FLDBK. .CMFLD,CM%SDH,,,,[BRMSK. USRB0.,USRB1.,USRB2.,USRB3.]]]]] ;[7.1160]
CALL FLDSKP ;GET THE TO FIELD
CMERRX ;CAN'T
TRVAR <SNDPT,SNDPTC,SNDLNO,USRNO,SAVP,SNDNOD,SNDMSK,<USNAM,10>> ;[7.1135]
SETZM USNAM ;[7.1135] Say we don't have arbitrary string
SETZM SNDNOD ;[7.1076] Indicate local send in progress for now
SETZM SNDMSK ;[7.1076] Init node mask for send all
LDB C,[POINT 9,0(C),8] ;FIGURE OUT WHAT WAS TYPED
CAIE C,.CMSWI ;[7.1076] Was it a switch?
IFSKP. ;[7.1076] Yes,
CALL VALNOD ;[7.1076] (A/A,B,C) Get valid CI node name
TXO B,TT%REM ;[7.1076] Indicate send will be remote
MOVEM B,SNDNOD ;[7.1076] Save the node to send to
MOVEM C,SNDMSK ;[7.1076] Save node mask
MOVEI B,[FLDDB. .CMUSR,CM%SDH,,<User name or Terminal number>,,[
FLDDB. .CMNUM,CM%SDH,8,,,[
FLDBK. .CMFLD,CM%SDH,,,,[BRMSK. USRB0.,USRB1.,USRB2.,USRB3.]]]] ;[7.1160]
CALL FLDSKP ;[7.1076] (A,B/A,B) Now continue to parse
CMERRX ;[7.1076] Slap the user's wrist
LDB C,[POINT 9,0(C),8] ;[7.1076] Get function parsed
ENDIF. ;[7.1076]
CAIE C,.CMUSR ;GOT A USER NAME ?
IFSKP.
MOVEM B,USRNO ;SAVE THE USER NUMBER
MOVEI B,-1 ;NOTE USER NAME WITH -1 IN RIGHT HALF ONLY
ENDIF.
CAIE C,.CMFLD ;[7.1135] Non-local user name?
IFSKP. ;[7.1135] If so,
HRROI A,USNAM ;[7.1135] Save user name string here
HRROI B,ATMBUF ;[7.1135] User name string is here now
MOVEI C,^D39 ;[7.1135] Don't transfer more than this
SETZ D, ;[7.1135] End on null
SOUT% ;[7.1135] Move string
ERJMP .+1 ;[7.1135] Just another FATCDP
LDB A,[POINT 7,USNAM,6] ;[7.1160] Get me a character
SKIPN A ;[7.1160] Did this field parse reasonably?
ERROR <Invalid username> ;[7.1160] No, it didn't
MOVEI B,-1 ;[7.1135] Say we have user name
SETZM USRNO ;[7.1135] But say it is not local
JRST USEND1 ;[7.1160] And go on
ENDIF. ;[7.1135]
CAIE C,.CMNUM ;LINE # ?
IFSKP.
SKIPL B ;CHECK FOR BIT 0
CAIL B,-1 ;LESS THAN 777777
ERROR <Invalid terminal number> ;NO OR BIT 0 ON
ENDIF.
USEND1: SETZM SNDPT ;[7.1160] Say no pointer to end of header
SETZM SNDPTC ;SAY NO POINTER TO HEADER STRING
MOVEM B,SNDLNO ;SAVE LINE NUMBER
MOVE A,[POINT 7,BUF0] ;GET POINTER TO STRING BUFFER
HRROI B,[ASCIZ /
[/]
CALL SAPPND ;BEGIN THE MESSAGE
JRST SENDD0 ;JUMP INTO ^ESEND CODE
;^ESEND (MESSAGE) TO ALL ON SYSTEM
.SEND:: NOISE (TO)
MOVEI B,[FLDDB. .CMSWI,CM%SDH,NODTAB,</NODE to send to a remote system>,,
[FLDDB. .CMUSR,CM%SDH,,<User name or Terminal number>,,
[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /*/]>,,,
[FLDDB. .CMNUM,CM%SDH,8,,,
[FLDBK. .CMFLD,CM%SDH,,,,[BRMSK. USRB0.,USRB1.,USRB2.,USRB3.]]]]]] ;[7.1160]
CALL FLDSKP ;GET THE TO FIELD
CMERRX ;CAN'T
TRVAR <SNDPT,SNDPTC,SNDLNO,USRNO,SAVP,SNDNOD,SNDMSK,<USNAM,10>> ;[7.1135]
SETZM USNAM ;[7.1135] Say we haven't done arbitrary string
SETZM SNDNOD ;[7.1076] Start out as a local send
SETZM SNDMSK ;[7.1076] Init send node mask
LDB C,[POINT 9,0(C),8] ;FIGURE OUT WHAT WAS TYPED
CAIE C,.CMSWI ;[7.1076] Did user type /NODE?
IFSKP. ;[7.1076] If so,
CALL VALNOD ;[7.1076] (A/A,B,C) Parse CI node name
TXO B,TT%REM ;[7.1076] Indicate remote send in progress
MOVEM B,SNDNOD ;[7.1076] Save parsed CI node number, and continue parsing
MOVEM C,SNDMSK ;[7.1076] Save node mask too
MOVEI B,[FLDDB. .CMUSR,CM%SDH,,<User name or Terminal number>,,
[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /*/]>,,,
[FLDDB. .CMNUM,CM%SDH,8,,,
[FLDBK. .CMFLD,CM%SDH,,,,[BRMSK. USRB0.,USRB1.,USRB2.,USRB3.]]]]] ;[7.1160]
CALL FLDSKP ;[7.1076] Get destination
CMERRX ;[7.1076] Can't
LDB C,[POINT 9,0(C),8] ;[7.1076] Now get typed function
ENDIF. ;[7.1076]
CAIE C,.CMUSR ;GOT A USER NAME ?
IFSKP.
MOVEM B,USRNO ;SAVE THE USER NUMBER
MOVEI B,-1 ;NOTE USER NAME WITH -1 IN RIGHT HALF ONLY
ENDIF.
CAIE C,.CMFLD ;[7.1135] J-Random string?
IFSKP. ;[7.1135] If so,
HRROI A,USNAM ;[7.1135] Transfer string to here
HRROI B,ATMBUF ;[7.1135] Get it from here
MOVEI C,^D39 ;[7.1135] Don't transfer more than biggest name
SETZ D, ;[7.1135] Stop on null
SOUT% ;[7.1135] Do it
ERJMP .+1 ;[7.1135] Have a magic mushroom
LDB A,[POINT 7,USNAM,6] ;[7.1160] Get character from user name
SKIPN A ;[7.1160] Did this field parse reasonably?
ERROR <Invalid username> ;[7.1160] No, it didn't
MOVEI B,-1 ;[7.1135] Now pretend like username typed
SETZM USRNO ;[7.1135] But don't really have a user number
JRST SENDA ;[7.1160] And go on
ENDIF. ;[7.1135]
CAIN C,.CMTOK ;GOT A STAR ?
SETO B, ;NOTE "*" WITH -1
CAIE C,.CMNUM ;LINE # ?
IFSKP.
SKIPL B ;CHECK FOR BIT 0
CAIL B,-1 ;LESS THAN 777777
ERROR <Invalid terminal number> ;NO OR BIT 0 ON
ENDIF.
SENDA: MOVEM B,SNDLNO ;SAVE LINE NUMBER
TLZ Z,F1 ;[7.1076] This is for punctuating a local send properly
MOVE A,[POINT 7,BUF0] ;GET POINTER TO STRING BUFFER
HRROI B,[ASCIZ /
[From /]
CALL SAPPND ;BEGIN THE MESSAGE
MOVE B,CUSRNO ;GET USER NAME
DIRST ;PUT NAME SO PEOPLE WILL KNOW WHO'S SWEARING
CALL JERR ;SHOULDN'T FAIL
HRROI B,[ASCIZ / on node /] ;[7.1076] Say our node please
CALL SAPPND ;[7.1076] (A,B/A) Put the prep in send all buffer
PUSH P,A ;[7.1076] Temporarily save send all header byte pointer
HRROI A,OURNOD ;[7.1076] Put our node name here
MOVEI B,NODBLK ;[7.1076] Argument block for NODE% is here
MOVEM A,.NDNOD(B) ;[7.1076] Save byte pointer for monitor
MOVEI A,.NDGLN ;[7.1076] Get our node name
NODE% ;[7.1076] Please...
ERCAL JERR ;[7.1076] Something messed up
POP P,A ;[7.1076] Restore header place mat
HRROI B,OURNOD ;[7.1076] Put our node name in send all header
CALL SAPPND ;[7.1076] (A,B/A) Do it
PUSH P,A ;SAVE OUTPUT DESIGNATOR
GJINF ;FIND OUT ABOUT MY JOB
POP P,A ;RESTORE AC
JUMPL D,SENDD ;SKIP ON IF WE'RE DETACHED
HRROI B,[ASCIZ / line /] ;GET SOME MORE TEXT
CALL SAPPND
MOVE B,D ;GET NUMBER IN RIGHT AC
MOVEI C,^D8 ;OCTAL OUTPUT
NOUT ;STORE TERMINAL NUMBER
CALL JERR
SENDD: SKIPN B,SNDNOD ;[7.1076] Get destination node
IFSKP. ;[7.1076] If there is one,
TXZ B,TT%REM ;[7.1076] Turn this off please
MOVEI C,CFGNOD ;[7.1076] Find our CI node number
HLRZ C,1(C) ;[7.1076] Here's our CI node
CAME B,C ;[7.1076] Is it the same?
IFSKP. ;[7.1076] If same,
SETZM SNDNOD ;[7.1076] Say local send
TLO Z,F1 ;[7.1076] Say send was local
JRST SEND05 ;[7.1076] And go on
ENDIF. ;[7.1076]
MOVE B,SNDLNO ;[7.1076] Get line number
CAIN B,-1 ;[7.1076] Did user give us terminal?
JRST SEND06 ;[7.1076] No, then can't put it in header
HRROI B,[ASCIZ / to /] ;[7.1076] Say this is going somewhere
CALL SAPPND ;[7.1076] (A,B/A) Let header know
SKIPL SNDNOD ;[7.1076] Sending to all nodes?
IFSKP. ;[7.1076] If so,
HRROI B,[ASCIZ /all nodes/] ;[7.1076] Say so
ELSE. ;[7.1076] Else, find the node string
HRROI B,[ASCIZ /node /] ;[7.1076] Say node something
CALL SAPPND ;[7.1076] (A,B/A) Put it in
HRRZ B,SNDNOD ;[7.1076] Get node number back
SETZ Q1, ;[7.1076] Here's our counter
DO. ;[7.1076] Loop over all CI node names until we find the one we want
AOS Q1 ;[7.1076] Here's the entry
HLRZ C,CFGNOD(Q1) ;[7.1076] Get its CI node number
CAME B,C ;[7.1076] Is it the one we want?
JRST TOP. ;[7.1076] No, do next entry
MOVE B,CFGBLK(Q1) ;[7.1076] Get byte pointer to CI node
ENDDO. ;[7.1076]
ENDIF. ;[7.1076]
CALL SAPPND ;[7.1076] (A,B/A) Put node name in header (or all nodes)
ELSE. ;[7.1076] Flag local send (for all lines potentially)
TLO Z,F1 ;[7.1076] Say local send
ENDIF. ;[7.1076]
SEND05: SKIPL SNDLNO ;[7.1076] Sending to all lines?
IFSKP. ;[7.1076] If so,
HRROI B,[ASCIZ / to/] ;[7.1187] This was left out
TLNE Z,F1 ;[7.1187] Must we use proper English?
CALL SAPPND ;[7.1187] (A,B/A) Put it in
HRROI B,[ASCIZ / all lines/] ;[7.1076] Say so
CALL SAPPND ;[7.1076] (A,B/A) Finish off the header
ELSE. ;[7.1076] Else, say individual line
MOVE B,SNDLNO ;[7.1076] Get line number
CAIN B,-1 ;[7.1076] Did user give us terminal?
JRST SEND06 ;[7.1076] No, then can't put it in header
HRROI B,[ASCIZ / to/] ;[7.1187] Insert to
TLNE Z,F1 ;[7.1187] Has "to" been set yet?
CALL SAPPND ;[7.1187] (A,B/A) Put it in sendall header
HRROI B,[ASCIZ / line /] ;[7.1076] Give cute prefix
CALL SAPPND ;[7.1076] (A,B/A) Stick it in
MOVE B,SNDLNO ;[7.1076] Now put in destination terminal
MOVEI C,^D8 ;[7.1076] Make it octal
NOUT% ;[7.1076] Do it
CALL JERR ;[7.1076] Oops
ENDIF. ;[7.1076]
SEND06: HRROI B,[ASCIZ /:/] ;[7.1076] Terminate header with a :
CALL SAPPND ;[7.1076] (A,B/A) Do the terminator
MOVEM A,SNDPTC ;SAVE POINTER TO START OF CRLF
HRRI B,[ASCIZ /
/]
CALL SAPPND ;SEPARATE HEADER FROM CONTENTS WITH A CRLF
SENDD0: MOVEM A,SNDPT ;UPDATE POINTER TO MESSAGE
LINEX <Message to be sent>
CMERRX
CONFIRM ;GET CONFIRMATION
MOVE A,SNDPT ;GET POINTER TO MESSAGE SO FAR
HRROI B,ATMBUF ;POINT TO MESSAGE IN ATOM BUFFER
CALL SNDFIX ;COPY, ADDING CRLF WHEN LINE WILL OVERFLOW
HRROI B,[BYTE (7) "]",15,12,0]
CALL SAPPND ;TERMINATE WITH "]", CRLF
SETZ Q1, ;END THE MESSAGE WITH A NULL
IDPB Q1,A
HRRZ B,A ;GET ADDRESS OF END OF MESSAGE
CAIG B,BUF0+17 ;IS THE MESSAGE SHORTER THAN 80 CHARACTERS?
SKIPN A,SNDPTC ;YES - IS THERE A HEADER?
JRST SENDD1 ;NO TO EITHER - PROCEED
MOVEI B," " ;YES TO BOTH - REPLACE THE CRLF BETWEEN
IDPB B,A ; THE HEADER AND THE MESSAGE SO THE WHOLE
IDPB B,A ; THING WILL FIT ENTIRELY ON ONE LINE
SENDD1: CALL LINCHK ;CHECK THE LINE NUMBER
MOVE B,[POINT 7,BUF0] ;GET POINTER TO THE MESSAGE STRING
SETZ A, ;[7.1076] Clear this out
SKIPN A,SNDNOD ;[7.1076] Doing remote send of some type?
IFSKP. ;[7.1076] If so,
CAME A,[-1] ;[7.1076] Are we doing all nodes?
IFSKP. ;[7.1076] If so,
MOVX A,<.CSALL> ;[7.1076] Say doing all nodes
ELSE. ;[7.1076] Else just put in CI node number
HRRZ C,SNDNOD ;[7.1076] Get just CI node number
HRLZM C,A ;[7.1076] Save CI node here
ENDIF. ;[7.1076]
TXO A,TT%REM ;[7.1076] Say this is a remote send
HRR A,SNDLNO ;[7.1076] Get line number to send to
ELSE. ;[7.1076] If not doing remote send
MOVE A,SNDLNO ;[7.1076] Get full line value
ENDIF. ;[7.1076]
TXO A,.TTDES ;[7.1076] Now make it a terminal designator
TTMSG% ;[7.1076] Send the message
ERJMP CJERRE ;IT FAILED SOMEHOW
CALLRET UNMAP ;O.K. - UNMAP BUFFER PAGE AND RETURN
;HERE TO CHECK THE LINE NUMBER TO SEE IF IT'S REALLY THE USER FLAG
LINCHK: MOVE A,SNDLNO ;GET THE LINE NUMBER
CAIE A,-1 ;GOT USER ARGUMENT ?
RET ;NO
SKIPE SNDNOD ;[7.1076] Remote send with username?
JRST REMLIN ;[7.1076] Yes, handle seperately
SKIPN USRNO ;[7.1153] Was arbitrary string typed?
ERROR <Invalid username> ;[7.1153] If so, tell user that we can't do that
MOVEM P,SAVP ;SAVE THE CURRENT STACK POINTER
TLZ Z,F1!F2 ;INIT FLAGS
HLLZ D,JOBRT ;-# OF JOBS AS AOBJN CNTR
LICK2: CALL USERNO ;GET USER # OF JOB IN D
CAME A,USRNO ;IS IT THE ONE WE WANT?
JRST LICK3 ;NO
GTB .JOBTT
TLO Z,F1 ;FLAG DETACHED JOB SEEN
JUMPL A,LICK3 ;AND SKIP IT IF DETACHED
HLRZS A
PUSH P,A ;SAVE TTY# (1ST WORD OF A POSSIBILITY)
GTB .JOBPN ;GET PROGRAM NAME
PUSH P,A ;SAVE SUBSYSTEM NAME (2ND WRD OF POSS.)
LICK3: AOBJN D,LICK2 ;LOOP THRU ALL JOBS
CAME P,SAVP ;FOUND ANY?
IFSKP.
TLNE Z,F1
ERROR <User has detached jobs only, Send mail instead>
ERROR <User is not logged in, Send mail instead>
ENDIF.
POP P,A ;SUBSYSTEM NAME
POP P,B ;TTY#
CAMN P,SAVP ;ONLY ONE POSSIBILITY?
JRST LICK9 ;YES - USE IT
LICK7: SKIPN A ;[4425] Any program name?
MOVX A,<SIXBIT/?/> ;[4425] Nope, load unknown
TXO B,.TTDES ;[4425] Make terminal designator please
ETYPE < %2L, %1'%%_> ;[4425] Tell about user's job
CAMN P,SAVP ;DONE ALL?
IFSKP.
POP P,A ;NO - NOT YET - GET PROGRAM NAME
POP P,B ;GET TTY
JRST LICK7
ENDIF.
PROMPT <TTY: >
OCTX <Terminal number>
CMERRX ;NON-OCTAL NUMBER TYPED
LICK9: MOVEM B,SNDLNO ;SAVE THE LINE NUMBER
TRO B,.TTDES ;MAKE LINE DESIGNATOR
MOVE A,B ;PUT WHERE GETJI LIKES LINE #
MOVE B,[-1,,A] ;PUT 1 WORD IN AC A
MOVEI C,.JIUNO ;THAT WORD IS USER NUMBER
GETJI ;GET IT
CMERRX
CAME A,USRNO ;SAME USER NAME THAT WAS ORIGNALLY WANTED ?
ERROR <Terminal number does not belong to specified user>
RET ;RETURN
;[7.1076]
;REMLIN - Routine used to handle remote sends with a specific user
;name in mind.
;
; Called with:
; SEND TRVAR setup (SNDNOD and SNDMSK)
; CALLRET REMLIN from LINCHK
;
; Returns:
; +1 - Always, with a definite send destination
REMLIN: SAVEAC <Q1,Q2,P1,P2> ;Save some quasi's
STKVAR <<JOBS,100>,PNAME> ;[7.1135] Temp storage
SKIPE USNAM ;[7.1135] Have something already?
JRST RLICK0 ;[7.1135] Yes, no need to do DIRST%
HRROI A,USNAM ;Put username string here
MOVE B,USRNO ;Get user number for translation
DIRST% ;Now get the username string
CMERRX ;If error, then report it
RLICK0: TLZ Z,F1!F2 ;[7.1135] Say no node obtained yet and no terminal yet
MOVEI A,INFBLK ;Here's the INFO% argument block
MOVEI B,INFLEN ;Get INFO% argument block size
HRLI B,.INJOB ;Do this INFO% function
MOVEM B,.INFUN(A) ;Store this
MOVEI B,JOBS ;Have INFO% put job list here
DO.
MOVEM B,.INAC2(A) ;Put it in the arg block
SETZM .JOLEN(B) ;Zero out count of words returned
MOVE B,SNDMSK ;Get node mask
JFFO B,RLICK1 ;Find node to check
EXIT. ;No more nodes to do
RLICK1: MOVEM C,.INCID(A) ;Save destination CI node
HRROI B,USNAM ;Here's the username
MOVEM B,.INAC1(A) ;Pass it in the JSYS
INFO% ;Get those job numbers from the remote system
ERJMP .+1 ;Errors don't phase us
TXNE A,IN%RER ;[7.1106] Remote error?
MOVEI A,INFBLK ;[7.1106] Yes, user not logged in, setup again
MOVE B,.INAC2(A) ;Find the count word
HRLM C,.JOLEN(B) ;Now save node number there too
HRRZ D,.JOLEN(B) ;Retrieve count
ADD B,D ;This is where new stuff is to be stored
MOVEI A,INFBLK ;INFO% block back
MOVE C,.INCID(A) ;Retrieve CI node number
MOVE D,BITS(C) ;Now clear this bit in node mask
ANDCAM D,SNDMSK ;Clear this node, we have checked it already
JRST TOP. ;Do more
ENDDO.
MOVEI B,JOBS ;Now check to see if user is logged in
SKIPN .JOLEN(B) ;Is user logged in anywhere?
DETLIK: ERROR <User is not logged in, Send mail instead>
HRRZ C,.JOLEN(B) ;Get how many words until next set of jobs
ADDI C,.JOLEN(B) ;This is address of next set of jobs
SKIPE .JOLEN(C) ;If there are no more sets of jobs,
IFSKP. ;Then user logged into one node only
HLRZ C,.JOLEN(B) ;Get the node the user is logged into
TLO Z,F1 ;Say we have a node
MOVEM C,SNDNOD ;And save it for the JSYS to come
ENDIF.
SETZ C, ;Indicate no real job seen yet
HRRZ Q1,.JOLEN(B) ;Here's our loop ender
SOS Q1 ;But don't count the count word
SETZ Q2, ;And here's the loop counter
DO. ;Loop through entry in the jobs and see if user has all detached jobs
AOS Q2 ;Step to an entry
MOVE A,B ;B holds the address of the current set of jobs
ADD A,Q2 ;Figure in the offset
HRRZ D,(A) ;Get the terminal
CAIE D,-1 ;Is it detached?
IFSKP. ;If so,
TLO Z,F2 ;Say we have seen a detached job
ELSE. ;Else,
JUMPN C,LICTTY ;Have we seen other jobs?
MOVE C,D ;Save terminal number
HLL C,.JOLEN(B) ;And the node number
ENDIF.
CAME Q1,Q2 ;Have we done all for this node?
JRST TOP. ;No, continue on
AOS B ;Increment past the count word
ADD B,Q1 ;Add on block length
SKIPN .JOLEN(B) ;Are we done?
EXIT. ;Yes, no more jobs in this block
HRRZ Q1,.JOLEN(B) ;No, get how many jobs in this block
SOS Q1 ;Adjust for count word
SETZ Q2, ;Start the counter
JRST TOP. ;And do this set of jobs
ENDDO.
IFE. C ;If we never found a job
TLNE Z,F2 ;Did we see a detached job?
JRST DETLIK ;Yep, that's all we saw
ERROR <User is not logged in, Send mail instead>
ENDIF.
HLRZM C,SNDNOD ;Here's the node the user is logged into
HRRZM C,SNDLNO ;And the terminal
RET ;Done
;At this point, we know the user is multiply logged in but we are not
;sure where the message should be sent. So now we will prompt the user
;to find out.
LICTTY: MOVEI P1,JOBS ;Start checking from here
SETZ Q1, ;Init our loop counter
HRRZ Q2,.JOLEN(P1) ;Init our loop fence
SOS Q2 ;But don't count the first word
DO. ;Loop over each terminal
HLRZ P2,.JOLEN(P1) ;Get node number
SETZ C, ;Init our loop counter
DO. ;Find byte pointer to node name
AOS C ;Do next entry
HLRZ A,CFGNOD(C) ;Get CI node for this entry
CAME P2,A ;Have we found what we are looking for?
JRST TOP. ;Nope, go on
MOVE P2,CFGBLK(C) ;Get byte pointer to node
ENDDO.
AOS Q1 ;Move to next entry
MOVE A,P1 ;P1 is our lower fence
ADD A,Q1 ;Get to right index
HLRZ D,(A) ;Get job number for GETJI%
HRRZ B,(A) ;Get the terminal number
CAIE B,-1 ;Is this a detached one?
IFSKP. ;If so,
CAME Q1,Q2 ;Have we done them all?
JRST TOP. ;No, go on to next job
ADD P1,Q2 ;Yes, now move to next set of jobs
AOS P1 ;Make sure we include the count word
SKIPN .JOLEN(P1) ;Are there more jobs to check?
EXIT. ;No, time for maroon to give us data
SETZ Q1, ;Reinit our counter
HRRZ Q2,.JOLEN(P1) ;And move our fence post up
SOS Q2 ;But don't go too far
JRST TOP. ;Now check the next set of jobs
ENDIF.
ETYPE < Node %11M, TTY%2O%, running > ;[4426]
MOVEI A,INFBLK ;Store information here
MOVE B,[.INGJI,,.INAC3] ;Get function code and argument block length
MOVEM B,.INFUN(A) ;Save this
HLRZ B,.JOLEN(P1) ;Get node number
MOVEM B,.INCID(A) ;Save it here
HRRZM D,.INAC1(A) ;Save job number
HRLI B,-1 ;Only want one word for GETJI%
HRRI B,PNAME ;And it goes here
MOVEM B,.INAC2(A) ;Stash this in the INFO% block
MOVEI B,.JIPNM ;Only want program name
MOVEM B,.INAC3(A) ;Save it
SETZM PNAME ;Init program name
INFO% ;Get job program name
ERJMP .+1 ;[7.1101] If remote not supplying...
SKIPN A,PNAME ;Get program name
IFSKP. ;If there was one,
CALL SIXPRT ;(A/) Print it
ELSE. ;Otherwise,
PRINT "?" ;At this point, we don't know
ENDIF.
ETYPE <%_> ;Make things real pretty
CAME Q1,Q2 ;Have we done them all?
JRST TOP. ;No, continue
ADD P1,Q2 ;Yes, now move to next set of jobs
AOS P1 ;Don't forget the count word
SKIPN .JOLEN(P1) ;Are there more jobs to check?
EXIT. ;No, time for maroon to give us data
SETZ Q1, ;Reinit our counter
HRRZ Q2,.JOLEN(P1) ;And move our fence post up
SOS Q2 ;But not too far
JRST TOP. ;Now check the next set of jobs
ENDDO.
TLNE Z,F1 ;Have a node name?
IFSKP. ;If not,
PROMPT <Node: > ;Get it from the user
CALL VALNDE ;[7.1269] (A,B/A,B,C) Get us a node (no * allowed)
CONFIRM ;Get confirmation
MOVEI A,JOBS ;Start here
DO. ;Loop over all entries
HLRZ Q1,.JOLEN(A) ;Get node number here
CAMN B,Q1 ;Did we parse goodness?
EXIT. ;That we did
HRRZ Q1,.JOLEN(A) ;No, move onto next set of jobs
ADD A,Q1 ;Point to next set of jobs
SKIPE .JOLEN(A) ;No more?
JRST TOP. ;There is more
ERROR <User not logged in on given node>
ENDDO.
MOVEM B,SNDNOD ;Now we have a real node
HRRZ Q1,.JOLEN(A) ;[7.1106] See how many jobs logged into this system
CAIE Q1,<1+1> ;[7.1106] Target logged in only once? (Header
;[7.1106] plus job word)
JRST LICTT1 ;[7.1106] No, find out which terminal to zap
HRRZ B,1(A) ;[7.1106] User logged in once, here's the TTY
MOVEM B,SNDLNO ;[7.1106] Put TTY here for TTMSG%
RET ;[7.1106] And return
ENDIF.
LICTT1: PROMPT <TTY: > ;Ask user for a choice
OCTX <Terminal number> ;Get user input
CMERRX ;User gafawed
CAIN B,-1 ;Did user do something stupid?
JRST BADLIK ;Sure did, tell them
MOVEM B,SNDLNO ;Save what we got from user
MOVEI A,JOBS ;Now we have to check the terminal given
DO. ;Find the node with the correct chunk of jobs
HLRZ B,.JOLEN(A) ;Get the node number
CAMN B,SNDNOD ;Correct one?
EXIT. ;Yes, now verify terminal
HRRZ B,.JOLEN(A) ;Get offset to next set of jobs
ADD A,B ;Here they are
JRST TOP. ;Try again
ENDDO.
MOVEI Q1,1 ;Here's our loop counter starting over
HRRZ Q2,.JOLEN(A) ;Here's the loop fencepost
MOVE B,A ;Get starting point
DO. ;Now check to make sure this is correct TTY
ADD B,Q1 ;Move to correct index
HRRZ B,(B) ;Now get the terminal for this job
CAMN B,SNDLNO ;Did user give us a good one?
RET ;Yes, now return
AOS Q1 ;Move onto next entry to check
MOVE B,A ;Get starting point
CAME Q1,Q2 ;Have we exhausted out possibilities?
JRST TOP. ;No, keep checking
ENDDO. ;Yes, tell maroon he goofed
BADLIK: ERROR <Terminal number does not belong to specified user>
;SNDFIX - ROUTINE TO BREAK UP LONG ^ESEND TEXT INTO MULTIPLE LINES
;ACCEPTS IN A/ POINTER TO WHERE TO STORE TEXT
; B/ ADDRESS OF USER'S TEXT
;RETURNS: +1 ALWAYS, WITH A/ POINTER TO END OF TEXT
SNDSIZ==^D76 ;MAX SIZE OF ^ESEND LINES
SNDFIX: HRLI B,(POINT 7,) ;MAKE ADDRESS OF USER'S DATA BE A POINTER
SNDFX0: MOVEI D,SNDSIZ ;GET MAX SIZE FOR ^ESEND LINES
SNDFX1: ILDB C,B ;GET A CHARACTER FROM THE USER'S STRING
JUMPE C,R ;ALL DONE IF END OF STRING
CAIN C," " ;BETWEEN WORDS?
JRST SNDFXW ;YES - SEE IF NEAR END OF LINE
SNDFX2: IDPB C,A ;ELSE DEPOSIT CHARACTER IN NEW STRING
SOJG D,SNDFX1 ;LOOP OVER A LINE-FULL OF CHARACTERS
SNDFX3: MOVEI C,.CHCRT ;THEN PUT IN A CRLF AND A SPACE
IDPB C,A
MOVEI C,.CHLFD
IDPB C,A
MOVEI C," "
IDPB C,A
JRST SNDFX0 ;AND CONTINUE COPYING
SNDFXW: CAILE D,7 ;NEAR THE END OF THE LINE?
JRST SNDFX2 ;NO - PROCEED
JRST SNDFX3 ;YES - START THE NEW LINE NOW
;SUBROUTINE TO APPEND A STRING TO THE END OF (A)
;ENTER WITH ASCIZ STRING POINTER IN AC B
SAPPND: HRLI B,(POINT 7,) ;MAKE ADDRESS INTO A POINTER
SAPND1: ILDB Q1,B ;GET A CHARACTER
JUMPE Q1,R ;DONE IF NULL
IDPB Q1,A ;ELSE SAVE IT AT END OF MESSAGE
JRST SAPND1 ;AND GET MORE
;TAKE (EXEC INPUT FROM) FILESPEC
.TAKE:: TRVAR <TAKCON,JFN1,JFN2> ;CELLS TO HOLD NEW JFNS
NOISE <COMMANDS FROM>
SETZM JFN1 ;INDICATE NO INPUT JFN YET
MOVE A,TAKDEF ;GET THE DEFAULTS
MOVEM A,TAKCON ;REMEMBER SETTINGS BEFORE SUBCOMMANDS CHANGE THEM
MOVE A,COJFN
MOVEM A,JFN2 ;DEFAULT NEW JFNS TO OLD
DEXTX <CMD> ;DEFAULT INPUT EXTENSION IS CMD
MOVX A,GJ%OLD+GJ%ACC ;OLD FILE ONLY AND DON'T LET INFERIORS KILL IT
MOVEM A,CJFNBK+.GJGEN ;STORE FLAGS
MOVEI B,[FLDDB. .CMCFM,CM%SDH,,<Carriage return to end current command level>,,[
FLDDB. .CMCMA,CM%SDH,,<Comma to enter subcommands>,,[
FLDDB. .CMFIL,CM%SDH,,<Command file name>]]]
CALL FLDSKP ;READ EITHER CR OR FILESPEC
CMERRX ;NEITHER TYPED!
LDB C,[331100,,(C)] ;FIGURE OUT WHAT GOT TYPED
CAIN C,.CMCFM ;CARRIAGE RETURN?
JRST PRIRES ;YES
CAIN C,.CMCMA ;COMMA?
JRST TAKEC ;YES, GET SUBCOMMANDS
MOVEM B,JFN1 ;REMEMBER FIRST JFN
MOVEI Q1,0 ;FIRST ASSUME NO SUBCOMMANDS
COMMAX <Comma to enter subcommands, or confirm with carriage return>
CAIA ;NO SUBCOMMANDS COMING
MOVEI Q1,1 ;SUBCOMMANDS COMING
CONFIRM ;REQUIRE CONFIRMATION AFTER FILE NAME
JUMPE Q1,TAKE1 ;SKIP SUBCOMMAND STUFF IF NO COMMA
CAIA ;WE'VE ALREADY GOT CONFIRMATION
TAKEC: CONFIRM
SUBCOM $TAKE ;DO THE SUBCOMMANDS
TAKE1: SKIPN A,JFN1 ;INPUT FILE TYPED?
RET ;NO, THIS IS A NO-OP
MOVE B,[XWD 70000,OF%RD]
OPENF
ERCAL CJERRE ;COULDN'T OPEN TAKE FILE
MOVE A,JFN2
MOVE B,COJFN ;GET OLD OUTPUT
CAIN A,(B) ;OUTPUT BEING CHANGED?
JRST TAKE33 ;NO
MOVE B,[XWD 70000,OF%APP]
OPENF
ERCAL CJERRE ;GO PRINT ERROR MESSAGE
TAKE33: HRL A,JFN1 ;GET XWD INPUT,OUTPUT
MOVE B,TAKCON ;GET DESIRED SETTING FOR NESTED TAKE
CALLRET PUSHIO ;START NEW STREAM, REMEMBER OLD
;HERE IF "TAKE" SEEN WITH NO FILESPEC - WILL SUPPRESS "END OF filespec" MESSAGE
PRIRES: SKIPE LGORET ;ARE WE LOGGING OUT? (i.e.,"TAKE" AT END OF LOGOUT.CMD)
JRST PRIR01 ;YES, DO THIS A LITTLE DIFFERENTLY
CALL CIOREL ;POP BACK ONE LEVEL
CAIA ;THERE WAS A LEVEL TO CLOSE
RET ;NOTHING TO CLOSE (WE'RE AT TOP LEVEL)
CLOSF ;CLOSE OLD INPUT SIDE
ERCAL JERR ;SHOULDN'T FAIL
RET
PRIR01: CALL CIOREL ;POP BACK ONE LEVEL
CAIA ;THERE WAS A LEVEL TO CLOSE
JRST @LGORET ;NO LEVEL TO CLOSE - KEEP ON LOGGIN' OUT
CLOSF ;CLOSE OLD INPUT SIDE
ERCAL JERR ;SHOULDN'T FAIL HERE, EITHER
MOVE A, TAKLEN ;SEE WHAT LEVEL WE'RE ON NOW
CAME A, SAVTAK ;SAME AS WHEN WE ENTERED "LOGOUT" PROCESSING?
RET ;NO, MUST BE MORE TO DO (TAKING A FILE INSIDE LOGOUT.CMD)
JRST @LGORET ;YES - ALL DONE NOW, KEEP LOGGING OUT
;SUBCOMMANDS TO "TAKE" COMMAND
$TAKE: TABLE
T ALLOW ;IGNORE ERRORS DURING TAKE
T DISALLOW ;STOP ON ERRORS DURING TAKE
T ECHO ;ECHO COMMANDS IN TAKE FILE
T LOG-FILE,,.TKLOG ;FILE TO LOG OUTPUT ON
T NO,,.NOTAK ;NO
TEND
.ALLOW: CALL ALONOI
MOVX A,TKALEF ;BIT TO ALLOW ERRORS
IORM A,TAKCON ;TURN IT ON
RET
.DISAL: CALL ALONOI
MOVX A,TKALEF ;BIT FOR ALLOWING ERRORS
ANDCAM A,TAKCON ;TURN IT OFF
RET
.ECHO: CALL ECHNOI
MOVX A,TKECOF ;FLAG TO ALLOW ECHOING
IORM A,TAKCON ;TURN IT ON
RET
.TKLOG: DEXTX <LOG> ;DEFAULT OUTPUT EXTENSION IS LOG
MOVX A,GJ%FOU+GJ%MSG+GJ%ACC ;FILE FOR OUTPUT USE PLUS PRINT MESSAGE
MOVEM A,CJFNBK+.GJGEN ;AND DON'T LET INFERIORS TOUCH THIS JFN
MOVEI B,[FLDDB. .CMFIL,CM%SDH,,<Output file name>]
CALL FLDSKP ;READ FILESPEC
CMERRX ;THAT'S NOT WHAT IT WAS
MOVEM B,JFN2 ;SAVE OUTPUT JFN
CONFIRM ;DON'T FORGET
RET
.NECHO: CALL ECHNOI
MOVX A,TKECOF ;FLAG TO ALLOW ECHOING
ANDCAM A,TAKCON ;TURN IT OFF
RET
.NOTAK: KEYWD $NOTAK ;GET NEXT KEYWORD
T ECHO,,.NECHO
JRST CERR
JRST (P3) ;CALL PROPER ROUTINE
$NOTAK: TABLE
T ECHO,,.NECHO
TEND
;ROUTINE TO PUSH THE EXEC PRIMARY IO STREAM
;
;ACCEPTS: A/ INPUT JFN,,OUTPUT JFN
; B/ FLAG BITS (SUCH AS TKALEF, TKECOF)
;
;RETURNS +1
PUSHIO::MOVE C,TAKLEN ;GET CURRENT LENGTH
CAIL C,TAKLNX ;MAKE SURE WE'RE NOT AT MAXIMUM
JRST NOPE ;WE ARE
AOJ C, ;INCREASE LENGTH OF LIST
CALL PIOFF ;NO ^C WHILE WE STRAIGHTEN THINGS OUT
MOVEM A,TAKJFN-1(C) ;STORE JFNS
MOVEM B,TAKBTS-1(C) ;STORE CONTROL BITS
MOVEM C,TAKLEN ;REMEMBER NEW LENGTH
CALL FIXIO ;SET UP DYNAMIC VARIABLES
GJINF ;GET JOB INFO
HRRZ A,CIJFN ;FIND OUT WHERE WE'RE READING FROM
SKIPGE D ; IF DETACHED
CAIE A,.PRIIN ; AND READING FROM PRIMARY INPUT
SKIPA
JRST [MOVE A,TAKCUR ;GET CURRENT SETTINGS
JRST PSH1] ;FALL IN TO TURN OFF TKTERF
HRRZ A,CIJFN ;FIND OUT WHERE WE'RE READING FROM
DVCHR
LDB B,[221100,,B] ;GET DEVICE TYPE OF INPUT DEVICE
MOVE A,TAKCUR ;GET CURRENT SETTINGS
TXO A,TKTERF ;FIRST ASSUME INPUTTING FROM TERMINAL
CAIE B,.DVTTY ;GOOD GUESS?
PSH1: TXZ A,TKTERF ;NO, LOUSY GUESS.
MOVEM A,TAKCUR ;UPDATE SETTINGS
MOVE B,TAKLEN ;GET POINTER TO END OF LIST AGAIN
MOVEM A,TAKBTS-1(B) ;REMEMBER WHETHER INPUTTING FROM TERMINAL
CALLRET PION ;ALLOW ^C AGAIN
NOPE: MOVE C,A ;SAVE JFNS IN C
HRRZ A,C
MOVE B,TAKJFN-1(B) ;GET LAST JFNS ON LIST
CAIE A,(B) ;DON'T CLOSE IF LAST JFN IS SAME
CLOSF ;CLOSE THIS LAST SET OF JFNS, SINCE THEY'RE NOT ON THE STACK YET
ERJMP .+1 ;FAILED, PROBABLY BECAUSE 100 OR 101
HLRZ A,C ;GET OTHER JFN
CLOSF
ERJMP .+1
HLRZ A,C ;PCL Look at input
CAIN A,.NULIO ;PCL Command procedure?
ERROR <Command procedures nested too deeply> ;PCL
ERROR <TAKE commands nested too deeply>
;"TYPE" AND "LIST" ARE IN A SEPARATE FILE BELOW.
;UNATTACH - DETACH REMOTE JOB WITHOUT REATTACHING HERE
.UNATT::TLO Z,F1 ;SAY UNATTACH INSTEAD OF ATTACH
JRST ATTAU1 ;GO JOIN ATTACH
;UNDELETE <DELETED FILE NAMES>
.UNDEL::NOISE <FILES>
MOVE A,[XWD -1,0] ;NO DEFAULT NAMES
MOVX B,(GJ%OLD!GJ%NS!GJ%DEL!GJ%IFG!1B15!1B16!1B17) ;"MUST BE NEW" AND "IGNORE DELETED BIT"
; ALSO, NO SEARCHING TO BE DONE
HRLI B,-3 ;DEFAULT VERSION IS *
TRO Z,IGINV ;SEE INVISIBLE FILES
CALL SPECFN ;INPUT FILE NAME USING GTJFN FLAGS IN B
JFCL ;IGNORE SUBCOMMAND ENDING
SETOM TYPGRP ;ALWAYS PRINT FILENAME AT TYPIF
UNDEL1: HRRZ A,@INIFH1 ;JFN
DVCHR
TXNN B,DV%MDD ;MULT DIR DEVICE?
JRST [ ETYPE <?%1H: Can't undelete files on this device
>
MOVSI A,(77B5)
ANDCAM A,@INIFH1 ;CLEAR * INDICATIONS TO FORCE STEPPING TO NEXT JFN
JRST UNDEL8]
HRRZ A,@INIFH1
MOVE B,[XWD 1,.FBCTL] ;CONTROL BITS WORD OF FILE DESC BLOCK
MOVEI C,C ;READ INTO C
CALL $GTFDB ;DO GTFDB JSYS, NO SKIP IF NO ACCESS
SETO C, ;NO ACCESS, ASSUME DELETED
TXNN C,FB%DEL ;"FILE IS DELETED" BIT
JRST [ MOVE A,@INIFH1 ;GET JFN WITH FLAGS
TLNE A,<77B5>B53 ;ANY *'S?
JRST UNDEL8 ;YES, NO MESSAGE
CALL TYPIF ;PRINT NAME
TYPE < Wasn't deleted
>
JRST UNDEL8]
CALL TYPIF ;TYPE NAME IF GROUP
HRLI A,.FBCTL ;1: XWD DISPLACEMENT, JFN
LDF B,FB%DEL ;MASK OF BITS TO CHANGE
SETZ C, ;VALUE TO CHANGE TO: OFF.
CALL $CHFDB ;DO CHFDB AND FIELD ITRAP IF ANY
JRST [ TYPE < Access not allowed
>
JRST UNDEL8]
CALL TYPOK ;INDICATE DONE OK
UNDEL8: CALL GNFIL ;GET JFN OF NEXT FILE OF GROUP
RET ;NO MORE, GO GET NEXT COMMAND.
JRST UNDEL1 ;HAVE ANOTHER
;PRIVILEGED COMMANDS
;^E EDDT
;TRANSFER CONTROL TO TOPS20 DDT, GETTING IT IF IT ISN'T ALREADY THERE.
.EDDT:: SKIPE DDTORG
JRST EDDT4 ;DDT ALREADY THERE
SKIPN Q1,.JOBSY ;DO WE HAVE SOME SYMBOLS?
SKIPE Q1,JOBSYM ;???
SKIPA B,[-1,,[GETSAVE <SYS:UDDT.>]]
HRROI B,[GETSAVE <SYS:SDDT.>] ;USE SDDT IF NO SYMBOLS
MOVSI A,(GJ%OLD!GJ%SHT) ;OLD FILE ONLY, AND SHORT FORM
CALL GTJFS ;GET AND STACK THE JFN
CALL CJERRE ;IF CAN'T, JUST GIVE ERROR TO USER
HRLI A,.FHSLF ;SAY THIS FORK (JFN IS IN RH A)
CALL DOGET ;DO THE GET
CALL CJERRE ;FAILED, SAY WHY
CALL RLJFNS
;"GET" CHANGES ENTRY VECTOR TO POINT AT DDT.
;CHANGE IT BACK.
MOVEI A,.FHSLF
DMOVE B,[EXP EVLEN,EXEC] ;ENTRY VECTOR
CALL SETENT
;IF WE CAN FIND A SYMBOL TABLE POINTER, PUT IT IN THE DDT.
SKIPN Q1 ;HAVE ONE?
JRST [TYPE <% No symbols
>
JRST EDDT4] ;NO - PROCEED
MOVEM Q1,@DDTORG+1 ;YES - STORE INTO DDT
EDDT4: MOVX A,OURNAM ;GET OUR NAME
SETNM ;SET IT IN CASE USER EXITS DDT AND TYPES "SAVE"
JRST DDTORG ;ENTER DDT
;DISABLE
;DISABLES PRIVILEGED COMMANDS,
;DISABLES USER (RH) SPEC CAPS IN EXEC AND INFERIOR FORK
; (CAPS POSSIBLE ARE STILL TRANSMITTED, SO INFERIOR CAN USE THEM
; IF IT ENABLES THEM ITSELF)
.DISAB::SETZ A, ;FLAG DISABLE
DISAB1: STKVAR <REMA>
MOVEM A,REMA ;REMEMBER DESIRED SETTING
NOISE <CAPABILITIES>
CONFIRM
MOVE A,REMA
MOVEM A,PRVENF ;GET DESIRED SETTING
MOVEI A,.FHSLF ;"ENABLE" JOINS HERE
RPCAP
ERJMP CJERR
TRZ C,-1
SKIPE PRVENF
HRR C,B
MOVE D,C ;REMEMBER EXEC'S CAPS
EPCAP ;EXEC'S CAPABILITIES
ERJMP CJERR
SKIPG A,FORK
RET ;NO INFERIOR, DONE
RPCAP
ERJMP CJERR
MOVE C,D ;SET FORK TO WHATEVER WE ARE
EPCAP ;INFERIOR'S CAPS
ERJMP CJERR
RET
;ENABLE
;ENABLES OTHER PRIVILEGED COMMANDS IN EXEC, AND ENABLES
;RH (USER) SPECIAL CAPS IN EXEC AND IN INFERIOR FORK, IF THERE IS ONE.
.ENABL::SETO A, ;FLAG TO DO ENABLE
JRST DISAB1
;^ELOGOUT (JOB #)
..LOGO::TRVAR <<JUSBLK,.JIPNM+1>,JUSJOB>
MOVEM A,JUSJOB
GJINF
CAMN 3,JUSJOB ;THIS JOB?
ERROR <If you want to logout this job, use LOGOUT>
MOVE D,JUSJOB ;RECOVER JOB NUMBER
HLRE A,JOBRT ;GET NUMBER OF JOBS ON SYSTEM
MOVM A,A ;MAKE IT POSITIVE
CAML D,A ;VALID ARG?
JRST ELOGO1 ;NO
JUMPL D,ELOGO1 ;NEGATIVE ALSO INVALID
GTB .JOBRT ;CHECK RUNTIME TABLE
JUMPGE 1,.+2 ;REQUESTED JOB EXISTS?
ELOGO1: ERROR <That job does not exist>
CONFIRM
MOVE A,D ;JOB NUMBER
MOVSI B,-<.JIPNM+1> ;GET UP TO THE PROGRAM NAME
HRRI B,JUSBLK ;PUT DATA IN TEMP AREA
MOVEI C,.JIJNO ;START WITH JOB NUMBER
GETJI ;GET IT
ERJMP CJERR
MOVEI C,JUSBLK ;POINT AT TEMP AREA
SKIPN A,.JIUNO(C) ;GET USER #
IFSKP.
ETYPE <User %1N> ;TYPE USER NAME OUT
ELSE.
ETYPE <Not logged in> ;OR NOT LOGGED IN IF USER # IS 0
ENDIF.
MOVE A,.JITNO(C) ;[4425] Load terminal number
TXO A,.TTDES ;[4425] Make that a designator
SKIPN B,.JIPNM(C) ;Load program name, skip if nonzero
MOVE B,.JISNM(C) ;If prog name was zero, use system name
ETYPE < %1L, running %2'> ;[4425] Give location and program running
ELOGO2: CALL FCONF ;CONFIRM
MOVE A,JUSJOB ;NOW, RECHECK THE USER NUMBERS
MOVE B,[1,,C] ;ONE WORD INTO AC C
MOVEI C,.JIUNO ;THE WORD IS THE USER NUMBER
GETJI ;GET IT
ERJMP CJERR
MOVEI B,JUSBLK
MOVE A,.JIUNO(B) ;GET JOB NUMBER
CAME C,A ;STILL THE SAME USER?
JRST CMDIN4 ;DIFFERENT USER, DO NOTHING
MOVE A,JUSJOB ;GET THE JOB NUMBER
LGOUT ;LOGOUT THE JOB
CALL CJERR
JRST CMDIN4
.BLANK::NOISE (SCREEN)
CONFIRM
BLANK1::STKVAR <TMOD>
MOVE 1,COJFN ;CURRENT OUTPUT JFN
RFMOD ;GET MODE WORD
MOVEM B,TMOD ;SAVE IT
TXZ B,TT%DAM ;NO XLATION
SFMOD
GTTYP ;GET TERMINAL TYPE
CAMGE B,NTTYPS ;IS IT WITHIN THE TABLE?
SKIPN A,BLNKTB(B) ;YES - GET STRING TO DUMP
JRST BLANK2 ;NO - DO NOTHING
TLNN A,-1 ;STRING OR POINTER?
TLOA A,-1 ;POINTER TO TEXT
HRROI A,BLNKTB(B) ;STRING - POINT TO IT INSTEAD
PSOUT ;DUMP IT
BLANK2: MOVE A,COJFN
MOVE B,TMOD ;RESTORE MODES WORD
SFMOD
RET
;[7.1076] NODTAB is used when /NODE is parsed or NODE keyword is parsed.
;VALNOD is then dispatched to and it attempts to parse a CI node name.
NODTAB: TABLE
[ASCIZ /NODE:/],,0
TEND
;[7.1076]
;VALNOD - Used to parse a CI node name ala COMND% style. The table
;that houses the CI nodes can dynamic change. Each time this routine
;is called, the table is wiped clean and a new table is built. This
;routine has 2 entry points. When VALNOD is called, privs are checked
;before parsing a '*' (non-prived users can't parse '*' in this case).
;If VALNDN is called, both '*' and CI nodes can be parsed no matter
;if privs are there or not. VALNDE was added as an after thought.
;When we are parsing a node name and must absolutely positively have
;a node name (* not allowed) then we call VALNDE.
;
; Call with:
; A/ COMND% state block
; CALL VALNOD
; or
; CALL VALNDN
; or
; CALL VALNDE
;
; Returns:
; +1 - Always, with
; A/ COMND% state block
; B/ Bit mask of node parsed (or -1 when * is seen)
; C/ CI node number (or -1 when * is seen)
;
;Note - on COMND% parse error, we return to EXEC command level.
VALNDE::MOVEI C,1 ;[7.1269] Flag entry point
JRST VALND0 ;[7.1269] And join common code
VALNDN::TDZA C,C ;Parse token regardless
VALNOD::SETO C, ;Check privs before parse
VALND0: SAVEAC <Q1,Q2> ;Preserve the smashed ones
STKVAR <SAVBLK,ENTPNT> ;Need place for COMND% state block
MOVEM A,SAVBLK ;Save this for later
MOVEM C,ENTPNT ;Save where we came in for later
SETZM CINODT ;Clear out lookup table
MOVE A,[CINODT,,CINODT+1] ;Force each entry in table to become 0
BLT A,CINODT+17 ;Do it
MOVEI A,MAXCI ;Only this many nodes allowed
MOVEM A,CINODT ;Save this value in table
VALND1: MOVEI A,CFGSIZ ;This is how big the argument block is
MOVEM A,CFGBLK ;Save it
MOVEM A,CFGNOD ;Save for CI node numbers too
MOVEI A,.CFCND ;Get all CI node names
MOVEI B,CFGBLK ;Get CI node names and put them here
CNFIG% ;Get node names
ERJMP JERR ;Must not have a KLIPA
MOVEI A,.CFCSE ;Now get all CI node numbers
MOVEI B,CFGNOD ;Store the node numbers here
CNFIG% ;Have the monitor get them
ERJMP JERR ;Must not have a KLIPA
HLRZ Q1,CFGBLK ;Get number of host names we received
HLRZ Q2,CFGNOD ;Also get number of CI nodes we received
SOS Q2 ;CNFIG% is messed up, it counts the count word for node numbers
CAME Q1,Q2 ;They at least better be the same
JRST VALND1 ;They weren't do it again because of cluster transition
SETZ Q1, ;This is our index counter
;Note - at this point there must be at least one living node in the cluster
;or things get sicker from here. Of course, since this machine is up, then
;there will be at least one node (us!).
VALND2: AOS Q1 ;Move onto next node entry
HRLZ B,CFGBLK(Q1) ;Get address of node name string
HLR B,CFGNOD(Q1) ;Get node number with string address
MOVEI A,CINODT ;Put entry into this table
TBADD% ;Do it
ERCAL JERR ;If error, report it
CAME Q1,Q2 ;Done all nodes returned?
JRST VALND2 ;No, do next node name
MOVE A,SAVBLK ;Recapture COMND% state block
MOVE B,ENTPNT ;[7.1269] Get entry point
CAIN B,1 ;[7.1269] Is it special?
JRST VALND3 ;[7.1269] Yes, don't parse token!
SKIPE ENTPNT ;Must we check privs first?
SKIPE PRVENF ;Is our user prived?
IFNSK. ;If so, use this FDB
MOVEI B,[FLDDB. .CMKEY,,CINODT,<CI node name,>,,
[FLDDB. .CMTOK,CM%SDH,<-1,,[ASCIZ /*/]>,<* for all nodes>]] ;[7.1166]
ELSE. ;User is just a peon
VALND3: MOVEI B,[FLDDB. .CMKEY,,CINODT,<CI node name,>] ;[7.1269] Token not included
ENDIF.
CALL FLDSKP ;(A,B/A,B,C)
CMERRX ;User is a bafoon
LDB C,[POINT 9,0(C),8] ;Get function that user did
CAIE C,.CMTOK ;Got token?
IFSKP. ;If so,
SETZ Q1, ;Start this counter over again
SETZ C, ;Init mask
DO. ;Loop over each CI node to return bit mask
AOS Q1 ;Go to entry to be worked on
HLRZ B,CFGNOD(Q1) ;Get its CI node number
IOR C,BITS(B) ;Light the bit for this node
CAME Q1,Q2 ;Done with all nodes?
JRST TOP. ;No, do next node for mask
ENDDO.
SETO B, ;Now say all nodes were requested
RET ;And return to caller
ENDIF.
HRRZ B,(B) ;Return CI node to caller
MOVE C,BITS(B) ;Get bit for this CI node also
RET ;Done
ENDSV.
END