Trailing-Edge
-
PDP-10 Archives
-
bb-kl11l-bm_tops20_v7_0_tsu03_2_of_3
-
t20src/acjdec.mac
There are 9 other files named acjdec.mac in the archive. Click here to see a list.
;RIP:<7.UTILITIES>ACJDEC.MAC.1248 4-Apr-89 20:14:57, Edit by GSCOTT
;(125) Sweep log file cache at time that system is going to be shutdown.
;RIP:<7.UTILITIES>ACJDEC.MAC.1235 30-Mar-89 11:59:54, Edit by GSCOTT
;(124) Substitute "*" in log file name for the current time.
;RIP:<7.UTILITIES>ACJDEC.MAC.1230 30-Mar-89 10:57:16, Edit by GSCOTT
;(123) Read LSN ACCESS.CONTROL files for feeble users.
;RIP:<7.UTILITIES>ACJDEC.MAC.1227 29-Mar-89 15:33:03, Edit by GSCOTT
;(122) Small log file fixes, cause entry into MDDT to sweep the log file cache.
;RIP:<7.UTILITIES>ACJDEC.MAC.1215 29-Mar-89 11:52:00, Edit by GSCOTT
;(121) Check for user deletion of access.control file to flush cache.
;RIP:<7.UTILITIES>ACJDEC.MAC.1210 29-Mar-89 01:44:11, Edit by GSCOTT
;(120) Write summary info to log file when closing it.
;RIP:<7.UTILITIES>ACJDEC.MAC.1193 29-Mar-89 00:16:04, Edit by GSCOTT
;(116) Fix log file line counter.
;RIP:<7.UTILITIES>ACJDEC.MAC.1183 28-Mar-89 23:31:06, Edit by GSCOTT
;(115) Look for filename first in cache flush of access.control files.
;RIP:<7.UTILITIES>ACJDEC.MAC.1178 28-Mar-89 22:38:19, Edit by GSCOTT
;(114) Add counter for cache flushes.
;RIP:<7.UTILITIES>ACJDEC.MAC.1159 28-Mar-89 10:50:17, Edit by GSCOTT
;(113) Log file cache sweep interval of zero disables the cache.
;RIP:<7.UTILITIES>ACJDEC.MAC.1157 28-Mar-89 10:43:02, Edit by GSCOTT
;(112) Make the log buffer three pages.
;RIP:<7.UTILITIES>ACJDEC.MAC.1155 24-Mar-89 02:13:10, Edit by GSCOTT
;(111) Implement the access control cache.
;RIP:<7.UTILITIES>ACJDEC.MAC.1083 21-Mar-89 17:20:03, Edit by GSCOTT
;(110) Sweep log file cache if reading log file, get new log file if renaming.
;RIP:<7.UTILITIES>ACJDEC.MAC.1070 20-Mar-89 13:31:36, Edit by GSCOTT
;(107) Implement the log file cache.
;RIP:<7.UTILITIES>ACJDEC.MAC.1042 2-Feb-89 10:23:25, Edit by GSCOTT
;(101) Don't output cap mask if job 0 in LOGSTA routine.
;RIP:<7.UTILITIES>ACJDEC.MAC.1040 1-Feb-89 11:38:29, Edit by GSCOTT
;(100) Bug in TAKCHK broke TAKE command lines over half the buffer size.
;RIP:<7.UTILITIES>ACJDEC.MAC.1039 31-Jan-89 18:23:01, Edit by GSCOTT
;(77) Make the log files secure when writing them.
;RIP:<7.UTILITIES>ACJDEC.MAC.1037 30-Jan-89 10:54:49, Edit by GSCOTT
;(75) Don't output bad information in spy file trailer.
;RIP:<7.UTILITIES>ACJDEC.MAC.1036 30-Jan-89 10:22:08, Edit by GSCOTT
;(74) Kill all inferior forks when crashing.
;RIP:<7.UTILITIES>ACJDEC.MAC.1033 30-Jan-89 10:02:23, Edit by GSCOTT
;(73) Output spy filename to log file if we can't open the spy file.
;RIP:<7.UTILITIES>ACJDEC.MAC.1031 26-Jan-89 11:20:21, Edit by GSCOTT
;(72) Add NOSECURE keyword to ACCESS.CONTROL
;RIP:<7.UTILITIES>ACJDEC.MAC.1030 26-Jan-89 10:07:01, Edit by GSCOTT
;(71) Add DENY-CTY and LOGIN-CTY support.
;RIP:<7.UTILITIES>ACJDEC.MAC.1028 24-Jan-89 17:01:52, Edit by GSCOTT
;(67) Make job information blocks, clean up attach and login policy code.
;RIP:<7.UTILITIES>ACJDEC.MAC.1010 19-Jan-89 22:50:33, Edit by GSCOTT
;(66) Fill text displayed by the SHOW command.
;RIP:<7.UTILITIES>ACJDEC.MAC.999 19-Jan-89 21:21:06, Edit by GSCOTT
;(65) Fill command lines output by the WRITE command.
;RIP:<7.UTILITIES>ACJDEC.MAC.996 19-Jan-89 17:46:14, Edit by GSCOTT
;(64) Improve logging of illegal requests.
;RIP:<7.UTILITIES>ACJDEC.MAC.985 19-Jan-89 13:28:48, Edit by GSCOTT
;(63) Add support for user functions.
;RIP:<7.UTILITIES>ACJDEC.MAC.982 12-Jan-89 23:12:28, Edit by GSCOTT
;(62) Ignore increment mount counts for ACJ just to be sure.
;RIP:<7.UTILITIES>ACJDEC.MAC.981 12-Jan-89 22:00:36, Edit by GSCOTT
;(60) Remove extra definition of RSKP, use MACREL's instead.
;RIP:<7.UTILITIES>ACJDEC.MAC.967 3-Jan-89 15:20:00, Edit by GSCOTT
;(51) Update copyright date.
;RIP:<7.UTILITIES>ACJDEC.MAC.966 3-Jan-89 15:18:48, Edit by GSCOTT
;(50) Add output in log file of number requests failed.
;RIP:<7.UTILITIES>ACJDEC.MAC.964 3-Jan-89 14:37:02, Edit by GSCOTT
;(47) Log more information for CRDIRs.
;RIP:<7.UTILITIES>ACJDEC.MAC.962 29-Dec-88 10:48:50, Edit by GSCOTT
;(45) Change policy to allow and log any secure operation if no ACCESS.CONTROL.
;RIP:<7.UTILITIES>ACJDEC.MAC.961 20-Dec-88 10:05:24, Edit by GSCOTT
;(41) Problem with previous edit (extra comma in BYTE 7 statement).
;RIP:<7.UTILITIES>ACJDEC.MAC.956 16-Dec-88 10:56:47, Edit by GSCOTT
;(40) Paginate the logging file.
;RIP:<7.UTILITIES>ACJDEC.MAC.955 14-Dec-88 18:50:16, Edit by GSCOTT
;(37) Add LOGIN-xxxx keywords to user profile.
;RIP:<7.UTILITIES>ACJDEC.MAC.950 14-Dec-88 17:56:36, Edit by GSCOTT
;(36) Restart ourselves if under job 0.
;RIP:<7.UTILITIES>ACJDEC.MAC.949 13-Dec-88 11:17:19, Edit by GSCOTT
;(35) Put username first in logging for easier reading.
;RIP:<7.UTILITIES>ACJDEC.MAC.948 12-Dec-88 14:04:11, Edit by GSCOTT
;(34) Add invisible bit when looking for ACCESS.CONTROL.
;RIP:<7.UTILITIES>ACJDEC.MAC.946 7-Dec-88 15:46:55, Edit by GSCOTT
;(32) In WRITE command only send keywords that differ from default enable bits.
;RIP:<7.UTILITIES>ACJDEC.MAC.940 7-Dec-88 01:33:04, Edit by GSCOTT
;(30) Implement DENY-xxx keywords for functions.
;RIP:<7.UTILITIES>ACJDEC.MAC.935 6-Dec-88 21:35:15, Edit by GSCOTT
;(27) Implement ALL as keyword in ACCESS.CONTROL, clean up here and there.
;RIP:<7.UTILITIES>ACJDEC.MAC.913 6-Dec-88 19:02:28, Edit by GSCOTT
;(26) Implement SET PRIME-TIME-BEGIN and SET PRIME-TIME-END
;RIP:<7.UTILITIES>ACJDEC.MAC.906 6-Dec-88 18:01:00, Edit by GSCOTT
;(25) Check for no functions enabled in SAVE command.
;RIP:<7.UTILITIES>ACJDEC.MAC.902 6-Dec-88 17:55:53, Edit by GSCOTT
;(24) Use TIME rather than HPTIM for uptime to prevent overflows after 4 days.
;RIP:<7.UTILITIES>ACJDEC.MAC.892 3-Dec-88 02:52:35, Edit by GSCOTT
;(23) OTIME routine needs to handle times in the range of days.
;RIP:<7.UTILITIES>ACJDEC.MAC.891 1-Dec-88 11:08:20, Edit by GSCOTT
;(22) Wrong AC tested in FINDIT after call to WTBLUK.
;RIP:<7.UTILITIES>ACJDEC.MAC.888 30-Nov-88 13:35:18, Edit by GSCOTT
;(21) Don't use TEXTBU in HDRLOG routine as logging routines could be using it.
;RIP:<7.UTILITIES>ACJDEC.MAC.883 30-Nov-88 10:05:27, Edit by GSCOTT
;(17) Add POLICY keyword.
;RIP:<7.UTILITIES>ACJDEC.MAC.880 29-Nov-88 17:34:19, Edit by GSCOTT
;(16) Move ACCESS.CONTROL code here, allow hyphen at end of line.
;RIP:<7.UTILITIES>ACJDEC.MAC.879 28-Nov-88 09:43:58, Edit by GSCOTT
;(14) Ignore errors from SPRIW.
;RIP:<7.UTILITIES>ACJDEC.MAC.872 22-Nov-88 20:27:01, Edit by GSCOTT
;(13) Support wild username specifications.
;RIP:<7.UTILITIES>ACJDEC.MAC.827 22-Nov-88 11:09:42, Edit by GSCOTT
;(12) Calculation of next midnight time was flawed. Again.
;RIP:<7.UTILITIES>ACJDEC.MAC.817 21-Nov-88 21:12:02, Edit by GSCOTT
;(11) Another log file bug, smashed AC in NEWLOG.
;RIP:<7.UTILITIES>ACJDEC.MAC.811 21-Nov-88 15:12:38, Edit by GSCOTT
;(7) Statistics should be sent to log file.
;RIP:<7.UTILITIES>ACJDEC.MAC.807 21-Nov-88 14:29:59, Edit by GSCOTT
;(6) Repair setting timer interrupt in midnight routine.
;RIP:<7.UTILITIES>ACJDEC.MAC.801 20-Nov-88 22:53:48, Edit by GSCOTT
;(4) Suppress created symbol on ERSKP, support log file switch at midnight.
;RIP:<7.UTILITIES>ACJDEC.MAC.781 20-Nov-88 14:37:06, Edit by GSCOTT
;(3) Send JSYS error messages to log file if we have a log file JFN.
;RIP:<7.UTILITIES>ACJDEC.MAC.770 20-Nov-88 12:24:13, Edit by GSCOTT
;(2) Fix problem with DISFNC.
;RIP:<GSCOTT>ACJDEC.MAC.768 20-Nov-88 12:04:50, Edit by GSCOTT
;(1) Creation.
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1988, 1989.
; 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.
TITLE ACJDEC - Access Control Facility Profile and Policy Driver
SUBTTL Gregory A. Scott
Subttl Table of Contents
; Table of Contents for ACJDEC
;
; Section Page
;
;
; 1. General Comments . . . . . . . . . . . . . . . . . . . 5
; 2. Definitions
; 2.1 Environment . . . . . . . . . . . . . . . . . 6
; 2.2 Version and Entry Vector . . . . . . . . . . . 7
; 2.3 Storage
; 2.3.1 Low Segment Pages . . . . . . . . . . . 8
; 2.3.2 Low Segment Writable . . . . . . . . . . 9
; 2.3.3 High Segment Writable . . . . . . . . . 13
; 2.4 Interrupt System . . . . . . . . . . . . . . . 14
; 2.5 Command GTJFN Blocks . . . . . . . . . . . . . 16
; 2.6 Command State Block . . . . . . . . . . . . . 18
; 2.7 Command Tables . . . . . . . . . . . . . . . . 19
; 2.8 Set Command Tables . . . . . . . . . . . . . . 20
; 3. Commands
; 3.1 Initialization . . . . . . . . . . . . . . . . 21
; 3.2 Top Level . . . . . . . . . . . . . . . . . . 22
; 3.3 Disable Command . . . . . . . . . . . . . . . 23
; 3.4 Enable Command . . . . . . . . . . . . . . . . 24
; 3.5 Help Command . . . . . . . . . . . . . . . . . 25
; 3.6 Save Command . . . . . . . . . . . . . . . . . 26
; 3.7 Set Command . . . . . . . . . . . . . . . . . 27
; 3.7.1 Access Log File . . . . . . . . . . . . 28
; 3.7.2 Log File Cache Sweep Interval . . . . . 29
; 3.7.3 Prime Time . . . . . . . . . . . . . . . 30
; 3.7.4 Spy Check Interval . . . . . . . . . . . 31
; 3.7.5 Spy Log Directory . . . . . . . . . . . 32
; 3.8 Show Command . . . . . . . . . . . . . . . . . 33
; 3.8.1 Show Functions . . . . . . . . . . . . . 34
; 3.8.2 Show Settings . . . . . . . . . . . . . 36
; 3.8.3 Show User . . . . . . . . . . . . . . . 37
; 3.8.4 Show Text On Terminal . . . . . . . . . 40
; 3.9 Take Command . . . . . . . . . . . . . . . . . 41
; 3.10 User Command . . . . . . . . . . . . . . . . . 44
; 3.11 Write Command . . . . . . . . . . . . . . . . 47
; 3.11.1 Write Settings . . . . . . . . . . . . . 49
; 3.11.2 Write User Profiles . . . . . . . . . . 50
; 3.11.3 Write Function Profiles . . . . . . . . 51
; 3.11.4 File Header . . . . . . . . . . . . . . 52
; 3.11.5 Fill and Write Line to File . . . . . . 53
; 3.11.6 Open/Close File . . . . . . . . . . . . 54
; 3.12 Command Subroutines . . . . . . . . . . . . . 55
Subttl Table of Contents (page 2)
; Table of Contents for ACJDEC
;
; Section Page
;
;
; 4. Access Control
; 4.1 Initialization . . . . . . . . . . . . . . . . 56
; 4.1.1 Capabilities and Interrupts . . . . . . 57
; 4.1.2 Configuration . . . . . . . . . . . . . 58
; 4.1.3 Access Control Functions . . . . . . . . 59
; 4.2 Processing Loop . . . . . . . . . . . . . . . 61
; 4.2.1 Find Function Profile . . . . . . . . . 62
; 4.2.2 Find User Profile . . . . . . . . . . . 63
; 4.2.3 Check Request . . . . . . . . . . . . . 64
; 4.2.4 Wait for failure . . . . . . . . . . . . 65
; 4.2.5 Log Request . . . . . . . . . . . . . . 66
; 4.3 Subroutines
; 4.3.1 Wild TBLUK Routine . . . . . . . . . . . 67
; 4.3.2 Get User Information . . . . . . . . . . 68
; 5. Logging Routines
; 5.1 Midnight Timer Routines . . . . . . . . . . . 72
; 5.2 System Shutdown Time Routines . . . . . . . . 73
; 5.3 Initialization of Log File . . . . . . . . . . 75
; 5.4 Send Text to Log File . . . . . . . . . . . . 78
; 5.5 Log File Cached Write . . . . . . . . . . . . 79
; 5.6 Log File Cache Sweep Interrupts . . . . . . . 80
; 5.7 Log File Cache Sweep . . . . . . . . . . . . . 81
; 5.8 Open/Close/Checkpoint Log File . . . . . . . . 82
; 5.9 New Page for Log File . . . . . . . . . . . . 83
; 5.10 Statistics Logging . . . . . . . . . . . . . . 84
; 5.11 Start Logging a Request . . . . . . . . . . . 87
; 6. Spy on Intruder . . . . . . . . . . . . . . . . . . . 88
; 6.1 Start a Spy Fork . . . . . . . . . . . . . . . 89
; 6.2 Kill Spy Fork . . . . . . . . . . . . . . . . 91
; 6.3 Start a Spy Fork
; 6.3.1 Get a Spy File . . . . . . . . . . . . . 92
; 6.3.2 Get a PTY . . . . . . . . . . . . . . . 94
; 6.4 Spy Fork
; 6.4.1 Initialization . . . . . . . . . . . . . 95
; 6.4.2 Main Loop . . . . . . . . . . . . . . . 96
; 6.4.3 Spy File I/O Routines . . . . . . . . . 97
; 6.4.4 Error Recovery and Termination . . . . . 98
; 6.4.5 Timer Interrupts . . . . . . . . . . . . 99
; 6.4.6 Setup Spy Link . . . . . . . . . . . . . 100
; 6.5 Spy File Header/Trailer . . . . . . . . . . . 101
; 6.6 Inferior Fork Termination Interrupt . . . . . 102
Subttl Table of Contents (page 3)
; Table of Contents for ACJDEC
;
; Section Page
;
;
; 7. Secure Files . . . . . . . . . . . . . . . . . . . . . 103
; 7.1 Find File's Entry . . . . . . . . . . . . . . 104
; 7.2 Check Desired Access . . . . . . . . . . . . . 105
; 7.3 Access Keywords . . . . . . . . . . . . . . . 106
; 7.4 Access Control Cache . . . . . . . . . . . . . 107
; 7.4.1 Open File . . . . . . . . . . . . . . . 108
; 7.4.1.1 Split Filename . . . . . . . . . . 109
; 7.4.1.2 Cache Find . . . . . . . . . . . . 110
; 7.4.1.3 Cache Stale Check . . . . . . . . 111
; 7.4.1.4 Cached Open . . . . . . . . . . . 112
; 7.4.1.5 Cached Input Setup . . . . . . . . 114
; 7.4.2 Close File
; 7.4.2.1 Read Finished . . . . . . . . . . 115
; 7.4.2.2 Flush Cache . . . . . . . . . . . 116
; 7.5 Action for Successful Access . . . . . . . . . 117
; 7.6 Read Line from File . . . . . . . . . . . . . 119
; 7.7 Read Character from File . . . . . . . . . . . 120
; 7.8 Read Character from Line Buffer . . . . . . . 121
; 7.9 Read Field from Line Buffer . . . . . . . . . 122
; 8. Subroutines
; 8.1 Simulate STCMP . . . . . . . . . . . . . . . . 123
; 8.2 Simulate SOUT . . . . . . . . . . . . . . . . 124
; 9. Output Subroutines
; 9.1 Output Information about Job . . . . . . . . . 125
; 9.2 Output Username/Device/Filename . . . . . . . 126
; 9.3 Output Capability Mask . . . . . . . . . . . . 127
; 9.4 Small Output Routines . . . . . . . . . . . . 128
; 9.5 Output Sixbit Word . . . . . . . . . . . . . . 129
; 9.6 Output Numbers . . . . . . . . . . . . . . . . 130
; 9.7 Output Floating Point Numbers . . . . . . . . 132
; 9.8 Output Millisecond Times . . . . . . . . . . . 133
; 9.9 Output Standard Date/Time . . . . . . . . . . 135
; 9.10 Output JSYS Error Message . . . . . . . . . . 136
; 10. Error Handler
; 10.1 Error Messages . . . . . . . . . . . . . . . . 137
; 10.2 Panic and Control-C Interrupt . . . . . . . . 138
; 10.3 Crash Handler . . . . . . . . . . . . . . . . 139
; 11. End of ACJDEC . . . . . . . . . . . . . . . . . . . . 142
SUBTTL General Comments
COMMENT ~
This Access Control Facility operates in two phases. In the first ("profile")
phase, commands are entered to set up a database of which GETOK functions are
desired and which users need special treatment. In the second ("policy") phase
the program implements the policy specified in the first phase by running as
the system access control facility.
This is the ACJDEC module. This module of the access control facility
implements the initial phase (profile phase). After the policy profile data
has been specified, a command generates a runnable ACJ.EXE which implements the
policy.
The ACJDEC module also contains the core Access Control Facility policy
program, which gets access control requests from the monitor and implements the
policy specified in the profile phase. This module also contains subroutines
called by this module in the profile and policy phases. These subroutines are
also called by the ACJUSR module.
The design of the program allows site specific policy implementations and
access control functions to be changed in the ACJUSR module. It is expected
that any site should not have to change any code in the ACJDEC module,
particularly in the core access control code. The ACJSYM module contains all
symbols that need to be shared between ACJDEC and ACJUSR.
This program was written in November 1988 by Gregory A. Scott, Digital
Equipment Corporation, Marlboro, Massachusetts.
Future enhancements to consider:
Write logfiles with date and/or time included in filespec.
Create some kind of idle job killer functionality.
~
SUBTTL Definitions -- Environment
;Normalize MACRO, load TOPS-20 standard definitions, define ACs, get MACREL.
SALL ;Clean listing
.DIREC FLBLST ;First line binary only
SEARCH MONSYM ;Get the usual monitor symbols
SEARCH MACSYM ;Get the usual macros
STDAC. ;Get the usual ACs
;ACJ specific initialization.
SEARCH ACJSYM ;Get our symbols
LOHIGH ;Tell me we need two segments for this
LOWCD ;Start off in low memory
SUBTTL Definitions -- Version and Entry Vector
;Set copyright.
.CPYRT <<1989>> ;Use the usual copyright macro there
;Define the entry vector
EV: JRST START ;Normal start
JRST START ;Reenter start
EXP VACJ ;Version
EVLEN==.-EV ;Length of entry vector
SUBTTL Definitions -- Storage -- Low Segment Pages
;[107] This section defines pages allocated in the low segment.
;[107] Pages 0-77 and 400-477 are reserved for code.
FLPAGE==000 ;[107] First page allocated to low code
LLPAGE==077 ;[107] Last page allocated to low code
FHPAGE==400 ;[107] First page allocated to high code
LHPAGE==477 ;[107] Last page allocated to high code
APAGE==LLPAGE+1 ;[111] Start at page after low code
;[107] Define a macro to allocate pages in memory.
DEFINE ALLOCP (ASIZE,SYMBPG,SYMBBU,SYMBLP),< ;[107]
IFL APAGE-<LHPAGE+1>,< ;[111] If current free page in low sen
IFGE <APAGE+ASIZE>-FHPAGE,< ;[111] and not enough space for block
APAGE==LHPAGE+1>> ;[111] Switch to high sec
IFG <APAGE+ASIZE-1>-777,< ;[111] No more memory?
PRINTX ? Too much buffer space allocated
PASS2 ;[107] Punt
END ;[107] and get out of here
> ;[107] End of IFE APAGE-LLPAGE
IFNB <SYMBPG>,<SYMBPG==APAGE> ;[120] Define first page number if needed
IFNB <SYMBLP>,<SYMBLP==APAGE+ASIZE-1> ;[120] Last page of buffer
SYMBBU=APAGE_PGSFT ;[121] Address of page map buffer
APAGE==APAGE+ASIZE ;[111] Point to next free page
> ;[107] End of DEFINE ALLOCP
;[111] First allocate pages for the access control file cache buffers.
DEFINE ALLOCC(A),<ALLOCP (SCACHE,<CBXF'A>,<CBX'A>,<CBXL'A>)> ;[111]
......==0 ;[111] Start with zero
REPEAT NCACHE,< ;[111] For each cache entry
ALLOCC(\......) ;[111] Allocate the pages for it
......==......+1> ;[111] and count to next entry
;Now allocate some other page aligned space.
ALLOCP (LOGBPC,LOGBFP,LOGBUF,LOGBLP) ;[112] Log file cache buffer
ALLOCP (1,SECOPG,SECOBU,) ;[120] Map access.control overflow pages here
ALLOCP (1,,TEXTBU,) ;[120] Place to put text into
ALLOCP (1,,HEADBU,) ;[120] Place to make header text into
SUBTTL Definitions -- Storage -- Low Segment Writable
LOWCD ;Low segment code
;Misc storage.
STACK: BLOCK PLEN ;Program stack
TEXTBP: BLOCK 1 ;Pointer into TEXTBU
;Storage used in statistics gathering.
NALLOW: BLOCK 1 ;Number of GETOKs allowed
NDENY: BLOCK 1 ;Number of GETOKs denied
NFAIL: BLOCK 1 ;Number of requests that failed
NHIT: BLOCK 1 ;[111] Number of access control cache hits
NMISS: BLOCK 1 ;[111] Number of access control cache misses
NFLUSH: BLOCK 1 ;[114] Number of access control cache flushes
RUNTIM: BLOCK 1 ;Program initial run time
PEOPLE: BLOCK 1 ;Program initial connect time
;Storage used in error reporting and crashing.
ERRBUF: BLOCK ^D400/5 ;Place to make error strings
ERRADR: BLOCK 1 ;Address of error string to print
LASERR: BLOCK 1 ;Last error at time of crash
BUGACS: BLOCK 20 ;ACs at time of crash
BUGPDL: BLOCK BUGLEN ;Stack for the crash
BUGFIL: BLOCK ^D<7+4+6+6+7+4+1>/5 ;Place to build filename
;Configuration information
TTYPTY: BLOCK 1 ;TTY number of first PTY
MAXPTY: BLOCK 1 ;Number of PTYs
CTYLNO: BLOCK 1 ;Line number of the CTY
OURNAM: BLOCK 2 ;Place to keep our ASCIZ node name
OPRUNO: BLOCK 1 ;User number of OPERATOR
OURUNO: BLOCK 1 ;User number of runner of profile generator
OURJOB: BLOCK 1 ;Our job number (0 or global job number)
LOGFIL: BLOCK ^D<40*5>/5 ;Log file name
PRIMEB: BLOCK 1 ;Time that prime time begins
PRIMEE: BLOCK 1 ;Time that prime time ends
;Storage used for access control housekeeping.
ARGBLK: BLOCK ARGLEN ;RCVOK argument block
USRSTR: BLOCK ^D<40*2>/5 ;Store a username here
TODCLK: BLOCK 1 ;[107] Uptime at the time of the last request
;Job information blocks
JIBLK: BLOCK JISIZ ;GETJI information for source job
CJBLK: BLOCK JISIZ ;Controlling job information block
TJBLK: BLOCK JISIZ ;Target job information block
;Storage used in remembering user profile.
;NOTE: Offset in right half of USRKEY is the index into USRPRO.
; Relative address in USRKEY is the index into USRNUM.
USRTBL: BLOCK 1 ;TBLUK table of [ASCIZ/user/],,profile offset
USRKEY: BLOCK NUSERS ;Data for USRTBL
USRSTG: BLOCK NUSERS*<USRCHR/5> ;ASCIZ username strings
USRPRO: BLOCK NUSERS ;Profile word for each user in table
;Storage used in writing the log file.
LOGLIN: BLOCK 1 ;Place to keep number of lines on this page
LOGPAG: BLOCK 1 ;Place to keep page number of this log file
LOGJFN: BLOCK 1 ;Place to keep the log file JFN
LOGPTR: BLOCK 1 ;[107] Pointer into log buffer
LOGCNT: BLOCK 1 ;[107] Count of freespace remaining in LOGBUF
LOGINT: EXP -1 ;[113] Interval in seconds between sweeps
LOGFNA: BLOCK ^D<5*40>/5 ;[110] Currently open log file name
LOGFTI: BLOCK ^D<2+1+3+1+4+1+2+1+2+1+2+1+1>/5 ;[124] Time used in log filename
LOGHSY: BLOCK 1 ;[125] Time that system is expected to HSYS
;Storage used in intruder spy facility.
SPYSLD: BLOCK ^D160/5 ;Spy log directory
SPYFIL: BLOCK ^D160/5 ;Place to build temp string for filename
SPYINT: BLOCK 1 ;Interval between spy fork checks
SPYFWZ==. ;First word to zero
SPYFRK: BLOCK NSPYS ;Save inferior handles here
SPYJOB: BLOCK NSPYS ;Job fork is watching
SPYUSR: BLOCK NSPYS ;Usernumber that fork is monitoring
SPYJFN: BLOCK NSPYS ;Log file JFN,,PTY JFN
SPYPDL: BLOCK NSPYS*SPLEN ;Stacks for the spy forks
SPYLWZ==.-1 ;Last word to zero
;Storage used in ACCESS.CONTROL routines.
SECGTJ: BLOCK .GJNOD+1 ;Place to build long form GTJFN
SECDIR: BLOCK ^D<40*3>/5 ;[111] Place to build "str:<directory>"
SECFNA: BLOCK ^D<40*5>/5 ;Place to build "file.type.gen"
SECFNV: BLOCK ^D<40*5>/5 ;[115] Place to build "file.type"
SECWRD: BLOCK ^D<40*5>/5 ;Place to read a field into
SECUSR: BLOCK ^D<40*2>/5 ;[115] Place to construct username
SECLIN: BLOCK SECCPL ;Place to read in the access control line
SECPMP: BLOCK 1 ;Page of file that is mapped now
SECPCT: BLOCK 1 ;Count of pages left to map
SECBCT: BLOCK 1 ;Byte count of mapped data area
SECBPT: BLOCK 1 ;Pointer into mapped data area
;[111] Access control cache blocks
DEFINE ALLOCC(A),<
XLIST ;[121] Turn listing off
PHASE 0 ;[111] Start definition of cache block
CBXJFN:!BLOCK 1 ;[111] JFN of this file
CBXCTL:!BLOCK 1 ;[111] FBCTL word of file
CBXPTR:!POINT 7,CBX'A ;[111] Byte pointer to read cached buffer
CBXPAG:!XWD .FHSLF,CBXF'A ;[111] Page number of the buffer
CBXMAP:!BLOCK 1 ;[111] Page count of cached file pages
CBXPCT:!BLOCK 1 ;[111] Page count of entire file
CBXRTI:!BLOCK 1 ;[111] Uptime at time that file was referenced
CBXMTI:!BLOCK 1 ;[111] Uptime at time that file was mapped
CBXDIR:!BLOCK ^D<6+1+1+<39*2>+1+1>/5 ;[111] Directory where file lives
CBXFIL:!BLOCK ^D<6+1+1+<39*2>+1+6+1+7+1>/5 ;[115] str:<dir>access.control
CBXSIZ:! ;[111] Define size of the block
DEPHASE ;[111] Get back to normal addressing
LIST ;[121] Turn listing on
> ;[111] End of DEFINE ALLOCC
CBPOOL: ......==0 ;[111] Start with zero
REPEAT NCACHE,< ;[111] For each cache entry
ALLOCC(\......) ;[111] Allocate the storage for it
......==......+1> ;[111] and count to next entry
SUBTTL Definitions -- Storage -- High Segment Writable
HIGHCD ;High segment code/data
;Storage for command parsing
CMDBUF: BLOCK <CBUFSZ==100> ;Command buffer
ATMBUF: BLOCK <ABUFSZ==40> ;Atom buffer
GTJBLK: BLOCK .GJATR+1 ;Long form GTJFN buffer
CSBLOK: BLOCK .CMGJB+1 ;Command state block
CMTADB: BLOCK 3 ;Block to parse time into
LINWID: BLOCK 1 ;Width of the terminal for showing text
TAKJFN: BLOCK 1 ;Take file JFN
PRSJFN: BLOCK 1 ;JFN used while parsing
SUBTTL Definitions -- Interrupt System
LOWCD ;Low segment code
;First create macro to assign each channel we desire.
;If channel not specified assign one from the range 0-6.
DEFINE ASSCHN(LEV,CHN,ADR,NAM),< ;Level, channel, routine, symbol
ONCHNS==ONCHNS!1B<^O<CHN>> ;Count this channel as one to enable
IFNB <CHN>,< ;If channel specified
CHAN'CHN==<LEV,,ADR> ;Construct this symbol for later
IFNB <NAM>,<NAM==CHN> ;Name it if desired
> ;End of IFNB <CHN>
IFB <CHN>,< ;If we want to assign one
ASSCHN(LEV,\FRECHN,ADR,NAM) ;Get one assigned and named
FRECHN==FRECHN+1 ;Count up one channel
IFE FRECHN-.ICAOV,< ;[125] If channel 0-5 now in use
FRECHN==.ICNXP+1 ;[125] Jump over panics to chan 23
> ;[125] End of IFE FRECHN-.ICAOV
> ;End of IFB <CHN>
> ;End of DEFINE ASSCHN
FRECHN==0 ;Start assigning with channel zero
ONCHNS==0 ;Start with no channels enabled
;Macro to grow the channel table from definitions set with ASSCHN.
DEFINE CHNGEN,< ;Macro to expand channel table
DEFINE PLANTC(NUM),< ;Macro to generate CHNTAB entry
XLIST ;Stop listing momentarily
IFNDEF CHAN'NUM,<EXP 0> ;Zero if no assignment
IFDEF CHAN'NUM,<EXP CHAN'NUM> ;Plant one channel table entry
LIST ;Resume listing now
......==......+1 ;Ratchet the channel number by one
> ;End of DEFINE PLANTC
......==0 ;Starting at channel 0
REPEAT ^D36,<PLANTC (\......)> ;Plant each channel
> ;End of DEFINE CHNGEN
;Assign panic channels first.
ASSCHN(1,\.ICPOV,PANIC) ;PDL overflows to PANIC
ASSCHN(1,\.ICDAE,PANIC) ;Data errors to PANIC
ASSCHN(1,\.ICQTA,PANIC) ;Disk full to PANIC
ASSCHN(1,\.ICILI,PANIC) ;Ill inst to PANIC
ASSCHN(1,\.ICIRD,PANIC) ;Ill mem read to PANIC
ASSCHN(1,\.ICIWR,PANIC) ;Ill mem write to PANIC
ASSCHN(1,\.ICMSE,PANIC) ;Sys resources exhausted to PANIC
;Assign other channels as needed.
ASSCHN(1,,CNTRLC,CCCHAN) ;Control-C trap on same as panic channel
ASSCHN(2,,MIDNIT,MDCHAN) ;Midnight interrupts
ASSCHN(2,,INTLFF,LFCHAN) ;[107] Log file cache sweeps
ASSCHN(2,,INTHSY,HFCHAN) ;[125] Hsys interrupt for log file sweep
ASSCHN(3,\.ICIFT,FRKTRM) ;Inferior fork termination interrupt
ASSCHN(3,,TIMINT,TICHAN) ;TIMER% interrupt (inferior fork use only)
;Make CHNTAB.
CHNTAB: CHNGEN ;Generate channel table
;Set the level table here.
LEVTAB: EXP LEV1PC ;Location to save level 1 PC return address
EXP LEV2PC ;Location to save level 2 PC return address
EXP LEV3PC ;Location to save level 3 PC return address
LEV1PC: BLOCK 1 ;Level 1 interrupt return PC
LEV2PC: BLOCK 1 ;Level 2 interrupt return PC
LEV3PC: BLOCK 1 ;Level 3 interrupt return PC
SUBTTL Definitions -- Command GTJFN Blocks
HIGHCD ;Back to high segment only code
;Save command GTJFN block
SAVGTJ: GJ%FOU!GJ%MSG ;(.GJGEN) Flags and generation
XWD .NULIO,.NULIO ;(.GJSRC) JFNs
0 ;(.GJDEV) Default device
0 ;(.GJDIR) Default directory
POINT 7,[ASCIZ/ACJ/] ;(.GJNAM) Default file
POINT 7,[ASCIZ/EXE/] ;(.GJEXT) Default type
0 ;(.GJPRO) Default protection
0 ;(.GJACT) Default account
0 ;(.GJJFN) Specified JFN
0 ;(.GJF2) Additional flags
;Set Access-log-file command GTJFN block
ALFGTJ: GJ%OFG ;(.GJGEN) Flags and generation parse only
XWD .NULIO,.NULIO ;(.GJSRC) Jfns
0 ;(.GJDEV) Default device
0 ;(.GJDIR) Default directory
0 ;(.GJNAM) Default file
0 ;(.GJEXT) Default type
0 ;(.GJPRO) Default protection
0 ;(.GJACT) Default account
0 ;(.GJJFN) Specified JFN
G1%SLN ;(.GJF2) Additional flags
;Set Spy-log-directory command GTJFN block
SLDGTJ: GJ%OFG ;(.GJGEN) Flags and generation parse only
XWD .NULIO,.NULIO ;(.GJSRC) Jfns
0 ;(.GJDEV) Default device
0 ;(.GJDIR) Default directory
0 ;(.GJNAM) Default file
0 ;(.GJEXT) Default type
0 ;(.GJPRO) Default protection
0 ;(.GJACT) Default account
0 ;(.GJJFN) Specified JFN
G1%SLN ;(.GJF2) Additional flags
;Take command GTJFN block
TAKGTJ: GJ%OLD ;(.GJGEN) Flags and generation
XWD .NULIO,.NULIO ;(.GJSRC) Jfns
0 ;(.GJDEV) Default device
0 ;(.GJDIR) Default directory
POINT 7,[ASCIZ/ACJPROFILE/] ;(.GJNAM) Default file
POINT 7,[ASCIZ/CMD/] ;(.GJEXT) Default type
0 ;(.GJPRO) Default protection
0 ;(.GJACT) Default account
0 ;(.GJJFN) Specified JFN
G1%IIN ;(.GJF2) Additional flags
;Write command GTJFN block
WRIGTJ: GJ%FOU!GJ%MSG ;(.GJGEN) Flags and generation
XWD .NULIO,.NULIO ;(.GJSRC) Jfns
0 ;(.GJDEV) Default device
0 ;(.GJDIR) Default directory
POINT 7,[ASCIZ/ACJPROFILE/] ;(.GJNAM) Default file
POINT 7,[ASCIZ/CMD/] ;(.GJEXT) Default type
0 ;(.GJPRO) Default protection
0 ;(.GJACT) Default account
0 ;(.GJJFN) Specified JFN
0 ;(.GJF2) Additional flags
SUBTTL Definitions -- Command State Block
;Command state block template.
CSBTPL: EXP COM2 ;(.CMFLG) Reparse at COM2
XWD .PRIIN,.PRIOU ;(.CMIOJ) Input and output JFNs
POINT 7,[EXP ASCII "ACJDE",<BYTE(7)"C",76,0>] ;(.CMRTY) Ptr to prompt
POINT 7,CMDBUF ;(.CMBFP) Pointer to start of buffer
POINT 7,CMDBUF ;(.CMPTR) Pointer to next input
EXP 5*CBUFSZ-1 ;(.CMCNT) Count of space remaining after .CMPTR
EXP 0 ;(.CMINC) Number of unparsed chars after .CMPTR
POINT 7,ATMBUF ;(.CMABP) Atom buffer pointer
EXP 5*ABUFSZ-1 ;(.CMABC) Atom buffer size in characters
EXP GTJBLK ;(.CMGJB) Address of long form GTJFN block
;Break mask for user names when they are being read by CMKEY.
USRBRK: EXP USRB0.,USRB1.,USRB2.,USRB3.
SUBTTL Definitions -- Command Tables
;Command table - must be in alphabetical order
; One entry for each command in the table
; CMND(name,help,routine,noflag)
DEFINE COMGEN<
XLIST
CMND(DISABLE,<(function) ALL|name>,DODISA)
CMND(ENABLE,<(function) ALL|name [profile]>,DOENAB)
CMND(HELP,<(message)>,DOHELP)
CMND(SAVE,<(program in) ACJ.EXE>,DOSAVE)
CMND(SET,<(mode) keywords>,DOSET)
CMND(SHOW,<ALL|FUNCTION [f]|SETTING [s]|USER [u]>,DOSHOW)
CMND(TAKE,<(commands from) acjprofile.cmd.0>,DOTAKE)
CMND(USER,<name [profile]>,DOUSER)
CMND(WRITE,<(commands to) acjprofile.cmd.-1>,DOWRIT)
LIST
>
;Command table suitable for use from COMND.
DEFINE CMND(A,B,C)<
XWD [ASCIZ/A/],C
>
CMDTBL: TBEGIN ;Insert table header
COMGEN ;Generate top level keywords
TEND ;Compute number of commands for header
;Table of keywords for HELP command.
DEFINE CMND(A,B,C)<
[ASCIZ\ A 'B'
\]
>
COMHLP: COMGEN ;Generate help text
HLPNUM==.-COMHLP ;Set number of entries
SUBTTL Definitions -- Set Command Tables
;Define a table of SET command keywords for setting and display
DEFINE SETGEN,<
XLIST
SETFUN(ACCESS-LOG-FILE,<Access Control log file>,<[-1,,LOGFIL]>,ISOUT,SETALF)
SETFUN(LOG-FILE-CACHE-SWEEP-INTERVAL,<Log file cache sweep interval in seconds>,LOGINT,ODEC,SETLFI) ;[107]
SETFUN(PRIME-TIME-BEGIN,<Prime time begin>,PRIMEB,OTOD,SETPTB)
SETFUN(PRIME-TIME-END,<Prime time end>,PRIMEE,OTOD,SETPTB)
SETFUN(SPY-CHECK-INTERVAL,<Spy check interval in seconds>,SPYINT,ODEC,SETSCI)
SETFUN(SPY-LOG-DIRECTORY,<Spy log directory and file>,<[-1,,SPYSLD]>,ISOUT,SETSLD)
LIST
> ;End of define SETGEN
;Table for SHOW SETTINGS command.
DEFINE SETFUN(A,B,C,D,E),<XWD [ASCIZ/B is set to /],D>
SETSHT: SETGEN ;Generate table of show text adr,,show routine
SETNUM==.-SETSHT ;Compute load number in table
;Table for command keywords and storing the data.
DEFINE SETFUN(A,B,C,D,E),<TENTRY(A,E)>
SETTBL: TBEGIN ;Table header
SETKEY: SETGEN ;Generate table
TEND ;End of commands table
DEFINE SETFUN(A,B,C,D,E),<EXP C>
SETDAT: SETGEN ;Generate table of data to show
;Define a microtable used to string "SETTINGS" onto command keyword lists.
SHOTBL: TBEGIN ;Plant the header
TENTRY(ALL,DOSHOA) ;SHOW ALL
TENTRY(FUNCTION,DOSHOF) ;SHOW FUNCTION function
TENTRY(SETTINGS,DOSHOS) ;SHOW SETTINGS
TENTRY(USER,DOSHOU) ;SHOW USER user
TEND ;Count that one keyword
;Define a microtable used to string "ALL" onto command keyword lists.
ALLTBL: TBEGIN ;Plant the header
ALLKEY: TENTRY(ALL,0) ;Just one keyword and that is all
TEND ;Count that one keyword
SUBTTL Commands -- Initialization
HIGHCD
;Here to start up the configuration phase of the program
START: RESET% ;The world
SETZ F, ;Load default flags
MOVE P,[IOWD PLEN,STACK] ;Load stack pointer
MOVE T1,[XWD CSBTPL,CSBLOK] ;Get BLT pointer for command state block
BLT T1,CSBLOK+.CMGJB ;Move it to the command state block
SETZM TAKJFN ;Not in a take file (any more)
SETZM PRSJFN ;Not filename parsing (any more)
MOVEI T1,NUSERS ;Load size of user table
SKIPN USRTBL ;Is the user table already set up?
MOVEM T1,USRTBL ;Save size of user table in the user table
MOVEI T1,SPYDCI ;Load default spy interval
SKIPN SPYINT ;Is one set?
MOVEM T1,SPYINT ;Nope, set default
MOVEI T1,LOGDCI ;[107] Load default spy interval
SKIPGE LOGINT ;[113] Is one set (-1 at startup)?
MOVEM T1,LOGINT ;[107] Nope, set default
HRROI T1,LOGFIL ;Point to log file area
HRROI T2,[ASCIZ/SYSTEM:LOGFILE.LOG/] ;Load default filespec
SKIPN LOGFIL ;Is log file spec set up?
CALL ISOUT ;(T1,T2/T1) Set it up now
HRROI T1,SPYSLD ;Point to spy log file area
HRROI T2,[ASCIZ/SYSTEM:ACJ-SPY/] ;Load default filespec
SKIPN SPYSLD ;Is spy log file spec set up?
CALL ISOUT ;(T1,T2/T1) Set it up now
MOVEI T1,PRIMDB ;Load default begin time
SKIPN PRIMEB ;Prime time begin set?
MOVEM T1,PRIMEB ;No, set it now
MOVEI T1,PRIMDE ;Load default end time
SKIPN PRIMEE ;Prime time end set?
MOVEM T1,PRIMEE ;No, set it now
GJINF% ;Get this job's information
MOVEM T1,OURUNO ;Save our user number for later
MOVEI T1,.PRIIN ;Load primary terminal
MOVEI T2,.MORLW ;Read line width
MTOPR% ;Get the terminal line width
ERSKP. ;Skip if error
CAIGE T3,^D40 ;At least 40?
MOVEI T3,^D40 ;Don't look bad if width zero
MOVEM T3,LINWID ;Save this here for later use
; JRST COM1 ;Start scanning commands
SUBTTL Commands -- Top Level
;Here when ready to read a command from the terminal.
COM1: MOVEI T2,[FLDDB. .CMINI] ;Get init function
CALL COMANE ;(T2/T1,T2,T3) Do it
;See if we are doing a TAKE file and if so process another line out of it.
CALL TAKCHK ;(/) Read a line from the TAKE file
;Here on a reparse
COM2: SKIPE T1,PRSJFN ;Is there a parse JFN?
RLJFN% ;Yes, release it please
ERNOP. ;Ignore errors
SETZM PRSJFN ;No parse JFN any more
MOVE P,[IOWD PLEN,STACK] ;Load stack pointer
MOVEI T2,[FLDDB. .CMKEY,,CMDTBL,<a command,>] ;Point to commands
CALL COMANE ;(T2/T1,T2,T3) Get a command
HRRZ T2,(T2) ;Get dispatch address
CALL (T2) ;(/) Do it
JRST COM1 ;Loop for more commands
SUBTTL Commands -- Disable Command
;DISABLE (function) ALL|name
DODISA: NOISE (function) ;Set noise words in front of the user
MOVEI T2,[FLDDB. .CMKEY,,FUNTBL,<a function,>,,[
FLDDB. .CMKEY,CM%SDH,ALLTBL,<ALL for all functions>]]
CALL COMANE ;(T2/T1-T3) Get a command
HRRZ P3,(T2) ;Get the function code (or 0 for all)
MOVEI P1,-FUNKEY(T2) ;Get address of enable bits
CALL CONFIR ;(/) Confirm that please
;Single function specified, disable it and return.
JUMPE P3,DODIS3 ;Jump if ALL specified
HRRZS FUNCTB(P1) ;Zero the left half of this entry
RET ;Return
;All functions specified, disable all of them and return.
DODIS3: MOVE T1,FUNAOB ;Load -number,,0
DO. ;For each function
HRRZS FUNCTB(T1) ;Zero an entry into the table
AOBJN T1,TOP. ;Loop for all of them
OD. ;End of clearing loop
RET ;Return to get more commands
SUBTTL Commands -- Enable Command
;ENABLE (function) ALL|name switch
DOENAB: NOISE (function) ;Set noise words in front of the user
MOVEI T2,[FLDDB. .CMKEY,,FUNTBL,<a function,>,,[
FLDDB. .CMKEY,CM%SDH,ALLTBL,<ALL for all functions>]]
CALL COMANE ;(T2/T1-T3) Get a command
HRRZ P3,(T2) ;Get the function code (or 0 for all)
MOVEI P1,-FUNKEY(T2) ;Get offset for this function bits
MOVE P2,ENADEF ;Load default bits to set in the mode word
;Parse profile keywords after function name.
DOENA1: MOVEI T2,[FLDDB. .CMCFM,,,,,[
FLDDB. .CMKEY,,ENATBL,<a profile keyword,>]]
CALL COMANE ;(T2/T1-T3) Parse a switch or confirm
LDB T3,[POINTR .CMFNP(T3),CM%FNC] ;Load the function parsed
CAIN T3,.CMCFM ;Was it the confirm?
JRST DOENA2 ;Yep, it certainly was this time
HRRZ T2,(T2) ;Load the address of the word with bits in it
SKIPN T2,(T2) ;Skip if there is a bit to set
IFSKP. ;There was a bit to set
TDO P2,T2 ;Set the bit please
JRST DOENA1 ;Loop until confirm seen
ENDIF. ;Otherwise it must be "NO", parse keyword
MOVEI T2,[FLDDB. .CMKEY,,ENANOT,<a profile keyword,>]
CALL COMANE ;(T2/T1,T2,T3) Get the thing parsed
HRRZ T2,(T2) ;Load address where the bits are
TDZ P2,(T2) ;Clear specified bit
JRST DOENA1 ;Loop until confirm seen
;Bits for this function are now in P2, if single function set them and return.
DOENA2: JUMPE P3,DOENA3 ;Loop for all of them if ALL specified
HLLM P2,FUNCTB(P1) ;Set bits the word where bits go today
RET ;Return happily to the caller
;All functions specified, set each one of them with bits in P2 and return.
DOENA3: MOVE T1,FUNAOB ;Load number of -functions,,0
DOENA4: HLLM P2,FUNCTB(T1) ;Zero an entry into the table
AOBJN T1,DOENA4 ;Loop for all of them
RET ;Return to get more commands
SUBTTL Commands -- Help Command
;HELP (message)
DOHELP: NOISE (message) ;Parse noise word por favor
CALL CONFIR ;(/) Confirm the command, maybe log or echo it
HRROI T1,TEXTBU ;Point to text buffer
CALL OCRLF ;(T1/T1) Start with crlf
HRROI T2,[VERSIO] ;Point to version string
CALL ISOUT ;(T1,T2/T1) Append version of this program
HRROI T2,HLPTXT ;Point to text
CALL ISOUT ;(T1,T2/T1) Append that help text next
CALL PTEXT ;(/) Print all of that on the terminal
MOVSI T3,-HLPNUM ;Get number of elements in table
HELPLP: HRRO T1,COMHLP(T3) ;Get pointer to help text
PSOUT% ;Tell that one
AOBJN T3,HELPLP ;Loop for all commands
CALLRET PCRLF ;(/) Output extra crlf and return
HLPTXT: ASCIZ/ commands:
/
SUBTTL Commands -- Save Command
;SAVE (program in) ACJ.EXE
DOSAVE: NOISE (program in) ;Mumble
;See if there is any functions enabled.
MOVE T1,FUNAOB ;Load -number,,0
MOVX T2,FU%ENA ;Load enable bits to test
DO. ;For each function
TDNE T2,FUNCTB(T1) ;Is this function enabled?
EXIT. ;Get out, there is at least one enabled
AOBJN T1,TOP. ;Loop for all of them
EMSG <No functions enabled> ;This isn't making sense
RET ;Return now
OD. ;So, there is at least function enabled
;Parse the rest of the command.
MOVE T1,[XWD SAVGTJ,GTJBLK] ;Make BLT pointer for source GTJFN
BLT T1,GTJBLK+.GJF2 ;Copy GTJFN block over there
MOVEI T2,[FLDDB. .CMFIL,CM%SDH,,<filename to save into>]
CALL COMANE ;(T1/T1-T3) Get filename
MOVEM T2,PRSJFN ;Save JFN for a sec
CALL CONFIR ;(/) Confirm that please
;Save ourselves as a runnable access control policy program.
HRROI T1,TEXTBU ;Point to text buffer
CALL OSPACE ;(T1/T1) Start with a space please
MOVE T2,PRSJFN ;Load the JFN today
CALL OJFNS ;(T1,T2/T1) Send the saved filename
HRROI T2,[ASCIZ/ Saved
/] ;Label the preceeding filename
CALL ISOUT ;(T1,T2/T1) Send that along as the end
MOVEI T1,ASTART ;Load new start address
HRRM T1,EV ;Save as new start address
IFE DBUGSW,HRRM T1,EV+1 ; and as reenter address
MOVE T1,PRSJFN ;Load the JFN back
SETZM PRSJFN ;Don't try to release the JFN later
HRLI T1,.FHSLF ;This fork
MOVX T2,SS%CPY!SS%RD!SS%EXE!FLD(-SAVCNT,SS%NNP)!FLD(0,SS%FPN)
SSAVE% ;Save our image
JSERRO (<Cannot create image>,,R) ;Owie!
CALL PTEXT ;(/) Output the "saved" message
HALTF% ;Halt the ACJ fork
JRST .-1 ;Don't allow continue
SUBTTL Commands -- Set Command
;SET keyword value
DOSET: MOVEI T2,[FLDDB. .CMKEY,,SETTBL,<item to set,>]
CALL COMANE ;(T2/T1-T3) Get a set command
MOVEI P1,-SETKEY(T2) ;Get offset for this function bits
HRRZ T2,(T2) ;Get dispatch address
CALLRET (T2) ;(/) Do it and return
SUBTTL Commands -- Set Command -- Access Log File
;SET ACCESS-LOG-FILE str:<dir>file.typ
SETALF: MOVE T1,[XWD ALFGTJ,GTJBLK] ;Make BLT pointer for source GTJFN
BLT T1,GTJBLK+.GJF2 ;Copy GTJFN block over there
MOVEI T2,[FLDDB. .CMFIL,CM%SDH,,<filespec for access control logging>,SYSTEM:LOGFILE.LOG]
CALL COMANE ;(T1/T1,T2,T3) Get filename
MOVEM T2,PRSJFN ;Save JFN for a sec
CALL CONFIR ;(/) Confirm that please
HRROI T1,LOGFIL ;Point to log directory area
MOVE T2,PRSJFN ;Load the JFN back, COM2 will release it
MOVX T3,JS%PAF!FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!FLD(.JSAOF,JS%NAM)!FLD(.JSAOF,JS%TYP)
JFNS% ;Make a string out of that
JSERRO (<Can't make access control filespec string>)
RET ;Return to get more commands
SUBTTL Commands -- Set Command -- Log File Cache Sweep Interval
;SET LOG-FILE-CACHE-INTERVAL n (seconds)
SETLFI: NOISE (seconds) ;[107] Mumble
MOVEI T2,[FLDDB. .CMNUM,CM%SDH,^D10,<cache sweep interval in seconds>] ;[107]
CALL COMANE ;[107] (T2/T1-T3) Parse that number
SKIPL P1,T2 ;[113] Skip if greater than zero or zero
IFSKP. ;[107] If zero or less
EMSG <Interval must be non-negative number> ;[113] Owie
RET ;[107] Return now
ENDIF. ;[107] End of error code
CALL CONFIR ;[107] (/) Confirm that command
MOVEM P1,LOGINT ;[107] Save log file interval time
RET ;[107] and return
SUBTTL Commands -- Set Command -- Prime Time
;SET PRIMT-TIME-BEGIN hh:mm
;SET PRIME-TIME-END hh:mm
SETPTB: MOVEI T2,[FLDDB. .CMTAD,CM%SDH,CM%ITM!CM%NCI!CMTADB,<time in form hh:mm>]
CALL COMANE ;(T2/T1,T2,T3) Parse that time
CALL CONFIR ;(/) Confirm that
MOVE T2,CMTADB+2 ;Load the time in seconds since midnight
HRRZM T2,@SETDAT(P1) ;Save the time
RET ; and return
SUBTTL Commands -- Set Command -- Spy Check Interval
;SET SPY-CHECK-INTERVAL n (seconds)
SETSCI: NOISE (seconds) ;Mumble
MOVEI T2,[FLDDB. .CMNUM,CM%SDH,^D10,<spy interval in seconds>]
CALL COMANE ;(T2/T1-T3) Parse that number
SKIPLE P1,T2 ;Skip if greater than zero
IFSKP. ;If zero or less
EMSG <Interval must be positive number>
RET ;Return now
ENDIF. ;End of error code
CALL CONFIR ;(/) Confirm that command
MOVEM P1,SPYINT ;Save spy interval time
RET ; and return
SUBTTL Commands -- Set Command -- Spy Log Directory
;SET SPY-LOG-DIRECTORY str:<dir>file
SETSLD: MOVE T1,[XWD SLDGTJ,GTJBLK] ;Make BLT pointer for source GTJFN
BLT T1,GTJBLK+.GJF2 ;Copy GTJFN block over there
MOVEI T2,[FLDDB. .CMFIL,CM%SDH,,<directory to save spy logs into>,SYSTEM:ACJ-SPY]
CALL COMANE ;(T1/T1-T3) Get filename
MOVEM T2,PRSJFN ;Save JFN for a sec
CALL CONFIR ;(/) Confirm that please
HRROI T1,SPYSLD ;Point to spy log directory area
MOVE T2,PRSJFN ;Load the JFN back, COM2 will release it
MOVX T3,JS%PAF!FLD(.JSAOF,JS%DEV)!FLD(.JSAOF,JS%DIR)!FLD(.JSAOF,JS%NAM)
JFNS% ;Make a string out of that
JSERRO (<Can't make spy log filespec string>)
RET ;Return to get more commands
SUBTTL Commands -- Show Command
;SHOW ALL|FUNCTION [ALL|fun]|SETTING [ALL|setting]|USER [ALL|user]
DOSHOW: MOVEI T2,[FLDDB. .CMKEY,,SHOTBL,<item to show,>,ALL] ;Parse keyword
CALL COMANE ;(T2/T1-T3) Parse that please
HRRZ T2,(T2) ;Load address to dispatch to
CALLRET (T2) ;(/) Perform show function and return
;Here for SHOW ALL, confirm it first. Show all possible things.
;Returns +1 always with all possible things showed.
DOSHOA: CALL CONFIR ;(/) Confirm this event
CALL SHOSEA ;(/) Show settings all
CALL SHOFUA ;(/) Show functions all
CALLRET SHOUSA ;(/) Show user all and return
SUBTTL Commands -- Show Command -- Show Functions
;Here for SHOW FUNCTION ALL|function.
DOSHOF: MOVEI T2,[FLDDB. .CMKEY,,FUNTBL,<a function,>,ALL,[
FLDDB. .CMKEY,,ALLTBL,<ALL for all functions>]]
CALL COMANE ;(T2/T1,T2,T3) Parse that
DMOVE P2,T2 ;Save entry from table and which adr used
CALL CONFIR ;(T1/T1) Confirm it
HRRZ T2,(P2) ;Get rh of returned keyword entry
JUMPE T2,SHOFUA ;(/) Use routine to perform ALL
MOVEI P1,-FUNKEY(P2) ;Load offset for this function
MOVE T2,FUNCTB(P1) ;Load the function enable bits
TXNN T2,FU%ENA ;Is it enabled?
SKIPA T2,[-1,,[ASCIZ/ Disabled function /]] ;Disabled function
HRROI T2,[ASCIZ/ Enabled function /] ;Enabled function
; CALLRET SHOFUN ;(T2,P1/) Yes, a function, send it and return
;Here to show information about a single function.
;Call with
; T2/ pointer to ASCIZ starting text
; P1/ function offset (into FUNKEY, etc.)
;Returns +1 always
SHOFUN: HRROI T1,HEADBU ;Point to text buffer buffer
CALL ISOUT ;(T1,T2/T1) Start off with this
HLRO T2,FUNKEY(P1) ;Load name of this function string
CALL ISOUT ;(T1,T2/T1) Append function name string
MOVE T4,ENAAOB ;Load -n,,0 where n is the count of ENATBL
DO. ;Loop through elements in table
HRRZ T3,ENAKEY(T4) ;Point to flag word
MOVE T3,(T3) ;Get that word with the bits in it
TDNN T3,FUNCTB(P1) ;Is this bit lit for this function?
IFSKP. ;Yes, tell me about this one
HRROI T2,[ASCIZ/, /] ;Load seperator
CALL ISOUT ;(T1,T2/T1) Append that
HLRO T2,ENASHO(T4) ;Point to string
CALL ISOUT ;(T1,T2/T1) Append that
ENDIF. ;End of output code
AOBJN T4,TOP. ;Loop for all function profile bits
OD. ;End of loop
CALL OCRLF ;(T1/T1) Append in a crlf
CALLRET SHOWIT ;(/) Output all of that and return
;Show all enabled and disabled functions.
;Returns +1 always.
SHOFUA: HRROI P3,[ASCIZ/The following functions are enabled:
/] ;Start the list off right with this text
MOVE P4,[TXNN T3,FU%ENA] ;Load instruction to execute
CALL SHOFU2 ;(T1,P3,P4/) Show all of the enabled ones
HRROI P3,[ASCIZ/The following functions are disabled:
/] ;Load initial text
MOVE P4,[TXNE T3,FU%ENA] ;Load instruction to execute
; CALLRET SHOFU2 ;(T1,P3,P4/) Show all of the disabled ones
;Worker routine for SHOFUA, shows all enabled or disabled functions.
;Call with
; P3/ pointer to identifier string
; P4/ TXN% T3,FU%ENA
;Returns +1 always, P1 and P3 smashed
SHOFU2: MOVE P1,FUNAOB ;Load -functions,,0
DO. ;Loop for all functions
MOVE T3,FUNCTB(P1) ;Load enable bits from the table
XCT P4 ;Skip if we should show this one
IFSKP. ;Yes, show this one
MOVE T2,P3 ;Load the next prepending text
HRROI P3,[ASCIZ/ /] ;Point to tab for next one
CALL SHOFUN ;(T2,P1/) Show this function
ENDIF. ;End of Missouri (show me) code
AOBJN P1,TOP. ;Loop for all function
OD. ;End of for all functions loop
RET ; and return when done
SUBTTL Commands -- Show Command -- Show Settings
;Here for SHOW SETTINGS.
DOSHOS: MOVEI T2,[FLDDB. .CMKEY,,SETTBL,<a setting,>,ALL,[
FLDDB. .CMKEY,,ALLTBL,<ALL for all settings>]]
CALL COMANE ;(T2/T1,T2,T3) Parse that
DMOVE P2,T2 ;Save entry from table and which adr used
CALL CONFIR ;(T1/T1) Confirm it
HRRZ T2,(P2) ;Get rh of returned keyword entry
JUMPE T2,SHOSEA ;(/) If ALL then use special routine
MOVEI P1,-SETKEY(P2) ;Load offset of entry from table
HRROI P3,[ASCIZ/ /] ;Load pointer to just a space string
; CALLRET SHOSET ;(P1,P3/) Show settings and return
;Here to show program settings.
;Call with P1/ offset to SETTBL P3/ string for beginning of each line
;Returns +1 always.
SHOSET: HRROI T1,HEADBU ;Point to text buffer buffer
MOVE T2,P3 ;Load initial text first
CALL ISOUT ;(T1,T2/T1) Send it first
HLRO T2,SETSHT(P1) ;Load text to print first
CALL ISOUT ;(T1,T2/T1) Send that
HRRZ T3,SETSHT(P1) ;Load address of routine to call
MOVE T2,@SETDAT(P1) ;Get the data itself to pass to show routine
CALL (T3) ;(T1,T2/T1) Show this item
CALL OCRLF ;(T1/T1) Append a CRLF to all of that
CALLRET SHOWIT ;(/) Show all of that and return
;Here to show all program settings.
;Returns +1 always.
SHOSEA: HRROI T1,[ASCIZ/The following program settings are in effect:
/] ;Load the header
PSOUT% ;Type it on terminal
HRROI P3,[ASCIZ/ /] ;Load pointer to a tab
MOVSI P1,-SETNUM ;Load -ive things to show,,0
DO. ;Loop for all things to show
CALL SHOSET ;(P1,P3/) Send one to terminal
AOBJN P1,TOP. ;Loop for all of them
OD. ;End of loop
RET ;Return
SUBTTL Commands -- Show Command -- Show User
;Here for SHOW USER ALL|wildusername.
DOSHOU: MOVEI T2,[FLDDB. .CMKEY,,USRTBL,<a user profile,>,ALL,[
FLDDB. .CMKEY,CM%SDH,ALLTBL,<ALL for all user profiles>]]
CALL COMANE ;(T2/T1,T2,T3) Parse that
DMOVE P2,T2 ;Save entry from table and which adr used
CALL CONFIR ;(T1/T1) Confirm it
HRRZ T2,(P2) ;Get rh of returned keyword entry
JUMPE T2,SHOUSA ;(/) If it was ALL use special routine
MOVEI P1,-USRKEY(P2) ;Load offset of entry from table
HRROI T2,[ASCIZ/ /] ;Load prepending text
; CALLRET SHOUSR ;(T2,P1/) Do just this user please
;Here to display information about a single user.
;Call with T2/ prepending text, P1/ offset into user table.
;Returns +1 always.
SHOUSR: HRROI T1,HEADBU ;Point to text buffer
CALL ISOUT ;(T1,T2/T1) Start with prepended text
HRROI T2,[ASCIZ/User /] ;Label the next string
CALL ISOUT ;(T1,T2/T1) Start off with this
HLRO T2,USRKEY(P1) ;Load pointer to username string
CALL ISOUT ;(T1,T2/T1) Append username string
MOVE T4,USEAOB ;Load -n,,0
DO. ;Loop through elements in table
HRRZ T2,USESHO(T4) ;Get dispatch address
CALL (T2) ;(T1,T3,P1/T1,P1) Output that
AOBJN T4,TOP. ;Loop for all function profile bits
OD. ;End of loop
CALL OCRLF ;(T1/T1) Append in a crlf
CALLRET SHOWIT ;(/) Print that and return
;Here to show user profile that happens to be a bit.
;Output "keyword" if bit (in data word) is lit in profile.
;Call with T1/ output pointer, T4/ USExxx offset, P1/ USRxxx offset
;Returns +1 always with T1/ updated
SHOBIT: HRRZ T3,USEKEY(T4) ;Load address of this keyword's flag word
HRRZ T2,USRKEY(P1) ;Load offset into profile table
MOVE T2,USRPRO(T2) ;Load user profile bits into T3
XOR T2,USEDEF ;Set not-default bits to 1
TDNN T2,(T3) ;Does this user not have default?
RET ;Default, return now
HRROI T2,[ASCIZ/, /] ;Load seperator
CALL ISOUT ;(T1,T2/T1) Append that
HRRZ T2,USRKEY(P1) ;Have to say something, load profile offset
MOVE T2,USRPRO(T2) ;Load user profile bits
TDNE T2,(T3) ;Skip if the bit is not lit
IFSKP. ;If bit is off
HRROI T2,[ASCIZ/no /] ;Load no keyword
CALL ISOUT ;(T1,T2/T1) Just say no
ENDIF. ;End of no code
HLRO T2,USESHO(T4) ;Point to string
CALLRET ISOUT ;(T1,T2/T1) Append that and return
;Here to show user profile that happens to be a decimal number.
;Output "keyword n", data word is byte pointer with 0 address.
;Call with T1/ output pointer, T4/ USExxx offset, P1/ USRxxx offset
;Returns +1 always with T1/ updated
SHODEC: HRRZ T2,USEKEY(T4) ;Load address of byte pointer
MOVE T2,(T2) ;Get bp into T2
HRRZ T3,USRKEY(P1) ;Load offset into profile table
HRRI T2,USRPRO(T3) ;Load user profile bits address into T3
LDB T3,T2 ;Get the value
JUMPE T3,R ;Return if zero
HRROI T2,[ASCIZ/, /] ;Load seperator
CALL ISOUT ;(T1,T2/T1) Append that
HLRO T2,USESHO(T4) ;Point to string
CALL ISOUT ;(T1,T2/T1) Append that
CALL OSPACE ;(T1/T1) A space next please
MOVE T2,T3 ;Reload the value
CALLRET ODEC ;(T1,T2/T1) Output that and return
;Here when SHOW USER ALL command.
;Returns +1 always.
SHOUSA: HLRZ P1,USRTBL ;Point to user table
JUMPE P1,R ;Return if no user defined
IMUL P1,[XWD -1,0] ;Make -users,,0
HRROI P3,[ASCIZ/The following user profiles are defined:
/] ;Label following
DO. ;Loop to show user profiles
MOVE T2,P3 ;Load the prependin text
HRROI P3,[ASCIZ/ /] ;Load a tab for the next one
CALL SHOUSR ;(T2,P1/) Show user profile
AOBJN P1,TOP. ;Loop for all of them
OD. ;End of loop for each user profile
RET ;Return
SUBTTL Commands -- Show Command -- Show Text On Terminal
;Here to display show text on terminal based on its line width.
;Call with HEADBU/ ASCIZ text
;Returns +1 always.
;ACs: T1/ destination pointer (TEXTBU)
; T2/ source pointer (HEADBU)
; T3/ current character
; T4/ space available on this line
; Q1/ copy of T1 at last space character
; Q2/ copy of T2 at last space character
SHOWIT: SAVEAC <Q1,Q2> ;Preserve these two ACs
MOVE T1,[POINT 7,TEXTBU] ;Point to destination buffer
MOVE T2,[POINT 7,HEADBU] ;Point to source buffer
SHOWI1: MOVE T4,LINWID ;Load maximum characters per line
SHOWI2: ILDB T3,T2 ;Load a source byte
IDPB T3,T1 ;Store it in destination
JUMPE T3,PTEXT ;Publish if a null seen
CAIE T3,.CHLFD ;Is it a linefeed
CAIN T3,.CHCRT ; or a return?
JRST SHOWI1 ;Yes, reset line counter and continue
CAIN T3,"," ;Is it a comma?
DMOVEM T1,Q1 ;Yes, remember where the last comma was
CAIN T3,.CHTAB ;Is it a tab?
SUBI T4,7 ;Yes, account for it as 8 positions always
SOJG T4,SHOWI2 ;Loop for all characters on the line
MOVE T1,Q1 ;Reload destination pointer after space char
HRROI T2,[BYTE(7).CHCRT,.CHLFD,.CHTAB,.CHTAB,0] ;Text is cr lf tab tab
CALL ISOUT ;(T1,T2/T1) Break the line here
MOVE T2,Q2 ;Reload source pointer
MOVE T4,LINWID ;Reload the terminal width
SUBI T4,^D16 ; account for those two tabs
JRST SHOWI2 ; and reenter the loop
SUBTTL Commands -- Take Command
;TAKE (commands from) file.typ
DOTAKE: SKIPN TAKJFN ;Are we in a TAKE now?
IFSKP. ;Yes
EMSG (Nested TAKE commands are illegal)
JRST TAKEOF ;Abort this take command
ENDIF. ;That's all
NOISE (commands from file) ;Mumble
MOVE T1,[XWD TAKGTJ,GTJBLK] ;Make BLT pointer for source GTJFN
BLT T1,GTJBLK+.GJF2 ;Copy GTJFN block over there
MOVEI T2,[FLDDB. .CMFIL,CM%SDH,,<take filename>]
CALL COMANE ;(T1/T1-T3) Get filename
MOVEM T2,PRSJFN ;Save JFN
CALL CONFIR ;(/) Confirm that command
;Open up the file, set the I/o JFNs and so forth, and then return.
MOVE T1,PRSJFN ;Load JFN again
MOVX T2,<FLD(7,OF%BSZ)!OF%RD> ;Read 7-bit bytes
OPENF% ;Pry it open
ERJMP COMERR ;Error, return
SETZM PRSJFN ;Don't release the JFN now
MOVEM T1,TAKJFN ;Reload that JFN please
MOVE T1,TAKGTJ+.GJSRC ;Load .NULIO,,.NULIO JFNs
MOVEM T1,CSBLOK+.CMIOJ ;That is the input JFN now
RET ;Return for all commands
;Routine to call after call to .CMINI function to process take file.
;Returns +1 always
TAKCHK: SKIPN T1,TAKJFN ;Do we have a take JFN?
RET ;Nope, return now
HRROI T2,CMDBUF ;Point to command buffer
MOVEI T3,<CBUFSZ*5>-1 ;Load characters we can supply to buffer
MOVEI T4,.CHLFD ;Load terminating character
;Loop reading one command from the file. Check for hyphen at end of line.
TAKCH1: SIN% ;String INput
ERJMP TAKEOF ;Check for EOF if error
CAILE T3,<CBUFSZ*5>-4 ;Have at least 3 characters been read?
JRST TAKCH5 ;Nope, no continuation possible
MOVNI Q1,3 ;Backup by this many bytes
ADJBP Q1,T2 ;Point back three
ILDB Q2,Q1 ;Get character two back
CAIE Q2,"-" ;Hyphen?
JRST TAKCH5 ;No, cannot be continuation then
ILDB Q2,Q1 ;Get the next character
CAIN Q2,.CHCRT ;Was it a return?
JRST TAKCH1 ;Yes, get the next line also please
;Entire command line has been read now, set up CSB, echo command, and return.
TAKCH5: MOVEI T4,<CBUFSZ*5>-1 ;Load mas possible characters transferred
SUB T4,T3 ;Compute number stored in buffer
MOVEM T4,CSBLOK+.CMINC ;Save that as number of unparsed characters
MOVEI T3,0 ;Load a null character
IDPB T3,T2 ;Insure a null at end of text string
MOVE T1,CSBLOK+.CMRTY ;Load the pointer to prompt string
PSOUT% ;Send that to the terminal please
HRROI T1,CMDBUF ;Point to command buffer again
PSOUT% ;Send it to the terminal
RET ;Back in the saddle again
;Come here when error reading from take file. If IOX4 it must be the end of
;the take file, otherwise give error message. Then close the TAKE file and go
;to COM1 to start getting commands from the terminal.
TAKEOF: CALL GETERR ;(/T2) Get last error code into T2
CAIE T2,IOX4 ;Is it end of file on take command?
OJSERR (<Error reading command file>) ;Nope, mumble about error instead
HRROI T1,TEXTBU ;Point to text buffer
HRROI T2,[ASCIZ/[End of /] ;Point bracket and start of message
CALL ISOUT ;(T1,T2/T1) Send that along
MOVE T2,TAKJFN ;Reload the JFN
CALL OJFNS ;(T1,T2/T1) Send along the filename
HRROI T2,[ASCIZ/]
/] ;Point to bracket cr lf string
CALL ISOUT ;(T1,T2/T1) Send that along
CALL PTEXT ;(/) Send all of that to terminal
CALL TAKCLS ;(/) Close out the take file JFN
JRST COM1 ;Restart command
;Here to close TAKE file.
;Returns +1 always.
TAKCLS: SKIPN T1,TAKJFN ;Reload the file's JFN
RET ;None there
CLOSF% ;Close it
ERCAL TAKCL3 ;Maybe it wasn't open
SETZM TAKJFN ;No more JFN
MOVE T1,CSBTPL+.CMIOJ ;Load the primary input JFN
MOVEM T1,CSBLOK+.CMIOJ ;That is the input JFN now
RET
TAKCL3: MOVE T1,TAKJFN ;Reload the JFN
RLJFN% ;Release it
ERNOP. ;HFO?
RET ;Return to above
SUBTTL Commands -- User Command
;USER name profile
;AC usage in this routine
; P2/ accumulated profile
; P3/ offset to USExxx tables
DOUSER: MOVEI T2,[FLDDB. .CMUSR,CM%SDH,,<Username to set profile for>,,[
FLDBK. .CMFLD,CM%SDH,,<Wild user specification to set profile for>,,USRBRK]]
CALL COMANE ;(T2/T1-T3) Parse username field
LDB T3,[POINTR .CMFNP(T3),CM%FNC] ;Load the function parsed
HRROI T1,USRSTR ;Place to keep user string
CAIE T3,.CMFLD ;Was it the field parse?
IFSKP. ;Yes
HRROI T2,ATMBUF ;Point to atom buffer source
CALL ISOUT ;(T1,T2/T1) Copy the user name down there
ELSE. ;Otherwise it was the username parse
CALL ODIRST ;(T1,T2/T1) Send username in there
ENDIF. ;End of field/username parse code
MOVE P2,USEDEF ;Load the default profile for a user
;Get this user's profile.
DOUSE1: MOVEI T2,[FLDDB. .CMCFM,,,,,[
FLDDB. .CMKEY,,USETBL,<a user profile keyword,>]]
CALL COMANE ;(T2/T1-T3) Parse a keyword or confirm
LDB T3,[POINTR .CMFNP(T3),CM%FNC] ;Load the function parsed
CAIN T3,.CMCFM ;Was it the confirm?
JRST DOUSE2 ;Yep, it certainly was this time
MOVEI P3,-USEKEY(T2) ;Load offset for USExxx tables
CALL @USEPRS(P3) ;(P2,P3/P2) Parse this field
JRST DOUSE1 ;Loop for more keywords or confirm
;Here when we are ready to store this user's profile.
DOUSE2: HLRZ T4,USRTBL ;Load entry count of table
IMULI T4,USRCHR/5 ;Compute offset into username storage area
HRROI T1,USRSTG(T4) ;Point to storage area
HRROI T2,USRSTR ;Point to atom buffer string we copied earlier
CALL ISOUT ;(T1,T2/T1) Send that as the user name string
;See if user already in table.
MOVEI T1,USRTBL ;See if this user is in the table
HRROI T2,USRSTG(T4) ;Load the address of the string
TBLUK% ;Is the user in the table already?
ERJMP DOUSE3 ;Nope
TXNE T2,TL%EXM ;Exact match for user in table?
JRST DOUSE4 ;Yep
;Add user to table.
DOUSE3: MOVEI T1,USRTBL ;Point to user table
HLRZ T2,USRTBL ;Get the offset again
HRLI T2,USRSTG(T4) ;Get address of string,,offset
TBADD% ;Add it to the table
JSERRO (<Cannot add user to table>)
;Set profile bits of user, entry address is now in T1 (from TBLUK or TBADD).
DOUSE4: HRRZ T1,(T1) ;Load the entry offset for this user
MOVEM P2,USRPRO(T1) ;Store new profile word
RET ;Return for more commands
;Here to parse format field that is just a bit.
;"NO keyword" clears the bit an "keyword" sets the bit.
;Call with P2/ accumulated format bits, P3/ offset to USExxx
;Returns +1 always with P2/ updated bits
PRSBIT: HRRZ T2,USEKEY(P3) ;Load the address of the word with bits in it
SKIPN T2,(T2) ;Skip if there is a bit to set
IFSKP. ;There was a bit to set
TDO P2,T2 ;Set the bit please
RET ;Loop until confirm seen
ENDIF. ;Otherwise it must be "NO", parse keyword
MOVEI T2,[FLDDB. .CMKEY,,USENOT,<a user profile keyword,>]
CALL COMANE ;(T2/T1,T2,T3) Get the thing parsed
HRRZ T2,(T2) ;Load address where the bits are
TDZ P2,(T2) ;Clear specified bit
RET ;Return to loop until confirm seen
;Here when parsing a keyword followed by a number.
;Call with P2/ accumulated format bits, P3/ offset to USExxx
;Returns +1 always with P2/ updated bits
PRSDEC: MOVEI T2,[FLDDB. .CMNUM,,^D10] ;Get a decimal number
CALL COMANE ;(T2/T1,T2,T3) Parse that
HRRZ T1,USEKEY(P3) ;Load address of data word
MOVE T1,(T1) ;Load the data which is the byte pointer
TXO T1,P2 ;Address to store in is P2
DPB T2,T1 ;Store the value
RET ;Return for more
SUBTTL Commands -- Write Command
;WRITE (commands to) acjprofile.com.-1
DOWRIT: NOISE (commands to) ;Mumble about this
MOVE T1,[XWD WRIGTJ,GTJBLK] ;Make BLT pointer for source GTJFN
BLT T1,GTJBLK+.GJF2 ;Copy GTJFN block over there
MOVEI T2,[FLDDB. .CMFIL,CM%SDH,,<filename to write profile to>]
CALL COMANE ;(T1/T1-T3) Get filename
MOVEM T2,PRSJFN ;Save JFN
CALL CONFIR ;(/) Confirm that command
;Open the file and write a header to it.
MOVE P2,PRSJFN ;Reload the JFN we parsed
SETZM PRSJFN ;Don't let anyone else try to release it
CALL WRIOPN ;(P2/) Open the file
CALLRET WRICLS ;(P2/) Error, return
CALL WRIHDR ;(P2/) Construct header text in TEXTBU
CALL WRITXT ;(P2/) Write that to the file
;Write program settings.
MOVSI P1,-SETNUM ;Load -ive things to show,,0
DO. ;Loop for all things to show
CALL WRISET ;(P1/) Send one line information to text buffer
CALL WRITXT ;(P2/) Send that to the file
AOBJN P1,TOP. ;Loop for all items
OD. ;End of loop
;Write function settings.
MOVE P1,FUNAOB ;Load number of functions to do
DO. ;Loop for each function
CALL WRIFUN ;(P1/) Show this function to text buffer
CALL WRITXT ;(P2/) Send the text buffer to the file
AOBJN P1,TOP. ;Loop for all function
OD. ;End of for each function loop
;Write user profiles.
HLRZ P1,USRTBL ;Point to user table
IFN. P1 ;If there are userd defined today
IMUL P1,[XWD -1,0] ;Make -users,,0
DO. ;Loop for each user
CALL WRIUSR ;(P1/) Show user profile to buffer
CALL WRITXT ;(P2/) Send that text to the file
AOBJN P1,TOP. ;Loop for all of them
OD. ;End of short loop
ENDIF. ;End of user write code
CALLRET WRICLS ;(P2/) Close JFN and return
SUBTTL Commands -- Write Command -- Write Settings
;Here to write all program settings.
;Returns +1 always with TEXTBU filled.
WRISET: HRROI T1,TEXTBU ;Point to text buffer
HRROI T2,[ASCIZ/Set /] ;Load initial text
CALL ISOUT ;(T1,T2/T1) Send that
HLRO T2,SETKEY(P1) ;Load text to print first
CALL ISOUT ;(T1,T2/T1) Send that
CALL OSPACE ;(T1/T1) Space it out
HRRZ T3,SETSHT(P1) ;Load address of routine to call
MOVE T2,@SETDAT(P1) ;Get the data itself to pass to show routine
CALL (T3) ;(T1,T2/T1) Show this item
CALLRET OCRLF ;(T1/T1) Append a CRLF to all of that
SUBTTL Commands -- Write Command -- Write User Profiles
;Here to display information about a single user, P1/ offset into USRTBL.
;Returns +1 always with TEXTBU set up.
WRIUSR: HRROI T1,TEXTBU ;Point to text buffer
HRROI T2,[ASCIZ/User /] ;Label the next string
CALL ISOUT ;(T1,T2/T1) Start off with this
HLRO T2,USRKEY(P1) ;Load username string
CALL ISOUT ;(T1,T2/T1) Append username string
MOVE T4,USEAOB ;Load AOB pointer to user profile table (-n,,0)
DO. ;Loop through elements in table
CALL @USEWRI(T4) ;(T1,T4,P1/T1,T4,P1) Call routine to write
AOBJN T4,TOP. ;Loop for all function profile bits
OD. ;End of loop
CALLRET OCRLF ;(T1/T1) Append in a crlf and return
;Here to write user profile that happens to be a bit.
;Call with T1/ string pointer, T4/ USEKEY offset, P1/ USRKEY offset
;Returns +1 always, T1/ updated
WRIBIT: HRRZ T3,USEKEY(T4) ;Load address of the flags mask for this bit
HRRZ T2,USRKEY(P1) ;Load offset into profile table
MOVE T2,USRPRO(T2) ;Load user profile
XOR T2,USEDEF ;Set non-default bit setting to 1
TDNN T2,(T3) ;Is the bit not the default setting?
RET ;Bit is default setting, say nothing
CALL OSPACE ;(T1/T1) Output a space
HRRZ T2,USRKEY(P1) ;Have to say something, load profile offset
MOVE T2,USRPRO(T2) ;Load user profile bits
TDNE T2,(T3) ;Skip if the bit is not lit
IFSKP. ;If bit is off
HRROI T2,[ASCIZ/NO#/] ;Load NO keyword
CALL ISOUT ;(T1,T2/T1) Just say no
ENDIF. ;End of no code
HLRO T2,USEKEY(T4) ;Point to string containing keyword
CALLRET ISOUT ;(T1,T2/T1) Append that keyword and return
;Here to write user profile that happens to be a decimal number.
;Call with T1/ string pointer, T4/ USEKEY offset, P1/ USRKEY offset
;Returns +1 always, T1/ updated
WRIDEC: HRRZ T2,USEKEY(T4) ;Get address of the data
MOVE T2,(T2) ;Get the byte pointer which is the data word
HRRZ T3,USRKEY(P1) ;Load offset into profile table
HRRI T2,USRPRO(T3) ;Load user profile address
LDB T3,T2 ;Get the data
JUMPE T3,R ;Return if its zero
CALL OSPACE ;(T1/T1) Space first
HLRO T2,USEKEY(T4) ;Point to string containing keyword
CALL ISOUT ;(T1,T2/T1) Append that keyword
CALL OSPACE ;(T1/T1) Output a space next
MOVE T2,T3 ;Reload the value
CALLRET ODEC ;(T1,T2/T1) Make it decimal and return
SUBTTL Commands -- Write Command -- Write Function Profiles
;Here to show information about a single function, P1/ function offset
;Returns +1 always with TEXTBU set up.
WRIFUN: HRROI T1,TEXTBU ;Point to text buffer
MOVE T3,FUNCTB(P1) ;Load bits for this function
HRROI T2,[ASCIZ/Enable /] ;Assume enabled
TXNN T3,FU%ENA ;Skip if this is true
HRROI T2,[ASCIZ/Disable /] ;The function is disabled
CALL ISOUT ;(T1,T2/T1) Start off with this
HLRO T2,FUNKEY(P1) ;Load function name string
CALL ISOUT ;(T1,T2/T1) Append function name string
TXNN T3,FU%ENA ;Is this function enabled?
CALLRET OCRLF ;(T1/T1) Nope, output crlf and return now
MOVE T4,ENAAOB ;Load -n,,0
DO. ;Loop through elements in table
HRRZ T3,ENAKEY(T4) ;Point to flag word
MOVE T3,(T3) ;Get that word with the bits in it
MOVE T2,FUNCTB(P1) ;Load the profile word for this bit
XOR T2,ENADEF ;Set not equal bits to one
TDNN T2,T3 ;Skip if the bit is not set to default value
IFSKP. ;Yes, need keyword output
CALL OSPACE ;(T1/T1) Output a space
HRROI T2,[ASCIZ/NO#/] ;Load NO keyword
TDNN T3,FUNCTB(P1) ;Skip if the bit is lit
CALL ISOUT ;(T1,T2/T1) Just say no
HLRO T2,ENAKEY(T4) ;Point to keyword string
CALL ISOUT ;(T1,T2/T1) Append that
ENDIF. ;OK, done with that one
AOBJN T4,TOP. ;Loop for all function profile bits
OD. ;End of loop
CALLRET OCRLF ;(T1/T1) Append in a crlf
SUBTTL Commands -- Write Command -- File Header
;Here to write a header to the file for later use.
;Call with P2/ file jfn
;Returns +1 always, TEXTBU/ header
WRIHDR: HRROI T1,TEXTBU ;Point to text buffer
HRROI T2,[ASCIZ/! /] ;Start with header string
CALL ISOUT ;(T1,T2/T1) Start with this please
HRROI T2,[VERSIO] ;Point to version string
CALL ISOUT ;(T1,T2/T1) Append that text next
HRROI T2,[ASCIZ/ profile written by /] ;Label the user who did this
CALL ISOUT ;(T1,T2/T1) Start with this please
MOVE T2,OURUNO ;Load our user number
CALL ODIRST ;(T1,T2/T1) Send that text next
HRROI T2,[ASCIZ/ at /] ;Label the time
CALL ISOUT ;(T1,T2/T1) Append that text next
CALL OODTIN ;(T1/T1) Send current date and time
CALLRET OCRLF ;(T1/T1) Output a crlf and return
SUBTTL Commands -- Write Command -- Fill and Write Line to File
;Here to send command in text buffer to the file, makes 79 character lines.
;Changes "#" to spaces that are not broken across lines.
;Call with
; P2/ JFN
; TEXTBU/ ASCIZ text
;Returns +1 always.
;ACs: T1/ destination pointer (HEADBU)
; T2/ source pointer (TEXTBU)
; T3/ current character
; T4/ space available on this line
; Q1/ copy of T1 at last space character
; Q2/ copy of T2 at last space character
WRITXT: SAVEAC <Q1,Q2> ;Get some more scratch storage
MOVE T1,[POINT 7,HEADBU] ;Point to destination buffer
MOVE T2,[POINT 7,TEXTBU] ;Point to source buffer
WRITX1: MOVEI T4,WRICPL ;Load maximum characters per line
WRITX2: ILDB T3,T2 ;Load a source byte
CAIE T3,"#" ;Nonbreakable space?
SKIPA CX,T3 ;Nope, use origional character
MOVEI CX," " ;Yes it is, make it a space please
IDPB CX,T1 ;Store it in destination
JUMPE T3,WRITX5 ;Get out if a null seen
CAIE T3,.CHCRT ;Is it a return
CAIN T3,.CHLFD ; or linefeed?
JRST WRITX1 ;Yes, reset line counter and continue
CAIN T3," " ;Is it a space?
DMOVEM T1,Q1 ;Yes, remember where the last space was
SOJG T4,WRITX2 ;Loop for all characters on the line
MOVE T1,Q1 ;Reload destination pointer after space char
HRROI T2,[BYTE(7)"-",.CHCRT,.CHLFD,.CHTAB,0] ;Point to dash cr lf tab
CALL ISOUT ;(T1.T2/T1) Break the line here
MOVE T2,Q2 ;Reload source pointer
MOVEI T4,WRICPL-^D8 ; and reload the character counter
JRST WRITX2 ; and reenter the loop
WRITX5: MOVE T1,P2 ;Load JFN of the file
HRROI T2,HEADBU ;Point to the text buffer
SETZB T3,T4 ;Terminate on a null please
SOUT% ;Send that to the file
JSERRO (<Can't write file>,<CALL WRICLS>,COM1) ;Owie
RET ;Return to caller
SUBTTL Commands -- Write Command -- Open/Close File
;Here to open the file for writing all profile commands into.
;Call with P2/ JFN
;Returns +1 if error
;Returns +2 if success
WRIOPN: MOVE T1,P2 ;Load JFN
MOVX T2,<FLD(7,OF%BSZ)!OF%WR> ;Write 7-bit bytes
OPENF% ;Pry it open
JSERRO (<Can't open file to write>,,R) ;Error, punt and return +1
RETSKP ;Skip return
;Here to close the file we are writing
;Call with P2/ JFN
;Returns +1 always with file closed.
WRICLS: MOVE T1,P2 ;Load the JFN again
CLOSF% ;Close it please
ERSKP. ;Skip if error
RET ;Return
MOVE T1,P2 ;Load the JFN back
RLJFN% ;Release it now
ERNOP. ;Well I tried
RET ;Return
SUBTTL Commands -- Command Subroutines
;Here to parse something using COMND JSYS.
;Call with T2/ address of command function block chain
;Returns +1 if no parse
;Returns +2 if parsed OK
COMAND: MOVEI T1,CSBLOK ;Point to command state block
COMND% ;Parse that function please
ERJMP COMAN3 ;Owie if error!
TXNN T1,CM%NOP ;Error during confirm parse?
AOS (P) ;Nope, give skip return
RET ;Nope, return OK
COMAN3: CALL GETERR ;(/T2) Get last error code
CAIN T2,IOX4 ;Is it "End of file reached"?
JRST COM1 ;Yes, handle it by going to COM1
RET ;No, return
;Call CONFIR to parse a confirm, echo command if in take file.
;Returns +1 always, goes to COMERR if there is a problem.
CONFIR: MOVEI T2,[FLDDB. .CMCFM] ;Point to confirm function
; CALLRET COMANE ;(T2/T1-T3) Get the function done and return
;Here to perform a COMND JSYS function and go to COMERR if error.
;Call with T2/ function block
;Returns +1 always (goes to COMERR if there is a problem).
COMANE: CALL COMAND ;(T2/T1-T3) Do the function
JRST COMERR ;Give error message
RET ;Return to caller
;Here when some kind of command error.
COMERR: OJSERR (<Command error>) ;Nope, an owie instead of EOF
JRST COM1 ;Reset stack and continue parsing commands
SUBTTL Access Control -- Initialization
LOWCD ;Switch back to low seg
ASTART: RESET% ;Init the world again
MOVX F,FL%ACJ!FL%NOI ;Running as the ACJ now, no ints for now
MOVE P,[IOWD PLEN,STACK] ;Load stack pointer
SETZM LOGJFN ;No log file because of reset above
SETZM SPYFWZ ;Zero first word to zero
MOVE T1,[SPYFWZ,,SPYFWZ+1] ;Load BLT pointer to clear
BLT T1,SPYLWZ ;Clear storage (including old fork handles!)
;Call various initialization routines.
CALL INICAP ;(/) Turn on capabilities
CALL INICON ;(/) Get configuration information
CALL NEWLOG ;(/) Get a new log file JFN and put stuff in it
CALL INIMID ;(/) Set interrupt for midnight
CALL INILFF ;(/) Set interrupt for log file cache sweeps
CALL DEFFNC ;(/) Get defaults for all functions
CALL ENAFNC ;(/) Enable the access control functions
JRST MAIN ;Start processing access control requests
SUBTTL Access Control -- Initialization -- Capabilities and Interrupts
;Here to enable capabilities and PI system.
INICAP: MOVEI T1,.FHSLF ;Read this fork's capabilities
RPCAP% ;Read Process CAPabilities
TRNN T2,SC%WHL!SC%OPR ;Must be able to set wheel or operator today
BUG(HLT,NEP,<Not enough privs available>) ;Crash
MOVE T3,T2 ;Enable all capabilities
EPCAP% ;Enable Process CAPabilities
ERJMP [BUG(HLT,CEP,<Can't enable privs>)] ;Crash
MOVEI T1,.FHSLF ;For this fork
MOVE T2,[LEVTAB,,CHNTAB] ;Point to level and channel table
SIR% ;Set the interrupt table addresses
MOVX T2,ONCHNS ;For these channels
AIC% ;Activate Interrupt Channels
EIR% ;Enable interrupt system
MOVX T1,<.TICCC,,CCCHAN> ;Load code for control c and control c channel
ATI% ;Attach terminal interrupt character
JSERRO (<Could not enable control-C trapping>)
MOVEI T1,.MSIIC ;Load ignore increment mount count function
MSTR% ;Now we don't have to mount structures
JSERRO (<Could not ignore increment mount counts>)
RET ;Return
SUBTTL Access Control -- Initialization -- Configuration
;Get configuration information today.
INICON: GJINF% ;Get job information for us
MOVEM T1,OURUNO ;Save our user number
MOVEM T3,OURJOB ;Save our job number
MOVEI T1,.NDGLN ;Function to read local node name
MOVEI T2,T3 ;Argument block address
HRROI T3,OURNAM ;Point to storage
NODE% ;Get our local node name
ERNOP. ;What?
MOVX T1,RC%EMO ;Exact match only
HRROI T2,[ASCIZ/OPERATOR/] ;For this user
RCUSR% ;Get operator user number
ERSKP. ;[112] Skip if error
MOVEM T3,OPRUNO ;Save operator user number
MOVE T1,[SIXBIT/PTYPAR/] ;Name of table telling how many PTYs
SYSGT% ;Get number of PTYs,, TTY number of first PTY
HRRZM T1,TTYPTY ;Put TTY number of first PTY here
HLRZM T1,MAXPTY ;Put number of PTYs here
MOVX T1,<1,,.LOGDE> ;Get LOGDES+1
GETAB% ; which is the designator for job 0 output
IFNJE. ;If no error getting it
TXZ T1,.TTDES ;Make it just a line number
MOVEM T1,CTYLNO ; and save it as the CTY line number
ENDIF. ;End of GETAB worked code
RET ;Return for more work
SUBTTL Access Control -- Initialization -- Access Control Functions
;Here to enable trapping of access control functions that are enabled by the
;access control profile phase. All access control functions listed in our
;table are enabled (if FU%ENA) after disabling all functions.
;Returns +1 always.
ENAFNC: CALL DISFNC ;(/) First clear all enabled functions
MOVE T4,FUNAOB ;Load -ive count of functions,,0
DO. ;Loop for all functions
MOVEI T1,.SFSOK ;Set GETOK function
MOVE T2,FUNTMO(T4) ;Load default for this
TXO T2,SF%EOK ;Light the enable bit for this function
HRR T2,FUNKEY(T4) ;Get function code
TXNE T2,.GOUSR ;Is it a user function code?
HRRI T2,.GOUSR ;Yes, make it just 1B18 please
MOVE T3,FUNCTB(T4) ;Load enable bits
TXNE T3,FU%ENA ;Enable this function?
SMON% ;Yes, enable the function
IFNJE. ;If no JSYS error
TXO T3,FU%GOK ;Record we are now fully awake for the 1st time
ELSE. ;If a JSYS error
TXZ T3,FU%GOK ;Then we didn't enable GETOKs for this one
HRROI T1,TEXTBU ;Point to usual text place this rainy afternoon
HRROI T2,[ASCIZ/Can't enable /] ;Start out mess
CALL ISOUT ;(T1,T2/T1) Start with that string
HLRO T2,FUNKEY(T4) ;Point to text describing function
CALL ISOUT ;Send that along next please
HRROI T2,[ASCIZ/: /] ;Start out mess
CALL ISOUT ;(T1,T2/T1) Start with that string
CALL GETERR ;(/T2) Get last error
HRROI CX,TEXTBU ;Point to text buffer now
CAIE T2,SMONX2 ;"Invalid SMON function" is OK
CALL JSERR1 ;(CX/) Print the error message
ENDIF. ;End of that testing
MOVEM T3,FUNCTB(T4) ;Store the updated function bits
AOBJN T4,TOP. ;Loop for all functions in the table
OD. ;End of function enable loop
RET ;Return to caller with functions enabled
;Here to disable all access control functions we enabled. Called when we crash
;and before enabling any functions.
;Returns +1 always.
DISFNC: MOVE T4,FUNAOB ;Load -ive count of functions,,0
DO. ;Loop for all functions we know about
MOVEI T1,.SFSOK ;Reload the SMON GETOK function code
HLL T2,FUNTMO(T4) ;Get the default action for this function
HRR T2,FUNKEY(T4) ;Get function code
TXNE T2,.GOUSR ;Is it a user function code?
HRRI T2,.GOUSR ;Yes, make it just 1B18 please
MOVE T3,FUNCTB(T4) ;Load enable bits for this function
TXZE T3,FU%GOK ;Were we enabled for this function?
SMON% ;Yes, disable the function
ERNOP. ;Ignore all errors for now
MOVEM T3,FUNCTB(T4) ;Store the bit back please
AOBJN T4,TOP. ;Loop for all functions in the table
OD. ;End of loop
RET ;Return to caller
;Here to remember the GETOK function settings for all functions on startup.
;Returns +1 always with FUNTMO set up
DEFFNC: MOVE T4,FUNAOB ;Load the -n,,0 for the function table
DO. ;For every function that we know today
MOVEI T1,.SFSOK ;Load the function for SMON
HRRZ T2,FUNKEY(T4) ;Load the function code
TXNE T2,.GOUSR ;Is it a user function code?
HRRI T2,.GOUSR ;Yes, make it just 1B18 please
TMON% ;Test MONitor
ERSKP. ;If error, function probably not in monitor
TDZA T2,[^-SF%DOK] ;Keep just the interesting bit for later use
MOVX T2,SF%DOK ;Allow whatever this is if TMON failed
MOVEM T2,FUNTMO(T4) ;Save the flag for resetting later
AOBJN T4,TOP. ;Do this for all of them
OD. ;End of loop to get them
RET ;Return now
SUBTTL Access Control -- Processing Loop
;This is the main processing loop for access control.
MAIN: TXZ F,FL%DEN!FL%UNU!FL%FAI!FL%NOI ;Clear flags set per request, OKINT
SETZM ARGBLK ;Clear first word of argument block
MOVE T1,[XWD ARGBLK,ARGBLK+1] ;Load BLT pointer to block
BLT T1,ARGBLK+20 ;Clear only first twenty words today
MOVEI T1,ARGBLK ;Get address of answer block
MOVEI T2,ARGLEN ;and length of block
RCVOK% ;Get next function to check/log
ERJMP [BUG(HLT,NRA,<Could not receive access requests>)]
TXO F,FL%NOI ;We got one, set noint flag
TIME% ;[107] Get system uptime
MOVEM T1,TODCLK ;[107] Save this for later use
CALL FINDUS ;(/P3,P4) Try to find the job and user profile
CALL FINDIT ;(/P1,P2,T2,T3) Try to find the request
CAIA ;Skip if illegal request with T2 and T3 setup
CALL REQUES ;(P1,P2,P3,P4/T2,T3,Q1,P2) Perform the checking
SKIPE T2 ;Are we allowing the thing?
AOSA NDENY ;Nope, count the deny
AOS NALLOW ;Count the allow
MOVE T1,ARGBLK+.RCRQN ;Get the request number
GIVOK% ;Allow or deny request
ERJMP [BUG(HLT,FOK,<Failed to give OK>)] ;Hell is freezin' over
CALL WAITFO ;(Q1,P1,P2,P3,P4/) Wait only if needed today
CALL LOGREQ ;(Q1,P1,P2,P3,P4/) Log this request or not
TXZE F,FL%NLF ;Do we need a new log file?
CALL NEWLOG ;(/) Yes, get a new log file
SKIPLE LOGINT ;[113] Is the log file cache disabled?
TXZE F,FL%SLF ;[107] Do we need to sweep log file cache?
CALL SWPLOG ;[107] (/) Yes, sweep the log file cache now
JRST MAIN ;Loop for more requests
SUBTTL Access Control -- Processing Loop -- Find Function Profile
;Here to find the function offset for this request.
;Returns +1 if error, log text filled in and
; T2/ error code
; T3/ error string
; P1/ 0 to indicate no profile found
; P2/ contents of ENADEF (default bits for a function profile)
;Returns +2 if found and should be processed, with
; P1/ offset into function tables
; P2/ FUNCTB bits from tables
FINDIT: HLRZ T1,ARGBLK+.RCFCJ ;Get function code to look for
MOVE P1,FUNAOB ;Load number of functions built with
DO. ;Looping to find the function code
MOVE P2,FUNCTB(P1) ;Load bits for this function
CAMN T1,FUNCOD(P1) ;Match this one
RETSKP ;Yes, return +2
AOBJN P1,TOP. ;Loop for all of them
OD. ;Uh oh, it wasn't found
;Request is not found and is therefore illegal and will be denied.
HRROI T2,[ASCIZ/illegal/] ;Load identification string
CALL LOGSTA ;(T2/T1) Start a log file entry
HRROI T2,[ASCIZ/, code /] ;Label for following number
HLRZ T3,ARGBLK+.RCFCJ ;Get function code to report
CALL OLOCT ;(T1,T2,T3/T1) Send that to logging text
MOVEM T1,TEXTBP ;Save the pointer to to text buffer
MOVEI T1,ERRILR ;Not found, illegal request
HRROI T2,[ASCIZ/Unexpected request for access - denied/]
SETZ P1, ;Indicate that none found, no logging
MOVE P2,ENADEF ;Load default bits (hopefully logging)
TXO F,FL%DEN ;Deny flag
RET ;Deny whatever it was
SUBTTL Access Control -- Processing Loop -- Find User Profile
;Try to find user profile for this request.
;Returns +1 always with USRSTR and JIBLK set up and
; P3/ offset for user profile tables
; P4/ USRPRO profile bits for this user
FINDUS: SETZ P3, ;Load default which is user not found in table
MOVE P4,USEDEF ;Load default bits to allow logins at least
;Fill in JIBLK which contains all information about the job for later checking.
HRRZ T1,ARGBLK+.RCFCJ ;Get the job number
MOVEI T4,JIBLK ;Point to job info block
CALL GETINF ;(T1,T4/T4) Get job information
BUG(HLT,GIJ,<Can't get information on job>)
HLRZ T1,ARGBLK+.RCFCJ ;Load the function again
MOVE T3,ARGBLK+.RCARA ;Point to the supplied argument block address
MOVE T3,.GELUN(T3) ;Get user number for login
CAIN T1,.GOLOG ;Is it the login function?
MOVEM T3,JIBLK+.JIUNO ;Yes, fix up GETJI argument block
;Find out the username, returning default P2 and P3 if error or illegal.
HRROI T1,USRSTR ;Point to user string storage area
MOVE T2,JIBLK+.JIUNO ;Load user number not from ARGBLK mind you
CALL ODIRST ;(T1,T2/T1,T2) Send that to the username string
TLNN T2,-1 ;Not logged in or unknown user?
RET ;Yes, return +1 now with P3 and P4 defaulted
;Find user in our database, returning default P2 and P3 if not found.
MOVEI T1,USRTBL ;Point to the usr keyword table
HRROI T2,USRSTR ;Point to string to compare against
CALL WTBLUK ;(T1,T2/T1,T2,T3) Do a wild TBLUK function
TXNE T2,TL%NOM ;No match?
RET ;Return P3 and P4 as defaults
HRRZ P3,(T1) ;Return the offset into USRPRO and such tables
MOVE P4,USRPRO(P3) ;Reload the profile bits
RET ;Skip return with P1 through P4 set up
SUBTTL Access Control -- Processing Loop -- Check Request
;Here to check on the request, called with
; P1/ offset into function tables
; P2/ FUNCTB bits from tables
; P3/ offset for user profile tables
; P4/ USRPRO profile bits for this user
;Returns +1 always, T2 and T3/ set up for GIVOK
REQUES: HLRO T2,FUNLOG(P1) ;Point to name of this function
CALL LOGSTA ;(T2/T1) Start filling in log information
MOVE Q1,ARGBLK+.RCARA ;Point to argument block
HRRZ T2,FUNLOG(P1) ;Load address of the routine
CALL (T2) ;(T1,Q1,P1,P2,P3,P4/T1) Fill in the log text
MOVEM T1,TEXTBP ;Store updated pointer
TXNE P2,FU%POL ;Enforce policy for this function?
IFSKP. ;No, just allow (or deny) always
SETZB T2,T3 ;Assume we will allow this
MOVE T4,FUNTMO(P1) ;Load TMON bits for this function
TXNE T4,SF%DOK ;Should we allow this?
RET ;Yes, allow the function
TXO F,FL%DEN ;Light the deny bit please
MOVEI T2,400000 ;Deny the request
HRROI T3,[ASCIZ/Denied by access control facility/]
RET ;Deny the request
ENDIF. ;Otherwise call routine to test policy
CALL @FUNTST(P1) ;(Q1,P1,P2,P3,P4/T2,T3) Should be allowed?
IFSKP. ;Skip means yes
CALL USRPOL ;(Q1,P1,P2,P3,P4/T2,T3) Should be allowed?
ANSKP. ;Skip means yes
SETZB T2,T3 ;Yes, allow the request
RET ; and return
ENDIF. ;Deny the request, insure T2 and T3 are OK
TRNE T2,400000 ;Is this a legal error code?
TLNE T2,-1 ;Cannot have bits in left half
MOVEI T2,ERRAEC ;Illegal access control code
TLC T3,-1 ;Check the left half
TLCE T3,-1 ;Is it -1,,address?
HRROI T3,[ASCIZ/Denied by access control facility/] ;Generic message
RET ;Return ready for GIVOK JSYS
SUBTTL Access Control -- Processing Loop -- Wait for failure
;Here to perform special checks after a request has been disposed of.
;Called with
; Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
; P1/ offset into function tables
; P2/ FUNCTB bits from tables (FU%xxx)
; P3/ offset for user profile tables
; P4/ USRPRO profile bits for this user (US%xxx)
;Returns +1 always.
WAITFO: HLRZ T1,ARGBLK+.RCFCJ ;Get function code
;Check for login or attach complete.
CAIE T1,.GOLOG ;Was it a login ?
CAIN T1,.GOATJ ; or an attach?
IFNSK. ;Yes
MOVEI T1,^D1000 ;Wait a sec...
DISMS% ; for the job to LOGIN or not
HRRZ T1,ARGBLK+.RCFCJ ;Get this job number
HRROI T2,T4 ;Want one word returned in T4
MOVEI T3,.JIUNO ;Job's user number
GETJI% ;Get it
ERNOP. ;Ignore error for now
TRNE T4,-1 ;Did user get logged in?
RET ;So then return
TXO F,FL%FAI ;Nope, failed
AOS NFAIL ;Count the failed attempt
RET ; and then return
ENDIF. ;It wasn't a login or attach
;[122] Check for functions that must cause a log file sweep.
CAIN T1,.GOHSY ;[125] HSYS setting?
CALLRET HSYLOG ;[125] (Q1/) Please set a timer interrupt then
CAIN T1,.GOMDD ;[122] Is it a MDDT entry?
TXO F,FL%SLF ;[122] Yes, sweep the log file
;Other special waits should go here.
RET ;Return
SUBTTL Access Control -- Processing Loop -- Log Request
;Here to possibly send the request to the log file.
;Call with P2/ function bits
LOGREQ: MOVE T1,TEXTBP ;Point to text buffer today please
HRROI T2,[ASCIZ/ [Denied]/] ;Load denied indicator
TXNE F,FL%DEN ;Denied?
CALL ISOUT ;(T1,T2/T1) Yes book 'em
HRROI T2,[ASCIZ/ [Unusual]/] ;Load unusual indicator
TXNE F,FL%UNU ;Unusual?
CALL ISOUT ;(T1,T2/T1) Yes tell me so
HRROI T2,[ASCIZ/ [Failed]/] ;Load failed indicator
TXNE F,FL%FAI ;Failed?
CALL ISOUT ;(T1,T2/T1) Yes the unfortunate consequences
CALL OCRLF ;(T1/T1) Append a CRLF to all of that stuff
CALLRET USRLOG ;(P1,P2,P3,P4/) Log if desired
SUBTTL Access Control -- Subroutines -- Wild TBLUK Routine
;Routine to do a wild TBLUK function.
;Call with TBLUK% ACs:
; T1/ address of table
; T2/ byte pointer to string to be compared with strings in table
;Returns +1 always
; T1/ address of entry that matches or would have
; T2/ Recognition flags (TL%NOM and TL%EXM being the interesting ones)
WTBLUK: SAVEAC <Q1,Q2,Q3> ;Save ACs to save calling arguments in
DMOVE Q1,T1 ;Copy the ACs over to the Qs
TBLUK% ;Look this user up
ERNOP. ;Never ITRAPs, but be careful anyway
TXNE T2,TL%EXM ;Exact match?
RET ;Yes, return T1, T2, T3
MOVEI Q3,(T1) ;Save address to be returned if no match
MOVEI T4,(T1) ;Load address returned by TBLUK%
DO. ;Start looping through the table backwards
MOVEI T1,.WLSTR ;Load wild string match function
HLRO T2,(T4) ;Point to the ASCIZ user argument
HRROI T3,USRSTR ;Point to username to compare against
WILD% ;Try and match this one
ERNOP. ;Never is supposed to ITRAP, but ya never know
IFN. T1 ;If no match
CAIE T4,1(Q1) ;Was this the last entry in the table?
SOJA T4,TOP. ;Nope, keep looking
MOVEI T1,(Q3) ;Return address where the TBLUK wanted it to be
MOVX T2,TL%NOM ;Return no match bit
RET ;Return +1 always
ENDIF. ;Otherwise it must have matched
OD. ; so fall out of the loop
MOVEI T1,(T4) ;Point to the entry that matched today
MOVX T2,TL%EXM ;Return exact match flag for caller
RET ;Return +1 always
SUBTTL Access Control -- Subroutines -- Get User Information
;Here to find out all about a job.
;Call with T1/ job, T4/ address of our GETJI block
;Returns +1 always if GETJI% error
;Returns +2 if no error in the GETJI%, and with following:
; GETJI block, NTINFB+.NWTTF, NTBLK, and MORSPW set up, T4 preserved
GETINF: SAVEAC <Q1,Q2,Q3> ;Save the Qs
MOVEI T2,(T4) ;Point to start of block
HRLI T2,-<.JIMAX+1> ;Load size of this block
SETZ T3, ;All info
GETJI% ;Get info on this job
ERJMP R ;Return +1 if error here
;Got basic job info, now get job origin information.
SETZM NTBLK(T4) ;Insure first work is zero for local lines
MOVX T1,<NW%NNT>B17 ;Load default which is non network terminal
MOVEM T1,NTINFB+.NWTTF(T4) ;Save this in case NTINF JSYS fails
SETZM MORSPW(T4) ;Clear returned speed word
;Danger Will Robinson! Since NTINF% will give you a free null at the end of
;the origin string if it is a LAT terminal in older (6.1 and early 7.0)
;monitors, we cannot just write the string to our output pointer. We have
;write to it NTBLK instead and copy it to the output pointer later.
HRROI T1,NTBLK(T4) ;Point to place to store the string
MOVEM T1,NTINFB+.NWNNP(T4) ;Save output pointer
MOVE T2,.JIJNO(T4) ;Load job number
MOVEM T2,NTINFB+.NWLIN(T4) ;Save job number for NTINF
DMOVE T1,[EXP .NWNU1+1,.NWRRH] ;Load size of arg block and arg type
DMOVEM T1,NTINFB+.NWABC(T4) ;Save size of the block and arg block type
MOVEI T1,NTINFB(T4) ;Load address of information block
NTINF% ;Get information on this user
ERJMP GETIN1 ;If error, assume local terminal
;Check result, if non network terminal we say nothing.
MOVE T2,NTINFB+.NWTTF(T4) ;Load returned type and flags
LDB T3,[POINT 9,NTINFB+.NWTTF(T4),17] ;(no symbol for this field)
CAIE T3,NW%NNT ;Non network terminal?
JRST GETIN2 ;Nope, a network terminal
; JRST GETIN1 ;Fall through if non network terminal
;Here if the line appears to be a non network (front end) terminal.
GETIN1: SKIPGE .JICPJ(T4) ;Is this a PTY job?
SKIPGE T1,.JITNO(T4) ; or is this a detached job?
RETSKP ;Yes, return now
TXO T1,.TTDES ;Make designator out of terminal number
MOVEI T2,.MORSP ;Read terminal speed word
MTOPR% ;Read terminal speed
ERJMP RSKP ;Return now if error
MOVEM T3,MORSPW(T4) ;Return to the user for later
RETSKP ;Now return
;Here if the line appears to be a network terminal. If name found copy it to
;the output pointer. If name not known, but network type is, return a properly
;formatted number.
GETIN2: MOVEI T1,NTBLK(T4) ;Point to place where we stored the string
HRLI T1,(POINT 7) ;Make a pointer to that please
TXNE T2,NW%NNN ;No name known for this network terminal?
JRST GETIN3 ;Yes, print a number instead
MOVE T3,T1 ;Get current pointer
DO. ;Find the end of that name string
ILDB T2,T3 ;Load a character
JUMPN T2,TOP. ;Loop if not a null
OD. ;End of null search loop
MOVNI T1,1 ;Load a -1
ADJBP T1,T3 ;Back up one so we can write over the null
JRST GETIN7 ;Nope, name known, add type next
;Here when network name not known.
GETIN3: CAIN T3,NW%TCP ;Unknown TCP host connection?
JRST GETIN4 ;Yes, do it
CAIN T3,NW%DNA ;Unknown DECnet host connection?
JRST GETIN5 ;Yes, handle it
CAIN T3,NW%LAT ;Unknown LAT connection?
JRST GETIN6 ;Yes
RET ;None of those return with T1 unchanged
;Here if its a TCP connection, output "0.0.0.0".
GETIN4: CALL OSPACE ;(T1/T1) Send a space along next
MOVEI Q1,4 ;Load number of octets to print
MOVE Q2,[POINT 8,NTINFB+.NWNNU(T4),3] ;Make ILDB pointer to data
DO. ;For each octet
ILDB T2,Q2 ;Load a TCP octet
CALL ODEC ;(T1,T2/T1) Output a octet in decimal
SOJG Q1,GETIN7 ;(T1/T1) Output connection type
HRROI T2,[ASCIZ/./] ;Point to a dot
CALL ISOUT ;(T1,T2/T1) Append that to the string
JRST TOP. ;Loop for all octets
OD. ;End of TCP loop
;Here if its a DECnet connection, output "0.0".
GETIN5: CALL OSPACE ;(T1/T1) Send a space along next
LDB T2,[POINT 6,NTINFB+.NWNNU(T4),25] ;Get area of DECnet node number
CALL ODEC ;(T1,T2/T1) Print it
HRROI T2,[ASCIZ/./] ;Load a pointer to a dot
CALL ISOUT ;(T1,T2/T1) Output the dot next
LDB T2,[POINT 10,NTINFB+.NWNNU(T4),35] ;Get node number part
CALL ODEC ;(T1,T2/T1) Output that and return
CALLRET GETIN7 ;(T1/T1) Output connection type and return
;Here if it is a LAT connection, output "00-00-00-00-00-00".
GETIN6: CALL OSPACE ;(T1/T1) Send a space along next
MOVEI Q1,6 ;Load number of hex bytes to print
MOVE Q2,[POINT 8,NTINFB+.NWNNU(T4)] ;Make ILDB pointer to data
MOVX T3,NO%LFL!NO%ZRO!FLD(2,NO%COL)!FLD(^D16,NO%RDX) ;Hex output
DO. ;For each octet
ILDB T2,Q2 ;Load a TCP octet
NOUT% ;Output that hex digit
ERNOP. ;Ignore errors for now
SOJG Q1,GETIN7 ;(T1/T1) Output connection type and retutn
HRROI T2,[ASCIZ/./] ;Point to a dot
CALL ISOUT ;(T1,T2/T1) Append that to the string
JRST TOP. ;Loop for all octets
OD. ;End of TCP loop
;Here to output type of connection from the table.
GETIN7: HRRZ T2,NTINFB+.NWTTF(T4) ;(no symbol for this field) Get line type
MOVSI Q1,-OORSIZ ;Load number of things in table,,0
DO. ;Loop for things in table
HRRZ Q2,OORTAB(Q1) ;Load type of connection from table
CAMN Q2,T2 ;Match the type we want to hear about?
EXIT. ;Yes
AOBJN Q1,TOP. ;Loop for all of them
RETSKP ;Unknown type
OD. ;End of loop
HLRO T2,OORTAB(Q1) ;Match, load address of text
CALL ISOUT ;(T1,T2/T1) Add that in
RETSKP ; and then skip return
;Table of network connection types for above code.
OORTAB: TENTRY (<(NRT)>,NW%MC) ;MCB (NRT) terminal
TENTRY (<(TCP)>,NW%TV) ;TVT (TCP) terminal
TENTRY (<(CTM)>,NW%CH) ;CTERM terminal
TENTRY (<(LAT)>,NW%LH) ;LAT terminal
OORSIZ==.-OORTAB ;Make size of table
SUBTTL Logging Routines -- Midnight Timer Routines
;Here on a timer interrupt at midnight to start a new log file. See if we can
;do it now and if so do it, otherwise set a flag and do it later.
;Returns +1 always.
MIDNIT: CALL MIDHAN ;(/) Handle the midnight interrupt
DEBRK% ;Dismiss from interrupt
MIDHAN: SAVEAC <T1,T2,T3,T4,Q1,Q2,Q3> ;Save all of the suspect ACs
TXNE F,FL%NOI ;Are we NOINT?
TXOA F,FL%NLF ;Yes, remember to do log file stuff later
CALL NEWLOG ;(/) OKINT, get a new log file now please
; CALLRET INIMID ;(/) Get back here again please at midnight
;Here to set the timer interrupt that goes off each night at midnight.
;Returns +1 always, T1-T4 smashed.
INIMID: SETO T2, ;The time is now
SETZ T4, ;No flags for this please
ODCNV% ;Get all seperate pieces of time
JSERRO (<ODCNV failure>,,R) ;This will never happen I hope
HRRI T4,0 ;Load time of midnight today
IDCNV% ;Convert midnight today back to internal format
JSERRO (<IDCNV failed>,,R) ;This should never happen
ADD T2,[1,,0] ;Get midnight tomorrow
MOVX T1,<.FHSLF,,.TIMDT> ;Set interrupt at particular time
MOVEI T3,MDCHAN ;Load channel number to interrupt on
TIMER% ;Set the interrupt
JSERRO (<Failed to set midnight timer>) ;Too many timer blocks?
RET ;Just return +1 no matter what happens
SUBTTL Logging Routines -- System Shutdown Time Routines
;[125] Here when ACJ is initializing to get any possible HSYS time.
;Sets a TIMER for the time specified that the system will go down.
;Returns +1 always.
INIHSY: MOVEI T1,.DWNTI ;[125] Load GETAB table for down time
GETAB% ;[125] Get this from the monitor
SETZ T1, ;[125] Assume no shutdown if that failed
MOVE T2,T1 ;[125] Copy time to T2
CALLRET HSSLOG ;[125] (T2/) Set a timer for that time please
;[125] Here when a GOHSY GETOK function has been processed.
;Call with Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets).
;Returns +1 always.
HSYLOG: MOVE T2,.GESDT(Q1) ;[125] Load the shutdown time specified
; CALLRET HSSLOG ;[125] (T2/) Set a timer interrupt at that time
;[125] Here to set a timer because we think the system will be shutdown.
;Call with T2/ time that the system is expected to be shutdown
;Returns +1 always.
HSSLOG: MOVEI T3,HFCHAN ;[125] Load channel number to interrupt on
SKIPN LOGHSY ;[125] Do we have a timer set now?
IFSKP. ;[125] Yes, we do in fact
EXCH T2,LOGHSY ;[125] Save new time, get old time
MOVX T1,<.FHSLF,,.TIMDD> ;[125] Get function for delete and this fork
TIMER% ;[125] Remove the old interrupt time
ERNOP. ;[125] Ignore error for now
MOVE T2,LOGHSY ;[125] Get new time in T2 again
ENDIF. ;[125] End of timer set previously code
MOVEM T2,LOGHSY ;[125] Save time of expected HSYS
JUMPE T2,R ;[125] Return now if shutdown canceled
GTAD% ;[125] Get current date time
ADDI T1,<<2,,0>/^D<60*60*24>> ;[125] Get time two seconds from now
CAMGE T1,T2 ;[125] Shutdown time is in the next 2 seconds?
IFSKP. ;[125] Yes, don't set a timer
SETZM LOGHSY ;[125] Not expecting an interrupt now
TXO F,FL%NLF ;[125] Get a new log file now
RET ;[125] and then return
ENDIF. ;[125] End of shutdown in the near future code
MOVX T1,<.FHSLF,,.TIMDT> ;[125] Set interrupt at time in T2
TIMER% ;[125] Yes, please set the interrupt
ERNOP. ;[125] Not that important today anyway
RET ;[125] Just return +1 no matter what happens
;[125] Here when timer interrupt goes off to get a new log file. Does not get
;a new log file if we get the timer interrupt when we don't expect to get one.
;Does the work now if OKINT, sets flag to do it later if NOINT.
INTHSY: SKIPE LOGHSY ;[125] Expecting system to go down?
CALL HSYINT ;[125] (/) Yes, call routine to do the work
DEBRK% ;[125] Return from interrupt
HSYINT: SAVEAC <T1,T2,T3,T4,Q1,Q2,Q3> ;[125] Save all of the suspect ACs
TXNE F,FL%NOI ;[125] Are we NOINT?
TXOA F,FL%NLF ;[125] Yes, remember to do log file stuff later
CALL NEWLOG ;[125] (/) A new broom sweeps the best
RET ;[125] Return from interrupt
SUBTTL Logging Routines -- Initialization of Log File
;Routine to get a JFN on a new log file.
;Returns +1 always.
NEWLOG: CALL CLOLOG ;(/) First try and close any old file
CALL NAMLOG ;[124] (/) Get a new log file name
;[107] Open a JFN up and then get the resulting filename for later use.
MOVX T1,GJ%SHT!GJ%FOU ;Load new log file bits
HRROI T2,LOGFNA ;[124] Point to log file spec
GTJFN% ;Try getting new file JFN
JSERRO (<Can't get JFN for log file>,<SETZ T1,>) ;Owie, return T1/ 0
MOVEM T1,LOGJFN ;[107] Save the JFN (zero if none)
JUMPE T1,R ;[107] Return now if no log file JFN
MOVE T2,T1 ;[110] Copy JFN of the log file
HRROI T1,LOGFNA ;[110] Point to log file area
MOVX T3,JS%SPC ;[110] We want the entire filespec por favor
JFNS% ;[110] Get the filename we are using
ERNOP. ;[110] Ignore errors for now
;[107] Open up the log file, set pointers to it, write header, and return.
CALL OPNLOG ;[107] (/) Open up that log file now
CALL NPTLOG ;[107] (/) Set up new log file cache pointers
CALL SECLOG ;(T1/T1) Make the log file secure
SETZM LOGLIN ;We have written no lines to this file
SETZM LOGPAG ;We have written no pages to this file
CALLRET HDRLOG ;[107] (/) Get a new header on the log file
;Local routine for NEWLOG to make a log file secure, call with T1/ JFN
;Returns +1 always.
SECLOG: SKIPN T1,LOGJFN ;[124] Reload the JFN of the log file
RET ;[124] Log file not open now
TXO T1,CF%NUD!FLD(.FBCTL,CF%DSP) ;Load the FBCTL word
MOVX T2,FB%SEC ;The secure bit mask
MOVX T3,FB%SEC ;We want the secure bit to be set
CHFDB% ;Set the file secure
ERNOP. ;Don't care about errors
RET ;Return +1 always
;[124] Local routine for NEWLOG to create a new log file name.
;The log filename is made by by moving the LOGFIL string into LOGFNA,
;replacing the character "*" with a string to output the time.
;Returns +1 always, LOGFNA set up.
NAMLOG: SETZM LOGFTI ;[124] Be sure to get a fresh time if needed
MOVE T4,[POINT 7,LOGFIL] ;[124] Point to the log file name
MOVE T1,[POINT 7,LOGFNA] ;[124] Point to place to build log file spec
DO. ;[124] Loop for all characters in the filename
ILDB T3,T4 ;[124] Load a character for the log file
CAIE T3,"*" ;[124] Is it the wild thing?
IFSKP. ;[124] Yes, substitute the time
SKIPN LOGFTI ;[124] Any time string set up?
CALL FNTLOG ;[124] (/) Make the time string
HRROI T2,LOGFTI ;[124] Point to formatted time
CALL ISOUT ;[124] (T1,T2/T1) Store the time
ELSE. ;[124] Otherwise it was not wild
IDPB T3,T1 ;[124] Not wild, store that character
ENDIF. ;[124] End of wild/nonwild check
JUMPN T3,TOP. ;[124] Loop until input null seen
OD. ;[124] End of loop for characters
RET ;[124] Return to caller with LOGFNA set up
;[124] Local routine called only from NAMLOG.
;Call to create time string "year-month-day-hours-minutes-seconds" in LOGFTI.
;Returns +1 always with LOGFTI filled.
FNTLOG: SAVEAC <T1,T2,T3,T4,Q1,Q2,Q3> ;[124] Save the Ts and Qs
SETO T2, ;[124] Load time of now
SETZ T4, ;[124] No particular options
ODCNV% ;[124] Get seperate numbers for time and so on
ERJMP R ;[124] This will not fail today
HRRZ Q3,T2 ;[124] Copy month to Q3
HLRZ Q2,T3 ;[124] Copy day to Q2
HRRZ Q1,T4 ;[124] Copy seconds since midnight to Q1
HRROI T1,LOGFTI ;[124] Point to place to build the time
HLRZ T2,T2 ;[124] Load the year
CALL ODEC ;[124] (T1,T2/T1) Send the year first
HRRZ T2,Q3 ;[124] Load numeric month
CALL FNTLON ;[124] (T1,T2/T1) Send hyphen and month
HRRZ T2,Q2 ;[124] Load the numeric day
CALL FNTLON ;[124] (T1,T2/T1) Send hyphen and day
IDIVI Q1,^D60*^D60 ;[124] Get hours in Q1,
IDIVI Q2,^D60 ;[124] minutes in Q2, seconds in Q3
MOVE T2,Q1 ;[124] Load hours
CALL FNTLON ;[124] (T1,T2/T1) Send hyphen and hours
MOVE T2,Q2 ;[124] Load the minutes
CALL FNTLON ;[124] (T1,T2/T1) Send hyphen and minutes
MOVE T2,Q3 ;[124] Load the seconds
CALL FNTLON ;[124] (T1,T2/T1) Send hyphen and seconds
MOVEI T2,0 ;[124] Load a null
IDPB T2,T1 ;[124] and store it there
RET ;[124] Return
;[124] Local routine called only from FNTLOG.
;Stores a hyphen followed by two ASCII digits from a binary number in T2.
;Returns +1 always.
FNTLON: MOVEI T3,"-" ;[124] Load hyphen
IDPB T3,T1 ;[124] store hyphen first
IDIVI T2,^D10 ;[124] Get the two digits
ADDI T2,"0" ;[124] Convert tens digit to ASCIZ
ADDI T3,"0" ;[124] And the ones digit to ASCIZ
IDPB T2,T1 ;[124] Store the tens digit
IDPB T3,T1 ;[124] and the ones digit
RET ;[124] Return to caller
SUBTTL Logging Routines -- Send Text to Log File
;Routine to send text to the log file, used for all logging of GETOK functions.
;Call with T1/ pointer to ASCIZ text.
;Returns +1 always, string written
SENLOG: SAVEAC Q1 ;Save an AC
MOVEM T1,Q1 ;Save the pointer to the string please
MOVE T1,LOGLIN ;[120] Skip if no lines printed on this page
CAIL T1,PAGLEN ;[120] Lines sent, over maximum number on page?
CALL HDRLOG ;[120] (/) Send header to log file
MOVE T1,Q1 ;[107] Restore pointer to string
CALLRET SOULOG ;[107] (T2/) Write that string to the log file
;[116] Here to write header and statistic information to the log file.
;Returns +1 always
HDRLOG: HRROI T1,HEADBU ;[116] Point to the header buffer
CALL NPGLOG ;[116] (T1/T1) Output first line of header
CALL STALOG ;[116] (T1/T1) Output second through nth lines
CALL OCRLF ;[116] (T1/T1) Repeat myself
HRROI T1,HEADBU ;[116] Point to text buffer
CALLRET SOULOG ;[116] (T1/) Send all of that to log file
;[120] Here to write summary information to the log file.
;Returns +1 always.
SUMLOG: MOVE T1,LOGLIN ;[120] Load lines printed
CAILE T1,PAGLEN-5 ;[120] Is there enough room on this page?
CALLRET HDRLOG ;[120] (/) Do a new header instead
HRROI T1,HEADBU ;[120] Point to the header buffer
CALL OCRLF ;[120] (/) First we want a CRLF output
CALL STALOG ;[120] (T1/T1) Output second through nth lines
HRROI T1,HEADBU ;[120] Point to text buffer
CALLRET SOULOG ;[120] (T1/) Send all of that to log file
SUBTTL Logging Routines -- Log File Cached Write
;[107] Routine to set up for new log file buffer.
;Uses CX so that no real ACs are damaged.
;Returns +1 always with pointers and counts reset.
NPTLOG: MOVEI CX,<<1+LOGBLP-LOGBFP>*5*1000>-1 ;[107] Load number of characters
MOVEM CX,LOGCNT ;[107] and save it here
MOVE CX,[POINT 7,LOGBUF] ;[107] Point to the log buffer
MOVEM CX,LOGPTR ;[107] Save that there
SETZM LOGBUF ;[107] Insure first word zero for checks
RET ;[107] Return always
;[107] Routine to do a SOUT to the log file.
;Note: this routine is called ONLY from SENLOG, HDRLOG, and SUMLOG.
;Call with T1/ pointer to ASCIZ text.
;Returns +1 always, string written (to cache or real file).
SOULOG: TLC T1,-1 ;[107] Complement left half
TLCN T1,-1 ;[107] Was the left half -1?
HRLI T1,(Point 7) ;[107] Yes, make it a byte pointer
DO. ;[107] Loop for entire string
ILDB T2,T1 ;[107] Load a character from the file
CAIN T2,.CHLFD ;[116] Is it a line feed?
AOS LOGLIN ;[116] Count this line as sent to log
JUMPE T2,ENDLP. ;[107] Get out if a null seen
CALL CHRLOG ;[107] (T2/) Send character to log file
LOOP. ;[107] Loop for all of them
OD. ;[107] End of copy loop
MOVE T1,LOGPTR ;[107] Load the pointer
IDPB T2,T1 ;[107] Store null to bind off string
RET ;[107] and return
;[107] Routine to store a log file character in log file cache buffer.
;Call with T2/ character.
;Returns +1 always.
CHRLOG: SOSLE LOGCNT ;[107] Is there space for that character?
IFSKP. ;[107] Nope
SETZ CX, ;[107] Load a null
IDPB CX,LOGPTR ;[107] and bind off the end of the buffer
CALL SWPLOG ;[107] (/) Sweep the log file out to disk
TXO F,FL%SLF ;[107] Perform another sweep later please
CALLRET CHRLOG ;[107] (/) Now output the character and return
ENDIF. ;[107] End of no more room code
IDPB T2,LOGPTR ;[107] Save the character in buffer
RET ;[107] and return to caller
SUBTTL Logging Routines -- Log File Cache Sweep Interrupts
;[107] Here on a interrupt to log file sweep every LOGINT seconds.
;Returns +1 always with log file cache swept.
INTLFF: CALL LFFHAN ;[107] (/) Handle the interrupt
DEBRK% ;[107] Dismiss from interrupt
LFFHAN: SAVEAC <T1,T2,T3,T4,Q1,Q2,Q3> ;[107] Save all of the suspect ACs
TXNE F,FL%NOI ;[107] Are we NOINT?
TXOA F,FL%SLF ;[107] Yes, remember to do log file stuff later
CALL SWPLOG ;[107] (/) Sweep out the log file cache please
; CALLRET INILFF ;[107] (/) Get back here again in LOGINT secs
;[107] Here to set the timer interrupt that goes off to sweep log file cache.
;Returns +1 always, T1-T4 smashed.
INILFF: MOVX T1,<.FHSLF,,.TIMEL> ;[107] Set interrupt at elapsed time
SKIPG T2,LOGINT ;[113] Load interval for log file updates
RET ;[113] If zero cache is disabled
IMULI T2,^D1000 ;[107] and convert it to milliseconds
MOVEI T3,LFCHAN ;[107] Load channel number to interrupt on
TIMER% ;[107] Set the interrupt
JSERRO (<Failed to set log file timer>) ;[107] Too many timer blocks?
RET ;[107] Just return +1 no matter what happens
SUBTTL Logging Routines -- Log File Cache Sweep
;[107] Routine to sweep contents of log file to disk.
;Returns +1 always with LOGBUF copied to log file.
SWPLOG: SKIPE LOGBUF ;[107] Is there anything to write or
SKIPN LOGJFN ;[107] any JFN on the log file?
RET ;[107] Nope, get out now
SAVEAC <T1,T2,T3,T4> ;[107] Save the temps as they are really needed
HRROI T2,LOGBUF ;[107] Point to the log buffer
SETZB T3,T4 ;[107] Terminate on a null
SKIPE T1,LOGJFN ;[107] Load the JFN for the log file
SOUT% ;[107] Send that text to the log file
IFJER. ;[107] If there was a problem
OJSERR (<Error writing to log file>) ;[107] Mumble about the error
HRROI T1,LOGBUF ;[107] Reload pointer to string
PSOUT% ;[107] Send to console terminal
ENDIF. ;[107] End of log file write problem code
CALL NPTLOG ;[107] (/) Set up new pointers and so on
; CALLRET CKPLOG ;[107] (/) Try closing and reopening log file
SUBTTL Logging Routines -- Open/Close/Checkpoint Log File
;[107] Routine to checkpoint the log file.
;Called only from SWPLOG, closes and then reopens the log file.
;Returns +1 always
CKPLOG: SKIPN T1,LOGJFN ;Get JFN, skip if there is one
CALLRET NEWLOG ;[107] (/) None there, try for a new one
TXO T1,CO%NRJ ;Keep the JFN but close the file
CLOSF% ;Yes, close the log file
ERCAL NEWLOG ;(/T1) Oh no! Holy OFN, something smells bad
; CALLRET OPNLOG ;[107] (/) Reopen the log file
;[107] Routine to open the log file.
;Returns +1 always.
OPNLOG: SKIPN T1,LOGJFN ;[107] Skip if a log file JFN assigned today
RET ;[107] No log file to open
MOVX T2,FLD(7,OF%BSZ)!OF%APP ;[107] 7 bit append mode
OPENF% ;[107] Open the jfn for append
JSERRO (<Can't open log file>,<CALL CLOLOX>) ;[107] Report error
RET ;[107] Return
;Here to close the log file JFN.
;Returns +1 always with log file closed.
CLOLOG: SKIPN LOGJFN ;[120] Anything to do?
RET ;[120] Nope, return now
CALL SUMLOG ;[120] (/) Send summary to log file
CALL SWPLOG ;[107] (/) Sweep log file cache
CLOLOX: SKIPE T1,LOGJFN ;[107] Load the log file JFN, skip if none
CLOSF% ;Shake rattle and roll
ERCAL RLSLOG ;Try to release the JFN if error
SETZM LOGJFN ;No longer a JFN to worry about
CALLRET NPTLOG ;[110] (/) Don't worry be happy
RLSLOG: MOVE T1,LOGJFN ;Load the JFN again
RLJFN% ;Release it today
ERNOP. ;Really don't care if this fails
RET ;In any case we tried to dump the JFN
SUBTTL Logging Routines -- New Page for Log File
;[116] Local routine to output first line of new page header.
;Call with T1/ output pointer
;Returns+1 always, T1/ updated pointer
NPGLOG: SETZM LOGLIN ;[116] Clear number of lines this page
HRROI T2,[BYTE(7).CHFFD,.CHCRT,.CHLFD,.CHTAB,0] ;Form feed crlf tab
CALL ISOUT ;(T1,T2/T1) Start with that
HRROI T2,[VERSIO] ;Point to my name and version
CALL ISOUT ;(T1,T2/T1) Send that out
HRROI T2,[ASCIZ/ on /] ;Label the node
CALL ISOUT ;(T1,T2/T1) Append that text next
HRROI T2,OURNAM ;Point to this node's name
CALL ISOUT ;(T1,T2/T1) Append that text next
HRROI T2,[ASCIZ/, /] ;Load the little seperator
CALL ISOUT ;(T1,T2/T1) Append that text next
SETOB T2,T3 ;The time is now, long format please
CALL OODTI1 ;(T1,T2,T3/T1) Do the ODTIM JSYS
AOS T3,LOGPAG ;Get the page number we are writing today
HRROI T2,[ASCIZ/, page /] ;Label for page number
CALL OLDEC ;(T1,T2,T3/T1) Output that label and number
CALLRET OCRLF ;[116] (T1/T1) Output a crlf and return
SUBTTL Logging Routines -- Statistics Logging
;[116] Local routine to output statistics, second through nth header lines.
;Call with T1/ output pointer
;Returns+1 always, T1/ updated pointer
STALOG: SKIPN NALLOW ;[116] [111] Any allowed?
SKIPE NDENY ;[111] Any denied?
IFNSK. ;[111] Yes to either
HRROI T2,[ASCIZ/ Allowed /] ;Space out for rest of text
CALL ISOUT ;Append that label
MOVE T2,NALLOW ;Load number allowed
HRROI T3,[ASCIZ/ request/] ;Label number
CALL OPLURA ;(T1,T2,T3/T1) Output number and label
HRROI T2,[ASCIZ/, denied /] ;Label for next number
CALL ISOUT ;Append that label
MOVE T2,NDENY ;Load number allowed
HRROI T3,[ASCIZ/ request/] ;Label number
CALL OPLURA ;(T1,T2,T3/T1) Output number and label
HRROI T2,[ASCIZ/, /] ;Label for next number
CALL ISOUT ;Append that label
MOVE T2,NFAIL ;Load number failed
HRROI T3,[ASCIZ/ request/] ;Label number
CALL OPLURA ;(T1,T2,T3/T1) Output number and label
HRROI T2,[ASCIZ/ failed
/] ;[111]
CALL ISOUT ;[111] Append that label
ENDIF. ;[111] That's all of the allow deny code
;[111] Output access control hit, misses, and ratio.
SKIPN NMISS ;[111] We will always have at least 1 miss
IFSKP. ;[111] Yes
MOVE T3,NHIT ;[113] Load (100*hits/hits+misses)
IMULI T3,^D100 ;[113] Make into percentage (times millisecs)
MOVE T2,NMISS ;[113] Load misses
ADD T2,NHIT ;[113] Count hits
IDIV T3,T2 ;[113] Compute percentage
HRROI T2,[ASCIZ/ Cache /] ;[113] What hit percentage
CALL OLDEC ;[113] (T1,T2/T1) Send hit percentage
HRROI T2,[ASCIZ/%, hit /] ;[113] Seperate hits
MOVE T3,NHIT ;[111] Load hits
CALL OLDEC ;[113] (T1,T2/T1) Send hits
HRROI T2,[ASCIZ/, missed /] ;[111] Seperate misses
MOVE T3,NMISS ;[111] Load misses
CALL OLDEC ;[111] (T1,T2/T1) Send misses along
HRROI T2,[ASCIZ/, flushed /] ;[113] Seperate flishes
MOVE T3,NFLUSH ;[113] Load flushes
CALL OLDEC ;[113] (T1,T2/T1) Send flushes
CALL OCRLF ;[111] (T1/T1) and a crlf
ENDIF. ;[111] End of access control cache display
;Get and save elapsed runtime and connect time.
SAVEAC <Q1,Q2> ;Save a couple of ACs today
MOVEM T1,Q2 ;[113] Save current pointer to text string
MOVEI T1,.HPRNT ;Get our runtime
HPTIM% ;In high precsion units
JSERRO (<HPTIM failure to get runtime>,<SETZ T1,>) ;Big owie
SKIPN RUNTIM ;Is there any runtime set?
MOVEM T1,RUNTIM ;Nope, set it now
MOVE Q1,T1 ;Copy that to T1
SUB Q1,RUNTIM ;Get our elapsed runtime
TIME% ;Get system uptime in milliseconds
SKIPN PEOPLE ;Any elapsed people time
MOVEM T1,PEOPLE ;Nope, store initial value
EXCH Q2,T1 ;[113] Swap uptime for saved pointer
SUB Q2,PEOPLE ;Get our elapsed people time
IFN. Q2 ;If there has been elapsed connect time
HRROI T2,[ASCIZ/ Used /] ;[111] Label for next number
CALL ISOUT ;Append that label
MOVE T2,Q1 ;Load run time
CALL OTIMEH ;(T1,T2/T1) Output time in HPTIM units
HRROI T2,[ASCIZ/ in /] ;In
CALL ISOUT ;Append that tiny string
MOVE T2,Q2 ;Load people time in milliseconds
CALL OTIME ;(T1,T2/T1) Output elapsed people time
CALL OCRLF ;(T1/T1) Output a CRLF
ELSE. ;Otherwise we are running for first time
HRROI T2,[ASCIZ/ ACJ restart
/] ;Load the pointer to message
CALL ISOUT ;(T1,T2/T1) Send that along please
ENDIF. ;[111] Done with logging time
RET ;[116] Done
SUBTTL Logging Routines -- Start Logging a Request
;Here to start out the log file text which is kept in TEXTBU until sending it
;to the log file. This routine should be called with
; JIBLK/ info about job in question
; USRSTR/ username string for the request
; T2/ pointer to function description string
;Returns +1 always, TEXTBP and T1/ pointer to log buffer
LOGSTA: SAVEAC <Q1> ;Place to keep text pointer
HRROI T1,TEXTBU ;Point to text buffer first of all
MOVEM T2,Q1 ;Save the pointer to text
SETO T2, ;Want current time
MOVX T3,OT%NDA ;No date
CALL OODTI1 ;(T1,T2,T3/T1) Do the ODTIM JSYS
CALL OSPACE ;(T1/T1) Append in a single space
HRROI T2,USRSTR ;Point to the username in question
CALL ISOUT ;(T1,T2/T1) Send username string to log file
CALL OSPACE ;(T1/T1) Append in a single space
MOVE T2,Q1 ;Load pointer to entry type name
CALL ISOUT ;(T1,T2/T1) Send name to log file
MOVEI T4,JIBLK ;Point to the GETJI block we made for this job
CALL OGETJ1 ;(T1,T4/T1) Output non-username job information
HRRZ T4,ARGBLK+.RCCAP ;Get capability mask enabled
SKIPE JIBLK+.JIJNO ;Is it job 0?
CALL OCAPAB ;(T1,T4/T1) Asciify caps if not job 0
MOVEM T1,TEXTBP ;Store the byte pointer for later
RET ;Return +1 with T1/ pointer
SUBTTL Spy on Intruder
;In order to spy on intruders (an excellent technique to discover unwanted
;tourists) the SPYON routine was stolen from another ACJ. This intruder spy
;facility puts the user's output to a file.
;For each intruder there is a fork in a BIN%/BIN% loop between a PTY TLINKed to
;the intruder's terminal and the suspected intruder's job. The fork runs in
;ACJ's address space so that it can be started quickly, and is started sharing
;adress space with the top level ACJ fork. Each fork has its own acs of course
;but also its own private stack. The private fork's stack and the ACs are the
;only storage the subfork writes into. Every 10 seconds it takes a TIMER
;interrupt to see if the job has moved to another terminal, logged out, or
;typed BREAK (it always redoes the spy link in case the user typed BREAK).
;After the spy fork halts, the superior fork notices on a fork termination
;interrupt and kills any spy forks that smell bad (halt or error halt status).
;AC usage in the spy on intruder fork startup code and in the spy fork:
; P1/ User number
; P2/ Job number
; P3/ Log file JFN
; P4/ PTY designator
; P5/ PTY's TTY I/O designator
;Define a little macro to catch spy fork errors and punt the spying session.
;This is done because the fork by design does not touch any memory that the
;superior ACJ main fork might be using.
DEFINE ERSPY(TEXT),<
ERJMP [ JSP T1,SPYERR
ASCIZ/ ACJ Spy: TEXT/]
>
DEFINE SPYER(TEXT),<
JRST [ JSP T1,SPYERR
ASCIZ/ ACJ Spy: TEXT/]
>
SUBTTL Spy on Intruder -- Start a Spy Fork
;Here to start spying on a suspected attacker.
;Call with
; T1/ user number to spy on
; T2/ job number to spy on
;Returns +1 Already logging or can't log
;Returns +2 Spy fork started
;AC usage in this routine, all of which are passed to inferior fork:
; Q1/ inferior fork's stack pointer
; Q2/ inferior fork's offset in SPYxxx tables
; P1/ User number
; P2/ Job number
; P3/ Log file JFN
; P4/ PTY designator
; P5/ PTY's TTY I/O designator
SPYON: SAVEAC <P1,P2,P3,P4,P5,Q1,Q2> ;Save the perms
DMOVE P1,T1 ;Copy user number to P1, job number to P2
SETZ Q2, ;Indicate no free slot found yet
MOVSI T4,-NSPYS ;Get number of forks we can have
DO. ;Search job/user table
CAME P2,SPYJOB(T4) ;Does the job match?
IFSKP. ;Yes
CAMN P1,SPYUSR(T4) ;Does the user match?
RET ;Yes, just return +1 for now
EXIT. ;Same job, not same user, start another spy
ENDIF. ;Job didn't match
SKIPE SPYFRK(T4) ;Is this slot used?
IFSKP. ;No, we have found a free slot then
SKIPN Q2 ;Do we have a free slot yet?
MOVE Q2,T4 ;Nope, we do now though
ENDIF. ;End of free slot code
AOBJN T4,TOP. ;Loop for all possible forks we are running
OD. ;End of search loop
JUMPE Q2,R ;Return if no fork slot available in table
;Create stack pointer for inferior fork.
MOVEI Q1,(Q2) ;Load which spy fork this is
IMULI Q1,SPLEN ;Point to proper stack start address
ADDI Q1,SPYPDL ;Make offset into address of stack
HRLI Q1,-SPLEN ;Make -n,,0
;Open up the spy log file.
CALL SPYGTJ ;(Q1,P2/P3) Get JFN on spy file
JRST SPYPNT ;(Q2/) Punt if error
HRLM P3,SPYJFN(Q2) ;Save log file JFN
;Get a PTY and remember which one.
CALL GETPTY ;(/T1,T2) Try to get a PTY
JRST SPYPNT ;(Q2/) Couldn't, punt JFN and return
DMOVE P4,T1 ;Save PTY JFN and TTY designator for fork
HRRM T1,SPYJFN(Q2) ;Save PTY JFN here too
;Create fork with our caps, our ACs, our map, starting it at SPYSTA.
MOVX T1,CR%CAP!CR%ACS!CR%MAP!CR%ST!FLD(SPYSTA,CR%PCV) ;All implemented
SETZ T2, ;Indicate that fork should get copy of our ACs
CFORK% ;Create a fork
IFJER. ;If error
CAIE T1,CFRKX3 ;No more forks?
OJSERR (<Can't create fork>,,SPYPNT) ;(Q2/) No, some other error
JRST SPYPNT ;(Q2/) Clean up and return
ENDIF. ;End of CFORK error recovery
;We have a bouncing baby fork, set up the SPYxxx tables for later use.
HRRZM T1,SPYFRK(Q2) ;Remember fork handle
MOVEM P1,SPYUSR(Q2) ;Save user number,
MOVEM P2,SPYJOB(Q2) ; and job that the fork is spying
RETSKP ;Spying fork running now
SUBTTL Spy on Intruder -- Kill Spy Fork
;Here to kill off the spy fork.
;Call SPYKIL with T4/ spy fork table offset
;Call SPYPNT with Q2/ spy fork table offset
;Returns +1 always fork is gone, PTY JFN released, log file closed
SPYPNT: MOVEI T4,(Q2) ;Load offset to tables
SPYKIL: MOVE T1,SPYFRK(T4) ;Load the fork handle again
KFORK% ;Kill it off now
ERNOP. ;Well at least I tried
CALL SPYTRL ;(T4/) Perform finishing functions
HLRZ T1,SPYJFN(T4) ;Load spy file JFN
SKIPE T1 ;Was there a JFN?
CLOSF% ;Yes, close it
ERNOP. ;Well, not much we can do at this point
HRRZ T1,SPYJFN(T4) ;Load PTY JFN
SKIPE T1 ;Was there a JFN?
CLOSF% ;Close that too
ERNOP. ;Crunch?
SETZM SPYFRK(T4) ;Clear table entry for fork
SETZM SPYJOB(T4) ;Clear job being spyed on
SETZM SPYUSR(T4) ;Clear user being spyed on
SETZM SPYJFN(T4) ;Clear JFN words
RET ;Return with all cleaned up
SUBTTL Spy on Intruder -- Start a Spy Fork -- Get a Spy File
;Here to get a JFN on the spy fork log file.
;Call with P2/ user number
;Returns +1 if error
;Returns +2 with spy log file open and header written, P3/ JFN
;First construct file name from "predefinedstring-OURNAM.USERNAME"
SPYGTJ: HRROI T1,SPYFIL ;Point to destination area
HRROI T2,SPYSLD ;Load initial text of filespec
CALL ISOUT ;(T1,T2/T1) Copy that string
HRROI T2,[ASCIZ/-/] ;Delimit the string
CALL ISOUT ;(T1,T2/T1) Send the delimiter
HRROI T2,OURNAM ;Point to our node name string
CALL ISOUT ;(T1,T2/T1) Append node name to filespec
HRROI T2,[ASCIZ/./] ;Point to a seperator character
CALL ISOUT ;(T1,T2/T1) Append seperator to filespec
MOVE T2,P1 ;Get user number back
CALL ODIRST ;(T1,T2/T1) Change it to up to 39 characters
CALL ISOUT ;(T1,T2/T1) Append that string in there
;Get a JFN on the file.
MOVX T1,GJ%FOU!GJ%SHT ;Load these flags
HRROI T2,SPYFIL ;Use this string
GTJFN% ;Get JFN for spying
JSERRO (<Unable to get JFN for spy file>,,SPYLFD)
MOVEI P3,(T1) ;Copy JFN for handing down to fork
TXO T1,CF%NUD!FLD(.FBCTL,CF%DSP) ;Load the FBCTL word, don't update
MOVX T2,FB%INV!FB%SEC ;Load the invisible and secure bits for mask
MOVX T3,FB%INV!FB%SEC ;Load the invisible and secure bits to set
CHFDB% ;Change file descriptor block
JSERRO (<Can't make spy file secure and invisible>,<CALL SPYLFD>)
MOVEI T1,(P3) ;Reload T1 incase previous CHFDB fails
TXO T1,CF%NUD!FLD(.FBBYV,CF%DSP) ;Load the FBBYV word and no updates
HRLI T1,.FBBYV ;We want to keep infinite generations
MOVX T2,FB%RET ;Load set retention bit
SETZ T3, ;Keep 0 generations
CHFDB% ;Change file descriptor block
JSERRO (<Can't make spy file generation retention count 0>,<CALL SPYLFD>)
CALL SPYOPN ;(P3/) Open up the file
OJSERR (<Can't open spy file>,,SPYLFD) ;Punt if errors
;Send header to spy file and then return.
CALL SPYHDR ;(P3/) Construct header and send it to file
CALL SPYCLS ;(P3/) Close spy file
OJSERR (<Can't close spy file>,,SPYLFD)
CALL SPYOPN ;(P3/) Reopen the file
OJSERR (<Can't reopen spy file>,,SPYLFD) ;Owie!
RETSKP ;Return OK
;Small local routine to append spy filename into log file.
;Called only from SPYGTJ because otherwise SPYFIL isn't set up.
;Returns +1 always with filename string sent to log file.
SPYLFD: TXO F,FL%ERR ;Indicate we are in error processing
HRROI T1,ERRBUF ;Point to error string buffer
HRROI T2,[ASCIZ/ File /] ;Space over four
CALL ISOUT ;(T1,T2/T1) Send some space along
HRROI T2,SPYFIL ;Point to the spy filename
CALL ISOUT ;(T1,T2/T1) Send that along
CALL OCRLF ;(T1/T1) and a crlf
HRROI T1,ERRBUF ;Point to error buffer again
CALL SENLOG ;(T1/) Send that to the usual log file
TXZ F,FL%ERR ;No longer in error processing
RET ;Return +1
SUBTTL Spy on Intruder -- Start a Spy Fork -- Get a PTY
;Called to get a PTY assigned to spy on intruder.
;Returns +1 always, T1/ PTY JFN, T2/ TTY designator for that PTY
GETPTY: MOVE T4,MAXPTY ;Load maximum number of PTYs on system
IMUL T4,[XWD -1,0] ;Make -n,,0
GETPT1: MOVSI T1,.DVDES!.DVPTY ;Load PTY designator value
HRRI T1,(T4) ;Make designator for particular PTY
DVCHR% ;Get characteristics of the device
ERJMP GETPT2 ;Owie
TXNN T2,DV%AV ;Is this PTY available?
JRST GETPT2 ;Nope, try next one
MOVE T2,T1 ;Load device designator
HRROI T1,SPYFIL ;Point to tempoary area
DEVST% ;Now convert the device to a string
JRST GETPT2 ;Bad, well try the next one
HRROI T2,[ASCIZ/:/] ;Point to the appropriate puctuation
CALL ISOUT ;(T1,T2/T1) Append that and a null
MOVX T1,GJ%SHT ;Load short form bit
HRROI T2,SPYFIL ;Point to string we just built
GTJFN% ;Now try to get a JFN on that PTY
ERJMP GETPT2 ;Well, try the next one then
MOVEI T3,(T1) ;Save JFN here for now
MOVX T2,FLD(7,OF%BSZ)!OF%RD!OF%WR ;Load the open bits
OPENF% ;Open the PTY for read/write
ERJMP GETPT3 ;This is got to be a problem
HRRZ T2,T4 ;Load the PTY unit number
ADD T2,TTYPTY ;Convert PTY unit to TTY unit
TXO T2,.TTDES ; and then make it a device designator
RETSKP ;Successful return with T1, T2 set up
;Here if some problem getting the PTY, release JFN and try again.
GETPT3: MOVEI T1,(T3) ;Get the JFN back
RLJFN% ;Give up the JFN
ERNOP. ;Ignore error here
;Here to try next PTY unit number.
GETPT2: AOBJN T4,GETPT1 ;Try next PTY unit
RET ;Out of units, return failure
SUBTTL Spy on Intruder -- Spy Fork -- Initialization
;This is the start of the fork that spys on intruders. It runs in ACJ's
;address space so that it can be started quickly.
;DANGER Will Robinson: the code running in the inferior fork cannot use any
;storage other than its ACs and stack! All private storage other than the ACs
;must be on the stack or in the big TRVAR at SPYSTA.
;AC usage:
; Q1/ Initial stack pointer
; P1/ User number
; P2/ Job number
; P3/ Spy file JFN
; P4/ PTY designator
; P5/ TTY designator (TTY end of PTY)
SPYSTA: MOVE P,Q1 ;Set up the stack for this fork
TRVAR <<SPYBUF,^D200/5>,<FRKLEV,3>,FRK3PC>
MOVEI T1,.FHSLF ;Load my own fork handle
MOVX T2,JP%SYS ;We are a system fork
SPRIW% ;Do this so we are fast and elude detection
ERNOP. ;Well, at least we tried today
MOVEI T2,FRK3PC ;Load level 3 PC return address
MOVEM T2,2+FRKLEV ;Save as return for level 3
SETZM 0+FRKLEV ;Clear level 1 PC return
SETZM 1+FRKLEV ;Clear level 1 PC return
HRLI T2,FRKLEV ;Load that address
HRRI T2,CHNTAB ;Make LEVTAB,,CHNTAB
SIR% ;Setup our interrupt tables
MOVX T2,1B<TICHAN> ;Load the bit for the timer channel
AIC% ;Activate interrupt channel
EIR% ;Enable interrupt system
CALL INITIM ;(/) Start timer interrupt
CALL SETSPY ;(P1,P2,P5/) Setup spy link
SPYER (<Cannot set up link to user>)
; JRST SPYLOP ;Start up main loop
SUBTTL Spy on Intruder -- Spy Fork -- Main Loop
;This is the loop that takes all of the output of the user's session to spy it.
SPYLOP: MOVE T1,P4 ;Load PTY JFN
BIN% ;Get a byte from the PTY into T2
ERNOP. ;Ignore error for the present time
MOVE T1,P3 ;Load the spy file JFN
BOUT% ;Put the character into the spy file
ERJMP SPYEND ;Punt everything if error writing to file
TXO F,FL%SIO ;Indicate the characters have been sent
JRST SPYLOP ;Loop for more characters to spy
SUBTTL Spy on Intruder -- Spy Fork -- Spy File I/O Routines
;Here to open up the spy file, called with P3/ spy file JFN
;Returns +1 if error
;Returns +2 if success
SPYOPN: MOVE T1,P3 ;Get just the JFN again, this time, all right?
MOVX T2,FLD(7,OF%BSZ)!OF%APP ;Load 7 bit append mode please today sir
OPENF% ;Pry the spy file open
ERJMP R ;Return if error
RETSKP ;Skip return, ok sir, that'll be all sir
;Here to close up the spy file, called with P3/ spy file JFN
;Returns +1 if error
;Returns +2 if success
SPYCLS: MOVE T1,P3 ;Load the JFN again
TXO T1,CO%NRJ ;Close spy file to make it real
CLOSF% ;Crunch
ERJMP R ;Return +1 if error
RETSKP ;Skip return
;Here to send a string to the spy file.
;Call with T2/ pointer to text, P3/ JFN
;Returns +1 if error
;Returns +2 if OK
SENSPY: MOVE T1,P3 ;Load the JFN of the file
SETZB T3,T4 ;Clear this so terminate on null
SOUT% ;Send that to the file
ERJMP R ;Return +1 if error
RETSKP ;Return to caller
SUBTTL Spy on Intruder -- Spy Fork -- Error Recovery and Termination
;Here to output an error message to the spy file, cleanup and halt.
;Call with T1/ address of ASCIZ text
;Kills the fork.
SPYERR: PUSH P,T1 ;Save message string
HRROI T1,SPYBUF ;Point to spy buffer
HRROI T2,[ASCIZ/
[/] ;Point to CRLF bracket
CALL ISOUT ;(T1,T2/T1) Send that along first
CALL OODTIN ;(T1/T1) Current date time
POP P,T2 ;Now send the message
TLO T2,-1 ;Make -1,,address
CALL ISOUT ;(T1,T2/T1) Send message next
HRROI T2,[ASCIZ/, /] ;Send some white space
CALL ISOUT ;(T1,T2/T1) Make it look nice
CALL OERSTR ;(T1/T1) Send last JSYS error
HRROI T2,[ASCIZ/]
/] ;Send closing bracket
CALL ISOUT ;Append all of that together
HRROI T2,SPYBUF ;Point to buffer
CALL SENSPY ;(T2,P3/) Send all of that to the log file
SKIPA T1,SPYBUF ;Uh oh
JRST SPYEND ;Now end this spying session
PSOUT% ;Send to terminal if nothing else possible
;Here when we want to end this spying session. Halts the spy fork.
SPYEND: HALTF% ;Halt the spy fork
JRST .-1 ;What?
SUBTTL Spy on Intruder -- Spy Fork -- Timer Interrupts
;Here when the spy fork wants to do a periodic check to see if job has logged
;out, changed terminals (i.e. got detached, and re-attached), or maybe typed a
;BREAK.
TIMINT: CALL SPYTIM ;(/) Handle the interrupt please
DEBRK% ;Return from interrupt
;Routine to do the work of checking things out at timer interrupts.
SPYTIM: SAVEAC <T1,T2,T3,T4> ;Save the temps for a second
TXZN F,FL%SIO ;Spy file I/O happened?
IFSKP. ;Yes
CALL SPYCLS ;(P3/) Close spy file
JRST SPYABT ;Abort this session if error
CALL SPYOPN ;(P3/) Reopen the spy file
JRST SPYABT ;Abort this session if error
ENDIF. ;End of file checkpoint code
CALL SETSPY ;(P1,P2,P5/) Fix the spy link if needed
JRST SPYABT ;Abort if failure
CALLRET INITIM ;(/) Start timer again and return
;Here to abort the spy fork by changing the interrupt return PC to SPYEND.
SPYABT: MOVEI T1,SPYEND ;Victim is gone, done logging
MOVEM T1,FRK3PC ;Save the return PC as where to return to
RET ;Return to dismiss interrupt and so on
;Setup a timer interrupt for 10 seconds from now
INITIM: MOVE T1,[.FHSLF,,.TIMEL] ;Set interrupt this fork, elapsed time
MOVE T2,SPYINT ;Load interval for spying
IMULI T2,^D1000 ;Convert seconds to milliseconds
MOVX T3,TICHAN ;Load channel for timer interrupts
TIMER% ;Have the monitor do that for us
ERSPY (<TIMER% failed>);Punt this session
RET ;Return as it all went well
SUBTTL Spy on Intruder -- Spy Fork -- Setup Spy Link
;Routine to set up spy link between our PTY and the victim's job.
;Called with
; P1/ Victim's user number
; P2/ Victim's job number
; P5/ TTY designator for our PTY
;Returns +1 no such job
;Returns +2 spy link setup (unless detached)
SETSPY: MOVE T1,P2 ;Get victim's job number
MOVE T2,[-2,,Q1] ;Get TTY and user number
MOVEI T3,.JITNO ; from the monitor on the victim
GETJI% ;Get Job Information
IFJER. ;If that failed
CAIN T1,GTJIX4 ;Did she go away?
RET ;Yes, return +1
SPYER (<GETJI% failed>)
ENDIF. ;End of error
IFN. Q2 ;If there is a user logged in
CAME P1,Q2 ;Is it the user we expect?
RET ;Nope, return +1
ENDIF. ;User not logged in or is who we expect
MOVE T1,P5 ;Get TTY end of the PTY
TXO T1,TL%ERO ;Setup spy link
SKIPGE T2,Q1 ;Load terminal of user's job
RETSKP ;Don't try TLINK if detached
TXO T2,.TTDES ;Make terminal number into designator
TLINK% ;Make link from user terminal to our PTY
ERSPY (<TLINK% failed>) ;Owie!
RETSKP ;Give +2 return
ENDTV. ;End of fork's private storage
SUBTTL Spy on Intruder -- Spy File Header/Trailer
;Here to write header shortly after the file is opened as as file is closed.
;Call with Q1/ freespace pointer
;Returns +1 always.
SPYTRL: SAVEAC <Q1,Q2,Q3> ;Need more ACs today
HRROI Q1,[ASCIZ/ end spying/] ;Here for trailer
HLRZ Q2,SPYJFN(T4) ;Load JFN to Q2
SETZ Q3, ;No job information please
JRST SPYMSG ;Send the message
SPYHDR: SAVEAC <Q1,Q2,Q3> ;Need more ACs today again
HRROI Q1,[ASCIZ/ spying on/] ;Here for header
MOVE Q2,P3 ;Copy the JFN to Q2
MOVEI Q3,JIBLK ;Point to that job's GETJI block
;Here with Q1/ message pointer and Q2/ JFN
SPYMSG: MOVE T1,TEXTBU ;Get current text pointer area
HRROI T1,1(T1) ;Point to some free space
HRROI T2,[ASCIZ/
[/] ;Point to crlf bracket
CALL ISOUT ;(T1,T2/T1) Start off
CALL OODTIN ;(T1/T1) Send time and date
CALL OSPACE ;(T1/T1) and a space
HRROI T2,[VERSIO] ;Load our version text
CALL ISOUT ;(T1,T2/T1) Send that to the line
HRROI T2,[ASCIZ/ on /] ;Label next little part
CALL ISOUT ;(T1,T2/T1) Send that to the line
HRROI T2,OURNAM ;Point to our node name
CALL ISOUT ;(T1,T2/T1) Send that to the line
MOVE T2,Q1 ;Load the mumble string
CALL ISOUT ;(T1,T2/T1) Send that
SKIPE T4,Q3 ;Telling about a job?
CALL OGETJI ;(T1,T4/T1) Tell about this job
HRROI T2,[ASCIZ/]
/] ;Load ending text
CALL ISOUT ;(T1,T2/T1) Send that to the line last
MOVE T1,Q2 ;Load the JFN of the file
MOVE T2,TEXTBU ;Get current text pointer area
HRROI T2,1(T2) ;Point to some free space
SETZB T3,T4 ;Clear this so terminate on null
SOUT% ;Send that to the file, don't use SENSPY
ERNOP. ;Return +1 if error
RET ;Return +1 always as a matter of fact
SUBTTL Spy on Intruder -- Inferior Fork Termination Interrupt
;Come here on fork termination interrupt to check for dead forks.
FRKTRM: CALL SPYTRM ;(/) Call worker routine to do the work
DEBRK% ;Return from interrupt
;Routine to look for spy forks that are halted and kill them off.
;Returns +1 always
SPYTRM: SAVEAC <T1,T2,T3,T4> ;Save those ACs on the stack
MOVSI T4,-NSPYS ;Get number of forks in table
SPYTR1: SKIPN T1,SPYFRK(T4) ;Is there a fork handle for this fork?
JRST SPYTR6 ;Nope, check next one
RFSTS% ;Get fork's status
ERJMP SPYTR2 ;If error kill it
HLRZ T2,T1 ;Load the fork status code
CAIE T2,.RFHLT ;Halted
CAIN T2,.RFFPT ; or forced termination?
SPYTR2: CALL SPYKIL ;(T4/) Yes, kill that fork please
SPYTR6: AOBJN T4,SPYTR1 ;Loop for all of forks in table
RET ;Return to sender
SUBTTL Secure Files
;This routine is called to determine if the user has access to a particular
;file that is set secure. This routine is called with the following arguments
;The format of the ACCESS.CONTROL file is as follows:
; filename access-keyword user user, access-keyword user user, ...
;The first entry that matches the filename (as determined by WILD%) is used.
;Call with:
; Q1/ ARGBLK+.RCARA
; Q2/ SF.xxx for the type of desired access
;Returns +1 if access is not allowed
;Returns +2 if access is allowed (or access control file is not found)
;ACs used in these routines:
; P1/ free
; P2/ byte pointer to current line from that file
; P3/ last character read from that file
; P4/ CBX (cache block index)
SECFIL: SAVEAC <P1,P2,P3,P4> ;Save the perms for our use today
;First try and find the file ACCESS.CONTROL in the same directory as the file
;in question. If this file is not found or is damaged, then the all secure
;operations are allowed and are logged as unusual. Change the "CALLRET SETUNU"
;to "RET" if all secure operations are to be denied if the access control file
;is not found.
CALL SECOPN ;(Q1/Q1,P4) Open up ACCESS.CONTROL
CALLRET SETUNU ;Not there, allow access but log as unusual
;Try and locate the filename in the ACCESS.CONTROL file.
CALL SECFND ;(Q1,P4/P2,P3) Locate this filename
CALLRET SECCLS ;(P4/) Not found, close the file and return +1
;Check desired access against listed allowed access.
HRROI T1,SECUSR ;Point to username build block
MOVE T2,JIBLK+.JIUNO ;Load user number in question
CALL ODIRST ;(T1,T2/T1) Get username made into string
CALL SECACC ;(Q2,P2,P3/) See if user has proper access
CALLRET SECCLS ;(P4/) Nope, close file and return +1
;Access is allowed, close the file and skip return.
CALL SECCLS ;(P4/) Yes, close file
CALL SECACT ;(Q1,Q2/) See if special action is needed
RETSKP ;Return +1 indicating the access is allowed
SUBTTL Secure Files -- Find File's Entry
;Here to try to locate an entry for the file in question in the ACCESS.CONTROL
;file. We are called with SECFNA/ "file.type.gen" and P4/ CBX
;Returns +1 if entry not found
;Returns +2 if entry found, P2/ line pointer and P3/ last character read
SECFND: CALL SECSIN ;(P4/P2,P3) Read a line in from file
RET ;If EOF return +1 (not found)
;We have a line read in, eat white space. If comment line get another line.
CALL SECSPN ;(P2/P2,P3) Eat until first non blank character
JRST SECFND ;None on that line, get another line
CAIN P3,";" ;Comment character semicolon first nonblank?
JRST SECFND ;Yes, this was a comment, get next line please
;Line has been read in, get the first field in it which should be the filename.
CALL SECFLD ;(P2,P3/P2,P3) Read a field into the word area
RET ;If EOL before field read, return +1
;We have a field read in. See if the file in question matches this entry.
MOVX T1,.WLSTR ;Load wild string match function
HRROI T2,SECWRD ;Point to the (possibly wild) entry from file
HRROI T3,SECFNA ;Point to the "file.type.gen" requested by user
WILD% ;Get the monitor's help here
ERJMP SECFND ;Should never ITRAP, but ya never know
JUMPN T1,SECFND ;Continue looping if the string didn't match
;Filename matched! Check terminator of field, it must be space or tab.
CAIE P3,.CHTAB ;Was previous field terminator a tab
CAIN P3," " ; or was it a space?
RETSKP ;Return +2 since the entry matched
JRST SECFND ;Look some more if illegal terminator
SUBTTL Secure Files -- Check Desired Access
;Called here after the entry for this file has been found to check the
;desired access, with Q2/ access code, P2 and P3 set up from SECFND.
;Returns +1 if access not allowed (not found)
;Returns +2 if access is allowed (user found)
SECACC: CALL SECFLD ;(P2,P3/P2,P3) Read in a field
RET ;If end of line return +1
;See if the keyword read is something we recognize.
MOVEI T1,SECTBL ;Point to table of keywords
HRROI T2,SECWRD ;Point to the word to match please
TBLUK% ;Look it up in our keyword table
ERJMP SECAC2 ;Shouldn't ITRAP, but if error check next one
TXNE T2,TL%NOM!TL%AMB ;No match or ambig?
JRST SECAC2 ;Yes, eat until end of line or comma seen
HRRZ T2,(T1) ;Get the value for this keyword
TDNN Q2,T2 ;Match the desired access?
JRST SECAC2 ;Nope, keep looking
CAIE P3,.CHTAB ;Was previous field terminator a tab
CAIN P3," " ; or was it a space?
JRST SECAC5 ;Yes, we have a winner on this particular entry
;The keyword didn't match or wasn't the desired access keyword, eat until ",".
SECAC2: CALL SECCHR ;(P2/P2,P3) Get the next character
RET ;Return badly if end of line
CAIE P3,"," ;Looking for a comma
JRST SECAC2 ;Keep looking until comma or end of line seen
SECAC4: CALL SECCHR ;(P2/P2,P3) Get the character after the comma
RET ;End of line? Not here, not after all of this!
JRST SECACC ;Char after comma loaded, examine next field
;We have reached the desired access keyword. See if desired user is in list.
SECAC5: CALL SECFLD ;(P2,P3/P2,P3) Read the next field in
RET ;Owie if end of line
MOVX T1,.WLSTR ;Load wild string match function
HRROI T2,SECWRD ;Point to the (possibly wild) entry from file
HRROI T3,SECUSR ;Point to the username we are concerned about
WILD% ;Get the monitor's help here
ERSKP. ;Should never ITRAP, but ya never know
JUMPE T1,RSKP ;User can do this! Our work is done
CAIN P3,"," ;Was terminator a comma?
JRST SECAC4 ;Yes keep looking on this line
CAIE P3,.CHTAB ;Was previous field terminator a tab
CAIN P3," " ; or was it a space?
JRST SECAC5 ;OK terminator, continue looping through users
RET ;Return badly if illegal terminator
SUBTTL Secure Files -- Access Keywords
;This is a TBLUK style table of access keywords and access keyword values.
;It is used when reading the keywords after the filenames in ACCESS.CONTROL.
;Lines commented out are ideas for future functions. A priv scheme must be
;thought about before implementation. There is also the possibility that the
;ACJ could cause quota or blocking problems with these same ideas.
SECTBL: TBEGIN ;Plant the header here
TENTRY (ALL,SF.ALL) ;All access (app, del, rea, ren, sec, wri)
TENTRY (APPEND,SF.APP) ;Append access (OPENF)
; TENTRY (ANNOUNCE,SF.ANN) ;Send message to user list specified (priv)
; TENTRY (CONSOLE,SF.CON) ;TTMSG to CTY when file touched (priv)
TENTRY (DELETE,SF.DEL) ;Delete access (DELF)
; TENTRY (LOG,SF.LOG) ;Log access in samestr:<user>ACCESS.LOG (priv?)
TENTRY (NOSECURE,SF.NOS) ;Clear secure access (CHFDB)
TENTRY (READ,SF.REA) ;Read access (OPENF)
TENTRY (RENAME,SF.REN) ;Rename access (RNAMF)
TENTRY (SECURE,SF.SEC) ;Set secure access (CHFDB)
TENTRY (WRITE,SF.WRI) ;Write access (OPENF)
TEND ;End of table
SUBTTL Secure Files -- Access Control Cache
;[111] The Access Control Cache maintains the last NCACHE files open read for
;secure files access control.
;The SECOPN routine is called to open an ACCESS.CONTROL file for parsing. This
;routine tries to find an entry in the cache for the directory of the filename
;passed to this routine. Routine SECOSF is called to split the given filename
;string apart into a string containing the structure and directory and other
;string containing just the file.type.version.
;Routine SECOCF is called to find a cache entry for the str:<directory> where
;the given file resides. If there is no entry for this directory, an entry is
;found by searching the cache for the first free cache block. If there is no
;free block the oldest referenced cache block which is then used for this
;opening of the file.
;The cache is organized into NCACHE non-contiguous fixed buffers in memory,
;each of SCACHE contiguous pages. A table of CBXSIZ words is used for each
;fixed buffer and contains the address of the buffer as determined at assembly
;time as well as the ASCIZ directory for which the cache is a part.
;After the cache block is idenitified, SECOCS is called to check to see that
;the entry is not "stale". Stale entries are determined by checking the time
;that the data pages were mapped. If stale entries were not flushed, changes
;in the ACCESS.CONTROL files would never be picked up. If the entry is
;considered stale the cache block is invalidated. This invalidation causes the
;file to be remapped (as if it was a new entry in the cache). This period
;should be fairly long to avoid overhead.
;Routine SECOCO is called after the stale check. This routine opens and maps
;the file if the cache block indicates that the file is not currently mapped.
;Finally, routine SECOCI is called to set up the pointers and counts needed to
;for routines that scan the ACCESS.CONTROL file.
;The cached paged are then read by the normal SECCIN routine. If the scan of
;the file causes all cached pages to be looked at, and the file was larger than
;SCACHE pages, routine SECMAP is called to map the next page in the file into
;the "overflow" buffer. Pages are then looked at one at a time until all pages
;in the file have been mapped.
;When SECCLS is called to close the file only the overflow buffer is unmapped.
;The file stays open along with its JFNs for possible future access. Routine
;SECFLU is called to flush an entry from the cache, unmapping all pages and
;releasing the JFN.
SUBTTL Secure Files -- Access Control Cache -- Open File
;Here to open the ACCESS.CONTROL file in the same directory as the secure file.
; Sets up SECDIR/ "str:<directory>" and SECFNA/ "file.type.gen"
; Finds cache entry for this file.
; If file not in cache, open and map SCACHE pages from it.
; Set up variables for reading the file.
;Called with Q1/ ARGBLK+.RCARA
;Returns +1 if file not found
;Returns +2 if file found, P4/ cache block
SECOPN: CALL SECOSF ;[111] (Q1/) Split filespec first
;Find cache entry, and try to open the file.
CALL SECOCF ;[111] (/P4) Find cache entry for this
CALL SECOCS ;[111] (P4/) Flush stale entry if needed
CALL SECOCO ;[111] (P4/) Open up the file if possible
RET ;[111] Owie, return +1
CALL SECOCI ;[111] (P4/) Setup for I/O
RETSKP ;Give the +2 return please
SUBTTL Secure Files -- Access Control Cache -- Open File -- Split Filename
;[111] Routine to split up filename strings. Sets SECDIR "str:<directory>",
;SECFNA "file.type.gen" and SECFNV "file.type"
;Called with Q1/ ARGBLK+.RCARA
;Returns +1 always with SECDIR and SECFNA and SECFNV set up.
SECOSF: MOVEI T2,.GEFIL(Q1) ;[111] Load address of the with the filename
HRLI T2,(POINT 7) ;[111] Point to the thing with a byte pointer
MOVE T1,[POINT 7,SECDIR] ;[111] Point to "str:<directory>" build area
DO. ;[111] Loop to grab the str:<dir>
ILDB T3,T2 ;[111] Load a source byte
IDPB T3,T1 ;[111] Store a byte please
CAIN T3,76 ;[111] Is it a close angly?
EXIT. ;[111] Yes, exit
JUMPN T3,TOP. ;[111] Continue looping if not end of string
RET ;[111] Return now if premature end of filename
OD. ;[111] Now we have the "str:<dir>" done
SETZ T3, ;[111] Load up a null
IDPB T3,T1 ;[111] and store it there to bind off dir
HRROI T1,SECFNA ;[111] Point to "file.type.gen" storage area
CALL ISOUT ;[111] (T1,T2/T1) Copy rest of filename there
HRROI T1,SECFNV ;[115] Point to filename area
HRROI T2,SECFNA ;[111] Load address of "file.type.gen"
CALL ISOUT ;[111] (T1,T2/T1) Copy string, ending bp in T1
DO. ;[111] Loop back from end to find first dot
SETO T2, ;[111] Load a -1 in T2
ADJBP T2,T1 ;[111] Back it up one
MOVEM T2,T1 ;[111] Store it back
LDB T2,T1 ;[111] Load character from there
CAIE T2,"." ;[111] Period?
JUMPN T2,TOP. ;[111] Not yet, go back another character
OD. ;[111] Found start of version
SETZ T2, ;[111] Load a null
DPB T2,T1 ;[111] Store it over period
RET ;[111] Return
SUBTTL Secure Files -- Access Control Cache -- Open File -- Cache Find
;[111] SECOPN routine to examine the cache and find entry for str:<directory>.
;It may return with
; 1) an existing valid cache block (cache hit)
; 2) a free cache entry (cache miss)
; 3) a reused cache entry (cache miss)
;Call with SECDIR set up.
;Returns +1 always with P4/ offset to cache block entry
SECOCF: MOVE P4,[-NCACHE,,CBPOOL] ;[111] Load number of entries in the cache
DO. ;[111] Loop for all cache blocks
SKIPN CBXJFN(P4) ;[111] Is this one free?
IFSKP. ;[111] Nope
HRROI T1,SECDIR ;[111] Point to "str:<directory>"
HRROI T2,CBXDIR(P4) ;[111] Point to filename for this entry
CALL ISTCMP ;[111] (T1,T2/T1) Compare the strings
IFE. T1 ;[111] If a match
AOS NHIT ;[111] Count as a cache hit
RET ;[111] Return
ENDIF. ;[111] End of string match code
ENDIF. ;[111] End of check
ADDI P4,CBXSIZ-1 ;[111] Point to next block -1
AOBJN P4,TOP. ;[111] Loop if more blocks to consider
OD. ;[111] End of loop to check old entries
AOS NMISS ;[111] Count a cache miss
;[111] Entry was not in the cache, locate a place for it and fill in the CB.
MOVE P4,[-NCACHE,,CBPOOL] ;[111] Now we find an empty slot or oldest
MOVX T1,.INFIN ;[111] Load a real log uptime about a year
DO. ;[111] Loop to find a free spot
SKIPN CBXJFN(P4) ;[111] Is this one free?
EXIT. ;[111] Yes, we found one
CAMG T1,CBXRTI(P4) ;[111] Is this the oldest one yet?
IFSKP. ;[111] Yes, this entry is older than last one
MOVE T1,CBXRTI(P4) ;[111] Load the time of the oldest one
MOVEI T2,(P4) ;[111] and remember which entry this was
ENDIF. ;[111] Continue
ADDI P4,CBXSIZ-1 ;[111] Point to next block -1
AOBJN P4,TOP. ;[111] Loop for each one
MOVEI P4,(T2) ;[111] Load the address of the one matching
CALL SECFLU ;[111] (P4/) Remove this entry from cache
OD. ;[111] End of loop
HRROI T1,CBXDIR(P4) ;[111] Point to filename for this entry
HRROI T2,SECDIR ;[111] Point to "str:<directory>"
CALLRET ISOUT ;[111] (T1,T2/T1) Copy the str:<dir> to CBX
SUBTTL Secure Files -- Access Control Cache -- Open File -- Cache Stale Check
;[111] SECOPN routine to check that cached entry found is not too stale to use.
;If the cache block entry specified is too old it is flushed before use.
;Call with P4/ CBX
;Returns +1 always.
SECOCS: SKIPN CBXJFN(P4) ;[111] Is this entry in use now?
RET ;[111] Nope, get out
;[111] Files are always kept in the cache we know when they change.
MOVX T1,FB%SEC ;[111] Load secure bit
TDNN T1,CBXCTL(P4) ;[111] Was this file secure when we looked?
IFSKP. ;[111] Yes
MOVX T1,FU%GOK ;[111] Load we are doing GETOKs bit
TDNE T1,GOOPNB ;[111] Can we tell a secure OPENF on this file?
RET ;[111] Yes, do nothing to interfere
ENDIF. ;[111] Let the timer take care of it
;[111] Non secure file, check for maximum map time.
MOVE T1,TODCLK ;[111] Load the uptime at last RCVOK function
SUB T1,CBXMTI(P4) ;[111] Get elapsed time that file mapped
CAILE T1,SECDCI*^D1000 ;[111] Is this entry too old?
CALL SECFLU ;[111] (P4/) Yes, abort it now and remap it
RET ;[111] Return
SUBTTL Secure Files -- Access Control Cache -- Open File -- Cached Open
;[111] SECOPN routine to open up a file that is not currently in the cache.
;Call with P4/ cache block offset
;Returns +1 if error
;Returns +2 if already open or just opened and cached file set up for reading.
SECOCO: SKIPE CBXJFN(P4) ;[111] Is there a cached entry?
RETSKP ;[111] Yes, it is all set up
;[111] Construct filename to use.
HRROI T1,CBXFIL(P4) ;[111] Point to filename area
HRROI T2,CBXDIR(P4) ;[111] Point to str:<directory>
CALL ISOUT ;[111] (T1,T2/T1) Copy that first
HRROI T2,[ASCIZ/ACCESS.CONTROL/] ;[111] Point to the filename we desire
CALL ISOUT ;[111] (T1,T2/T1) Append in the desired file
;[111] Get a JFN on the access.control file.
MOVX T1,GJ%OLD!GJ%XTN ;[111] Load old file flags long form block
MOVEM T1,SECGTJ+.GJGEN ;[111] and set in long form block
MOVX T1,G1%IIN ;[111] Include invisible files
MOVEM T1,SECGTJ+.GJF2 ;[111] and set this in second flag word
MOVEI T1,SECGTJ ;[111] Point to long form GTJFN block
MOVX T1,GJ%OLD!GJ%SHT ;[111] Load short form and old file flags
HRROI T2,CBXFIL(P4) ;[111] Point to the filename please
GTJFN% ;[111] Try to find that file
ERJMP R ;[111] Return +1 if file not found
;[111] Open up the access control file.
MOVEM T1,CBXJFN(P4) ;[111] Save the JFN
MOVX T2,OF%PDT!OF%RD!FLD(7,OF%BSZ) ;[111] Preserve dates, 7 bit, read
OPENF% ;[111] Pry that file open please
ERJMP SECFLU ;[111] (P4/) Close file and return +1 if errors
;[111] Get FBCTL word for this file and store it.
SETZM CBXCTL(P4) ;[111] Default FBCTL work to zero
MOVX T2,<1,,.FBCTL> ;[111] Just this word
MOVEI T3,CBXCTL(P4) ;[111] Poimt to block for storing this
GTFDB% ;[111] Get the file's FDB word
ERJMP SECFLU ;[111] (P4/) We must be able to get this word
;[111] Get size of file and compute how many pages to map.
MOVE T1,CBXJFN(P4) ;[111] Load the JFN for the file again
SIZEF% ;[111] Get the size of the file
ERJMP SECFLU ;[111] (P4/) If error, close it now
MOVEM T3,CBXPCT(P4) ;[111] Save file page count
CAILE T3,SCACHE ;[111] Is it over the size of the cache buffer?
MOVEI T3,SCACHE ;[111] Reduce pages to map to the size
MOVEM T3,CBXMAP(P4) ;[111] Save as mapped page count
;[111] We know all about the file, map the first SCACHE pages into cache.
HRLZ T1,CBXJFN(P4) ;[111] Load JFN of that file please
MOVE T2,CBXPAG(P4) ;[111] Load fork,,page number of cache buffer
TXO T3,PM%RD!PM%CNT ;[111] We have to read and have a count please
PMAP% ;[111] Map those pages into cache please
ERJMP SECFLU ;[111] (P4/) If error we are screwed now
;[111] Update the mapped time for this cache entry.
MOVE T1,TODCLK ;[111] Load now
MOVEM T1,CBXMTI(P4) ;[111] and save it as time of mapping
RETSKP ;[111] Return OK
SUBTTL Secure Files -- Access Control Cache -- Open File -- Cached Input Setup
;[111] SECOPN routine to set up the pointers and counts to read cached pages.
;Call with P4/ CBX
;Returns +1 always with pointers and counts set up.
SECOCI: MOVE T1,TODCLK ;[111] Load now
MOVEM T1,CBXRTI(P4) ;[111] and save it as time of reference
MOVE T1,CBXPTR(P4) ;[111] Get byte pointer to cache buffer
MOVEM T1,SECBPT ;[111] Save as byte pointer to data
MOVE T1,CBXMAP(P4) ;[111] Load number of pages mapped today
IMULI T1,PGSIZ*5 ;[111] Compute possible bytes there
MOVEM T1,SECBCT ;[111] Save as byte count
MOVE T1,CBXMAP(P4) ;[111] Load number of pages mapped today
SUBI T1,1 ;[111] Get next page to map-1 for SECMAP
MOVEM T1,SECPMP ;[111] Save the logical last page mapped
MOVE T1,CBXPCT(P4) ;[111] Reload the total size of the file
SUB T1,CBXMAP(P4) ;[111] Compute pages that are NOT cached
SKIPGE T1 ;[111] Did it fit in the cache?
SETZ T1, ;[111] Yes, load zero non cached page count
MOVEM T1,SECPCT ;[111] Save non cached page count
RET ;[111] Return
SUBTTL Secure Files -- Access Control Cache -- Close File -- Read Finished
;[111] Here when finished with ACCESS.CONTROL file. This routine just returns
;after unmapping the page used when the entire file does not fit into one
;cache buffer (greater than SPAGES pages). The cached part of the file will
;remain so it's JFN must remain as well.
;Call with P4/ CBX
;Returns +1 always
SECCLS: SETO T1, ;Load a -1 for no mapping
MOVX T2,<.FHSLF,,SECOPG> ;[111] This fork that page
MOVEI T3,0 ;Load no flags and junk
TXZE F,FL%LAC ;[111] Long access control file mapped?
PMAP% ;Unmap that stuff
ERNOP. ;[111] Ignore errors or nothing to unmap
RET ;[111] Return, that's all there is to do
SUBTTL Secure Files -- Access Control Cache -- Close File -- Flush Cache
;[111] Here when aborting use of ACCESS.CONTROL file.
;Unmaps all pages, closes JFN, frees cache block.
;Call with P4/ cache block address
;Returns +1 always.
SECFLU: CALL SECCLS ;[111] (P4/) First unmap junk page if any
SKIPN T3,CBXMAP(P4) ;[111] Load mapped page count, skip if some
IFSKP. ;[111] Pages were in fact mapped today
SETO T1, ;[111] Get ready to unmap the cache paged
MOVE T2,CBXPAG(P4) ;[111] Load page number and this fork
TXO T3,PM%CNT ;[111] We have to have a count please
PMAP% ;[111] Unmap all of those pages
ERNOP. ;[111] Forget errors
SETZM CBXMAP(P4) ;[111] Perform housekeeping
ENDIF. ;[111] End of unmap code
MOVE T1,CBXJFN(P4) ;[111] Load the JFN
CLOSF% ;[111] Close and release the JFN
ERCAL SECABR ;[111] (P4/) If that failed, try releasing it
SETZM CBXJFN(P4) ;[111] Clear this cache entry then now
AOS NFLUSH ;[115] Count a flushed one
RET ;[111] Return +1 please
SECABR: MOVE T1,CBXJFN(P4) ;[111] JFN must not be open (OPENF failed!)
RLJFN% ;[111] So release the JFN already
ERNOP. ;[111] Ignore errors this fine spring day
RET ;[111] Return +1 always
;[111] Here when wanting to abort all cache entries.
;Called from the crash routine.
;Returns +1 always.
SECCLA: MOVE P4,[-NCACHE,,CBPOOL] ;[111] For all entries in the cache
DO. ;[111] Loop through eache entry
CALL SECFLU ;[111] (P4/) Flush this entry
ADDI P4,CBXSIZ-1 ;[111] Count to next block address-1
AOBJN P4,TOP. ;[111] Loop for all cache entries
OD. ;[111] End of that loop
RET ;[111] Return to caller
SUBTTL Secure Files -- Action for Successful Access
;[110] Here to check to see if the secure file being touched is our log file.
;If a read of the log file is requested, then we set the sweep cache flag. If
;a rename of the log file is requested, then we get a new log file.
;[111] Then if a rename or a write, check each access control block to see if
;it matches the filename of one of our cached files, and if so flush entry.
;
;Call only after determining that access is allowed with
; Q1/ ARGBLK+.RCARA
; Q2/ SF.xxx for the type of desired access
;Returns +1 always.
SECACT: TXNE Q2,SF.REN!SF.REA ;[121] Is it a rename or read function?
CALL SECACL ;[121] (/) Yes, have to check log file spec
TXNE Q2,SF.REN!SF.WRI!SF.DEL ;[121] Is it a rename, write, or delete?
CALL SECACA ;[121] (/) Check for access.control file
RET ;[121] Return to caller
;[121] Local routine for SECACT to check for access.control file.
;Called here if a rename or write function was specified.
;Returns +1 always, access.control cache entry flushed if a match.
SECACA: HRROI T1,SECFNV ;[121] Point to "file.type" of the file
HRROI T2,[ASCIZ/ACCESS.CONTROL/] ;[121] Point to the usual filename
CALL ISTCMP ;[121] (T1,T2/T1) See if it is the magic one
JUMPN T1,R ;[121] If no match return now
SAVEAC <P4> ;[111] Save an AC
MOVE P4,[-NCACHE,,CBPOOL] ;[111] For all entries in the cache
DO. ;[111] Loop through eache entry
SKIPN CBXJFN(P4) ;[111] Is this entry active?
IFSKP. ;[111] Yes see if access.control file
HRROI T1,SECDIR ;[115] Load address of "str:<directory>"
HRROI T2,CBXDIR(P4) ;[115] Point to cache block str:<directory>
CALL ISTCMP ;[111] (T1,T2/T1) See if a match
SKIPN T1 ;[111] Skip if no match
CALLRET SECFLU ;[121] (P4/) Flush if touching access.control
ENDIF. ;[111] End of check for entry to flush
ADDI P4,CBXSIZ-1 ;[111] Count to next block address-1
AOBJN P4,TOP. ;[111] Loop for all cache entries
OD. ;[111] End of that loop
RET ;[121] Return to caller
;[121] Local routine for SECACT to check for manipulation of the log file.
;Called here if a rename or read function is being performed.
;Returns +1 always, with new log file or flush log file bit set.
SECACL: SKIPN LOGJFN ;[121] Log file open now?
RET ;[121] Nope, return now
HRROI T1,.GEFIL(Q1) ;[111] Point to filename
HRROI T2,LOGFNA ;[111] Point to log filename
CALL ISTCMP ;[111] (T1,T2/T1) Compare those strings now
JUMPN T1,R ;[121] Return now if not a match on filename
CAIN Q2,SF.REA ;[110] Reading the log file?
TXO F,FL%SLF ;[110] It was a match, we need to sweep
CAIN Q2,SF.REN ;[110] Rename log file?
CALL NEWLOG ;[110] (/) Yes, we need a new log file then
RET ;[121] Return to caller
SUBTTL Secure Files -- Read Line from File
;Here to read one non-comment line from ACCESS.CONTROL into the buffer.
;Called with P4/ CBX
;Returns +1 if EOF (or any other error)
;Returns +2 if line read, P2/ pointer to line, P3/ first nonblank character
SECSIN: MOVE P2,[POINT 7,SECLIN] ;Point to the line first of all
MOVEI P3,<SECCPL*5>-1 ;Load maximum characters per line today
DO. ;Loop to read in a line from the file
CALL SECCIN ;(P4/T1) Get a character from the file
EXIT. ;End the loop if not possible
CAIE T1,"-" ;Is it a hyphen?
IFSKP. ;Yes, possibly a line continuation character
CALL SECCIN ;(P4/T1) Get next character
EXIT. ;End loop if end of file
CAIE T1,.CHCRT ;Return after hyphen?
IFSKP. ;Yes, return after hyphen
CALL SECCIN ;(P4/T1) Get next character
EXIT. ;End loop if end of file
CAIN T1,.CHLFD ;Must be a line feed next
LOOP. ;Yes, it was, continue as if nothing happened
EXIT. ;Format error in file, lets get out of here now
ELSE. ;Otherwise hyphen not followed by a return
MOVEI T2,"-" ;Reload the hyphen
IDPB T2,P2 ;Store it followed by character we just read
SOJLE P3,ENDLP. ;Count this character, fall thru to store T1
ENDIF. ;End of hyphen not followed by return case
ENDIF. ;End of hyphen seen case
IDPB T1,P2 ;Store that byte please
CAIN T1,.CHLFD ;Is it a line feed?
EXIT. ;Yes, get out of here with a line read
SOJG P3,TOP. ;Loop for all possible characters
OD. ;End of loop to read line of characters
MOVEI T1,0 ;Load zero also known as the null character
IDPB T1,P2 ;Store that there to insure null on end
MOVE P2,[POINT 7,SECLIN] ;Point to line please
RETSKP ;Skip return
SUBTTL Secure Files -- Read Character from File
;Local routine to read a character from the file, call with P4/ CBX.
;Returns +1 if error
;Returns +2 if no error, T1/ character
SECCIN: SOSL SECBCT ;See if any bytes left in buffer
IFSKP. ;If none left there
CALL SECMAP ;(P4/) Map a page of the file
RET ;If no mapping possible return +1
JRST SECCIN ;Try again please
ENDIF. ;Otherwise we do not need to get more bytes
ILDB T1,SECBPT ;Load a byte from the file
MOVE CX,SECBPT ;[123] Load the byte pointer
MOVE CX,(CX) ;[123] Load the data word
TRNE CX,1B35 ;[123] Is this a LSN line?
JRST SECCIN ;[123] Yes, ignore it now
JUMPN T1,RSKP ;If a real character, skip return
JRST SECCIN ;A null was seen, check next character
;Here to map another page of the access control file. [111] We only get here
;when the cached page count is exhausted, that is the file is larger than
;SCACHE pages long, after thatn this routine is called for each remainting page
;in the file. It is felt that files over SCACHE pages are unusual, and at
;least the first SCACHE pages are cached.
;Call with P4/ CBX and SECPCT/ count of pages left to map
;Returns +1 if end of file or other problem with mapping.
;Returns +2 if file mapped, SECBPT and SECPTR set up
SECMAP: SOSGE SECPCT ;Count a page that is mapped
RET ;End of file
AOS T1,SECPMP ;Load the next page number
HRL T1,CBXJFN(P4) ;Load the JFN into the proper place
MOVX T2,<.FHSLF,,SECOPG> ;[111] This fork and this page
MOVX T3,PM%RD ;Reading only the one page today
PMAP% ;Map those pages in please
ERJMP R ;If error we are done
TXO F,FL%LAC ;[111] Indicate long access control file
MOVE T1,[POINT 7,SECOBU] ;[111] Point to proper place
MOVEM T1,SECBPT ;Store this in the correct place
MOVEI T1,PGSIZ*5 ;Load byte count of the page
MOVEM T1,SECBCT ;Save the byte count of this page
RETSKP ;Skip return
SUBTTL Secure Files -- Read Character from Line Buffer
;Here to read a character from the line. Eats embedded comments.
;Call with P2/ pointer to the line
;Returns +1 if end of line seen
;Returns +2 if not end of line, P2/ updated pointer P3/ character
SECCHR: CALL SECCH2 ;(P2/P2,P3) Load a character
RET ;End of line!
CAIE P3,"!" ;Is it a embedded comment character?
RETSKP ;Nope, return +2 now
SECCH1: CALL SECCH2 ;(P2/P2,P3) Get next character
RET ;Returns +1 at end of line
CAIE P3,"!" ;Is it the end of embedded comment?
JRST SECCH1 ;Nope, keep looking for end of comment
; CALLRET SECCH2 ;(P2/P2,P3) Yes, get next character and return
SECCH2: ILDB P3,P2 ;Load a character please
CAIE P3,.CHCRT ;Return?
CAIN P3,.CHFFD ;Form feed?
JRST SECCHR ;Yes, eat those
CAIN P3,.CHLFD ;End of line?
RET ;Yes, return +1
CAIL P3,"a" ;Is it
CAILE P3,"z" ; lowercase?
RETSKP ;Nope, return +2
SUBI P3,"a"-"A" ;Yes, convert to upper case
RETSKP ; and return +2
;Here to eat characters from pointer in P2 until a nonblank character is found.
;Call SECSPA with P2/ pointer to the line, P3/ 0 or last character read
;Call SECSPN to ignore last character read, P2/ pointer to the line
;Returns +1 if end of line
;Returns +2 if not end of line with P2/ updated pointer and P3/ character
SECSPN: CALL SECCHR ;(P2/P2,P3) Read a character
RET ;Return +1 if end of line
SECSPA: CAIE P3," " ;Was the last character read a space?
CAIN P3,.CHTAB ;Was the last character read a tab?
JRST SECSPN ;Yes, get another character then please
RETSKP ;Return +2, P3/ nonblank character
SUBTTL Secure Files -- Read Field from Line Buffer
;Here to read in a field from the access control listing file.
;Legal field characters are alphanumerics, asterisk, dot, percent.
;Call with P2/ pointer to the line, P3/ last character read
;Returns +1 if blank field (EOL or field terminator detected before field read)
;Returns +2 if non-blank field, P2/ updated, P3/ field terminator
SECFLD: CALL SECSPA ;(P2,P3/P2,P3) Eat any leading spaces
RET ;End of line
MOVE T1,[POINT 7,SECWRD] ;Point to output area (word/field to match)
SETZM SECWRD ;Make it easy to see blank fields
SECFL1: CAIL P3,"0" ;OK, well is it a character we can consider
CAILE P3,"9" ; a numeric character?
CAIN P3,"." ;Is it a hot dot? (dot is less than zero)
JRST SECFL5 ;Yes in fact this is a legal character
CAIE P3,"*" ;Is it a going to be
CAIN P3,"%" ; a wild character?
JRST SECFL5 ;Yes, proceed to store it and loop
CAIN P3,"$" ;Is it money?
JRST SECFL5 ;Yes
CAIE P3,"_" ;Is it a going to be underscore
CAIN P3,"-" ; or a hyphen?
JRST SECFL5 ;Yes, proceed to store it and loop
CAIL P3,"A" ;Is the character one that we consider
CAILE P3,"Z" ; alphabetic?
JRST SECFL6 ;Nope, it is a field terminator
;Here if non-terminator character. Store it, get next character, and loop.
SECFL5: IDPB P3,T1 ;It is a legal character, store the character
CALL SECCHR ;(P2,P2/P3) Read a non blank character
JRST SECFL6 ;End of line, check it out
JRST SECFL1 ; and loop for more of them today please sir
;Here if field terminator seen. Store a null, return +2 if non-null word read.
SECFL6: SETZ T2, ;Load a zero or null character to tie it off
IDPB T2,T1 ;Stick a null at end of the string
SKIPE SECWRD ;Here if end of line, did we store something?
AOS (P) ;Yes, skip return
RET ;Return +1 or +2
SUBTTL Subroutines -- Simulate STCMP
;[111] Here to quickly/cheaply compare to ASCIZ strings.
;Call with T1 and T2 pointing to two ASCIZ strings.
;CAUTION! This routine smashes T1 through T4!
;Returns +1 always, T1/0 if strings matched.
ISTCMP: TLC T1,-1 ;[111] Complement left half
TLCN T1,-1 ;[111] Was the left half -1?
HRLI T1,(Point 7) ;[111] Yes, make it a byte pointer
TLC T2,-1 ;[111] Complement left half
TLCN T2,-1 ;[111] Was the left half -1?
HRLI T2,(Point 7) ;[111] Yes, make it a byte pointer
DMOVE T3,T1 ;[111] Copy the pointers to T3 and T4
DO. ;[111] Loop through the characters
ILDB T2,T4 ;[111] Get character from user's filespec
ILDB T1,T3 ;[111] Get character from log filespec
CAIN T1,(T2) ;[111] Do the characters match?
JUMPN T1,TOP. ;[111] Yes, continue to loop unless null seen
OD. ;[111] End of loop, null in T1 if a match seen
RET ;[111] Return with T1 set up
SUBTTL Subroutines -- Simulate SOUT
;Here to quickly/cheaply copy ASCIZ string, insures null at end of string.
;Call with T1/ destination byte pointer, T2/ source byte pointer
;CAUTION! This routine MUST preserve all ACs except T1 and T2.
;Returns +1 always, string copied, T1 and T2 updated
ISOUT: TLC T1,-1 ;Complement left half
TLCN T1,-1 ;Was the neft half -1?
HRLI T1,(Point 7) ;Yes, make it a byte pointer
TLC T2,-1 ;Complement left half
TLCN T2,-1 ;Was the neft half -1?
HRLI T2,(Point 7) ;Yes, make it a byte pointer
ISOUT1: ILDB CX,T2 ;Load a byte
IDPB CX,T1 ;Store it
JUMPN CX,ISOUT1 ;Jump if not done
MOVNI CX,1 ;Back up the byte pointer
ADJBP CX,T1 ; by one and
MOVEM CX,T1 ; store back the byte pointer
RET ;Return
SUBTTL Output Subroutines -- Output Information about Job
;Here to output information about a particular job.
;Call with T1/ output pointer and T4/ address of GETJI block.
;Returns +1 always
OGETJI: CALL OSPACE ;(T1/T1) Output a space next please
;Output username.
MOVE T2,.JIUNO(T4) ;Load the user number
CALL ODIRST ;(T1,T2/T1) Output directory name
;Output any controlling job information next.
OGETJ1: HRROI T2,[ASCIZ/ job /] ;Label the job number, first part of data
MOVE T3,.JIJNO(T4) ;Load the job number
CALL OLDEC ;(T1,T2,T3/T1) Append in the job number
SKIPGE .JICPJ(T4) ;Is there a controlling job ?
IFSKP. ;Yes
SKIPL .JIBAT(T4) ;Is the controlling job BATCON?
IFSKP. ;Yes it is batch
HRROI T2,[ASCIZ/ batch/] ;Label it as such
CALL ISOUT ;(T1,T2/T1) Append that to the string
ELSE. ;Job is controllied and not batch
HRROI T2,[ASCIZ/ ctrl /] ;Label next field
MOVE T3,.JICPJ(T4) ;Load the controlling job again
CALL OLDEC ;(T1,T2,T3/T1) Output label and job in decimal
ENDIF. ;End of job not batch code
ENDIF. ;End of controlling job check
;Output terminal number and origin.
SKIPGE T3,.JITNO(T4) ;Have a terminal number?
IFSKP. ;Yes
HRROI T2,[ASCIZ/ TTY/] ;Label the number
CALL OLOCT ;(T1,T2,T3/T1) Append the label and octal line
SKIPN NTBLK(T4) ;Have network terminal information?
IFSKP. ;Yes, output that
CALL OSPACE ;(T1/T1) First a space
HRROI T2,NTBLK(T4) ;Point to block with name in it
CALL ISOUT ;(T1,T2/T1) Send that along next
ENDIF. ;End of network org available code
ELSE. ;We don't have a terminal number
HRROI T2,[ASCIZ/ Det/] ;Its detached
CALL ISOUT ;(T1,T2/T1) Append detached string
ENDIF. ;End of terminal number output
;Output program name.
CALL OSPACE ;(T1/T1) Output a space
SKIPN T2,.JIPNM(T4) ;Get program name
MOVE T2,.JISNM(T4) ;If none, use subsystem name
CALLRET OSIXBI ;(T1,T2/T1) Output sixbit word
SUBTTL Output Subroutines -- Output Username/Device/Filename
;Routine to do a DIRST.
;Call with T1/ output designator, T2/ user or directory number (5B2+n)
;Returns +1 always, T1/ updated pointer
; T2/ user or directory number if legal,
; 0,,error if unknown or 0,,0 if not logged in
ODIRST: TRNE T2,-1 ;Not logged in?
IFSKP. ;If not logged in
HRROI T2,[ASCIZ/not-logged-in/] ;Indicate not logged in today
CALL ISOUT ;(T1,T2/T1) Send all of that to string and ret
SETZ T2, ;Indicate not logged in
RET ;Return with T1/ updated pointer and T2/ 0
ENDIF. ;End of not logged in case
MOVE T3,T1 ;Copy pointer in case error
DIRST% ;DIRectory number to STring
ERSKP. ;Skip if error
RET ;Return to caller
EXCH T1,T3 ;Swap pointer with error code
HRROI T2,[ASCIZ/unknown/] ;Say something if failure
CALL ISOUT ;(T1,T2/T1) Return a string
MOVE T2,T3 ;Return error code in T2
RET ;Return pointer in T1
;Routine to do a DEVST.
;Call with T1/ output designator, T2/ directory number
;Returns +1 always
ODEVST: MOVE T3,T1 ;Copy designator to T3 in case of error
DEVST% ;Convert to string
ERSKP. ;Skip if error
RET ;Return if success
MOVE T1,T3 ;Reload the pointer
HRROI T2,[ASCIZ/unknown/] ;Load unknown tag
CALLRET ISOUT ;(T1,T2/T1) Send that and return
;Routine to do a JFNS.
;Call with T1/ output designator, T2/ JFN
;Returns +1 always
OJFNS: SETZ T3, ;Default format today
JFNS% ;JFN to String
JSERRO (<JFNS failure>) ;Owie
RET ;Return +1
SUBTTL Output Subroutines -- Output Capability Mask
;Here to output text for bits in capability mask
;Call with
; T1/ output pointer
; T4/ capability bits
;Returns +1 always, T1/ updated pointer, T2 and T3 smashed
OCAPAB: MOVSI T3,-CAPNUM ;Load AOBJN pointer to capabilities
DO. ;Loop for these capabilities
HLRO T2,CAPTBL(T3) ;Load ASCIZ string for this capability
TDNE T4,CAPTBL(T3) ;Is this one lit?
CALL ISOUT ;(T1,T2/T1) Yes, dump its string
AOBJN T3,TOP. ;Loop for all of them
OD. ;End of loop
RET ;Return to caller
;Table of interesting (right halfword) capabilities.
CAPTBL: TENTRY (< whl>,SC%WHL)
TENTRY (< opr>,SC%OPR)
TENTRY (< cnf>,SC%CNF)
TENTRY (< mnt>,SC%MNT)
TENTRY (< enq>,SC%ENQ)
TENTRY (< ipc>,SC%IPC)
TENTRY (< nwz>,SC%NWZ)
TENTRY (< nas>,SC%NAS)
TENTRY (< dna>,SC%DNA)
TENTRY (< ana>,SC%ANA)
TENTRY (< sem>,SC%SEM)
CAPNUM==.-CAPTBL ;Compute number in table
SUBTTL Output Subroutines -- Small Output Routines
;Here to output CRLF (PCRLF) or text buffer (PTEXT).
;Returns +1 always.
PTEXT: SKIPA T1,[XWD -1,TEXTBU] ;Point to text area and skip always
PCRLF: HRROI T1,[BYTE(7).CHCRT,.CHLFD] ;Point to crlf
PSOUT% ;Send to terminal
RET ; and return
;Here to print error buffer as an error message.
;Returns +1 always.
PERRO: HRROI T1,ERRBUF ;Point to the finished message
ESOUT% ;Output that error string to terminal
RET ;Return +1 always
;Here to append a CRLF to the string pointed to by T1.
;Returns +1 always, T1/ updated pointer.
OCRLF: HRROI T2,[BYTE(7).CHCRT,.CHLFD] ;Point to crlf
CALLRET ISOUT ;(T1,T2/T1) Append that to the string and ret
;Here to output a space or comma, insures a null after character of course.
;Call with T1/ output pointer
;Returns +1 always, T1/ updated pointer.
OCOMMA: SKIPA T2,[XWD -1,[ASCIZ/,/]] ;Load pointer to a comma and skip
OSPACE: HRROI T2,[ASCIZ/ /] ;Load pointer to a space
CALLRET ISOUT ;Send that along and return
;Small routine to check on the byte pointer in T1.
;Call with T1/ suspected pointer
;Returns +1 always T1/ real byte pointer
PCHECK: TLC T1,-1 ;Complement left half
TLCN T1,-1 ;Was the neft half -1?
HRLI T1,(Point 7) ;Yes, make it a byte pointer
RET ;Return +1 always
SUBTTL Output Subroutines -- Output Sixbit Word
;Here to output a SIXBIT word.
;Call with
; T1/ output pointer
; T2/ SIXBIT word
;Returns +1 always, T1/ updated, T2 smashed
OSIXBI: SAVEAC <T3,T4> ;Save some ACs for scratch
CALL PCHECK ;(T1/T1) Insure real byte pointer in T1
MOVE T4,[POINT 6,T2] ;Load byte pointer to string
OSIXB3: ILDB T3,T4 ;Load character
JUMPE T3,OSIXB6 ;Done if null (space) seen
ADDI T3,"A"-'A' ;Convert to ASCII
IDPB T3,T1 ;Store character
JRST OSIXB3 ;Loop for all characters
OSIXB6: MOVEM T1,T4 ;Get a copy of the current byte pointer
IDPB T3,T4 ;Store a null past the last real character
RET ; and then return
SUBTTL Output Subroutines -- Output Numbers
;Here to prepend a text string and then output a number in decimal radix.
; T1/ destination pointer
; T2/ pointer to ASCIZ text
; T3/ number to be output
;Returns +1 always, T1/ updated pointer
OLDEC: CALL ISOUT ;(T1,T2/T1) Output string (preserves T3!)
MOVE T2,T3 ;Load number to print into T2
CAME T2,[INFQUO] ;Is it +inf quota?
CALLRET ODEC ;Nope, print the number
HRROI T2,[ASCIZ/inf/] ;Load infinity string
CALLRET ISOUT ;(T1,T2/T1) Output that and return
;Here to prepend a text string and then output a number in octal radix.
; T1/ destination pointer
; T2/ pointer to ASCIZ text
; T3/ number to be output
;Returns +1 always, T1/ updated pointer
OLOCT: CALL ISOUT ;(T1,T2/T1) Send label string first
MOVE T2,T3 ;Load number
; CALLRET OOCT ;(T1,T2/T1) Send octal number and return
;Here to output number quickly (without using a JSYS to do so).
; T1/ destination pointer
; T2/ number to be output
;Returns +1 always, T1/ updated pointer, T2/ 0, T3/ smashed
OOCT: SKIPA CX,[4+4] ;Radix 8
ODEC: MOVEI CX,5+5 ;Radix 10
CALL PCHECK ;(T1/T1) Insure real byte pointer in T1
CALL ONUMB ;(T1,T2,CX/T1,T2) Call local routine for output
MOVE T3,T1 ;Copy output pointer
IDPB T2,T3 ;Store that null after the useful text
RET ; and quickly return to the caller
ONUMB: IDIVI T2,(CX) ;Extract digit from the number in proper radix
ADDI T3,"0" ;Convert that binary digit to ASCII
PUSH P,T3 ;Save this on the stack
SKIPE T2 ;Skip if we are all done
CALL ONUMB ;(T1,T2/T1) Loop for all numbers
POP P,T3 ;Restore a digit from the stack
IDPB T3,T1 ;Store that in the output pointer
RET ;Return to caller or to get another digit
;Here to output a label and number in octal halfword format such as a PPN.
;Call with
; T1/ destination pointer
; T2/ pointer to ASCIZ text
; T3/ number to be output
;Returns +1 always, T1/ updated pointer
OLPPN: CALL ISOUT ;(T1,T2/T1) Output string (preserves T3!)
MOVE T2,T3 ;Load number to print into T2
; CALLRET OPPN ;(T1,T2/T1) Output number in halfword format
;Here to output a number in octal halfword format such as a PPN.
;Call with
; T1/ destination pointer
; T2/ number to be output
;Returns +1 always, T1/ updated pointer.
OPPN: PUSH P,T2 ;Save the number
HLRZ T2,T2 ;Load the project number into the right half
CALL OOCT ;(T1,T2/T1) Send that project number out
MOVEI T2,"," ;Load a comma for the halfword seperator
IDPB T2,T1 ;Store that comma next please
POP P,T2 ;Restore the project-programmer number
ANDI T2,-1 ;Clear the left half leaving programmer number
CALLRET OOCT ;(T1,T2/T1) Output programmer and return
;Here to output number and name of it with "s" as appropriate.
;Call with
; T1/ destination
; T2/ number
; T3/ pointer to ASCIZ text
;Returns +1 always, T1/ updated pointer.
OPLURA: SAVEAC <Q1,Q2> ;Save a couple of ACs first
DMOVEM T2,Q1 ;Save the number and pointer to text
CALL ODEC ;(T1/T1,T2) Output number
MOVE T2,Q2 ;Load pointer to the text
CALL ISOUT ;(T1,T2/T1) Output that string next
SOSN Q1 ;Was the number just one?
RET ;Yep, done
HRROI T2,[ASCIZ/s/] ;Load your S up
CALLRET ISOUT ;(T1,T2/T1) Output and insure a null on end
SUBTTL Output Subroutines -- Output Floating Point Numbers
;Here to output floating point number
; T1/ destination pointer
; T2/ floating point number to be output
;Returns +1 always, T1/ updated
OFLOUT: MOVX T3,FL%ONE!FL%PNT!FLD(4,FL%RND)!FLD(3,FL%SND) ;Format bits
FLOUT% ;Output that
JSERRO (<FLOUT failure>) ;Snowballs exist in hell today
RET ;Return to sender
SUBTTL Output Subroutines -- Output Millisecond Times
;Routine to output time in the form "h:mm:ss.tt" or "n days hh:mm:ss".
;Call at OTIMEH with T1/ destination byte pointer, T2/ time in HPTIM units
;Call at OTIME with T1/ destination byte pointer, T2/ time in milliseconds
;Returns +1 always, T1/ updated pointer
OTIME: IDIV T2,[^D<24*60*60*1000>] ;Milliseconds, get days in T2, time in T3
IMULI T3,^D100 ;Convert milliseconds to HPTIM units
JRST OTIME1 ; and enter the high precision units output
OTIMEH: IDIV T2,[^D<24*60*60*1000*100>] ;HPTIM unit, get days in T2, time in T3
OTIME1: SAVEAC <P1,P2,P3,P4,P5> ;Save the Ps
;Now T1/ output pointer, T2/ days, T3/ time in HPTIM units.
MOVEM T3,P1 ;Save the time in HPTIM units for later
HRROI T3,[ASCIZ/ day/] ;Label the number as "day" or "days"
SKIPN P5,T2 ;Skip if days, load P5 with number of days
JRST OTIME2 ;No days to output today
CALL OPLURA ;(T1,T2,T3/T1) Output that
CALL OSPACE ;(T1/T1) followed by a space
;Now P1/ time, T1/ output pointer, breakup the time into its components.
OTIME2: EXCH T1,P1 ;Get time in T1, save output pointer
ADDI T1,^D500 ;Round up the hundredths of seconds
IDIVI T1,^D1000 ;Get units into hundredths of seconds
IDIV T1,[^D<100*60*60>] ;Get hours from hundreths of seconds
IDIVI T2,^D<100*60> ;Get minutes from fractional hours
IDIVI T3,^D100 ;Get seconds from fractional minutes
DMOVEM T3,P3 ;Save seconds in P3 and hundreths of secs in P4
MOVEM T2,P2 ;Save minutes in P2
EXCH T1,P1 ;Save hours in P1, get string pointer back
;Now P1/ hours, P2/ minutes, P3/ seconds, P4/ hundreths, P5/ days.
;Output hours and colon if days output or if hours are not zero.
MOVX T3,^D10 ;Load radix 10 for the hours please
MOVEI T4,":" ;Load a colon for a suffix
SKIPN T2,P1 ;Always output nonzero hours
SKIPE P5 ;If any days always output hours even if zero
CALL OTIME3 ;(T1,T2,T3,T4/T1,T3) Output hours and a colon
;Output minutes and a colon if hours output or if minutes is nonzero.
SKIPN T2,P2 ;Always output minutes if nonzero
TXNE T3,NO%LFL ;Mins zero, output mins if hours or days output
CALL OTIME3 ;(T1,T2,T3,T4/T1,T3) Output minutes and colon
;Output seconds always, suffix is a dot only if no hours output.
MOVE T2,P3 ;Load seconds as they are always output
SKIPE P5 ;If no hours were output
TDZA T4,T4 ; then no suffix will be printed
MOVEI T4,"." ;Suffix after seconds should be a hot dot
CALL OTIME3 ;(T1,T2,T3,T4/T1,T3) Output seconds and a dot
;Output hundreths with no suffix only if no days have been output.
JUMPN P5,R ;Return now if hours were output
SETZ T4, ;No seperator now
MOVE T2,P4 ;Load hundredths of seconds and fall through
;Local routine called from above to output parts of the time and a suffix.
OTIME3: NOUT% ;Output number
JSERRO (<NOUT failed>) ;Owie
SKIPE T4 ;Any seperator character?
IDPB T4,T1 ;Yes, store it now
MOVX T3,NO%LFL!NO%ZRO!FLD(2,NO%COL)!FLD(^D10,NO%RDX) ;2 for the rest
RET ;Return to above
SUBTTL Output Subroutines -- Output Standard Date/Time
;Outputs time of day from internal format, call with T1/ output byte pointer.
;Call at OODTIN with T1/ pointer, current time, suppressing columnation.
;Call at OODTIM with T1/ pointer, T2/ time, suppressing columnation.
;Call at OODTI1 with T1/ pointer, T2/ time, and T3/ time format bits.
;Returns +1 always with T1/ updated pointer.
OODTIN: SETO T2, ;The time is now
OODTIM: MOVX T3,OT%SCL ;Suppress columnation 9 days of the month
OODTI1: ODTIM% ;Zap it to terminal
JSERRO (<ODTIM failed>) ;Owie
RET ;Return
;Routine to output time of day as expressed in seconds since midnight.
;Call with T1/ pointer, T2/ time as seconds since midnight.
;Returns +1 always T1/ updated.
OTOD: SAVEAC <P1,P2> ;Save some space
CALL PCHECK ;(T1/T1) Insure real byte pointer in T1
IDIVI T2,^D60*^D60 ;Get hours in T2
IDIVI T3,^D60 ;Get minutes in T3 and seconds in T4
DMOVEM T3,P1 ;Put minutes in P1 and seconds in P2
CALL OTOD2 ;(T1,T2/T1) Use local routine for just numbers
MOVE T2,P1 ;Load the number of minutes
CALL OTOD1 ;(T1,T2/T1) Use routine sending colon and time
SKIPE T2,P2 ;Load the seconds, don't output if its zero
CALL OTOD1 ;(T1,T2/T1) Use routine sending colon and time
MOVEI T2,0 ;Load a null
IDPB T2,T1 ;Store it last
MOVNI T2,1 ;Back up the byte pointer
ADJBP T2,T1 ; by one and
MOVEM T2,T1 ; store back the byte pointer
RET ;Return
;Local routine to send time (OTOD2) or colon and time (OTOD1).
;Accepts T1/ output pointer, T2/ number.
;Returns +1 always, T1/ updated
OTOD1: MOVEI T3,":" ;Load suffix character next
IDPB T3,T1 ;Store seperator
OTOD2: IDIVI T2,^D10 ;Get the two digits
ADDI T2,"0" ;Convert to ASCII
IDPB T2,T1 ;Send that first digit out
ADDI T3,"0" ;Pump up another ASCII digit
IDPB T3,T1 ;Send that too
RET ;Return
SUBTTL Output Subroutines -- Output JSYS Error Message
;Subroutine to send along the last JSYS error
;Call with T1/ output designator
;Returns +1 always with T1/ updated
OERSTR: MOVX T2,<.FHSLF,,-1> ;This fork's last error
SETZ T3, ;No limit
ERSTR% ;Get string to error
CALLRET OERSTE ;(T1/T1) Undefined error number
JFCL ;String size out of bounds or bad designator?
RET ;Return to caller with T1 updated
OERSTE: HRROI T2,[ASCIZ/Undefined error /] ;Output label for string
CALL ISOUT ;(T1,T2/T1) Append that string too
CALL GETERR ;(/T2) Get fork's last error
MOVEI T3,4+4 ;Radix 8
NOUT% ;Don't use OOCT routine to output that number
ERNOP. ;Ignore error within error within error
RET ;Return with T1 updated
SUBTTL Error Handler -- Error Messages
;Subroutine to handle JSYS errors
;Call with CX/address of ASCIZ string
;Returns +1 always, message, error, and trailing CRLF printed
JSERR1: TXOE F,FL%ERR ;Error within an error?
RET ;Return before additional damage can occur
HRROM CX,ERRADR ;Save address of string to print
SAVEAC <T1,T2,T3,T4> ;Save some ACs today please
HRROI T1,ERRBUF ;Point to text buffer
TXNN F,FL%ACJ ;Acting like the ACJ?
IFSKP. ;Yes
HRROI T2,[ASCIZ/Access Control Facility error detected at /] ;Label
CALL ISOUT ;(T1,T2/T1) Send that
CALL OODTIN ;(T1/T1) Output date time of now
HRROI T2,[ASCIZ/
/] ;Label the next little bit
CALL ISOUT ;(T1,T2/T1) Send that and return
ENDIF. ;End of acting like the ACJ code
MOVE T2,ERRADR ;Load pointer to error text string
CALL ISOUT ;(T1,T2/T1) Start off with that text
CALL OERSTR ;(T1/T1) Append in the last error text please
CALL OCRLF ;(T1/T1) Append a CRLF to all of that
CALL PERRO ;(/) Send all of that to terminal as error mess
HRROI T1,ERRBUF ;Point to text buffer again
TXNE F,FL%ACJ ;[116] Acting like the ACJ?
CALL SENLOG ;[116] (T1/) Send to log file if possible
TXZ F,FL%ERR ;Clear error bit
RET ; and return
;Small routine to return this fork's last error in T2
;Returns +1 always, T2/ error number, T1 preserved
GETERR: PUSH P,T1 ;Save T1
MOVEI T1,.FHSLF ;Load this fork
GETER% ;Get last error in T2
TLZ T2,-1 ;Zap junk in LH
POP P,T1 ;Restore T1
RET ;Return
SUBTTL Error Handler -- Panic and Control-C Interrupt
;Here when a panic interrupt hits us. For now we just crash.
PANIC: BUG(HLT,PAN,<Panic interrupt>) ;Just say crash
;Here when a control-C seen, terminate the world by crashing.
CNTRLC: BUG(HLT,CCC,<Control-C Crash>) ;Boom
SUBTTL Error Handler -- Crash Handler
;Here when we want to crash, save all of the ACs, save ourself, then crash.
;Called by JSR BUGHLT, following is ASCIZ/crash code/ and ASCIZ/crash reason/.
BUGHLT: EXP 0 ;Called by JSR BUGHLT
;Save all the ACs, get a new stack.
MOVEM 17,BUGACS+17 ;Save all of the ACs here please
MOVEI 17,BUGACS ;Get source,,destination (0,,BUGACS)
BLT 17,BUGACS+16 ;Move all of the rest of them to memory please
MOVE P,[IOWD BUGLEN,BUGPDL] ;Load a new stack pointer
;Save last TOPS-20 error, send message to terminal about this problem.
CALL GETERR ;(/T2) Get last JSYS error code
HRRZM T2,LASERR ;Save it here
CALL FATALE ;(/) Let me tall ya sumthin ma ma ma ma mannn
;Save our image in a good place today.
HRROI T2,[ASCIZ/DMP:ACJ-/] ;Load the initial part of filename
CALL BUGSAV ;(T2/) Save ourselves
IFNSK. ;If it failed
HRROI T2,[ASCIZ/SYSTEM:ACJ-/] ;Try SYSTEM: this time
CALL BUGSAV ;(T2/) Try again
OJSERR (<Can't save crash>) ;This will be interesting debugging
ENDIF. ;We did all we could
;Kill inferiors, disable all GETOK functions, close log file.
MOVX T1,.FHINF ;Load fork handle for all inferiors
KFORK% ;Kill all of them
ERNOP. ;Ignore errors at this point
TXO F,FL%ERR ;[110] Light error in progress bit please
CALL DISFNC ;(/) Disable all functions before crashing
CALL CLOLOG ;[110] (/) Sweep and close the log file
CALL SECCLA ;[111] (/) Close all cached access.control
;Restore ACs. Halt if not running as job 0. Restart if running as job 0.
MOVSI 17,BUGACS ;Get source,,destination (BUGACS,,0)
BLT 17,16 ;Move all but one of them back from memory
MOVE 17,BUGACS+17 ;Reload the last AC
RESET% ;Dump all resources we might have
SKIPN OURJOB ;Are we running under job 0?
JRST ASTART ;For security reasons, restart ourselves
HALTF% ;Halt
JRST .-1 ; and don't continue either
;Print a message on the console about this problem, only called from BUGHLT.
;Returns +1 always.
FATALE: HRROI T1,ERRBUF ;Point to error buffer today
HRROI T2,[ASCIZ/
Access control program fatal error "/]
CALL ISOUT ;(T1,T2/T1) Send that along first
MOVE T2,BUGHLT ;Point to ASCIZ strings
HRLI T2,(Point 7) ;Make a byte pointer to it
CALL ISOUT ;(T1,T2/T1) Copy the reason code
MOVE Q1,T2 ;Save this for a little bit
HRROI T2,[ASCIZ/" (/] ;Load the next little bit
CALL ISOUT ;(T1,T2/T1) Copy the string
MOVEI T2,1(Q1) ;Get next address after null
HRLI T2,(Point 7) ;Point to rest of string
CALL ISOUT ;(T1,T2/T1) Send that along
HRROI T2,[ASCIZ/)
Last TOPS-20 error: /] ;Label next string
CALL ISOUT ;(T1,T2/T1) Send that along
CALL OERSTR ;(T1/T1) Send last JSYS error next
HRROI T2,[ASCIZ/
Access control terminated at /] ;Start the next line
CALL ISOUT ;(T1,T2/T1) Send that along also
CALL OODTIN ;(T1/T1) Output the time of now
CALL OCRLF ;(T1/T1) Append a crlf
HRROI T1,ERRBUF ;Point to error buffer again
PSOUT% ;Send to the console
RET ;Return to caller
;Here to get a JFN on a crash filename and save ourselves.
;Call with T2/ pointer to initial part of crash filename
;Returns +1 if error.
;Returns +2 if crash saved.
BUGSAV: HRROI T1,BUGFIL ;Point to place to store filename
CALL ISOUT ;(T1,T2/T1) Copy first part of string
HRRZ T2,EV+2 ;Load the edit number of the ACJ
CALL OOCT ;(T1,T2/T1) Send the OCTAL edit number next
HRROI T2,[ASCIZ/-/] ;Delimit the string
CALL ISOUT ;(T1,T2/T1) Send the delimiter
MOVE T2,BUGHLT ;Load the stop address again
HRLI T2,(Point 7) ;Make a byte pointer again
CALL ISOUT ;(T1,T2/T1) Copy the crash code next
HRROI T2,[ASCIZ/-CRASH.EXE/] ;Finish up the string
CALL ISOUT ;(T1,T2/T1) Send the file type last
MOVX T1,GJ%SHT!GJ%FOU ;Load short form and for output bits
HRROI T2,BUGFIL ;Point to file we just made up
GTJFN% ;Try to get a JFN on dump file
ERJMP R ;Return +1 for error
MOVE T4,T1 ;We got a JFN, copy it for a sec
HRROI T1,ERRBUF ;Point back to error buffer again
HRROI T2,[ASCIZ/ Access control crash saved as /] ;Load label
CALL ISOUT ;(T1,T2/T1) Start the text right
MOVE T2,T4 ;Load the JFN
CALL ISOUT ;(T1,T2/T1) Save initial text
CALL OJFNS ;(T1,T2/T1) Send the filename next
CALL OCRLF ;(T1/T1) Make it neat
MOVE T1,T4 ;Reload the JFN again
HRLI T1,.FHSLF ;Make this fork,,jfn
MOVX T2,SS%CPY!SS%RD!SS%EXE!FLD(-770,SS%NNP)!FLD(0,SS%FPN) ;Page 0-767
SSAVE% ;Save our image, closes the JFN today
ERJMP R ;Return +1 if errors today
HRROI T1,ERRBUF ;Point to error buffer
PSOUT% ;Send to console
RETSKP ;Return +2 for success
SUBTTL End of ACJDEC
;Dump literals here
LOWCD ;Get to low seg
DECLIT: XLIST ;Remove literals from listing
LIT ;Dump them here
LIST ;Resume listing
;Get globular symbols
GGLOBS
END <EVLEN,,EV>