Trailing-Edge
-
PDP-10 Archives
-
BB-KL11L-BM_1990
-
t20src/acjusr.mac
There are 9 other files named acjusr.mac in the archive. Click here to see a list.
; Edit= 133 to ACJUSR.MAC on 14-Sep-89 by GSCOTT
;Implement support for GETOK functions .GODSK, .GOSJP, and .GOSPR.
;RIP:<7.UTILITIES>ACJUSR.MAC.1004 14-Jul-89 11:56:40, Edit by GSCOTT
;(131) Allow attach of not-logged-in jobs for FTPSRT.
;RIP:<7.UTILITIES>ACJUSR.MAC.1003 25-May-89 15:39:09, Edit by GSCOTT
;(130) Edit 127 forgot about the case that the user is not enabled.
;RIP:<7.UTILITIES>ACJUSR.MAC.1002 23-May-89 20:38:23, Edit by GSCOTT
;(127) Fix unkillable directories, RCDIR in GOCRDT kept directory cached.
;RIP:<7.UTILITIES>ACJUSR.MAC.1001 8-Apr-89 14:49:19, Edit by GSCOTT
;(126) Add GETOK functions .GOGTD and .GOSTD.
;RIP:<7.UTILITIES>ACJUSR.MAC.1000 20-Mar-89 10:48:06, Edit by GSCOTT
;(106) Correct extra space output in GOSMNL.
;RIP:<7.UTILITIES>ACJUSR.MAC.998 9-Feb-89 10:12:28, Edit by GSCOTT
;(105) CRDIR policy had a bug allowing building new non-files-only directories.
;RIP:<7.UTILITIES>ACJUSR.MAC.996 4-Feb-89 10:40:12, Edit by GSCOTT
;(104) Do not log on special cases of FB%SEC bit changes.
;RIP:<7.UTILITIES>ACJUSR.MAC.995 2-Feb-89 21:06:05, Edit by GSCOTT
;(103) Always allow setting of new file nosecure.
;RIP:<7.UTILITIES>ACJUSR.MAC.993 2-Feb-89 10:26:48, Edit by GSCOTT
;(102) Change a couple of strings output to the log file.
;RIP:<7.UTILITIES>ACJUSR.MAC.991, 31-Jan-89 14:27:54, Edit by RASPUZZI
;(76) Test T4 for CD%MOD before making a decision about the mode bits in CRDIRT
;RIP:<7.UTILITIES>ACJUSR.MAC.987 26-Jan-89 11:20:12, Edit by GSCOTT
;(72) Add NOSECURE keyword to ACCESS.CONTROL
;RIP:<7.UTILITIES>ACJUSR.MAC.986 26-Jan-89 10:06:42, Edit by GSCOTT
;(71) Add DENY-CTY and LOGIN-CTY support.
;RIP:<7.UTILITIES>ACJUSR.MAC.985 25-Jan-89 09:48:55, Edit by GSCOTT
;(70) Minor bug and a bad comment in CRDIR policy code.
;RIP:<7.UTILITIES>ACJUSR.MAC.984 24-Jan-89 17:00:19, Edit by GSCOTT
;(67) Make job information blocks, clean up attach and login policy code.
;RIP:<7.UTILITIES>ACJUSR.MAC.978 19-Jan-89 13:29:47, Edit by GSCOTT
;(63) Add support for user functions
;RIP<7.UTILITIES>ACJUSR.MAC.973 12-Jan-89 22:43:41, Edit by GSCOTT
;(61) Log "function n" if SMON function not in table of functions.
;RIP:<7.UTILITIES>ACJUSR.MAC.967 12-Jan-89 09:41:46, Edit by GSCOTT
;(57) Add "new" short bug typeout SMON function.
;RIP:<7.UTILITIES>ACJUSR.MAC.964 10-Jan-89 10:50:15, Edit by GSCOTT
;(56) Test was backwards in GOCRDL to say "set" or "clear".
;RIP:<7.UTILITIES>ACJUSR.MAC.960 5-Jan-89 12:13:06, Edit by GSCOTT
;(55) Provide check for CRDIRs on FOREIGN structures.
;RIP:<7.UTILITIES>ACJUSR.MAC.952 4-Jan-89 14:58:38, Edit by GSCOTT
;(54) Don't allow user/directory groups or passwords on any <ROOT-DIRECTORY>.
;RIP:<7.UTILITIES>ACJUSR.MAC.932 4-Jan-89 11:09:34, Edit by GSCOTT
;(53) Asciify the GETAB tables for logging.
;RIP:<7.UTILITIES>ACJUSR.MAC.929 3-Jan-89 15:45:11, Edit by GSCOTT
;(52) Asciify the INFO% functions logged.
;RIP:<7.UTILITIES>ACJUSR.MAC.928 3-Jan-89 15:21:02, Edit by GSCOTT
;(51) Update copyright date.
;RIP:<7.UTILITIES>ACJUSR.MAC.926 3-Jan-89 13:29:37, Edit by GSCOTT
;(47) Log more information for CRDIRs.
;RIP:<7.UTILITIES>ACJUSR.MAC.917 30-Dec-88 11:32:23, Edit by GSCOTT
;(46) Prevent logging into ROOT-DIRECTORY or making it non-files-only.
;RIP:<7.UTILITIES>ACJUSR.MAC.916 29-Dec-88 10:38:55, Edit by GSCOTT
;(45) Remove edit 43, instead allow any secure operation if no ACCESS.CONTROL.
;RIP:<7.UTILITIES>ACJUSR.MAC.915 28-Dec-88 14:36:08, Edit by GSCOTT
;(44) Add support for OF%NXS bit on .GOOPN function.
;RIP:<7.UTILITIES>ACJUSR.MAC.914 28-Dec-88 13:03:11, Edit by GSCOTT
;(43) Allow setting and clearing of FB%SEC if enabled and file is new.
;RIP:<7.UTILITIES>ACJUSR.MAC.911 20-Dec-88 11:41:45, Edit by GSCOTT
;(42) Enhance logging of TMON/SMON functions.
;RIP:<7.UTILITIES>ACJUSR.MAC.905 14-Dec-88 18:49:44, Edit by GSCOTT
;(37) Add LOGIN-xxxx keywords to user profile.
;RIP:<7.UTILITIES>ACJUSR.MAC.897 7-Dec-88 14:49:27, Edit by GSCOTT
;(31) DECnet policy routine can now be activated due to NO POLICY setting.
;RIP:<7.UTILITIES>ACJUSR.MAC.890 7-Dec-88 01:33:21, Edit by GSCOTT
;(30) Implement DENY-xxx keywords for functions.
;RIP:<7.UTILITIES>ACJUSR.MAC.881 6-Dec-88 21:35:56, Edit by GSCOTT
;(27) Implement ALL as keyword in ACCESS.CONTROL, clean up here and there.
;RIP:<7.UTILITIES>ACJUSR.MAC.875 6-Dec-88 20:12:16, Edit by GSCOTT
;(26) Implement SET PRIME-TIME-BEGIN and SET PRIME-TIME-END
;RIP:<7.UTILITIES>ACJUSR.MAC.862 30-Nov-88 10:33:11, Edit by GSCOTT
;(20) Allow policy for GOACC to allow connections to "owned" subdirectories.
;RIP:<7.UTILITIES>ACJUSR.MAC.858 30-Nov-88 10:08:07, Edit by GSCOTT
;(17) Add POLICY keyword.
;RIP:<7.UTILITIES>ACJUSR.MAC.850 29-Nov-88 17:34:19, Edit by GSCOTT
;(16) Allow hyphen at end of line in ACCESS.CONTROL, move code to ACJDEC.
;RIP:<7.UTILITIES>ACJUSR.MAC.812 29-Nov-88 09:53:18, Edit by GSCOTT
;(15) Implement ACCESS.CONTROL facility for secure files.
;RIP:<7.UTILITIES>ACJUSR.MAC.754 22-Nov-88 13:28:10, Edit by GSCOTT
;(12) Yet more info to log file.
;RIP:<7.UTILITIES>ACJUSR.MAC.741 21-Nov-88 22:12:33, Edit by GSCOTT
;(11) More information with TLINK logging.
;RIP:<7.UTILITIES>ACJUSR.MAC.723 21-Nov-88 15:36:55, Edit by GSCOTT
;(10) Allow WHEEL to login to batch under OPERATOR.
;RIP:<7.UTILITIES>ACJUSR.MAC.721 21-Nov-88 13:33:04, Edit by GSCOTT
;(5) Fix bug in GOLOGT where second GTDIR would fail.
;RIP:<7.UTILITIES>ACJUSR.MAC.718 20-Nov-88 12:30:25, Edit by GSCOTT
;(2) Fix problem with DISFNC, adding FU%GOK.
;RIP:<GSCOTT>ACJUSR.MAC.716 20-Nov-88 12:06:05, Edit by GSCOTT
;(1) Creation.
; COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 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 ACJUSR - Access Control Facility Policy Administrator and Logger
SUBTTL Gregory A. Scott
Subttl Table of Contents
; Table of Contents for ACJUSR
;
; Section Page
;
;
; 1. General Comments . . . . . . . . . . . . . . . . . . . 5
; 2. Definitions
; 2.1 Environment . . . . . . . . . . . . . . . . . 6
; 2.2 Storage . . . . . . . . . . . . . . . . . . . 7
; 2.3 Tables
; 2.3.1 Function Enable/Disable Tables . . . . . 8
; 2.3.2 Function Profile Tables . . . . . . . . 10
; 2.3.3 User Profile Tables . . . . . . . . . . 12
; 3. Logging . . . . . . . . . . . . . . . . . . . . . . . 14
; 3.1 GOASD (ASND%) . . . . . . . . . . . . . . . . 15
; 3.2 GOCAP (EPCAP%) . . . . . . . . . . . . . . . . 16
; 3.3 GOCJB (CRJOB%) . . . . . . . . . . . . . . . . 17
; 3.4 GOLOG (LOGIN%) . . . . . . . . . . . . . . . . 18
; 3.5 GOCFK (CFORK%) . . . . . . . . . . . . . . . . 19
; 3.6 GOTBR (MTOPR% to set Terminal Baud Rate) . . . 20
; 3.7 GOLGO (LGOUT%) . . . . . . . . . . . . . . . . 21
; 3.8 GOENQ (ENQC% ENQ Quota Set) . . . . . . . . . 22
; 3.9 GOCRD (CRDIR%) . . . . . . . . . . . . . . . . 23
; 3.10 GOSMT (MSTR% to Increment Mount Count) . . . . 26
; 3.11 GOMDD (MDDT%) . . . . . . . . . . . . . . . . 27
; 3.12 GOCLS (SKED% to set scheduler class) . . . . . 28
; 3.13 GOCL0 (Class Set at Login) . . . . . . . . . . 29
; 3.14 GOMTA (MTA Access) . . . . . . . . . . . . . . 30
; 3.15 GOACC (ACCES%) . . . . . . . . . . . . . . . . 32
; 3.16 GOOAD (OPENF% Assign Device) . . . . . . . . . 33
; 3.17 GODNA (DECnet) . . . . . . . . . . . . . . . . 34
; 3.18 GOANA (Arpanet) . . . . . . . . . . . . . . . 35
; 3.19 GOATJ (ATACH%) . . . . . . . . . . . . . . . . 37
; 3.20 GOINF (INFO%) . . . . . . . . . . . . . . . . 38
; 3.21 GOLAT (LATOP%) . . . . . . . . . . . . . . . . 40
; 3.22 GOCTM (CTERM Connection) . . . . . . . . . . . 42
; 3.23 GOTTM (TTMSG%) . . . . . . . . . . . . . . . . 43
; 3.24 GOSMN (SMON%) . . . . . . . . . . . . . . . . 44
; 3.25 GOHSY (HSYS%) . . . . . . . . . . . . . . . . 47
; 3.26 GOSGT (SYSGT%) . . . . . . . . . . . . . . . . 48
; 3.27 GOGTB (GETAB%) . . . . . . . . . . . . . . . . 49
; 3.28 GOOPN (OPENF% with FB%SEC) . . . . . . . . . . 52
; 3.29 GORNF (RNAMF% with FB%SEC) . . . . . . . . . . 53
; 3.30 GODLF (DELF%/DELNF% with FB%SEC) . . . . . . . 54
; 3.31 GOTLK (TLINK%) . . . . . . . . . . . . . . . . 55
; 3.32 GOCRL (CRLNM%) . . . . . . . . . . . . . . . . 57
; 3.33 GODTC (DTACH%) . . . . . . . . . . . . . . . . 58
; 3.34 GOCFD (CHFDB% of FB%SEC) . . . . . . . . . . . 59
; 3.35 GOGTD (Get directory information) . . . . . . 60
; 3.36 GOSTD (Set time) . . . . . . . . . . . . . . . 61
; 3.37 GODSK (DSKOP% JSYS) . . . . . . . . . . . . . 62
; 3.38 GOSJP (SJPRI% JSYS) . . . . . . . . . . . . . 65
Subttl Table of Contents (page 2)
; Table of Contents for ACJUSR
;
; Section Page
;
;
; 3.39 GOSPR (SJPRI% JSYS) . . . . . . . . . . . . . 66
; 3.40 GOUSR (User test function) . . . . . . . . . . 67
; 3.41 Logging only if needed . . . . . . . . . . . . 68
; 4. Policy . . . . . . . . . . . . . . . . . . . . . . . . 69
; 4.1 GOASD (ASND%) . . . . . . . . . . . . . . . . 70
; 4.2 GOCAP (EPCAP%) . . . . . . . . . . . . . . . . 71
; 4.3 GOCJB (CRJOB%) . . . . . . . . . . . . . . . . 72
; 4.4 GOLOG (LOGIN%) . . . . . . . . . . . . . . . . 73
; 4.5 GOCFK (CFORK%) . . . . . . . . . . . . . . . . 76
; 4.6 GOTBR (MTOPR% to set Terminal Baud Rate) . . . 77
; 4.7 GOLGO (LGOUT%) . . . . . . . . . . . . . . . . 78
; 4.8 GOENQ (ENQC% ENQ Quota Set) . . . . . . . . . 79
; 4.9 GOCRD (CRDIR%) . . . . . . . . . . . . . . . . 80
; 4.10 GOSMT (MSTR% to Increment Mount Count) . . . . 84
; 4.11 GOMDD (MDDT%) . . . . . . . . . . . . . . . . 85
; 4.12 GOCLS (SKED% to set scheduler class) . . . . . 86
; 4.13 GOCL0 (Class Set at Login) . . . . . . . . . . 87
; 4.14 GOMTA (MTA Access) . . . . . . . . . . . . . . 88
; 4.15 GOACC (ACCES%) . . . . . . . . . . . . . . . . 89
; 4.16 GOOAD (OPENF% Assign Device) . . . . . . . . . 90
; 4.17 GODNA (DECnet) . . . . . . . . . . . . . . . . 91
; 4.18 GOANA (Arpanet) . . . . . . . . . . . . . . . 92
; 4.19 GOATJ (ATACH%) . . . . . . . . . . . . . . . . 93
; 4.20 GOINF (INFO%) . . . . . . . . . . . . . . . . 96
; 4.21 GOLAT (LATOP%) . . . . . . . . . . . . . . . . 97
; 4.22 GOCTM (CTERM Connection) . . . . . . . . . . . 98
; 4.23 GOTTM (TTMSG%) . . . . . . . . . . . . . . . . 99
; 4.24 GOSMN (SMON%) . . . . . . . . . . . . . . . . 100
; 4.25 GOHSY (HSYS%) . . . . . . . . . . . . . . . . 101
; 4.26 GOSGT (SYSGT%) . . . . . . . . . . . . . . . . 102
; 4.27 GOGTB (GETAB%) . . . . . . . . . . . . . . . . 103
; 4.28 GOOPN (OPENF% with FB%SEC) . . . . . . . . . . 104
; 4.29 GORNF (RNAMF% with FB%SEC) . . . . . . . . . . 105
; 4.30 GODLF (DELF%/DELNF% with FB%SEC) . . . . . . . 106
; 4.31 GOTLK (TLINK%) . . . . . . . . . . . . . . . . 107
; 4.32 GOCRL (CRLNM%) . . . . . . . . . . . . . . . . 108
; 4.33 GODTC (DTACH%) . . . . . . . . . . . . . . . . 109
; 4.34 GOCFD (CHFDB% of FB%SEC) . . . . . . . . . . . 110
; 4.35 GOGTD (Get directory information) . . . . . . 113
; 4.36 GOSTD (Set time) . . . . . . . . . . . . . . . 114
; 4.37 GODSK (DSKOP% JSYS) . . . . . . . . . . . . . 115
; 4.38 GOSJP (SJPRI% JSYS) . . . . . . . . . . . . . 116
; 4.39 GOSPR (SPRIW% JSYS) . . . . . . . . . . . . . 117
; 4.40 GOUSR (User test function) . . . . . . . . . . 118
; 4.41 Deny by Terminal Line Type . . . . . . . . . . 119
Subttl Table of Contents (page 3)
; Table of Contents for ACJUSR
;
; Section Page
;
;
; 5. Subroutines
; 5.1 Find Line Type Entry . . . . . . . . . . . . . 120
; 5.2 Deny, Unusual, Failed setting . . . . . . . . 122
; 5.3 Check Capabilities . . . . . . . . . . . . . . 123
; 5.4 Check Time for Enable . . . . . . . . . . . . 124
; 5.5 CRDIR Snooping . . . . . . . . . . . . . . . . 125
; 5.5.1 Find Request Block . . . . . . . . . . . 126
; 5.5.2 Find User's ACs . . . . . . . . . . . . 127
; 5.5.3 Get Directory String . . . . . . . . . . 128
; 5.5.4 Get User Argument Block . . . . . . . . 129
; 5.5.5 Read Physical Memory . . . . . . . . . . 130
; 5.5.6 Snoop Monitor Symbols . . . . . . . . . 131
; 6. End of ACJUSR . . . . . . . . . . . . . . . . . . . . 132
SUBTTL General Comments
COMMENT ~
This module of the Access Control Facility implements two functions: Policy
administration (deciding to allow or deny the request) and logging (extraction
of all data furnished to us by the operating system) for each Access Control
(GETOK%) function.
This module is constructed so that local site changes can be kept seperate from
the more sensitive code that resides in the modules that actually allow or deny
the request (using GIVOK%). Functions can be added easily to this module by
making an entry in the function table and writing a GOxxxT test routine and a
GOxxxL logging routine.
This module was written in November 1988 by Gregory A. Scott, Digital Equipment
Corporation, Marlboro, Massachusetts. Ideas for the policy portions of this
module and the CRDIR snooping code is from the modified ACJ for TOPS-20
development cluster written by Mike Raspuzzi.
Future enhancements:
Setting or clearing privs on directories should be [Unusual].
Implement policy for MTA access: if label TOPS-20 and non-owner user
can connect to owner's PS dir without a password then consider this
user an owner of the tape and allow access to the tape (GOMTA).
If the TLINK function is operating, the periodic re-TLINKing of
jobs being spyed on could be inactivated and instead we would
reestablish the link after the TLINK (to break links with us)
is allowed.
If LOGOUT function enabled, then stop spying when job logs out.
~
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
.REQUI SYS:MACREL ;Load the usual support routines
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 -- Storage
;Storage used in policy decisions.
GTDIRB: BLOCK .CDDGP+1 ;User GTDIR% block (default size of 15 words)
GTDIRC: BLOCK .CDDGP+1 ;Controlling job GTDIR% block (default size)
GTDIRT: BLOCK .CDDGP+1 ;Target job GTDIR% block (default size)
MSTRB: BLOCK .MSGSI+1 ;MSTR% .MSGSS block
SKEDB: BLOCK .SAJCL+1 ;SKED% block for setting job class at login
DIRBLK: BLOCK ^D<40*5>/5 ;Block to make directory or filename string
;Storave used in CRDIR snooping routines.
MONSPT: BLOCK 1 ;Snooped address of SPT
ACB: BLOCK 1 ;Snooped offset of PAC in PSB, used to read ACs
PSBPG: BLOCK 1 ;Snooped address of monitor FKPGS table
GETOKQ: BLOCK 1 ;Snooped address of monitor's GETOK queue
SPTENT: BLOCK 1 ;Entry from SPT when looking for arg blocks
PSB: BLOCK 1 ;Will have FKPGS+FORK
CURBLK: BLOCK 1 ;Address of current block
UACS: BLOCK 20 ;User's ACs are here
NXTBLK: BLOCK 1 ;Address of next block
REQFRK==3 ;Fork number is at this offset in request
REQNUM==11 ;Request number is at this offset in request
REQBLK: BLOCK 14 ;Hidden part of GETOK% block
UARGBK: BLOCK .CDPPN+1 ;User's CRDIR% argument block
XPKBLK: BLOCK .XPUAD+1 ;XPEEK% block
SUBTTL Definitions -- Tables -- Function Enable/Disable Tables
;Tables used to create keywords, function codes, and actions for each possible
;GETOK function. This macro will be expanded wherever a table is needed. Any
;new GETOK function codes should be added to this table. Note that keywords
;must remain in alphabetical order.
DEFINE GFUNCT,<
XLIST
FUN(ACCESS,<Access>,GOACC)
FUN(ARPANET-ACCESS,<Arpanet>,GOANA)
FUN(ASSIGN-DEVICE,<Assign>,GOASD)
FUN(ASSIGN-DUE-TO-OPENF,<Open-assign>,GOOAD)
FUN(ATTACH-JOB,<Attach>,GOATJ)
FUN(CAPABILITIES,<Caps>,GOCAP)
FUN(CLASS-ASSIGNMENT,<Class>,GOCLS)
FUN(CLASS-SET-AT-LOGIN,<Class-set-at-login>,GOCL0)
FUN(CREATE-DIRECTORY,<Create-directory>,GOCRD)
FUN(CREATE-FORK,<Create-fork>,GOCFK)
FUN(CREATE-JOB,<CRJOB>,GOCJB)
FUN(CREATE-LOGICAL-NAME,<Create-logical-name>,GOCRL)
FUN(CTERM,<Cterm>,GOCTM)
FUN(DECNET-ACCESS,<DECnet>,GODNA)
FUN(DETACH,<Detach>,GODTC)
FUN(DSKOP,<DSKOP>,GODSK) ;[133]
FUN(ENQ-QUOTA,<ENQ-quota>,GOENQ)
FUN(GET-DIRECTORY,<Get-directory>,GOGTD) ;[126]
FUN(GETAB,<GETAB>,GOGTB)
FUN(HSYS,<HSYS>,GOHSY)
FUN(INFO,<INFO>,GOINF)
FUN(LATOP,<LATOP>,GOLAT)
FUN(LOGIN,<Login>,GOLOG)
FUN(LOGOUT,<Logout>,GOLGO)
FUN(MDDT,<MDDT>,GOMDD)
FUN(MTA-ACCESS,<MTA-access>,GOMTA)
FUN(SECURE-CHFDB,<Secure-CHFDB>,GOCFD)
FUN(SECURE-DELF,<Secure-DELF>,GODLF)
FUN(SECURE-OPENF,<Secure-OPENF>,GOOPN)
FUN(SECURE-RNAMF,<Secure-RNAMF>,GORNF)
FUN(SET-TIME,<Set-time>,GOSTD) ;[126]
FUN(SJPRI,<SJPRI>,GOSJP) ;[133]
FUN(SMON,<SMON>,GOSMN)
FUN(SPRIW,SPRIW,GOSPR) ;[133]
FUN(STRUCTURE-MOUNT,<Str-mount>,GOSMT)
FUN(SYSGT,<SYSGT>,GOSGT)
FUN(TERMINAL-SPEED,<Terminal-speed>,GOTBR)
FUN(TLINK,<TLINK>,GOTLK)
FUN(TTMSG,<TTMSG>,GOTTM)
FUN(USER-TEST,<User-test-function>,GOUSR)
LIST
> ;End of DEFINE GFUNCT
LOWCD ;Low code
;Get the storage used for remembering the per function access control profile.
DEFINE FUN(KEY,LOG,COD),<'COD'B: EXP 0>
FUNCTB: GFUNCT ;Generate profile word for each GETOK function
FUNSIZ==.-FUNCTB ;Count number of functions we are handing
FUNAOB: XWD -FUNSIZ,0 ;Make AOB pointer to these tables
;Make tables of .GOXXX code, GOxxxL logging, GOxxxT test routines.
DEFINE FUN(KEY,LOG,COD),<EXP .'COD'>
FUNCOD: GFUNCT ;Make table of .GOxxx codes
DEFINE FUN(KEY,LOG,COD),<XWD [ASCIZ/LOG/],'COD'L>
FUNLOG: GFUNCT ;Make table of GOxxxL addresses
DEFINE FUN(KEY,LOG,COD),<EXP 'COD'T>
FUNTST: GFUNCT ;Make table of GOxxxT addresses
;Define a table of initial GETOK function values so that they can be reset
;on a crash of the access control facility.
FUNTMO: BLOCK FUNSIZ ;Place to store TMON functions from monitor
;Define the tables of keywords and corresponding function numbers.
DEFINE FUN(KEY,LOG,COD),<[ASCIZ/KEY/],,.'COD'>
FUNTBL: TBEGIN ;Plant TBLUK header
FUNKEY: GFUNCT ;Generate command keywords for each table
TEND ;Count expanded keywords
SUBTTL Definitions -- Tables -- Function Profile Tables
HIGHCD ;Used in profile generation only
;Define table of characteristics for each function listed above.
DEFINE FUNGEN,<
XLIST ;Don't show this part
TAB(CONSOLE,NO,<Console>,FU%CON)
TAB(DENY-BATCH,NO,<Deny Batch>,FU%DBA)
TAB(DENY-CTY,NO,<Deny CTY>,FU%DCT)
TAB(DENY-DECNET,NO,<Deny DECnet>,FU%DDN)
TAB(DENY-DETACHED,NO,<Deny Detached>,FU%DDE)
TAB(DENY-LAT,NO,<Deny LAT>,FU%DLA)
TAB(DENY-LOCAL,NO,<Deny Local>,FU%DLO)
TAB(DENY-PTY,NO,<Deny PTY>,FU%DPT)
TAB(DENY-REMOTE,NO,<Deny Remote>,FU%DRM)
TAB(DENY-TCP,NO,<Deny TCP>,FU%DTC)
TAB(LOG,NO,<Log>,FU%LOG)
TAB(NO,,,0)
TAB(POLICY,NO,<Policy>,FU%POL)
LIST ;Resume listing
> ;End of DEFINE FUNGEN
;For each GETOK function "funct", there is a profile word of bits "functB".
;This word contains what action should be taken for each GETOK function.
;Note: 1B3-1B8 are reserved for future use in ACJSYM/ACJDEC, and 1B17-1B35 are
;reserved for customer implementations.
; 1B0-1B8 reserved for use in ACJSYM/ACJDEC
; FU%ENA==1B1 ;If 1 enable this function, if 0 do not enable
; FU%GOK==1B2 ;If 1 we are getting OKs on this function
FU%LOG==1B7 ;If 1 log into log file
FU%CON==1B8 ;If 1 log on console terminal
FU%DBA==1B9 ;If 1 deny Batch access
FU%DCT==1B10 ;If 1 deny CTY access
FU%DDN==1B11 ;If 1 deny DECnet access
FU%DDE==1B12 ;If 1 deny Detached access
FU%DLA==1B13 ;If 1 deny LAT access
FU%DLO==1B14 ;If 1 deny Local access
FU%DPT==1B15 ;If 1 deny PTY access
FU%DRM==1B16 ;If 1 deny Remote access
FU%DTC==1B17 ;If 1 deny TCP access
; 1B17-35 reserved for customer defined bits.
;Define table of switches used in ENABLE command.
DEFINE TAB(KEY,NOF,SHO,BIT),<TENTRY (KEY,[BIT])>
ENATBL: TBEGIN ;Plant TBLUK header
ENAKEY: FUNGEN ;Generate per-function switch table
TEND ;Count the commands
ENAAOB: -<.-ENAKEY>,,0 ;AOB pointer to table
;Define table of keywords to type after NO.
DEFINE TAB(KEY,NOF,SHO,BIT),<IFNB <NOF>,<TENTRY (KEY,[BIT])>>
ENANOT: TBEGIN ;Plant TBLUK header
FUNGEN ;Generate per-function NO table
TEND ;Count the commands
;Define table of keywords for SHOW command output
DEFINE TAB(KEY,NOF,SHO,BIT),<[ASCIZ/SHO/],,0>
ENASHO: FUNGEN
;Default enable bits are used in FINDIT and DOENAB routines in ACJDEC.
LOWCD
ENADEF: EXP FU%ENA!FU%LOG!FU%POL ;Default P2 on ENABLE command (incl FU%ENA)
SUBTTL Definitions -- Tables -- User Profile Tables
HIGHCD ;This is used in profile phase only
;The user table will be pointed to by a TBLUK style table (for profile
;generation). The right halfword of this table will be an offset into two
;other tables: one table of user numbers and one table of user profile bits.
DEFINE USEGEN,<
XLIST ;Don't show this table please
TAB(CLASS-AT-LOGIN,,<Class at login>,US%CLA,DEC)
TAB(ENABLE-NON-PRIME-TIME,NO,<Enable non-prime>,US%ENP,BIT)
TAB(LOGIN-BATCH,NO,<Login Batch>,US%BAT,BIT)
TAB(LOGIN-CTY,NO,<Login CTY>,US%CTY,BIT)
TAB(LOGIN-DECNET,NO,<Login DECnet>,US%DNA,BIT)
TAB(LOGIN-DETACHED,NO,<Login Detached>,US%DET,BIT)
TAB(LOGIN-LAT,NO,<Login LAT>,US%LAT,BIT)
TAB(LOGIN-LOCAL,NO,<Login Local>,US%LOC,BIT)
TAB(LOGIN-PTY,NO,<Login PTY>,US%PTY,BIT)
TAB(LOGIN-REMOTE,NO,<Login Remote>,US%REM,BIT)
TAB(LOGIN-TCP,NO,<Login TCP>,US%TCP,BIT)
TAB(NO,,,0,BIT)
TAB(SPY-ON,NO,<Spy on>,US%SPY,BIT)
LIST ;Resume listing
> ;End of DEFINE USEGEN
;Define bits in the user profile.
;1B0 ;Free
US%ENP==1B1 ;User is allowed to enable during non-prime
US%SPY==1B2 ;User should be spyed on whenever logged in
US%BAT==1B3 ;Login Batch
US%CTY==1B4 ;Login CTY
US%DNA==1B5 ;Login DECnet
US%DET==1B6 ;Login Detached
US%LAT==1B7 ;Login LAT
US%LOC==1B8 ;Login Local
US%PTY==1B9 ;Login PTY
US%REM==1B10 ;Login Remote
US%TCP==1B11 ;Login TCP
US%CLA==77B17 ;Class assignment at login (B12-B17)
;Right half reserved for customers.
;Define table of keywords used in USER command. The data is the bit to
;to set if a BIT functon, byte pointer to data if a value function.
DEFINE TAB(KEY,NOF,TXT,DAT,TYP),<
IFIDN <TYP>,<BIT>,<TENTRY(KEY,<[DAT]>)>
IFIDN <TYP>,<DEC>,<TENTRY(KEY,<[POINTR 0,DAT]>)>>
USETBL: TBEGIN ;Plant TBLUK header
USEKEY: USEGEN ;Generate table of bits to check in ACJUSR
TEND ;Count the commands
USEAOB: -<.-USEKEY>,,0 ;AOB pointer to table
;Define table of keywords to type after NO
DEFINE TAB(KEY,NOF,TXT,DAT,TYP),<IFNB <NOF>,<TENTRY (KEY,[DAT])>>
USENOT: TBEGIN ;Plant TBLUK header
USEGEN ;Generate per-function NO table
TEND ;Count the commands
;Define table of routines to parse the field called PRSxxx.
DEFINE TAB(KEY,NOF,TXT,DAT,TYP),<EXP PRS'TYP>
USEPRS: USEGEN ;Rable of parsing routines
;Define table of strings for SHOW command and show action routines SHOxxx.
DEFINE TAB(KEY,NOF,TXT,DAT,TYP),<[ASCIZ/TXT/],,SHO'TYP>
USESHO: USEGEN ;Generate table for SHOW command
;Define dispatch table for WRITE command routines WRIxxx.
DEFINE TAB(KEY,NOF,TXT,DAT,TYP),<EXP WRI'TYP>
USEWRI: USEGEN ;Generate table for SHOW command
LOWCD ;Some data in LOWCD
;Define default user profile bits, referred to by policy portion.
USEDEF: EXP US%BAT!US%CTY!US%DNA!US%DET!US%LAT!US%LOC!US%PTY!US%REM!US%TCP
SUBTTL Logging
LOWCD ;Rest of module is LOWCD only
;For each access control function defined in ACJSYM, there will be two routines
;in this module that the ACJDEC module will call. The names are based on the
;names of the functions (GOxxx). The logging routine is called GOxxxL.
;The logging routine (GOxxxL) will furnish additional information to the log
;file, and is always called (even if the function is not being logged).
;Each logging routine will be called with the following ACs set up:
; T1/ pointer to text log buffer
; 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)
;The logging routine will preserve all of those ACs except T1 and P2.
;An updated T1, which points to the logging text, will be returned. This byte
;pointer to the logging text is kept in TEXTBP and so T1 and be reloaded from
;TEXTBP. The logging routine may turn off the FU%LOG and FU%CON bits in P2 to
;further prevent logging of particular users (or particular circumstances).
;The logging routine will always return +1.
SUBTTL Logging -- GOASD (ASND%)
;Logging routine for GOASD.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOASDL: HRROI T2,[ASCIZ/, /] ;Load comma space string
CALL ISOUT ;(T1,T2/T1) Send that first
MOVE T2,.GEADD(Q1) ;Load device designator
CALLRET ODEVST ;(T1,T2/T1) Perform DEVST and return
SUBTTL Logging -- GOCAP (EPCAP%)
;Routine to log the changing of capabilities
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOCAPL: HRROI T2,[ASCIZ/, desired/] ;Load label for this
CALL ISOUT ;(T1,T2/T1) Label this next bit
HRRZ T4,.GENCP(Q1) ;Load new caps
JUMPN T4,OCAPAB ;(T1,T4/T1) If any, send them and return
HRROI T2,[ASCIZ/ none/] ;Load string saying none
CALLRET ISOUT ;(T1,T2/T1) Send that
SUBTTL Logging -- GOCJB (CRJOB%)
;Routine to log CRJOBs
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOCJBL: RET ;Nothing special to log
SUBTTL Logging -- GOLOG (LOGIN%)
;Routine to log logins.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOLOGL: MOVEI T4,CJBLK ;Point to area to return data into
SETZM CJBLK+.JILNO ;Zero controlling job's login directory number
SKIPL T1,JIBLK+.JICPJ ;Load controlling job, skip if none
CALL GETINF ;(T1,T4/T4) Get job information
SKIPA T1,TEXTBP ;Error or no ctrl job, reload pointer and skip
SKIPA T1,TEXTBP ;No error, reload text pointer and skip
RET ;Return if can't get information
HRROI T2,[ASCIZ/, by/] ;Load little blurb text
CALL ISOUT ;(T1,T2/T1) Send that string
CALLRET OGETJI ;(T1,T4/T1) Output all information about job
SUBTTL Logging -- GOCFK (CFORK%)
;Logging routine for GOCFK.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOCFKL: HRROI T2,[ASCIZ/, using /] ;Label the string
MOVE T3,.GEFCT(Q1) ;Load number of forks
CALLRET OLDEC ;(T1-T3/T1) Send to logging area
SUBTTL Logging -- GOTBR (MTOPR% to set Terminal Baud Rate)
;Logging routine for GOTBR.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOTBRL: HRROI T2,[ASCIZ/, TTY/] ;Load label for terminal number today
MOVE T3,.GELIN(Q1) ;Load line number
CALL OLOCT ;(T1,T2,T3/T1) Label that octal number
HRROI T2,[ASCIZ/ input /] ;Label input speed
HLRZ T3,.GESPD(Q1) ;Load input speed
CALL OLDEC ;(T1,T2,T3/T1) Send and label input speed
HRROI T2,[ASCIZ/ output /] ;Label output speed
HRRZ T3,.GESPD(Q1) ;Load output speed
CALLRET OLDEC ;(T1,T2,T3/T1) Send and label output speed
SUBTTL Logging -- GOLGO (LGOUT%)
;Routine to log a logout.
;Flag entry in the log file if this job is logging out another job.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOLGOL: MOVEI T4,CJBLK ;Point to block to get info into
SKIPL T1,.GERLG(Q1) ;Job number logging out, -1 if caller
CALL GETINF ;(T1/) Get job information
SKIPA T1,TEXTBP ;Error or no target, reload pointer and skip
SKIPA T1,TEXTBP ;Point to text area again if something to say
RET ;Return if nothing to say
HRROI T2,[ASCIZ/, target/] ;Label following
CALL ISOUT ;(T1,T2/T1) Send that first
CALLRET OGETJI ;(T1,T2/T1) Output all information about job
SUBTTL Logging -- GOENQ (ENQC% ENQ Quota Set)
;Logging routine for GOENQ.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOENQL: HRROI T2,[ASCIZ/, desired /] ;Label the string
MOVE T3,.GEEQU(Q1) ;Load desired quota
CALL OLDEC ;(T1-T3/T1) Send to logging area
MOVEM T1,TEXTBP ;Save the pointer
SKIPL T1,.GEEUN(Q1) ;Get target job number, skip if self
CAMN T1,JIBLK+.JIJNO ;Is it for this job?
IFSKP. ;Not for this job, display target job number
MOVEI T4,CJBLK ;Point to cotnrolling job block
CALL GETINF ;(T1,T4/T4) Get job information
ANSKP. ;If it skipped
MOVE T1,TEXTBP ;Load text pointer again
CALLRET OGETJI ;(T1,T4/T1) Output all information about job
ENDIF. ;End of job check
MOVE T1,TEXTBP ;Target job same as us, reload the pointer
RET ;Return
SUBTTL Logging -- GOCRD (CRDIR%)
;Routine to log CRDIRs.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
;Newer monitors return the CRDIR argument block, directory string, and user's
;AC2. Older monitors do not give us anything to work with. The CHKCRD routine
;will root around and try to copy the user's CRDIR argument block by looking at
;monitor data structures and physical memory. If no information exists after
;calling this routine, log nothing.
GOCRDL: CALL CHKCRD ;(Q1/) Check for old format CRDIR argument
MOVE T1,TEXTBP ;Reload pointer to text buffer
SKIPN .GEDIR(Q1) ;Any stuff present?
RET ;Nope, nothing to tell about, so return now
;Output the directory name first.
HRROI T2,[ASCIZ/, /] ;Point to comma space
CALL ISOUT ;(T1,T2/T1) Send that to log buffer
HRROI T2,.GEDIR(Q1) ;Point to directory
CALL ISOUT ;(T1,T2/T1) Send that to log file
;Log any changes that we might be interested in today.
MOVSI T4,-CRDSIZ ;Load AOB pointer to tables
DO. ;Loop for all of them
MOVE T3,CDBTAB(T4) ;Load bit to test
TDNN T3,.GECFL(Q1) ;Is this bit set?
IFSKP. ;Yes, tell us about it
HRRO T2,CDTTAB(T4) ;Load descriptive string about this into T2
XCT CDXTAB(T4) ;Load possible additional data into T3
CALL @CDATAB(T4) ;(T1,T2,T3/T1) Call routine to create text
ENDIF. ;End of output code
AOBJN T4,TOP. ;Loop for all items
OD. ;End of interpretation loop
;Tell about interesting mode bits.
MOVE T4,.GECFL(Q1) ;Is this bit set?
TXNN T4,CD%MOD ;Changing mode bits?
IFSKP. ;Yes, see if to files only or not
MOVE T3,.GECAB+.CDMOD(Q1) ;Get directory mode bits
HRROI T2,[ASCIZ/ files-only/] ;Assume files only
TXNN T3,CD%DIR ;Directory files only?
HRROI T2,[ASCIZ/ non-files-only/] ;No, shout this
CALL ISOUT ;(T1,T2/T1) Tell me yes or now
HRROI T2,[ASCIZ/ secure/] ;Load "secure" pointer
TXNE T3,CD%SEC ;Making directory secure?
CALL ISOUT ;(T1,T2/T1) Tell me so
ENDIF. ;End of mode change code
;Tell about capability changes. Must be last information output.
TXNN T4,CD%PRV ;User setting capabilities?
IFSKP. ;Yes
HRROI T2,[ASCIZ/ caps/] ;Load label for following text
CALL ISOUT ;(T1,T2/T1) Take me along
MOVE T4,.GECAB+.CDPRV(Q1) ;Load capability mask
HRROI T2,[ASCIZ/ none/] ;Assume no caps
TRNN T4,-1 ;Any set now?
CALLRET ISOUT ;(T1,T2/T1) None, send to log file and return
CALLRET OCAPAB ;(T1,T4/T1) Send capabiltity mask out
ENDIF. ;End of user setting caps code
RET ;Return with logging all done
;These macros create the tables for interpretation of each interesting CRDIR
;bit in AC2. If logging for a particular bit is no longer desired, comment out
;a line in the following macro. Each line is of the form:
; CD < string>,bit-to-test,,routine-to-call
;or CD < string >,bit-to-test,<adr-of-additional-data>,routine-to-call
DEFINE CRDGEN,<
XLIST ;Clean listing please
CD < password>,CD%PSW,,ISOUT
CD < working >,CD%LIQ,<MOVE T3,.GECAB+.CDLIQ(Q1)>,OLDEC
CD < permanent >,CD%LOQ,<MOVE T3,.GECAB+.CDLOQ(Q1)>,OLDEC
CD < number >,CD%NUM,<HRRZ T3,.GECAB+.CDNUM(Q1)>,OLOCT
CD < default-protection >,CD%FPT,<HRRZ T3,.GECAB+.CDFPT(Q1)>,OLOCT
CD < directory-protection >,CD%DPT,<HRRZ T3,.GECAB+.CDDPT(Q1)>,OLOCT
CD < retention-count >,CD%RET,<MOVE T3,.GECAB+.CDRET(Q1)>,OLDEC
CD < dir-group>,CD%DGP,,ISOUT
CD < user-group>,CD%UGP,,ISOUT
CD < subdirectory-quota >,CD%SDQ,<MOVE T3,.GECAB+.CDSDQ(Q1)>,OLDEC
CD < default-account>,CD%DAC,,ISOUT
CD < PPN >,CD%PPN,<MOVE T3,.GECAB+.CDPPN(Q1)>,OLPPN
CD < killing>,CD%DEL,,ISOUT
LIST ;Resume listing
> ;End of DEFINE CRDGEN
DEFINE CD(A,B,C,D),<XWD 0,[ASCIZ/A/]>
CDTTAB: CRDGEN ;Table of text strings for each AC2 bit
CRDSIZ==.-CDTTAB ;Compute number of elements in the table
DEFINE CD(A,B,C,D),<EXP B>
CDBTAB: CRDGEN ;Table of bits to test from user's AC2
DEFINE CD(A,B,C,D),<
IFNB <C>,<C>
IFB <C>,<JFCL>>
CDXTAB: CRDGEN ;Table of instructions to load additional data
DEFINE CD(A,B,C,D),<EXP D>
CDATAB: CRDGEN ;Table of action routines for each bit
SUBTTL Logging -- GOSMT (MSTR% to Increment Mount Count)
;Logging routine for GOSMT.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOSMTL: HRROI T2,[ASCIZ/, /] ;Load comma space structure label
CALL ISOUT ;(T1,T2/T1) Send that first
MOVE T2,.GESDE(Q1) ;Load device designator
CALLRET ODEVST ;(T1,T2/T1) Perform DEVST and return
SUBTTL Logging -- GOMDD (MDDT%)
;Routine to log a job entering MDDT
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOMDDL: RET ;No additional data today
SUBTTL Logging -- GOCLS (SKED% to set scheduler class)
;Logging routine for GOCLS.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOCLSL: MOVE T1,.GOTJB(Q1) ;Get target job number
MOVEI T4,CJBLK ;Point to area to return data into
CALL GETINF ;(T1,T4/T4) Get job information
SKIPA T1,TEXTBP ;Error, reload pointer and skip
SKIPA T1,TEXTBP ;No error, reload text pointer and skip
RET ;Return if can't get information
HRROI T2,[ASCIZ/, class /] ;Load label for class number
MOVE T3,.GECLS(Q1) ;Load class desired
CALL OLDEC ;(T1,T2,T3/T1) Send class and its label
HRROI T2,[ASCIZ/ for/] ;Label the job
CALL ISOUT ;(T1,T2/T1) Send that along
CALLRET OGETJI ;(T1,T4/T1) Output all information about job
SUBTTL Logging -- GOCL0 (Class Set at Login)
;Logging routine for GOCL0.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOCL0L: LDB T3,[POINTR P4,US%CLA] ;Load class
JUMPE T3,R ;Return (do nothing) if zero
HRROI T2,[ASCIZ/, class /] ;Load label for this class
CALLRET OLDEC ;(T1,T2,T3/T1) Send that along and return
SUBTTL Logging -- GOMTA (MTA Access)
;Logging routine for GOMTA.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
;Send unit number first.
GOMTAL: HRROI T2,[ASCIZ/, unit /] ;Load MT unit number
MOVE T3,.GEUNT(Q1) ;Load unit number
CALL OLOCT ;(T1,T2,T3/T1) Send number along
;Label type.
MOVSI T4,-LABSIZ ;Load count of label types
DO. ;Loop for find label type
HRRZ T2,LABTAB(T4) ;Load a label type
CAME T2,.GELTP(Q1) ;Match supplied label type?
IFSKP. ;Yes this is it!
HLRO T2,LABTAB(T4) ;Point to ASCIZ
EXIT. ;End the loop
ENDIF. ;End of we got it code
AOBJN T4,TOP. ;Loop for all entries in table
HRROI T2,[ASCIZ/ unknown-label-type/] ;Load generic unknown text
OD. ;End of loop
CALL ISOUT ;(T1,T2/T1) Send label type
;Code from HDR1.
SKIPN .GEACC(Q1) ;HDR1 access specified?
IFSKP. ;Yes
HRROI T2,[ASCIZ/ HDR1-access /] ;Point to label string
CALL ISOUT ;(T1,T2/T1) Send that too
MOVE T2,.GEACC(Q1) ;Point to access
IDPB T2,T1 ;Store it
ENDIF.
;User number if any.
SKIPN .GEUSN(Q1) ;Is there a user number?
IFSKP. ;Yes
HRROI T2,[ASCIZ/ user /] ;Point to string for user
CALL ISOUT ;(T1,T2/T1) Send that along
MOVE T2,.GEUSN(Q1) ;Load user number
CALL ODIRST ;(T1,T2/T1) Send that to log
ENDIF. ;End of user number output
;User's desired access bits.
HRROI T2,[ASCIZ/ desired /] ;Point to next label
CALLRET ISOUT ;(T1,T2/T1) Send it
MOVSI T4,-FPBSIZ ;Load AOBJN pointer
MOVE T3,.GEACD(Q1) ;Load access bits
DO. ;Loop through access bits
HLRO T2,FPBTAB(T4) ;Load address of asciz string
TDNE T3,FPBTAB(T4) ;Is this bit set?
CALL ISOUT ;(T1,T2/T1) Yes, send string along
AOBJN T4,TOP. ;Loop for all strings
OD. ;End of access checking loop
RET ; and return
;Table of access bits.
FPBTAB: TENTRY (< directory listing>,FP%DIR)
TENTRY (< append>,FP%APP)
TENTRY (< execute>,FP%EX)
TENTRY (< write>,FP%WR)
TENTRY (< read>,FP%RD)
FPBSIZ==.-FPBTAB ;Count entries in table
;Table of MTA label types.
LABTAB: TENTRY (< unlabeled>,.LTUNL) ;Unlabeled
TENTRY (< ANSI label>,.LTANS) ;ANSI standard label
TENTRY (< EBCDIC label>,.LTEBC) ;Something pretending to be IBM labels
TENTRY (< TOPS-20 label>,.LTT20) ;Our label type
LABSIZ==.-LABTAB ;Number of entries
SUBTTL Logging -- GOACC (ACCES%)
;Routine to log the connects or accesses.
;Supply the directory that the user wants to access or connect to.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOACCL: MOVSI T4,-ACCSIZ ;Load -count,,0 for table search
DO. ;Loop for asciifying bits in user AC1
HLRO T2,ACCTAB(T4) ;Load something to say today
HRRZ T3,ACCTAB(T4) ;Load address of bits to test
MOVE T3,(T3) ;Load the mask to test
TDNE T3,.GOAC0(Q1) ;Is this bit set?
CALL ISOUT ;(T1,T2/T1) Yes it is in fact
AOBJN T4,TOP. ;Loop for all of those bits
OD. ;End of flags translation loop
;Put the directory string into a place for later use by GOACCT.
MOVE T4,T1 ;Copy output pointer to T4 for a little bit
HRROI T1,DIRBLK ;Point to directory block
MOVE T2,.GOAC1(Q1) ;Get directory number of attempted access
CALL ODIRST ;(T1,T2/T1) Make directory to string
MOVE T1,T4 ;Reload output pointer
HRROI T2,DIRBLK ;Point to directory block
CALLRET ISOUT ;(T1,T2/T1) Output all of that and return
;Table to verbalize those pesky ACCES JSYS bits.
ACCTAB: TENTRY(<, connect >,[AC%CON])
TENTRY(<, access >,[AC%OWN])
TENTRY(<, end-access >,[AC%REM])
TENTRY(<, encrypt-password >,[AC%PWD])
ACCSIZ==.-ACCTAB
SUBTTL Logging -- GOOAD (OPENF% Assign Device)
;Logging routine for GOOAD.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOOADL: HRROI T2,[ASCIZ/, device /] ;Load device
CALL ISOUT ;(T1,T2/T1) Send that first
MOVE T2,.GEADD(Q1) ;Load device designator
CALLRET ODEVST ;(T1,T2/T1) Perform DEVST and return
SUBTTL Logging -- GODNA (DECnet)
;Routine to log DECnet access.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GODNAL: HRROI T2,[ASCIZ/, to /] ;Load label for next text
CALL ISOUT ;(T1,T2/T1) Send that text first
HRROI T2,.GEHST(Q1) ;Point to ASCII node name
CALL ISOUT ;(T1,T2/T1) Send node name
RET ;Return
SUBTTL Logging -- GOANA (Arpanet)
;Routine to log arpanet access today.
;Called with
; T1/ pointer to text log buffer
; 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 to deny, +2 to allow
;Returns +1 always, T1/ updated text log buffer pointer
GOANAL: HRROI T2,[ASCIZ/, to /] ;Label the next little string
CALL ISOUT ;(T1,T2/T1) Send that to the logging buffer
MOVE T2,T1 ;Destination byte pointer should be in 2 now
MOVX T1,.GTHNS ;Translate host # to string function
MOVE T3,.GEHSN(Q1) ;Host number for GTHST
GTHST% ;Output host name
ERCAL GOANA2 ;(T2/T2) If error, output the number and skip
MOVE T1,T2 ;Reload the output pointer if GTHST worked
LDB T3,[POINTR T4,HS%STY] ;Get operating system type code
HRROI T2,[ASCIZ/ (unknown)/] ;Load default host type
CAIG T3,ANASIZ ;Higher than we know?
HRROI T2,@ANATAB(T3) ;No, output system type
CALL ISOUT ;(T1,T2/T1) Send out host type
HRROI T2,[ASCIZ/ port /] ;Load the socket label
MOVE T3,.GEPRT(Q1) ;Load the port number
CALLRET OLDEC ;(T1,T2,T3/T1) Send that to logging buffer
GOANA2: SAVEAC <Q2,Q3> ;Save a couple of ACs
MOVE T1,T2 ;Reload the output pointer to T1
MOVEI Q3,4 ;Load number of octets to print
MOVE Q2,[POINT 8,.GEHSN(Q1),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 Q3,RSKP ;Skip return when all octets are output
HRROI T2,[ASCIZ/./] ;Point to a hot dot
CALL ISOUT ;(T1,T2/T1) Append that to the string
JRST TOP. ;Loop for all octets
OD. ;End of TCP loop
;Table of host types for logging.
ANATAB: [ASCIZ / (other)/] ;(0)
[ASCIZ / (Tenex)/] ;(1)
[ASCIZ / (ITS)/] ;(2)
[ASCIZ / (TOPS-10)/] ;(3)
[ASCIZ / (TIP)/] ;(4)
[ASCIZ / (MTIP)/] ;(5)
[ASCIZ / (ELF)/] ;(6)
[ASCIZ / (ANTS)/] ;(7)
[ASCIZ / (Multics)/] ;(10)
[ASCIZ / (TOPS-20)/] ;(11)
[ASCIZ / (UNIX)/] ;(12)
[ASCIZ / (Network)/] ;(13)
[ASCIZ / (Fuzzball)/] ;(14)
[ASCIZ / (VMS)/] ;(15)
[ASCIZ / (TAC)/] ;(16)
[ASCIZ / (MSDOS)/] ;(17)
ANASIZ==.-ANATAB-1 ;Highest known system type
SUBTTL Logging -- GOATJ (ATACH%)
;Logging routine for attach.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOATJL: HRRZ T1,.GOTJB(Q1) ;[131] Get target job number
MOVEI T4,TJBLK ;Point to area to return data into
CALL GETINF ;(T1,T4/T4) Get job information
SKIPA T1,TEXTBP ;Error, reload pointer and skip
SKIPA T1,TEXTBP ;No error, reload text pointer and skip
RET ;Return if can't get information
HRROI T2,[ASCIZ/, target/] ;Load little blurb text
CALL ISOUT ;(T1,T2/T1) Send that string
CALL OGETJI ;(T1,T4/T1) Output all information about job
HRROI T2,[ASCIZ/ to TTY/] ;Load label text for terminal
MOVE T3,.GOTTY(Q1) ;Load terminal number
CAME T3,JIBLK+.JITNO ;Is it the same as the caller's TTY?
CALL OLOCT ;(T1,T2,T3/T1) No, send TTY to log buffer
RET ;Return with T1 updated
SUBTTL Logging -- GOINF (INFO%)
;Logging routine for GOINF.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOINFL: CALL OCOMMA ;(T1/T1) Send a comma to the log file
HRROI T2,[ASCIZ/ job /] ;Label for the job number
MOVE T3,.GEJOB(Q1) ;Load the number of the job
CAME T3,JIBLK+.JIJNO ;Is it the same job number?
CALL OLDEC ;(T1,T2,T3/T1) Nope, label and display job no
HRROI T2,[ASCIZ/ node /] ;Load label for node number
MOVE T3,.GECIN(Q1) ;Load CI node number
CALL OLDEC ;(T1,T2,T3/T1) Send to logging buffer
MOVSI T4,-INFSIZ ;Load AOB pointer for table
DO. ;Loop through table to find function
HRRZ T3,INFTAB(T4) ;Load the function code
CAMN T3,.GEINF(Q1) ;Does this one match?
EXIT. ;Yes, get out an print it
AOBJN T4,TOP. ;Nope, get the next one please
HRROI T2,[ASCIZ/ function /] ;No match, load label for function
MOVE T3,.GEINF(Q1) ;Load function number that wasn't found
CALLRET OLOCT ;(T1,T2,T3/T1) Send all of that to log
OD. ;End of loop
CALL OSPACE ;(T1/T1) Output a space then
HLRO T2,INFTAB(T4) ; point to text describing this function
CALLRET ISOUT ;(T1,T2/T1) Output that and return now please
;Table of INFO% functions and string to send to log file.
INFTAB: TENTRY (<get-CI-nodes>,.INCIN)
TENTRY (<CNFIG%>,.INCFG)
TENTRY (<DIRST%>,.INDST)
TENTRY (<GETAB%>,.INGTB)
TENTRY (<GETJI%>,.INGJI)
TENTRY (<GTTYP%>,.INGTY)
TENTRY (<INLNM%>,.ININL)
TENTRY (<LNMST%>,.INLNS)
TENTRY (<MSTR%>,.INMSR)
TENTRY (<MTOPR%>,.INMTO)
TENTRY (<MUTIL%>,.INMUT)
TENTRY (<RCUSR%>,.INRCR)
TENTRY (<SKED%>,.INSKD)
TENTRY (<SNOOP%>,.INSNP)
TENTRY (<SYSGT%>,.INSGT)
TENTRY (<TMON%>,.INTMN)
TENTRY (<XPEEK%>,.INXPK)
TENTRY (<DVCHR%>,.INDVC)
TENTRY (<NTINF%>,.INNTF)
TENTRY (<STDEV%>,.INSTV)
TENTRY (<DEVST%>,.INDVT)
TENTRY (<SYSTAT>,.INSYS)
TENTRY (<jobs-of-user>,.INJOB)
TENTRY (<RCDIR%>,.INRCD)
TENTRY (<TIME%>,.INTIM)
INFSIZ==.-INFTAB
SUBTTL Logging -- GOLAT (LATOP%)
;Logging routine for GOLAT.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
;Output function code first
GOLATL: MOVSI Q2,-LATSIZ ;Load size of table
HRRZ T4,.GEFUN(Q1) ;Load function code
DO. ;Loop to find entry to match
HRRZ T3,LATTAB(Q2) ;Load entry from table
HLRO T2,LATTAB(Q2) ;Load string in case we need it
CAMN T3,T4 ;Match?
EXIT. ;Yes
AOBJN Q2,TOP. ;Loop for all of them
HRROI T2,[ASCIZ/ unknown-function/] ;I dunno which one
OD. ;End of loop T2/ string pointer
CALL ISOUT ;(T1,T2/T1) Send function to logging text area
;Output port name if any.
SKIPN .GESRN(Q1) ;Server name specified?
IFSKP. ;Yes
HRROI T2,[ASCIZ/ server /] ;Label the server
CALL ISOUT ;(T1,T2/T1) Send that label
HRROI T2,.GESRN(Q1) ;Load the server name pointer
CALL ISOUT ;(T1,T2/T1) Send that also
ENDIF. ;End of server output code
;Output port name if any.
SKIPN .GEPRN(Q1) ;Port name specified?
IFSKP. ;Yes
HRROI T2,[ASCIZ/ port /] ;Label the port
CALL ISOUT ;(T1,T2/T1) Send that label
HRROI T2,.GEPRN(Q1) ;Load the port name pointer
CALL ISOUT ;(T1,T2/T1) Send that also
ENDIF. ;End of port output code
;Output service name.
SKIPN .GESVN(Q1) ;Service name specified?
IFSKP. ;Yes
HRROI T2,[ASCIZ/ service /] ;Label the service
CALL ISOUT ;(T1,T2/T1) Send that label
HRROI T2,.GESVN(Q1) ;Load the service name pointer
CALL ISOUT ;(T1,T2/T1) Send that also
ENDIF. ;End of service output code
RET ;Nothing special
;Table of LATOP functions, includes all of them in case monitor changed.
LATTAB: TENTRY(<, set>,.LASET)
TENTRY(<, clear>,.LACLR)
TENTRY(<, show-characteristics>,.LASCH)
TENTRY(<, show-terminal-connect>,.LASTC)
TENTRY(<, show-adjacent-servers>,.LASAS)
TENTRY(<, show-counters>,.LASCO)
TENTRY(<, zero-counters>,.LAZCO)
TENTRY(<, request-host-initiated-connect>,.LARHC)
TENTRY(<, terminate-host-initiated-connect>,.LATHC)
TENTRY(<, show-host-initiated-connect>,.LASHC)
LATSIZ==.-LATTAB
SUBTTL Logging -- GOCTM (CTERM Connection)
;Logging routine for GOCTM.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOCTML: HRROI T2,[ASCIZ/, from /] ;Label the text to follow
CALL ISOUT ;(T1,T2/T1) Send that
HRROI T2,.GEWHO(Q1) ;Point to who this is
CALLRET ISOUT ;(T1,T2/T1) Send that and return
SUBTTL Logging -- GOTTM (TTMSG%)
;Logging routine for GOTTM.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOTTML: HRROI T2,[ASCIZ/, to/] ;Load usual label text
CALL ISOUT ;(T1,T2/T1) Send that
SKIPL T3,.GEDTY(Q1) ;Load user's AC1 argument, skip if sendall
TXNN T3,TT%REM ;Remote sendall?
IFSKP. ;Yes
TXC T3,.CSALL ;Let me see here,
TXCE T3,.CSALL ; is it is all nodes today?
IFSKP. ;Yes, it is all nodes
HRROI T2,[ASCIZ/ all nodes/] ;Indicate so
CALL ISOUT ;(T1,T2/T1) Send that along
ELSE. ;Otherwise it was just one node
LDB T3,[POINTR .GEDTY(Q1),.TTCIN] ;Load CI node specifier
HRROI T2,[ASCIZ/ node /] ;Load label text
CALL OLDEC ;(T1,T2,T3/T1) Send label and decimal number
ENDIF. ;End of not all nodes check
ENDIF. ;End of remote sendall check
HRRZ T3,.GEDTY(Q1) ;Load the terminal number again
CAIE T3,-1 ;Is it a sendall?
IFSKP. ;Yes
HRROI T2,[ASCIZ/ all lines/] ;Load where its is going
CALLRET ISOUT ;(T1,T2/T1) Log that and return
ENDIF. ;Otherwise it was not a sendall
TXZ T3,.TTDES ;Turn off terminal designator bit
HRROI T2,[ASCIZ/ TTY/] ;Load the label for the terminal number
CALLRET OLOCT ;(T1,T2,T3/T1) Send octal terminal and return
SUBTTL Logging -- GOSMN (SMON%)
;Logging routine for GOSMN.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOSMNL: HRROI T2,[ASCIZ/, /] ;Load label for first part of data
CALL ISOUT ;(T1,T2/T1) Send that to the log
MOVSI T4,-SMNSIZ ;Load -<number of SMON functions>,,0
DO. ;Loop looking for the right one
HRRZ T3,SMNTAB(T4) ;Get a function code
CAME T3,.GESMF(Q1) ;Match the one we are called with?
IFSKP. ;If a match
HLRO T2,SMNTAB(T4) ;Load string that makes it text
CALL ISOUT ;(T1,T2/T1) Send function name
EXIT. ;Get out of loop
ENDIF. ;OK, it didn't match this function
AOBJN T4,TOP. ;Loop for all of them looking for it
HRROI T2,[ASCIZ/function /] ;[106] Unknown function name
MOVE T3,.GESMF(Q1) ;Load SMON function
CALL OLOCT ;(T1,T2,T3/T1) Send function number along
OD. ;End of loop
HRROI T2,[ASCIZ/ value /] ;Load value label
MOVE T3,.GESMV(Q1) ;Load actual value please sir
CALLRET OLOCT ;(T1,T2,T3/T1) Send that out and return
;Table of SMON/TMON functions, unlikely ones are commented out.
SMNTAB:
; TENTRY (<allow-fact>,.SFFAC)
; TENTRY (<CHECKD-found-errors>,.SFCDE)
; TENTRY (<CHECKD-running>,.SFCDR)
; TENTRY (<manual-start-in-progress>,.SFMST)
TENTRY (<remote-logins>,.SFRMT)
TENTRY (<PTY-logins>,.SFPTY)
TENTRY (<CTY-login>,.SFCTY)
TENTRY (<operator-in-attendance>,.SFOPR)
TENTRY (<local-logins>,.SFLCL)
; TENTRY (<bit-table-errors found on startup>,.SFBTE)
TENTRY (<user-change-directory-characteristics>,.SFCRD)
TENTRY (<Arpanet-logins>,.SFNVT)
TENTRY (<wheel-login-CTY>,.SFWCT)
TENTRY (<wheel-login-local>,.SFWLC)
TENTRY (<wheel-login-remote>,.SFWRM)
TENTRY (<wheel-login-PTYs>,.SFWPT)
TENTRY (<wheel-login-Arpanet>,.SFWNV)
; TENTRY (<usage-file>,.SFUSG)
TENTRY (<full-latency-optimization>,.SFFLO)
TENTRY (<magtape-allocation>,.SFMTA)
TENTRY (<system-message-level-0>,.SFMS0)
TENTRY (<system-message-level-1>,.SFMS1)
TENTRY (<job-0-output>,.SFBGS)
TENTRY (<DECnet-logins>,.SFMCB)
TENTRY (<disk-preallocation>,.SFDPR)
TENTRY (<LAT-logins>,.SFLAT)
TENTRY (<wheel-login-LAT>,.SFWLT)
TENTRY (<wheel-login-DECnet>,.SFWDN)
;Following are functions that do not map into bits in FACTSW.
TENTRY (<Arpanet-on>,.SFNTN)
TENTRY (<Apranet-down-up>,.SFNDU)
TENTRY (<Arpanet-host-table-initialize>,.SFNHI)
TENTRY (<set-time-zone>,.SFTMZ)
TENTRY (<Arpanet-host-number>,.SFLHN)
TENTRY (<account-validation>,.SFAVR)
TENTRY (<enable-status-reporting>,.SFSTS)
TENTRY (<GETOK-enable>,.SFSOK)
TENTRY (<max-ordinary-offline-expiration>,.SFMCY)
TENTRY (<read-date-update>,.SFRDU)
TENTRY (<max-archive-expiration>,.SFACY)
TENTRY (<retrieval-waits>,.SFRTW)
TENTRY (<tape-mount-controls>,.SFTDF)
TENTRY (<working-set-preloading>,.SFWSP)
TENTRY (<daylight-Saving-Time-method>,.SFDST)
TENTRY (<short-bug-output>,.SFBUG)
TENTRY (<allow-disk-for-MSCP-server>,.SFMSD)
TENTRY (<SPEAR-event-counter>,.SFSPR)
TENTRY (<carrier-off-time>,.SFCOT)
TENTRY (<hangup-action-if-not-logged-in>,.SFHU0)
TENTRY (<hangup-action-if-logged-in>,.SFHU1)
TENTRY (<EXEC-flags-word>,.SFXEC)
TENTRY (<ethernet-address>,.SFSEA)
TENTRY (<don't-care-disk>,.SFDCD)
TENTRY (<LAT-state>,.SFLTS)
TENTRY (<CLUDGR-SYSAP>,.SFCLU)
TENTRY (<remote-send-alls>,.SFTMG)
TENTRY (<offline-structures-timer>,.SFOFS)
TENTRY (<login-structure>,.SFLGS)
TENTRY (<minimum-password-length>,.SFMPL)
TENTRY (<system-ACJ>,.SFACJ)
TENTRY (<password-expiration>,.SFPEX)
TENTRY (<password-dictionary>,.SFPWD)
TENTRY (<hangup-on-detach>,.SFHDT)
SMNSIZ==.-SMNTAB
SUBTTL Logging -- GOHSY (HSYS%)
;Logging routine for GOHSY.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOHSYL: SKIPE .GESDT(Q1) ;Time specified?
IFSKP. ;Nope, cancel
HRROI T2,[ASCIZ/, cancel/] ;What was it again?
CALLRET ISOUT ;(T1,T2/T1) Send that and return
ENDIF. ;Otherwise there was a time specified
HRROI T2,[ASCIZ/, down /] ;Load down time label
CALL ISOUT ;(T1,T2/T1) Send that
MOVE T2,.GESDT(Q1) ;Load shutdown time
CALL OODTIM ;(T1,T2/T1) Send that
SKIPN .GERES(Q1) ;Is there an up time?
RET ;Nope, just return
HRROI T2,[ASCIZ/ up /] ;Load up at label
CALL ISOUT ;(T1,T2/T1) Send that
MOVE T2,.GERES(Q1) ;Load actual up at time
CALLRET OODTIM ;(T1,T2/T1) Send that and return
SUBTTL Logging -- GOSGT (SYSGT%)
;Logging routine for GOSGT.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOSGTL: HRROI T2,[ASCIZ/, table /] ;Load the label
CALL ISOUT ;(T1,T2/T1) Send it
MOVE T2,.GETBN(Q1) ;Load sixbit stuff
CALLRET OSIXBI ;(T1,T2/T1) Send that and return
SUBTTL Logging -- GOGTB (GETAB%)
;Logging routine for GOGTB.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOGTBL: HRROI T2,[ASCIZ/, /] ;Point to comma space
CALL ISOUT ;(T1,T2/T1) Output that first
HRRZ T3,.GETBN(Q1) ;Load that table entry number
CAILE T3,GTBSIZ ;Do we know this table's name?
IFSKP. ;Yes, in fact we do
MOVE T2,GTBTAB(T3) ;Load SIXBIT table number
CALL OSIXBI ;(T1,T2/T1) Send that along
ELSE. ;Otherwise we don't know the table name
HRROI T2,[ASCIZ/table /] ;Load label for table number
CALL OLOCT ;(T1,T2,T3/T1) No, label and print the number
ENDIF. ;OK, something has now been said about table
HRROI T2,[ASCIZ/ index /] ;Label the index number
HLRZ T3,.GETBN(Q1) ;Load the number to display
CALLRET OLOCT ;(T1,T2,T3/T1) Send the label and number, ret
;Table of GETAB names, kept here in table order and in SIXBIT to be compact.
GTBTAB: SIXBIT /JOBTTY/ ;(0) Job number to tty number
SIXBIT /JOBRT/ ;(1) Job runtime
SIXBIT /TICKPS/ ;(2) Ticks per second
SIXBIT /JOBDIR/ ;(3) Job number to directory numbers (obs)
SIXBIT /TTYJOB/ ;(4) Tty number to job number
SIXBIT /NCPGS/ ;(5) Number physical core pages
SIXBIT /DEVNAM/ ;(6) Device name
SIXBIT /DEVCHR/ ;(7) Device characteristics
SIXBIT /DEVUNT/ ;(10) Device unit numbers
SIXBIT /DSKERR/ ;(11) Disk error words (obs)
SIXBIT /DRMERR/ ;(12) Drum error words (obs)
SIXBIT /SYSVER/ ;(13) Version text
SIXBIT /SYSTAT/ ;(14) Statistics
SIXBIT /QTIMES/ ;(15) Sched queue times
SIXBIT /JOBNAM/ ;(16) Job number to program name
SIXBIT /SNAMES/ ;(17) Subsystem name
SIXBIT /STIMES/ ;(20) Subsystem time
SIXBIT /SPFLTS/ ;(21) Subsystem page faults
SIXBIT /SSIZE/ ;(22) Subsystem size integral
SIXBIT /SNBLKS/ ;(23) Subsystem number wakeups
SIXBIT /DBUGSW/ ;(24) DBUGSW, DCHKSW
SIXBIT /LOGDES/ ;(25) Log, job 0 designators
SIXBIT /PTYPAR/ ;(26) PTY parameters
SIXBIT /SYMTAB/ ;(27) GETAB symbol table
SIXBIT /DWNTIM/ ;(30) HSYS variables
SIXBIT /JOBPNM/ ;(31) Job number to program name
SIXBIT /BLDTD/ ;(32) Monitor build time and date
SIXBIT /LSTDRN/ ;(33) Last dir number assigned (obs)
SIXBIT /APRID/ ;(34) Apr serial number
SIXBIT /HQLAV/ ;(35) High queue load averages
SIXBIT /LQLAV/ ;(36) Low queue load averages
SIXBIT /NETRDY/ ;(37) Arpanet status
SIXBIT /IMPHRT/ ;(40) Host ready (obs)
SIXBIT /HSTSTS/ ;(41) Dead host status (obs)
SIXBIT /HSTNAM/ ;(42) Host names (obs)
SIXBIT /HOSTN/ ;(43) Host name index (obs)
SIXBIT /NETLSK/ ;(44) Local socket (obs)
SIXBIT /GNTFSK/ ;(45) Foreign socket (obs)
SIXBIT /NETAWD/ ;(46) Arpa connection address (obs)
SIXBIT /NETBAL/ ;(47) Bit allocation (obs)
SIXBIT /NETSTS/ ;(50) Connection status (obs)
SIXBIT /NETBUF/ ;(51) Arpanet buffers (obs)
SIXBIT /NETBTC/ ;(52) Byte count statistics (obs)
SIXBIT /IMPLT1/ ;(53) Imp link table one (obs)
SIXBIT /IMPLT2/ ;(54) Imp link table two (obs)
SIXBIT /IMPLT3/ ;(55) Imp link table three (obs)
SIXBIT /IMPLT4/ ;(56) Imp link table four (obs)
SIXBIT /LHOSTN/ ;(57) Local host number
;Table of GETAB names in SIXBIT continued.
SIXBIT /JBONT/ ;(60) Owning job
SIXBIT /NSWPGS/ ;(61) Default swapping pages
SIXBIT /SCOUNT/ ;(62) Count snames table
SIXBIT /MONVER/ ;(63) Monitor version (address 137)
SIXBIT /CISTAT/ ;(64) CI statistics
GTBSIZ==.-GTBTAB ;Compute size of table
SUBTTL Logging -- GOOPN (OPENF% with FB%SEC)
;Logging routine for GOOPN.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOOPNL: CALL OCOMMA ;(T1/T1) Send a comma to the log file
MOVSI T4,-OPNSIZ ;Load size of table
DO. ;Loop for asciifying bits in user AC1
HLRO T2,OPNTAB(T4) ;Load something to say today
HRRZ T3,OPNTAB(T4) ;Load address of bits to test
TDNE T3,.GEOAC(Q1) ;Is this bit set?
CALL ISOUT ;(T1,T2/T1) Yes it is in fact
AOBJN T4,TOP. ;Loop for all of those bits
OD. ;End of flags translation loop
CALL OSPACE ;(T1/T1) Send space to the file please
HRROI T2,.GEFIL(Q1) ;Load filename string pointer
CALLRET ISOUT ;(T1,T2/T1) Send that and return
;Table for logging OPENF bits.
OPNTAB: TENTRY(< read>,OF%RD)
TENTRY(< write>,OF%WR)
TENTRY(< append>,OF%APP)
TENTRY(< read-unrestricted>,OF%RDU)
TENTRY(< thawed>,OF%THW)
TENTRY(< preserve-dates>,OF%PDT)
TENTRY(< new-file>,OF%NXS)
OPNSIZ==.-OPNTAB ;Size of table
SUBTTL Logging -- GORNF (RNAMF% with FB%SEC)
;Logging routine for GORNF.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GORNFL: HRROI T2,[ASCIZ/, /] ;Load label for filename (comma space)
CALL ISOUT ;(T1,T2/T1) Send it
HRROI T2,.GEFIL(Q1) ;Load filename string pointer
CALLRET ISOUT ;(T1,T2/T1) Send that and return
RET ;Nothing special
SUBTTL Logging -- GODLF (DELF%/DELNF% with FB%SEC)
;Logging routine for GODLF.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GODLFL: CALL OCOMMA ;(T1/T1) Send a comma to the log file
MOVSI T4,-DLFSIZ ;Load size of table
DO. ;Loop for asciifying bits in user AC1
HLRO T2,DLFTAB(T4) ;Load something to say today
HRRZ T3,DLFTAB(T4) ;Load address of bits to test
MOVE T3,(T3) ;Get bit mask from that address
TDNE T3,.GEDAC(Q1) ;Is this bit set?
CALL ISOUT ;(T1,T2/T1) Yes it is in fact
AOBJN T4,TOP. ;Loop for all of those bits
OD. ;End of flags translation loop
CALL OSPACE ;(T1/T1) Now send a space to the log
HRROI T2,.GEFIL(Q1) ;Load filename string pointer
CALLRET ISOUT ;(T1,T2/T1) Send that and return
RET ;Nothing special
DLFTAB: TENTRY(< no-release-JFN>,[DF%NRJ])
TENTRY(< expunge>,[DF%EXP])
TENTRY(< forget>,[DF%FGT])
TENTRY(< directory>,[DF%DIR])
TENTRY(< archive>,[DF%ARC])
TENTRY(< contents-only>,[DF%CNO])
DLFSIZ==.-DLFTAB
SUBTTL Logging -- GOTLK (TLINK%)
;Logging routine for GOTLK.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOTLKL: SAVEAC <Q2> ;Get a Q
MOVE Q2,.GETTB(Q1) ;Load the users bits
CALL OCOMMA ;(T1/T1) Send a comma to the log file
;First interpret the hard to interpret bits.
TXNN Q2,TL%SAB ;Setting receive or refuse links?
IFSKP. ;Yes
TXNN Q2,TL%ABS ;Accept
SKIPA T2,[-1,,[ASCIZ/ refuse links/]] ;Refuse links
HRROI T2,[ASCIZ/ receive links/] ;Receive links
CALL ISOUT ;(T1,T2/T1) Send that
ENDIF. ;End of links code
TXNN Q2,TL%STA ;Setting receive or refuse advice?
IFSKP. ;Yes
TXNN Q2,TL%AAD ;Receive advice?
SKIPA T2,[-1,,[ASCIZ/ refuse advice/]] ;Refuse advice
HRROI T2,[ASCIZ/ receive advice/] ;Receive advice
CALL ISOUT ;(T1,T2/T1) Send that
ENDIF. ;End of advice code
;Output the rest of the bits from a table of bits.
MOVSI T4,-TLKSIZ ;Load size of table
DO. ;Loop for asciifying bits in user AC1
HLRO T2,TLKTAB(T4) ;Load something to say today
HRRZ T3,TLKTAB(T4) ;Load address of bits to test
MOVE T3,(T3) ;Get bit mask from that address
TDNE T3,Q2 ;Is this bit set?
CALL ISOUT ;(T1,T2/T1) Yes it is in fact
AOBJN T4,TOP. ;Loop for all of those bits
OD. ;End of flags translation loop
;Bits are all interpreted, now output the object and remote fields as needed.
TXNN Q2,TL%ERO!TL%EOR!TL%COR!TL%CRO!TL%SAB!TL%STA ;Object?
IFSKP. ;Yes
HRROI T2,[ASCIZ/ object /] ;Load label for filename
CALL ISOUT ;(T1,T2/T1) Send object label along
HRRZ T3,.GETTB(Q1) ;Load object number
CAIE T3,-1 ;Is it 777777 (self)?
IFSKP. ;Yes
HRROI T2,[ASCIZ/self/] ;Use string of self
CALL ISOUT ;(T1,T2/T1) Send to log file rather than 777777
ELSE. ;Otherwise
TXZN T3,.TTDES ;Designator?
SKIPA T2,[-1,,[ASCIZ/JFN /]] ;It was a JFN
HRROI T2,[ASCIZ/TTY/] ;It was a TTY
CALL OLOCT ;(T1,T2,T3/T1) No send that number
ENDIF. ;End of value check
ENDIF. ;End of output object number code
TXNN Q2,TL%ERO!TL%EOR!TL%COR!TL%CRO ;Remote possible?
IFSKP. ;Yes
HRROI T2,[ASCIZ/ remote /] ;Label remote
CALL ISOUT ;(T1,T2/T1) Send remote label along
HRRZ T3,.GERMT(Q1) ;Load the remote value
CAIE T3,-1 ;Is it 777777 (all)?
IFSKP. ;Yes
HRROI T2,[ASCIZ/all/] ;Use string of all
CALL ISOUT ;(T1,T2/T1) Send to log file rather than 777777
ELSE. ;Otherwise
TXZN T3,.TTDES ;Designator?
SKIPA T2,[-1,,[ASCIZ/JFN /]] ;It was a JFN
HRROI T2,[ASCIZ/TTY/] ;It was a TTY
CALL OLOCT ;(T1,T2,T3/T1) No send that number
ENDIF. ;End of value check
ENDIF. ;End of output remote code
RET ;Return now
;Table to TLINK bits that aren't hard to comprehend.
TLKTAB: TENTRY(< clear remote-to-object>,[TL%CRO])
TENTRY(< clear object-to-remote>,[TL%COR])
TENTRY(< establish object-to-remote>,[TL%EOR])
TENTRY(< establish remote-to-object>,[TL%ERO])
TLKSIZ==.-TLKTAB
SUBTTL Logging -- GOCRL (CRLNM%)
;Logging routine for GOCRL.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOCRLL: MOVSI T4,-CRLSIZ ;Load size of table
DO. ;Loop for asciifying bits in user AC1
HLRO T2,CRLTAB(T4) ;Load something to say today
HRRZ T3,CRLTAB(T4) ;Load value to test for
CAMN T3,.GECFN(Q1) ;Does this value match?
CALL ISOUT ;(T1,T2/T1) Yes it would be wise to say so
AOBJN T4,TOP. ;Loop for all of those bits
OD. ;End of flags translation loop
HRROI T2,.GELNM(Q1) ;Point to logical name if any
SKIPE .GELNM(Q1) ;Skip if none
CALL ISOUT ;(T1,T2/T1) Send logical name oto
RET ;All done here
;Table for GOCRLL
CRLTAB: TENTRY(<, create >,.CLNSY)
TENTRY(<, delete >,.CLNS1)
TENTRY(<, delete-all-logical-names >,.CLNSA)
CRLSIZ==.-CRLTAB
SUBTTL Logging -- GODTC (DTACH%)
;Logging routine for GODTC.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GODTCL: RET ;Nothing special
SUBTTL Logging -- GOCFD (CHFDB% of FB%SEC)
;Logging routine for GOCFD.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOCFDL: MOVE T3,.GESFS(Q1) ;Load .FBCTL bits for this file if we allow
HRROI T2,[ASCIZ/, set /] ;Assume setting the bit
TXNN T3,FB%SEC ;Are we settin the file secure today?
HRROI T2,[ASCIZ/, clear /] ;Clear!
CALL ISOUT ;(T1,T2/T1) Send that along
HRROI T2,[ASCIZ/new /] ;Load the string to send to log file
TXNE T3,FB%NXF ;Is this a new (not closed yet) file?
CALL ISOUT ;(T1,T2/T1) Send that along if file is new
; HRROI T2,[ASCIZ/nex /] ;Load the string to send to log file
; TXNE T3,FB%NEX ;Is this a non existant new file type?
; CALL ISOUT ;(T1,T2/T1) Send that along if file is new
HRROI T2,.GEFIL(Q1) ;Point to filename
CALLRET ISOUT ;(T1,T2/T1) Send filename and return
SUBTTL Logging -- GOGTD (Get directory information)
;[126] Logging routine for GOGTD.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOGTDL: SKIPE .GEDNO(Q1) ;[126] Skip if getting defaults
IFSKP. ;[126] Yes, getting defaults
HRROI T2,[ASCIZ/, defaults/] ;[126] I guess he wants defaults
CALLRET ISOUT ;[126] (T1,T2/) Send that along and return
ENDIF. ;[126] End of defaults wanted code
HRROI T2,[ASCIZ/, /] ;[126] Label the seperator string
CALL ISOUT ;[126] (T1,T2/) Send that along
MOVE T2,.GEDNO(Q1) ;[126] Get the directory
CALL ODIRST ;[126] (T1,T2/T1,T2) Send the directory name
TLNE T2,-1 ;[126] Did the DIRST work?
RET ;[126] Yes, return now
HRROI T2,[ASCIZ/ argument /] ;[126] Maybe its illegal dorectory number
MOVE T3,.GEDNO(Q1) ;[126] Load the argument supplied
CALLRET OLOCT ;[126] (T1,T2,T3/T1) Output all of that and ret
SUBTTL Logging -- GOSTD (Set time)
;[126] Logging routine for GOSTD.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOSTDL: HRROI T2,[ASCIZ/, setting /] ;[126] Label the time
CALL ISOUT ;[126] (T1,T2/) Send that along
MOVE T2,.GESTT(Q1) ;[126] Get the time to set
CALLRET OODTIM ;[126] (T1,T2/T1) Output the time and return
SUBTTL Logging -- GODSK (DSKOP% JSYS)
;[133] Logging routine for GODSK.
;[133] Called with
;[133] T1/ pointer to text log buffer
;[133] Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;[133] P1/ offset into function tables
;[133] P2/ FUNCTB bits from tables (FU%xxx)
;[133] P3/ offset for user profile tables
;[133] P4/ USRPRO profile bits for this user (US%xxx)
;[133] Returns +1 always, T1/ updated text log buffer pointer
GODSKL: SAVEAC <Q2,Q3> ;[133] Save a Q or two for our use
MOVE Q2,.GEST2(Q1) ;[133] Load the control flags,,word count
;[133] Output the type of addressing and unit number or structure name.
LDB T4,[POINTR .GEST1(Q1),DOP%AT] ;[133] Load address type
CAIE T4,.DOPSR ;[133] Check structure relative first
IFSKP. ;[133] Yes, its structure relative
HRROI T2,[ASCIZ/, str /] ;[133] So indicate
CALL ISOUT ;[133] (T1,T2/T1) that it is structure relative
LDB T3,[POINTR .GEST1(Q1),DOP%SN] ;[133] Load structure number
CAIE T3,<.RTJST (DOP%SN,DOP%SN)> ;[133] Is field all ones?
IFSKP. ;[133] Yes, structure designator in T4
MOVE T2,.GEST4(Q1) ;[133] Load device designator
CALL ODEVST ;[133] (T1,T2/T1) Change it into a device
ELSE. ;[133] Otherwise it is probably PS
SKIPE T3 ;[133] Want structure PS?
SKIPA T2,[-1,,[ASCIZ/?/]] ;[133] Illegal value for this field
HRROI T2,[ASCIZ/PS/] ;[133] Yes, it is PS, so say so please
CALL ISOUT ;[133] (T1,T2/T1) So just say PS if so
ENDIF. ;[133] End of structure name output code
LDB Q3,[POINTR .GEST1(Q1),DOP%RA] ;[133] Load the relative address
ELSE. ;[133] End of structure relative output code
HRROI T2,[ASCIZ/, unit /] ;[133] Must be a disk unit instead
TXNN Q2,DOP%NF ;[133] Use CKU from T4?
IFSKP. ;[133] Yes please use the new format
SKIPGE .GEST4(Q1) ;[133] Is it a real looking CKU?
IFSKP. ;[133] Yes, it is
LDB T3,[POINTR .GEST4(Q1),DOP%C2] ;[133] Load the controller
CALL OLDEC ;[133] (T1,T2,T3/T1) Output that channel
HRROI T2,[ASCIZ/ /] ;[133] Label for kontroller
LDB T3,[POINTR .GEST4(Q1),DOP%K2] ;[133] Load the kontroller
CAIE T3,<.RTJST (DOP%K2,DOP%K2)> ;[133] Is field all ones?
CALL OLDEC ;[133] (T1,T2,T3/T1) Output that kontroller
HRROI T2,[ASCIZ/ /] ;[133] Label for unit
LDB T3,[POINTR .GEST4(Q1),DOP%U2] ;[133] Load the unit
CALL OLDEC ;[133] (T1,T2,T3/T1) Output that unit
ELSE. ;[133] Otherwise illegal new style unit
HRROI T2,[ASCIZ/, ill unit/] ;[133] It is probably DS poking
CALL ISOUT ;[133] (T1,T2/T1) Send illegal string along
ENDIF. ;[133] End of new style cku format code
ELSE. ;[133] Use old style C and U, T2/ label pointer
LDB T3,[POINTR .GEST1(Q1),DOP%CN] ;[133] Load the controller
CALL OLDEC ;[133] (T1,T2,T3/T1) Output that channel
LDB T3,[POINTR .GEST1(Q1),DOP%UN] ;[133] Load the unit
HRROI T2,[ASCIZ/ /] ;[133] Label for unit
CALL OLDEC ;[133] (T1,T2,T3/T1) Output that unit
ENDIF. ;[133] End of old style chan/unit code
LDB Q3,[POINTR .GEST1(Q1),DOP%UA] ;[133] Load unit address
ENDIF. ;[133] Disk address is in Q3
;[133] Output the rest of the bits from a table of bits.
MOVSI T4,-DOPSIZ ;[133] Load size of table
DO. ;[133] Loop for asciifying bits in user AC1
HLRO T2,DOPTAB(T4) ;[133] Load something to say today
HRRZ T3,DOPTAB(T4) ;[133] Load address of bits to test
MOVE T3,(T3) ;[133] Get bit mask from that address
TDNE T3,Q2 ;[133] Is this bit set?
CALL ISOUT ;[133] (T1,T2/T1) Yes it is in fact
AOBJN T4,TOP. ;[133] Loop for all of those bits
OD. ;[133] End of flags translation loop
;[133] Output desired disk address and then we are done.
MOVE T3,Q3 ;[133] Load the address please
HRROI T2,[ASCIZ/ adr /] ;[133] Load text of address
CALLRET OLOCT ;[133] (T1,T2,T3/T1) Send along the address
;[133] Table of bits to text for the GODSKL.
DOPTAB: TENTRY(< ero>,[DOP%EO]) ;[133] Error if offline
TENTRY(< iel>,[DOP%IL]) ;[133] Inhibit error logging
TENTRY(< ier>,[DOP%IR]) ;[133] Inhibit error recovery
TENTRY(< wri>,[DOP%WR]) ;[133] Write as opposed to read
TENTRY(< phy>,[DOP%PS]) ;[133] Physical, must be last
DOPSIZ==.-DOPTAB ;[133] Size of table
SUBTTL Logging -- GOSJP (SJPRI% JSYS)
;[133] Logging routine for GOSJP.
;[133] Called with
;[133] T1/ pointer to text log buffer
;[133] Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;[133] P1/ offset into function tables
;[133] P2/ FUNCTB bits from tables (FU%xxx)
;[133] P3/ offset for user profile tables
;[133] P4/ USRPRO profile bits for this user (US%xxx)
;[133] Returns +1 always, T1/ updated text log buffer pointer
GOSJPL: MOVE T1,.GEST1(Q1) ;[133] Load the target job number
MOVEI T4,TJBLK ;[133] Point to area to return data into
CALL GETINF ;[133] (T1,T4/T4) Get job information
IFSKP. ;[133] If that worked
MOVE T1,TEXTBP ;[133] Reload the pointer to text buffer
HRROI T2,[ASCIZ/, job/] ;[133] Load little blurb text
CALL ISOUT ;[133] (T1,T2/T1) Send that string
CALL OGETJI ;[133] (T1,T4/T1) Output all info about job
ELSE. ;[133] Otherwise couldn't get the data
MOVE T1,TEXTBP ;[133] Reload the pointer to text buffer
MOVE T3,.GEST1(Q1) ;[133] Load what user gave in T1
HRROI T2,[ASCIZ/, job /] ;[133] Point to the label string
CALL OLDEC ;[133] (T1,T2,T3/T1) Send the job number along
ENDIF. ;[133] End of job output code
CALLRET GOSPR1 ;[133] (T1,Q1/T1) Use GOSPRL routine for rest
SUBTTL Logging -- GOSPR (SJPRI% JSYS)
;[133] Logging routine for GOSPR.
;[133] Called with
;[133] T1/ pointer to text log buffer
;[133] Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;[133] P1/ offset into function tables
;[133] P2/ FUNCTB bits from tables (FU%xxx)
;[133] P3/ offset for user profile tables
;[133] P4/ USRPRO profile bits for this user (US%xxx)
;[133] Returns +1 always, T1/ updated text log buffer pointer
GOSPRL: MOVE T3,.GEST1(Q1) ;[133] Load the fork handle
HRROI T2,[ASCIZ/, fork /] ;[133] Load the label to it
CALL OLOCT ;[133] Output fork handle first
;[133] Output runtime percent, system bit, and run queues for GOSJPL & GOSPRL.
GOSPR1: LDB T3,[POINTR .GEST2(Q1),JP%RTG] ;Load runtime guarantee
IFN. T3 ;[133] Is it set?
HRROI T2,[ASCIZ/ guarantee /] ;[133] Label it with this
CALL OLDEC ;[133] (T1,T2,T3/T1) Send out the percentage
ENDIF. ;[133] End of percentage output code
MOVE T3,.GEST2(Q1) ;[133] Load user's AC2 again
HRROI T2,[ASCIZ/ system-priority/] ;[133] Load text for JP%SYS
TXNE T3,JP%SYS ;[133] Is the system bit on?
CALL ISOUT ;[133] (T1,T2/T1) Yes, indicate so
LDB T3,[POINTR .GEST2(Q1),JP%MNQ] ;Load minimum queue
IFN. T3 ;[133] Is it set?
SOJ T3, ;[133] Yes, it was specified as desired queue+1
HRROI T2,[ASCIZ/ min-Q /] ;[133] Label it with this
CALL OLDEC ;[133] (T1,T2,T3/T1) Send out the min queue
ENDIF. ;[133] End of min queue output code
LDB T3,[POINTR .GEST2(Q1),JP%MXQ] ;Load max queue
IFN. T3 ;[133] Is it set?
SOJ T3, ;[133] Yes, it was specified as desired queue+1
HRROI T2,[ASCIZ/ max-Q /] ;[133] Label it with this
CALL OLDEC ;[133] (T1,T2,T3/T1) Send out the max queue
ENDIF. ;[133] End of max queue output code
RET ;[133] Return with logging done
SUBTTL Logging -- GOUSR (User test function)
;New DEC-defined functions should be added before this function.
;This is the logging routine for the test user function.
;Called with
; T1/ pointer to text log buffer
; 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, T1/ updated text log buffer pointer
GOUSRL: RET ;Just return, no additional data needed today
SUBTTL Logging -- Logging only if needed
;This is a policy routine that is called after log text is constructed, sends
;it only if needed.
;Returns +1 always.
USRLOG: HRROI T1,TEXTBU ;Point to text buffer
TXNE P2,FU%LOG ;Log this function?
CALL SENLOG ;(T1/) Yes, send text buffer to log file
TXNE P2,FU%CON ;Send to console?
CALL PTEXT ;(/) Print text buffer on terminal
RET ;Return to ACJDEC
SUBTTL Policy
;For each access control function defined in ACJSYM, there will be two routines
;in this module that the ACJDEC module will call. The names are based on the
;names of the functions (GOxxx). The test routine (GOxxxT) will perform the
;policy checks associated with the function.
;Each test routine will be called with the following ACs set up:
; 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)
;All of those ACs are preserved by the test routines.
;The test routine is only called when the bit FU%POL is set in the function
;bits (FUNCTB indexed by function offset, also carried in P2).
;If logging of particular status strings is wanted, the test routine should
;light FL%DEN ("[Denied]"), FL%UNU ("[Unusual]"), or FL%FAI ("[Failed]") in F
;by calling SETDEN, SETUNU, or SETFAI.
;If it is desired for logging to be disabled, the routine can clear the FU%LOG
;and or the FU%CON bits in P2.
;The test routine will return +1 to deny access and +2 to allow access.
SUBTTL Policy -- GOASD (ASND%)
;Test routine for GOASD.
;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 to deny, +2 to allow
;We are called by the monitor for each ASND%.
;Only allow Wheel or Operator to assign MTA devices.
GOASDT: HLRZ T1,.GEADD(Q1) ;Load the device type
CAIE T1,.DVDES+.DVMTA ;Magtape device?
RETSKP ;Nope, allow it always
CALL CHKWOP ;(/) Wheel or operator?
RETSKP ;Yes, allow always
CALLRET SETDEN ;(/) Nope deny assignment of MTA devices
SUBTTL Policy -- GOCAP (EPCAP%)
;Test for change of capabilities.
;Enabling WHEEL or OPERATOR is only allowed if
; User is not on a TCP line
; User is detached
; User is not batch only
; It is prime time or non-prime time and user is in table
;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 to deny, +2 to allow
;The monitor calls us for each EPCAP%. We disallow setting of WHEEL or
;OPERATOR on during non-prime time unless the user has been allowed to.
GOCAPT: MOVE T2,.GENCP(Q1) ;Get the desired capabilities
TXNN T2,SC%WHL!SC%OPR ;Wants to set WHEEL or OPERATOR?
RETSKP ;No, return and allow it
HRRZ T2,JIBLK+.JIUNO ;Load user number
JUMPE T2,RSKP ;OK to enable if not logged in yet (RMSFAL)
CALL CHKTIM ;Find out who and what time
CALLRET SETDEN ;(/) User cannot enable at this time
RETSKP ;Allow the capability setting
SUBTTL Policy -- GOCJB (CRJOB%)
;Special routine to test to allow CRJOB
;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 to deny, +2 to allow
;Monitor calls us on each and every CRJOB% JSYS call.
GOCJBT: CALL CHKWOP ;(/) Check if wheel or operator
RETSKP ;Yes, allow the CRJOB
CALLRET SETDEN ;Nope, deny the CRJOB
SUBTTL Policy -- GOLOG (LOGIN%)
;Routine to test for logins.
;Called with CJBLK set up with controlling job information and
; 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 to deny, +2 to allow
;The monitor calls us for each attempted LOGIN. This routine starts a spy
;fork if we are watching this user. We disallow logins if:
; Trying to LOGIN to ROOT-DIRECTORY.
; User is over quota on PS:<user>.
; Controlling job has OPERATOR caps and trying to LOGIN to WHEEL user.
; User profile specifies that user cannot LOGIN to this line type.
; WHEEL-only LOGINs are set and user is not WHEEL.
GOLOGT: HRRZ T1,JIBLK+.JIUNO ;Load the user number
CAIN T1,ROOTDN ;Is it ROOT-DIRECTORY?
CALLRET SETDEN ;(/) Yes, deny this always!
HLL T1,JIBLK+.JILNO ;Make it a directory number
MOVEM T1,JIBLK+.JILNO ; and put it back there for later
;Don't allow logins if user is over quota on PS:<user>.
GTDAL% ;Get directory allocation on PS:<user>
IFNJE. ;If that worked
CAMG T2,T3 ;Pages in use more than permanent quota?
IFSKP. ;Yes, used more than permanent quota
SKIPGE T1,JIBLK+.JITNO ;Get user's terminal number
CALLRET SETDEN ;(/) Detached, so don't send message
TXO T1,.TTDES ;Make TTY designator
HRROI T2,[ASCIZ/LOGIN denied because your login directory is currently over quota.
You cannot login to the system until this has been fixed.
/] ;The message to send
TTMSG% ;Let'em have it
ERNOP. ;Don't care if there was an error today
CALLRET SETDEN ;(/) Deny the login
ENDIF. ;End of quota check
ENDIF. ;End of GTDAL worked code
;Get the capability mask of the user attempting to LOGIN.
MOVE T1,JIBLK+.JILNO ;We need to get the capability mask of user
MOVEI T2,GTDIRB ;Point to storage
SETZ T3, ;No password please
GTDIR% ;Get directory info
ERJMP SETDEN ;(/) If owie directory deny the login
;Make sure any jobs under PTYCON don't get any more caps than the controlling
;job (don't allow job with OPERATOR to login to job with WHEEL).
SKIPL JIBLK+.JIBAT ;Is this a batch job?
SKIPGE JIBLK+.JICPJ ;Is there a controlling job?
IFSKP. ;It is not a controlled job nor is it batch
SKIPN T1,CJBLK+.JILNO ;Controlling job's login directory number
CALLRET SETDEN ;(/) Not available, deny the login
MOVEI T2,GTDIRC ;Point to storage
SETZ T3, ;No password please
GTDIR% ;Get directory info on controlling job
ERJMP SETDEN ;(/) Deny the login if this fails
MOVE T1,GTDIRC+.CDPRV ;Get capability word
TXNE T1,SC%WHL ;Is it a wheel job?
IFSKP. ;Controlling job is not a wheel job
MOVE T1,GTDIRB+.CDPRV ;Get capability word for login directory
TXNE T1,SC%WHL ;Non wheel controlling trying to get wheel?
CALLRET SETDEN ;(/) Yes, deny this
ENDIF. ;End of non-wheel controlling job check
ENDIF. ;End of controlling job check
;See if user profile allows LOGIN to this line type.
MOVEI T4,JIBLK ;Point to the job block, it has line type
CALL FNDLIN ;(T4/T3,T4) Find line type today
TDNN P4,DENUSB(T3) ;Can user even login to this line type?
CALLRET SETDEN ;(/) No, deny access
;See if wheel only logins are set. If so only let user LOGIN if he is WHEEL.
MOVE T1,DENTMN(T3) ;Load type of line
TMON% ;Peek at monitor
IFNJE. ;If no error on that one
IFN. T2 ; and if wheel logins are set today
MOVE T1,GTDIRB+.CDPRV ;Get capability word for login directory
TXNN T1,SC%WHL ;Is this user a wheel?
CALLRET SETDEN ;(/) Non wheel, deny the login
ENDIF. ;End of wheel logins set check
ENDIF. ;End of wheel login TMON worked code
;See if user needs to be spyed on and if so set up spy fork.
TXNE P4,US%SPY ;Need to spy on this user
SKIPGE ARGBLK+.RCTER ;Yes, are we detached?
RETSKP ;No need to spy on this job
MOVE T1,JIBLK+.JIUNO ;Load user number next
HRRZ T2,JIBLK+.JIJNO ;Load job number
CALL SPYON ;(T1,T2/) Start up a logging fork
JFCL ;Proably we are already watching her
CALLRET SETUNU ;Say this was unusual and return +2
SUBTTL Policy -- GOCFK (CFORK%)
;Test routine for GOCFK.
;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 to deny, +2 to allow
;Monitor calls us for each CFORK% that creates more than FKCNT forks.
GOCFKT: RETSKP ;Just allow always
SUBTTL Policy -- GOTBR (MTOPR% to set Terminal Baud Rate)
;Test routine for GOTBR.
;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 to deny, +2 to allow
;Monitor calls us for each attempt to set terminal speed. Disallow the setting
;of the speed unless wheel or operator.
GOTBRT: CALL CHKWOP ;(/) See if wheel or operator
RETSKP ;Yes, allow
CALLRET SETDEN ;(/) No, deny
SUBTTL Policy -- GOLGO (LGOUT%)
;Test routine for logouts.
;Does not allow users to logout if they are over quota.
;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 to deny, +2 to allow
;The monitor calls this routine each and every time a job wants to logout.
GOLGOT: SKIPL .GERLG(Q1) ;Job number logging out, -1 if caller
RETSKP ;Logging out another job always works
MOVE T1,.GEUSD(Q1) ;Get used pages in directory
MOVE T2,.GEQUO(Q1) ;Get user's quota
CAMG T1,T2 ;More used than quota?
RETSKP ;No, then LOGOUT is OK
SKIPGE T1,JIBLK+.JITNO ;Get terminal number
CALLRET SETDEN ;(/) Detached, deny the request anyway
TXO T1,.TTDES ;Make TTY device designator
HRROI T2,[ASCIZ/LOGOUT denied because your login directory is currently over quota.
Please get under quota before logging out.
/]
TTMSG% ;Send to user
ERNOP. ;Ignore errors, user will figure it out
CALLRET SETDEN ;(/) Deny the request returning +1
SUBTTL Policy -- GOENQ (ENQC% ENQ Quota Set)
;Test routine for GOENQ.
;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 to deny, +2 to allow
;Monitor calls us only if setting ENQ quota (ENQC% function .ENQCC) and the
;user is not wheel or operator.
GOENQT: CALL CHKWOP ;(/) Check if wheel or operator
RETSKP ;Yes, allow it
CALLRET SETDEN ;(/) Just say no
SUBTTL Policy -- GOCRD (CRDIR%)
;Routine to test for CRDIR.
;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 to deny, +2 to allow
;The monitor calls us on each and every CRDIR% JSYS. Note that if an older
;monitor is being used, the logging routine tried to steal the argument block.
GOCRDT: SETZM GTDIRB ;First, clear first word of the block
MOVE T1,[GTDIRB,,GTDIRB+1] ;Load a BLT pointer to it
BLT T1,GTDIRB+.CDDGP ;Clear the entire block
;Try to get the directory number of this directory, this will fail if this is a
;new directory. The remembered directory number (GTDIRB+.CDNUM) will be zero
;if new directory.
MOVX T1,RC%EMO ;Exact match only this time please
HRROI T2,.GEDIR(Q1) ;Point to the directory we are changing
RCDIR% ;Get the directory string to a directory number
ERSKP. ;Skip if error in the RCDIR
TXNE T1,RC%NOM ;Did we get a "no match" from the monitor?
SETZ T3, ;Either RCDIR failed or we got no match
MOVEM T3,GTDIRB+.CDNUM ;Save directory number or 0 if new directory
;Now try to get the status of this structure (domestic or foreign) for later.
MOVX T1,<.MSGST+1,,.MSGSS> ;Set two word arg block, get str status fcn
MOVEI T2,MSTRB ;Argument block starts here
HRROI T3,.GEDIR(Q1) ;Use directory name furnished by monitor
MOVEM T3,MSTRB+.MSGSN ;Save pointer to structure name
MSTR% ;Get structure status
ERJMP SETDEN ;(/) If error, deny the request
;It is very important to not allow <ROOT-DIRECTORY> to have a password, user
;groups, directory groups, or be non-files-only for security reasons. You
;don't want anyone to ACCESS or CONNECT the <ROOT-DIRECTORY> or LOGIN to
;ROOT-DIRECTORY, as owner access to the ROOT-DIRECTORY means any directory is
;yours to change.
HRRZ T3,GTDIRB+.CDNUM ;Load the directory number today
CAIE T3,ROOTDN ;Is it <ROOT-DIRECTORY> for this structure?
IFSKP. ;Yes it is the root directory, special checks
TXO F,FL%UNU ;Indicate request is unusual
MOVE T2,.GECFL(Q1) ;Load user's AC2 (change bits) for this CRDIR
MOVE T3,.GECAB+.CDMOD(Q1) ;Load the bits user wants to change
TXNE T2,CD%MOD ;Changing mode word?
TXNE T3,CD%DIR ;Yes, making it non-files-only?
CAIA ;Not setting mode word or setting files-only
CALLRET SETDEN ;Setting non-files-only, deny this request
TXNE T2,CD%PSW ;Setting a password?
SKIPN .GECAB+.CDPSW(Q1) ;Yes, is there a password supplied?
CAIA ;Not setting password or setting null one
CALLRET SETDEN ;Setting non null password, deny this request
TXNE T2,CD%UGP ;Setting user groups?
SKIPN .GECAB+.CDUGP(Q1) ;Yes, is there a user group list supplied?
CAIA ;Not setting user groups or setting null list
CALLRET SETDEN ;Setting non null group list, deny this request
TXNE T2,CD%DGP ;Setting directory groups?
SKIPN .GECAB+.CDDGP(Q1) ;Yes, is there a directory group list?
CAIA ;Not setting dir groups or setting null list
CALLRET SETDEN ;Setting non null group list, deny this request
ENDIF. ;End of <ROOT-DIRECTORY> policy code
;If structure is FOREIGN, we don't care what happens to it (a mounted BS: and
;PS: cannot be made FOREIGN). If structure is DOMESTIC, check capabilites and
;if a enabled WHEEL, let anything happen.
MOVE T2,MSTRB+.MSGST ;Load structure status word
TXNE T2,MS%DOM ;Is structure domestic?
CALL CHKWHL ;(/) Is this user a wheel?
JRST GOCRD2 ;[130] Str foreign or user is enabled wheel
MOVE T4,.GECFL(Q1) ;No, get user's AC2 (change bits) from CRDIR
;The structure is DOMESTIC and the user is not a WHEEL. The directory mode
;(SECURE and FILES-ONLY) and capabilities (WHEEL and OPERATOR and
;SEMI-OPERATOR) cannot be changed except by WHEELs on DOMESTIC structures. New
;directories on domestic structures must be NO SECURE and FILES-ONLY.
SKIPN T1,GTDIRB+.CDNUM ;Get directory number back, skip if new dir
IFSKP. ;If an old cirectory
MOVEI T2,GTDIRB ;Point to storage
SETZ T3, ;No password please
GTDIR% ;Get directory info
ERJMP SETDEN ;(/) Errors? Deny the CRDIR
ELSE. ;OK, the directory does not exist
TXNN T4,CD%MOD ;If a new directory, we must be setting mode
CALLRET SETDEN ;Not setting mode bits, dir is non-files-only
ENDIF. ;OK, we have the information we need now
MOVE T3,.GECAB+.CDMOD(Q1) ;Get directory mode bits
MOVE T2,T3 ;Get a copy of the current mode bits
XOR T3,GTDIRB+.CDMOD ;Light bits where changes are being made
TXNN T4,CD%MOD ;Are changing mode bits?
IFSKP. ;Yes
TXNE T3,CD%SEC ;Yes, changing secure?
TXNN T2,CD%SEC ; and making it secure now?
CAIA ;Not changing mode or not secure directory
CALLRET SETDEN ;Yes, deny the request
TXNE T3,CD%DIR ;Yes, changing files only?
TXNE T2,CD%DIR ; and making it non files only now?
CAIA ;Not changing mode or not secure directory
CALLRET SETDEN ;Yes, deny the request
ENDIF. ;End of mode bit checks
MOVE T3,.GECAB+.CDPRV(Q1) ;Get capability bits
XOR T3,GTDIRB+.CDPRV ;Light bits in T3 where changes were made
TXNE T4,CD%PRV ;Changing capability bits?
TXNN T3,SC%WHL!SC%OPR!SC%SEM ;Changing wheel or operator or big-rigs?
JRST GOCRD2 ;[130] No, so allow the request
CALLRET SETDEN ;Setting wheel or operator, deny
;[130] Attempts to kills a directory will fail with "Directory file is mapped"
;if we leave an entry in the directory cache because of the RCDIR and/or CRDIR
;above. So, when indicating success we coma here to insure that directory
;cache is cleared if a CD%DEL is set.
GOCRD2: MOVE T2,.GECFL(Q1) ;[130] Load user's AC2 (CRDIR change bits)
TXNN T2,CD%DEL ;[130] Trying to murder this directory?
RETSKP ;[130] No let's have a skip return
HRROI T2,[ASCIZ/PS:<ROOT-DIRECTORY>/] ;[130] I hope this dir exists
MOVX T1,RC%EMO ;[130] Exact match only will do for RCDIR
RCDIR% ;[130] Get rid of dir cache entry
ERNOP. ;[130] I don't care (that much) if RCDIR fails
RETSKP ;[130] Skip return always
SUBTTL Policy -- GOSMT (MSTR% to Increment Mount Count)
;Test routine for GOSMT.
;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 to deny, +2 to allow
;Monitor always calls us for each and every increment mount count function.
GOSMTT: RETSKP ;Just allow always
SUBTTL Policy -- GOMDD (MDDT%)
;Test routine for MDDT entry.
;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 to deny, +2 to allow
;Monitor calls us only if user has Wheel OR Operator capability. Disallow
;entering MDDT by anyone over TCP connections, non-wheels, anyone on a PTY.
GOMDDT: CALL CHKWHL ;(/) Is this a wheel?
RETSKP ;Yes, allow the entry into MDDT
CALLRET SETDEN ;(/) Nope, deny the request
SUBTTL Policy -- GOCLS (SKED% to set scheduler class)
;Test routine for GOCLS.
;Only allows wheel or operator to set job's scheduler class.
;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 to deny, +2 to allow
;Monitor calls us for all job class setting, but if a user is not wheel or
;operator and is trying to set another job's class, we will not be consulted
;and the user will get a CAPX1 error.
GOCLST: CALL CHKWOP ;(/) See if wheel or operator
RETSKP ;Yes, allow
CALLRET SETDEN ;(/) No, deny
SUBTTL Policy -- GOCL0 (Class Set at Login)
;Test routine for GOCL0.
;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 to deny, +2 to allow
;Monitor calls us each time a job logs in only if the class scheduler is on and
;class assignments are by the policy program (us). A SKED% JSYS is used to set
;the job in a particular class as specified by the user profile word.
GOCL0T: LDB T3,[POINTR P4,US%CLA] ;Load class
JUMPE T3,RSKP ;Skip return (do nothing) if zero
MOVEI T1,SKEDB+.SAJCL+1 ;Load size of argument block
HRRZ T2,JIBLK+.JIJNO ;Load job number
DMOVEM T1,SKEDB+.SACNT ;Set up count and job number (.SAJOB)
MOVEM T3,SKEDB+.SAJCL ;Store class of job also
MOVEI T1,.SKSCJ ;Set job scheduler class function
MOVEI T2,SKEDB ;Point to block
SKED% ;Do it
ERJMP SETUNU ;Unusual if failed
RETSKP ;Just allow always
SUBTTL Policy -- GOMTA (MTA Access)
;Test routine for GOMTA.
;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 to deny, +2 to allow
;Monitor calls us for labelled MTA access where the label type is TOPS-20 and
;access is by non-owner and there is a protection failure, or if ANSI labels
;and volume accessability is not "full", or if EBCDIC labels and accessability
;byte is from 1 to 3 inclusive. A MTU% JSYS can be used to check the labels on
;the tape for user access to labelled tape.
GOMTAT: RETSKP ;Just allow always
SUBTTL Policy -- GOACC (ACCES%)
;Test code for access or connect function.
;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 to deny, +2 to allow
;The monitor calls us only if the user is (NOT (wheel or operator)) AND (user
;gave bad password). Therefore this request is normally always denied.
;We allow a directory's owner to connect to his/her subdirectories.
GOACCT: MOVE T1,.GOAC0(Q1) ;Load the first user AC which are the bits
TXNN T1,AC%CON ;Is it a connect?
CALLRET SETDEN ;(/) Nope, deny the request
MOVX T1,<2,,.MSGSS> ;Set two word arg block, get str status fcn
MOVEI T2,T3 ;Argument block starts at T3
HRROI T3,DIRBLK ;Use directory block set up by GOACCL
MSTR% ;Get structure status
ERJMP SETDEN ;(/) If error, deny the request
TXNN T4,MS%DOM ;Is structure domestic?
CALLRET SETDEN ;(/) Nope, deny the connect
;User is attempting to connect to a directory on a domestic structure.
;If the directory is a subdirectory of the user's home directory allow it.
;We know that USRSTR/ username and DIRBLK/ directory.
MOVE T1,[POINT 7,DIRBLK] ;Point to directory block
DO. ;Loop to eat until left angly bracket
ILDB T2,T1 ;Load a character of the string
CAIN T2,74 ;Is it a left angly?
EXIT. ;Yes, get out of loop
JUMPN T2,TOP. ;Keep looping unless null seen
CALLRET SETDEN ;Deny request if can't find left angly
OD. ;Now T1 points to the directory name
MOVE T3,[POINT 7,USRSTR] ;Point to username of requestor
DO. ;Loop to see if username matches
ILDB T2,T1 ;Load a character from directory
ILDB T4,T3 ;Load a character from username
CAIN T2,(T4) ;Do they still match?
LOOP. ;Yes, loop until mismatch
OD. ;So now we have a mismatch
JUMPN T4,SETDEN ;Deny request if not at end of username
RETSKP ;Allow request
SUBTTL Policy -- GOOAD (OPENF% Assign Device)
;Test routine for GOOAD.
;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 to deny, +2 to allow
;Monitor calls us for each OPENF% JSYS that assigns a device.
;Only allow Wheel or Operator to assign MTA devices.
GOOADT: HLRZ T1,.GEADD(Q1) ;Load the device type
CAIE T1,.DVDES+.DVMTA ;Magtape device?
RETSKP ;Nope, allow it always
CALL CHKWOP ;(/) Wheel or operator?
RETSKP ;Yes, allow always
CALLRET SETDEN ;(/) Nope deny assignment of MTA devices
SUBTTL Policy -- GODNA (DECnet)
;Routine to test for DECnet access.
;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 to deny, +2 to allow
;Monitor calls us on each and every DECnet OPENF%.
GODNAT: HRRZ T2,ARGBLK+.RCCAP ;Get this set of capabilities
TRNE T2,SC%DNA ;Is the DECnet-ACCESS capability set ?
RETSKP ;Yes, allow the access
CALLRET SETDEN ;(/) Nope, deny it
SUBTTL Policy -- GOANA (Arpanet)
;Test routine for arpanet access
;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 to deny, +2 to allow
;Monitor calls us for each TCP/IP OPENF%. This routine allows access for
;users with SC%ANA capability.
GOANAT: HRRZ T2,ARGBLK+.RCCAP ;Get this set of capabilities
TRNE T2,SC%ANA ;ARPANET-ACCESS set ?
RETSKP ;Yes, allow the access
CALLRET SETDEN ;(/) Nope, deny it
SUBTTL Policy -- GOATJ (ATACH%)
;Policy control routine for attach.
;Called with TJBLK set up with target job information and
; 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 (for source job)
; P4/ USRPRO profile bits for this user (US%xxx) (for source job)
;Returns +1 to deny, +2 to allow
;Monitor calls us for each ATACH%. We have to find the proper target job's
;user profile first. We disallow the attach if:
; Batch job (batch cannot attach to anything).
; User profile says that target user cannot LOGIN to source line type.
; WHEEL-only LOGINs are set and target job is not WHEEL user.
; Target job is batch job and user doing attach is not WHEEL.
; Job has OPERATOR caps and target job is WHEEL user.
GOATJT: SKIPGE JIBLK+.JIBAT ;Is this a batch job?
CALLRET SETDEN ;(/) Yes, batch cannot attach anywhere
;The source job's user profile has been selected, however we really want the
;profile of the target job's user, so we have to get the target's username.
SETZ P3, ;Load default which is user not found in table
MOVE P4,USEDEF ;Load default bits to allow logins at least
HRROI T1,DIRBLK ;Point to user string storage area
MOVE T2,TJBLK+.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?
RETSKP ;[131] (/) OK to allow this for FTPSRT
;Now we try to find the target job's user profile in our database.
MOVEI T1,USRTBL ;Point to the user profile table
HRROI T2,DIRBLK ;Point to string to compare against
CALL WTBLUK ;(T1,T2/T1,T2,T3) Do a wild TBLUK function
TXNE T2,TL%NOM ;No match?
IFSKP. ;Nope, a match
HRRZ P3,(T1) ;Return the offset into USRPRO and such tables
MOVE P4,USRPRO(P3) ;Reload the profile bits
ENDIF. ;Now we have the proper user profile bits
;User profile bits in P3 and P4 are now for target user. Now get the
;capability mask of the target job's username.
MOVE T1,TJBLK+.JILNO ;We need to get the capability mask of user
MOVEI T2,GTDIRT ;Point to storage for the directory info
SETZ T3, ;No password please
GTDIR% ;Get directory info
ERJMP SETDEN ;(/) If owie directory deny the attach
;See if user profile allows LOGIN to line type that the ATACH is being done on.
MOVEI T4,JIBLK ;Point to the job block
CALL FNDLIN ;(T4/T3,T4) Find line type today
TDNN P4,DENUSB(T3) ;Can user even login to this line type?
CALLRET SETDEN ;(/) No, deny access
;See if WHEEL-only LOGINs are set. If so only let user attach if target wheel.
MOVE T1,DENTMN(T3) ;Load type of line
TMON% ;Peek at monitor
IFNJE. ;If no error on that one
IFN. T2 ; and if wheel logins are set today
MOVE T1,GTDIRT+.CDPRV ;Get capability word for login directory
TXNN T1,SC%WHL ;Is this user a wheel?
CALLRET SETDEN ;Non wheel, deny the login
ENDIF. ;End of wheel logins set check
ENDIF. ;End of wheel login TMON worked code
;A job with wheel can attach to anything. The monitor will allow an enabled
;user with operator to attach to a user with wheel without a password - we deny
;this. (If a non-enabled user with operator tries to attach to a user with
;wheel and gets the password right we will let the attach happen.) The monitor
;will allow a job controlled by user with operator to attach to a user with
;wheel without a password - we deny this.
CALL CHKWHL ;(/) Skip if not wheel
IFSKP. ;Job doing that ATACH is not wheel
MOVE T1,GTDIRT+.CDPRV ;Get capability word login of target directory
TXNN T1,SC%WHL ;Is this target job a wheel user?
IFSKP. ;Yes, target job is wheel user
CALL CHKWOP ;(/) Is it enabled operator trying to attach?
CALLRET SETDEN ;(/) Yes, don't allow operator attach to wheel
SKIPGE T1,JIBLK+.JICPJ ;Is there a controlling job?
IFSKP. ;Yes there is a controlling job
MOVEI T4,CJBLK ;Point to controlling job information block
CALL GETINF ;(T1,T4/T4) Get information about controller
CALLRET SETDEN ;(/) If owie, deny the attach
MOVE T1,CJBLK+.JILNO ;Get controlling job's login directory
MOVEI T2,GTDIRC ;Point to storage for that directory
SETZ T3, ;No password please
GTDIR% ;Get directory info on controlling job
ERJMP SETDEN ;(/) Deny the login if this fails
MOVE T1,GTDIRC+.CDPRV ;Get capability word of controller job
TXNE T1,SC%WHL ;Is it a wheel user controlling source job?
CALLRET SETDEN ;(/) Nope, don't allow the attach
ENDIF. ;End of controlling job check
ENDIF. ;End of target job is a wheel user checks
ENDIF. ;End of source job is not enabled wheel checks
RETSKP ;Allow the attach
SUBTTL Policy -- GOINF (INFO%)
;Test routine for GOINF.
;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 to deny, +2 to allow
;Monitor calls us for all INFO% JSYS except when it thinks the INFO% comes from
;a GALAXY component.
GOINFT: RETSKP ;Just allow always
SUBTTL Policy -- GOLAT (LATOP%)
;Test routine for GOLAT.
;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 to deny, +2 to allow
;Monitor calls us on all .LARHC (request host connect) functions only.
GOLATT: CALL CHKWOP ;(/) Wheel or operator?
RETSKP ;Yes, allow
CALLRET SETDEN ;No, deny it
SUBTTL Policy -- GOCTM (CTERM Connection)
;Test routine for GOCTM.
;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 to deny, +2 to allow
;Monitor calls us from job 0 on each CTERM connection. The nodename and/or
;user name can be checked to allow access to this system. NOTE: a hostile user
;program can send over any source data that it wants to in the CTERM connect
;message.
GOCTMT: RETSKP ;Just allow always
SUBTTL Policy -- GOTTM (TTMSG%)
;Test routine for GOTTM.
;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 to deny, +2 to allow
;Monitor calls this routine for all TTMSG% unless TTMSG% is being done by the
;monitor (previous context is monitor).
GOTTMT: CALL CHKWOP ;(/) Check wheel or operator
RETSKP ;Allow it
CALLRET SETDEN ;(/) Deny it
SUBTTL Policy -- GOSMN (SMON%)
;Test routine for GOSMN.
;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 to deny, +2 to allow
;Monitor calls this routine for SMON% functions not done by Wheel or Operator.
GOSMNT: CALL CHKWOP ;(/) Check if wheel or operator
RETSKP ;Yes, allow it
CALLRET SETDEN ;(/) Just say no
SUBTTL Policy -- GOHSY (HSYS%)
;Test routine for GOHSY.
;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 to deny, +2 to allow
;Monitor calls us for each HSYS% JSYS.
GOHSYT: MOVE T1,ARGBLK+.RCCAP ;Load user's capabilities
TXNE T1,SC%WHL!SC%OPR!SC%MNT ;Wheel or operator or maintenance?
RETSKP ;Just allow it then
CALLRET SETDEN ;(/) Nope
SUBTTL Policy -- GOSGT (SYSGT%)
;Test routine for GOSGT.
;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 to deny, +2 to allow
;Monitor calls us for each SYSGT% when the previous context is not monitor.
GOSGTT: RETSKP ;Just allow always
SUBTTL Policy -- GOGTB (GETAB%)
;Test routine for GOGTB.
;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 to deny, +2 to allow
;Monitor calls us for each GETAB% when the previous context is not monitor.
GOGTBT: RETSKP ;Just allow always
SUBTTL Policy -- GOOPN (OPENF% with FB%SEC)
;Test routine for GOOPN.
;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 to deny, +2 to allow
;Monitor calls us for each OPENF% of a file with FB%SEC set and previous mode
;is not monitor mode.
GOOPNT: MOVE T2,.GEOAC(Q1) ;Load open bits for this access
MOVX Q2,SF.REA ;Assume read access
TXNE T2,OF%WR ;Write access?
MOVX Q2,SF.WRI ;Yes, write access
TXNE T2,OF%APP ;Append access?
MOVX Q2,SF.APP ;Yes, append access
CALL SECFIL ;(Q1,Q2/) Check access to this file
CALLRET SETDEN ;Denied access
RETSKP ;Allow the access to the file
SUBTTL Policy -- GORNF (RNAMF% with FB%SEC)
;Test routine for GORNF.
;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 to deny, +2 to allow
;Monitor calls us for each RNAMF% of a file with FB%SEC set and previous mode
;is not monitor mode.
GORNFT: MOVX Q2,SF.REN ;Trying to get rename access
CALL SECFIL ;(Q1,Q2/) Check access to this file
CALLRET SETDEN ;Denied access
RETSKP ;Allow the access to the file
SUBTTL Policy -- GODLF (DELF%/DELNF% with FB%SEC)
;Test routine for GODLF.
;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 to deny, +2 to allow
;Monitor calls us for each DELF%/DELNF% of a file with FB%SEC set and previous
;mode is not monitor mode.
GODLFT: MOVX Q2,SF.DEL ;Trying to get delete access to this file
CALL SECFIL ;(Q1,Q2/) Check access to this file
CALLRET SETDEN ;Denied access
RETSKP ;Allow the access to the file
SUBTTL Policy -- GOTLK (TLINK%)
;Test routine for GOTLK.
;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 to deny, +2 to allow
;Monitor calls us for each TLINK% JSYS when previous mode is not monitor mode.
GOTLKT: TXNE P4,US%SPY ;Is this user being spyed upon?
CALLRET SETUNU ;(/) This is unusual, log it so please
RETSKP ;Just allow always
SUBTTL Policy -- GOCRL (CRLNM%)
;Test routine for GOCRL.
;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 to deny, +2 to allow
;Monitor calls us for each CRLNM% JSYS functions .CLNS1, .CLNSA, or .CLNSY and
;user is not Wheel or Operator.
GOCRLT: CALL CHKWOP ;(/) Wheel or operator?
RETSKP ;Just allow it
CALLRET SETDEN ;(/) Deny it
SUBTTL Policy -- GODTC (DTACH%)
;Test routine for GODTC.
;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 to deny, +2 to allow
;Monitor calls us for all DTACH% JSYS.
GODTCT: RETSKP ;Just allow always
SUBTTL Policy -- GOCFD (CHFDB% of FB%SEC)
;Test routine for GOCFD.
;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 to deny, +2 to allow
;Monitor calls us for each CHFDB% of a file with FB%SEC set and previous mode
;is not monitor mode.
;There are currently three special cases of changing FB%SEC that are always
;allowed without logging in order to preserve the current and seperate actions
;of files that aren't secure.
;Special case 1: CHFDB to clear FB%SEC on a totally new file type always works
;with no logging. This allows nosecure files to be created in a directory
;without some kind of ACCESS.CONTROL keywords (for example DUMPER restoring
;nosecure files) causing lots of unusual logging on files that are not intended
;to be secure.
;Special case 2: CHFDB not really changing SECURE on new file generation always
;works with no logging. This allows new generations of files to be copied even
;if stupid programs (such as FCOPY and DUMPER) set the .FBCTL word with FB%SEC
;the same as it is now. A case of this is when DUMPER restores new generations
;of nosecure files.
;Special case 3: If access is allowed because there is no ACCESS.CONTROL file
;and the user is trying to clear FB%SEC, let this happen wihout logging. This
;happens when an existing nosecure file is overwritten with new contents and
;the program is attempting to clear FB%SEC. A case of this is when DUMPER is
;restoring (overwriting) a nosecure MAIL.TXT.1.
;If the file already exists, always consult ACCESS.CONTROL.
GOCFDT: MOVE T1,.GESFS(Q1) ;Load the new FBCTL word contents
TXNN T1,FB%NXF ;Not yet closed file?
JRST GOCFDF ;Nope, old file, always consult access.control
;We now will try to lookup the highest existing generation of the file to see
;what its FB%SEC bit is. If setting this new generation of the file to the
;same as that of the currently highest generation we consider this a special
;case.
HRROI T1,DIRBLK ;Point to temp area
HRROI T2,.GEFIL(Q1) ;Point to the filename
CALL ISOUT ;(T1,T2/T1) Copy it
DO. ;Look backwards for last dot
SETO T2, ;Load a -1
ADJBP T2,T1 ;Back up byte pointer by one
MOVE T1,T2 ;Copy the byte pointer back then
LDB T2,T1 ;I wish that there was a DLDB instruction
CAIE T2,"." ;Is this a dot yet?
LOOP. ;Nope
OD. ;Now T1 points to last dot in string
SETZ T2, ;Load a null
DPB T2,T1 ;Remove generation number from filename
MOVX T1,GJ%OLD!GJ%SHT ;Short form old file
HRROI T2,DIRBLK ;Point to filename
GTJFN% ;Try to get a JFN, should be fast
ERJMP GOCFDS ;Totally non existant file is special
MOVE Q3,T1 ;Save JFN
MOVX T2,<1,,.FBCTL> ;Just need the one word
MOVX T3,T4 ;Return the one word here
SETZ T4, ;In case GTFDB fails, file is not sec
GTFDB% ;Get that word from the FDB
ERSKP. ;Skip if error in that call
XOR T4,.GESFS(Q1) ;Now you find the bits that changed in T4
MOVE T1,Q3 ;Load the JFN back
RLJFN% ;Dump that JFN
ERNOP. ;Ignore errors at this point
TXNN T4,FB%SEC ;Changing FB%SEC?
JRST GOCFDS ;No changes, a special case that succeeds
; JRST GOCFDF ;Changing FB%SEC, look at ACCESS.CONTROL
;Here when we must check ACCESS.CONTROL, looking for [NO]SECURE access.
GOCFDF: MOVE T1,.GESFS(Q1) ;Load the new FBCTL word contents
MOVX Q2,SF.SEC ;Assume setting secure function
TXNN T1,FB%SEC ;Is the user trying to set or clear?
MOVX Q2,SF.NOS ;Clear, load the nosecure function
CALL SECFIL ;(Q1,Q2/) Check access to the secure bit
CALLRET SETDEN ;Denied access to secure bit
;If access is allowed because there is no ACCESS.CONTROL file and the user is
;trying to clear FB%SEC, let this happen wihout logging.
MOVE T1,.GESFS(Q1) ;Reload the flags
TXNE F,FL%UNU ;Did it succeed because no access.control?
TXNE T1,FB%SEC ;Was he trying to set or clear?
RETSKP ;Making secure or there was an access.control
;Here to clear logging for special cases that always succeed. Remove the TXZ
;instruction to always log each attempt of setting or clearing FB%SEC.
GOCFDS: TXZ P2,FU%LOG ;Clearing secure on file without access.control
RETSKP ;Allow the access
SUBTTL Policy -- GOGTD (Get directory information)
;[126] Test routine for GOGTD.
;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 to deny, +2 to allow
;Monitor calls us for all GTDIR% JSYS.
GOGTDT: RETSKP ;[126] Just allow and log always
SUBTTL Policy -- GOSTD (Set time)
;[126] Test routine for GOSTD.
;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 to deny, +2 to allow
;Monitor calls us for all STAD% JSYS.
GOSTDT: RETSKP ;[126] Just allow and log always
SUBTTL Policy -- GODSK (DSKOP% JSYS)
;[133] Test routine for GODSK.
;[133] Called with
;[133] Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;[133] P1/ offset into function tables
;[133] P2/ FUNCTB bits from tables (FU%xxx)
;[133] P3/ offset for user profile tables
;[133] P4/ USRPRO profile bits for this user (US%xxx)
;[133] Returns +1 to deny, +2 to allow
;[133] Monitor calls us for each DSKOP% JSYS.
GODSKT: MOVE T2,.GEST2(Q1) ;[133] Load the control flags,,word count
TXNE T2,DOP%WR ;[133] Write as opposed to read?
CALLRET SETUNU ;[133] (/) This is unusual, allow it
RETSKP ;[133] Just allow and log always
SUBTTL Policy -- GOSJP (SJPRI% JSYS)
;[133] Test routine for GOSJP.
;[133] Called with
;[133] Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;[133] P1/ offset into function tables
;[133] P2/ FUNCTB bits from tables (FU%xxx)
;[133] P3/ offset for user profile tables
;[133] P4/ USRPRO profile bits for this user (US%xxx)
;[133] Returns +1 to deny, +2 to allow
;[133] Monitor calls us for each SJPRI% JSYS not executed from monitor context.
GOSJPT: RETSKP ;[133] Just allow and log always
SUBTTL Policy -- GOSPR (SPRIW% JSYS)
;[133] Test routine for GOSPR.
;[133] Called with
;[133] Q1/ ARGBLK+.RCARA ("user" argument block for .Gxxxx offsets)
;[133] P1/ offset into function tables
;[133] P2/ FUNCTB bits from tables (FU%xxx)
;[133] P3/ offset for user profile tables
;[133] P4/ USRPRO profile bits for this user (US%xxx)
;[133] Returns +1 to deny, +2 to allow
;[133] Monitor calls us for each SPRIW% JSYS.
GOSPRT: RETSKP ;[133] Just allow and log always
SUBTTL Policy -- GOUSR (User test function)
;NOTE: new DEC functions should be added immediately before this function.
;Test routine for GOUSR, which is the user test function. All user
;functions (codes 400000-777777) should appear immediately after this one.
;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 to deny, +2 to allow
;Monitor calls us for each user function (function 400000) We always allow it.
GOUSRT: RETSKP ;Allow the function to succeed
SUBTTL Policy -- Deny by Terminal Line Type
;Test routine for ACJUSR implemented controls (like DENY-xxx keywords)
;Called after GOxxxT routines 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 to deny, +2 to allow
USRPOL: MOVEI T4,JIBLK ;Point to job's information block
CALL FNDLIN ;(T4/T3,T4) Get index into deny tables
TDNE P2,DENFUB(T3) ;Is function denied for this line type?
CALLRET SETDEN ;(/) Deny access
RETSKP ;Function is OK for this line type
SUBTTL Subroutines -- Find Line Type Entry
;Routine called to find an entry in the deny line type table.
;Called with T4/ address of job information block
;Returns +1 always, T3/ index into tables.
FNDLIN: SAVEAC <Q1,Q2,Q3> ;Save the Qs
LDB Q1,[POINT 9,NTINFB+.NWTTF(T4),17] ;(no symbol for this field)
MOVE Q2,MORSPW(T4) ;Load speed word for this terminal
MOVE Q3,.JITNO(T4) ;Load terminal number for this terminal
MOVSI T3,-<DENSIZ-1> ;Load -<number in table-1>,,0 for AOB pointer
DO. ;Until line type found
XCT DENCHK(T3) ;(Q1,Q2,Q3/) Is it a line match?
AOBJN T3,TOP. ;Nope, keep looking
OD. ;End of look checking for line type
RET ;Return with T4/ line type
;Now we define the tables used in the line type checking routines.
;Each entry is of the form
; FUN(<Instr>,FunctionBit,UserBit,SMONfunct)
;Where
; Instr is the instruction to test for line type, skips if a match
; FunctionBit is bit to deny this function for this line type
; UserBit is bit to allow logins for this line type
; SMONfunct is SMON function to check for wheel logins for line type
;CAUTION: The order of checks is critical to proper operation of this feature.
;New network-type tests should be added immediately after the other network
;checks and before the "remote" check.
DEFINE DENGEN,<
XLIST
FUN(<SKIPL .JIBAT(T4)>,FU%DBA,US%BAT,.SFWPT) ;Batch check first
FUN(<SKIPGE .JICPJ(T4)>,FU%DPT,US%PTY,.SFWPT) ;PTY check after batch
FUN(<SKIPL .JITNO(T4)>,FU%DDE,US%DET,.SFWRM) ;DET check after PTY
FUN(<CAME Q3,CTYLNO>,FU%DCT,US%CTY,.SFWCT) ;CTY check after det check
FUN(<CAIE Q1,NW%DNA>,FU%DDN,US%DNA,.SFWDN) ;DECnet (NRT or CTERM)
FUN(<CAIE Q1,NW%TCP>,FU%DTC,US%TCP,.SFWNV) ;TCP/IP Internet (TELNET)
FUN(<CAIE Q1,NW%LAT>,FU%DLA,US%LAT,.SFWLT) ;LAT terminal
FUN(<TXNN Q2,MO%RMT>,FU%DRM,US%REM,.SFWRM) ;Remote (dialup on FE)
FUN(<CAIA>,FU%DLO,US%LOC,.SFWLC) ;Local, must be last
LIST
>
;Now build the needed tables
DEFINE FUN(A,B,C,D),<A>
DENCHK: DENGEN ;Generate table of terminal test instructions
DENSIZ==.-DENCHK ;Define symbol for number of tests
DEFINE FUN(A,B,C,D),<B>
DENFUB: DENGEN ;Generate table of function deny bits
DEFINE FUN(A,B,C,D),<C>
DENUSB: DENGEN ;Generate table of user allow bits
DEFINE FUN(A,B,C,D),<D>
DENTMN: DENGEN ;Generate table TMON wheel login functions
SUBTTL Subroutines -- Deny, Unusual, Failed setting
;Here to say that request is denied.
;Returns +1 always.
SETDEN: MOVEI T2,400000 ;Return error
SETZ T3, ;No specific code to return
TXO F,FL%DEN ;Indicate request is denied
RET ;Return +1 to deny request
;Here if request is unusual, allow it but note this in the log file.
;Returns +2 always.
SETUNU: TXO F,FL%UNU ;Indicate request is unusual
RETSKP ;Return +2 to allow request anyway.
;Here if request was in some way a failure.
;Returns +1 always.
SETFAI: MOVEI T2,400000 ;Return error
SETZ T3, ;No specific code to return
RET ;Return +1 to fail request
SUBTTL Subroutines -- Check Capabilities
;Here to check if this user is a wheel or operator
;Returns +1 wheel or operator
;Returns +2 if not wheel or operator
CHKWOP: MOVE CX,ARGBLK+.RCCAP ;Load user's capabilities
TXNN CX,SC%WHL!SC%OPR ;Wheel or operator?
AOS (P) ;Skip return
RET ;Return
;Here to check if this user is a wheel
;Returns +1 wheel
;Returns +2 if not wheel
CHKWHL: MOVE CX,ARGBLK+.RCCAP ;Load user's capabilities
TXNN CX,SC%WHL ;Wheel?
AOS (P) ;Skip return
RET ;Return
SUBTTL Subroutines -- Check Time for Enable
;Routine to check if this user can enable caps after prime time.
;Returns +1 if function is denied
;Returns +2 To allow the function
CHKTIM: TXNE P4,US%ENP ;User can enable non-prime?
RETSKP ;Yes, return success now
SETO T2, ;Current time
SETZ T4, ;No flags
ODCNV% ;Get time
HRRZ T3,T3 ;Day of week only
CAIE T3,.SAT ;Is it Saturday?
CAIN T3,.SUN ;Is it Sunday?
RET ;Yes, can't enable
HRRZ T4,T4 ;Just get time
CAMGE T4,PRIMEB ;Past prime time start?
RET ;No, denied
CAMLE T4,PRIMEE ;Before prime time end?
RET ;Off hours, can't do this function
RETSKP ;Time is OK
SUBTTL Subroutines -- CRDIR Snooping
;This routine tries to make up for the deficiency in the GETOK argument block
;for the CRDIR% JSYS. The monitor justs ask if it is OK for the user to do the
;CRDIR%, and doesn't furnish any of the CRDIR arguments. This routine checks
;to see if we are running on a new monitor that furnishes the user's arguments.
;If so, we just return. If not, we XPEEK% and PMOVE data out of the monitor,
;and this data is used to fix up the GETOK% request block to make it look like
;a newer monitor.
;Since the fork doing the CRDIR% is in balance set wait while waiting for us to
;OK the CRDIR%, the CRDIR% arguments should also be in memory. This is true of
;the EXEC who just has written the CRDIR% argument block. Note that this
;routine assumes that the caller is using private page pointers where the data
;is (e.g. the CRDIR done from a fork which was created with CR%MAP).
;Call with Q1/ ARGBLK+.RCARA.
;Returns +1 always
CHKCRD: SKIPE .GEDIR(Q1) ;Did monitor give us user arguments?
RET ;Yes, just return now and avoid all of this
SETZM .GECFL(Q1) ;No CRDIR% flags yet
SETZM .GECAB(Q1) ;No block containing CRDIR% argument block
;Get monitor symbol values only if first time through here.
SKIPN PSBPG ;Did we snoop the monitor symbols yet?
CALL SNOOPM ;(/) No, snoop them from the monitor
;Find request block for this request and make the GETOK argument block look
;like the new monitor format.
CALL FNDREQ ;(/) Find request block to get fork number
RET ;Can't find it
CALL FNDUAC ;(/) Get user's ACs
RET ;Some problem, return now
CALL STRGET ;(/) Now get directory string from user space
CALLRET BLKGET ;(/) And lastly, get user's arg block and ret
SUBTTL Subroutines -- CRDIR Snooping -- Find Request Block
;Here to find request block for this user.
;Returns +1 if not found or error looking
;Returns +2 if found, block in NXTBLK
FNDREQ: MOVE T1,GETOKQ ;Get queue place
MOVEI T2,CURBLK ;Put result here
CALL XPEEK1 ;(T1,T2/) Get it from the monitor
RET ;Failed!
FNDRE0: MOVE T1,CURBLK ;Get address of current block
MOVEI T2,NXTBLK ;Save request block here
MOVEI T3,15 ;Size of hidden part of block
CALL XPEEKX ;(T1,T2,T3/) Get those words from monitor
RET ;We failed
MOVE T3,REQNUM+NXTBLK ;Retrieve request number
CAMN T3,ARGBLK+.RCRQN ;Is this the request we want?
RETSKP ;Skip return indicates success
SKIPN T2,NXTBLK ;Get address of next block
RET ;If no more arg blocks, return +1
MOVEM T2,CURBLK ;Make it current
JRST FNDRE0 ;Now see if this the one
SUBTTL Subroutines -- CRDIR Snooping -- Find User's ACs
;We now have the request block we are looking for, get the user's ACs
;Call with Q1/ ARGBLK+.RCARA
;Returns +1 always
FNDUAC: HLRZ T1,REQFRK+NXTBLK ;Get target fork number
ADD T1,PSBPG ;Here's where the PT,,PSB will be
MOVEI T2,PSB ;Put result here
CALL XPEEK1 ;(T1,T2/) Get that word
RET ;Return owie!
HRRZ T1,PSB ;Get PSB address
ADD T1,MONSPT ;Off set into SPT
MOVEI T2,UACS ;Put SPT entry here briefly
CALL XPEEK1 ;(T1,T2/) Get that word from the monitor
RET ;I don't get it!
HLRZ T1,UACS ;Get what we just read
TRNE T1,77 ;Was the PSB swapped out?
RET ;Yes, oh well, return
;We now have the physical location of the user's ACs
HRRZ T1,UACS ;Get physical page of user ACs
LSH T1,PGSFT ;Shift to a page
ADD T1,ACB ;AC block starts at this offset
MOVEI T2,5 ;Read only some of the ACs
MOVEI T3,UACS ;Put them here
CALL PHYRED ;(T1,T2,T3/) Read physical memory
MOVE T2,UACS+2 ;Load AC2 from user
MOVEM T2,.GECFL(Q1) ;Save CRDIR% flags
RETSKP ;Return +2
SUBTTL Subroutines -- CRDIR Snooping -- Get Directory String
;This routine is called to read the string that the user supplied to the CRDIR%
;JSYS. Note, this routine has severe limitations at the current time. It
;assumes that string is coming from section zero of the calling process. The
;correct thing to do is check for a section, go through USECTB and then find
;the page. This could take a long time if there are indirect pointers. For now,
;this will do.
;Call with Q1/ ARGBLK+.RCARA
;Returns +1 always
STRGET: HLRZ T1,PSB ;Get SPT index for user page table
ADD T1,MONSPT ;Load address where the page table is
MOVEI T2,SPTENT ;Put the data here please
CALL XPEEK1 ;(T1,T2/) Get it from monitor
RET ;It failed! How can this be?
HLRZ T1,SPTENT ;Get swap status
TRNE T1,77 ;Page table swapped out?
RET ;Yes, let this happen
HRRZ T1,SPTENT ;Get physical page number
LSH T1,PGSFT ;Make real address
HRRZ T2,UACS+1 ;Get address of byte pointer
LSH T2,-PGSFT ;Just get page number
ADD T1,T2 ;Now we have then entry we want
USRIO% ;Be a monitor (almost)
ERJMP R ;Shouldna happen
PMOVE T2,T1 ;Get page table entry
ERJMP R ;Owie
JRSTF @[.+1] ;No longer in I/O mode
;Another assumption: we assume that the string is coming out of a private page
;from user space. If not, pointers would have to be chased.
HRRZ T1,T2 ;Just get physical page
LSH T1,PGSFT ;Make it an address
HRRZ T2,UACS+1 ;Get the address the user specified back
ANDI T2,777 ;Just get offset in the page
ADD T1,T2 ;String should start here
MOVEI T2,^D11 ;Get eleven words from user space
MOVE T3,ARGBLK+.RCARA ;Load arg block address
MOVEI T3,.GEDIR(Q1) ;Get block for STR:<DIRECTORY> string
CALLRET PHYRED ;(T1,T2,T3/) Go read string and return
SUBTTL Subroutines -- CRDIR Snooping -- Get User Argument Block
;This routine gets the user's argument block that he is passing to CRDIR%.
;Call with Q1/ ARGBLK+.RCARA
;Returns +1 always
BLKGET: HLRZ T1,PSB ;Get SPT index for user page table
ADD T1,MONSPT ;Here's where the page table is
MOVEI T2,SPTENT ;Here's where to put the data
CALL XPEEK1 ;(T1,T2/) Peek a word from the monitor
RET ;Big trouble in River City
HLRZ T1,SPTENT ;Get swap status
TRNE T1,77 ;Page table swapped out?
RET ;Yes, let this happen
HRRZ T1,SPTENT ;Get physical page number
LSH T1,PGSFT ;Make real address
HRRZ T2,UACS+2 ;Get address of argument block
LSH T2,-PGSFT ;Just get page number
ADD T1,T2 ;Now we have then entry we want
USRIO% ;Be a monitor (almost)
ERJMP R ;Shouldna happen
PMOVE T2,T1 ;Get page table entry
ERJMP R ;Wrong microcode
JRSTF @[.+1] ;No longer in I/O mode
;Another assumption: we assume that the block is coming out of a private page
;from user space. If not, pointers would have to be chased.
HRRZ T1,T2 ;Just get physical page
LSH T1,PGSFT ;Make it an address
HRRZ T2,UACS+2 ;Get address user furnished back
ANDI T2,777 ;Just get offset
ADD T1,T2 ;String should start here
MOVEI T2,^D25 ;Read twenty five words today
MOVEI T3,.GECAB(Q1) ;Point to block containing CRDIR% argument
CALLRET PHYRED ;(T1,T2,T3/) Go read block and return
SUBTTL Subroutines -- CRDIR Snooping -- Read Physical Memory
;Routine to read words from monitor's physical memory into specified
;spot in user space.
;Call with:
; T1/ Physical address in the monitor to start
; T2/ Number of words
; T3/ Place to start storing in user space
; T4/ smashed
;Returns +1 - always with data in
PHYRED: USRIO% ;Pretend we are the monitor
ERJMP R ;Should not ever happen
PHYRD0: PMOVE T4,T1 ;Get word phyically
ERJMP R ;KL microcode rev level too low
MOVEM T4,(T3) ;Save in space we are supposed to
AOS T1 ;Next spot to read
AOS T3 ;Next spot to store
SOJG T2,PHYRD0 ;Loop for all words
JRSTF @[R] ;Get out of I/O mode and return
;Here to perform XPEEK function.
;Call XPEEK1 for one word, XPEEKX for N words, with:
; T1/ monitor address
; T2/ user address
; T3/ count of words (XPEEKX only)
;Returns +1 if error
;Returns +2 if OK
XPEEK1: MOVEI T3,1 ;Load a one for one word
XPEEKX: DMOVEM T1,XPKBLK+.XPMAD ;Save monitor and user address (.XPUAD)
MOVEM T3,XPKBLK+.XPCN1 ;Save word count
DMOVE T1,[EXP .XPUAD+1,.XPPEK] ;Size of arg block and function code
DMOVEM T1,XPKBLK+.XPABL ;Save as first two words of argument block
MOVEI T1,XPKBLK ;Point to block now
XPEEK% ;Peek at the monitor
ERJMP R ;Return +1 if error
RETSKP ;Return +2 if not
SUBTTL Subroutines -- CRDIR Snooping -- Snoop Monitor Symbols
;Routine to SNOOP% out the monitor symbols we need.
;Returns +1 Always
SNOOPM: MOVEI T1,.SNPSY ;Get address of ...
MOVE T2,[RADIX50 0,FKPGS] ;... this monitor symbol
SETZ T3, ;Search entire symbol table
SNOOP% ;Get address
ERJMP SNOOPE ;Fatal error
MOVEM T2,PSBPG ;Save for later
MOVEI T1,.SNPSY ;SNOOP% another symbol
MOVE T2,[RADIX50 0,GETOKF] ;ACJ queue pointer
SETZ T3, ;Search whole symbol table
SNOOP% ;Get address
ERJMP SNOOPE ;Oh no
MOVEM T2,GETOKQ ;Save address of GETOK% queue
MOVEI T1,.SNPSY ;Get next symbol
MOVE T2,[RADIX50 0,SPT] ;Find the SPT
SETZ T3, ;Zap this
SNOOP% ;Get the address
ERJMP SNOOPE
MOVEM T2,MONSPT ;Save SPT address here
MOVEI T1,.SNPSY ;Get symbol
MOVE T2,[RADIX50 0,UAC] ;This symbol is in PSB
SETZ T3, ;Search whole symbol table
SNOOP% ;Get address
ERJMP SNOOPE ;Fatal
ANDI T2,777 ;Only want relative offset in PSB
MOVEM T2,ACB ;Save AC block offset here
RET ;We are ready!
SNOOPE: OJSERR (<Could not snoop monitor symbols>)
RET
SUBTTL End of ACJUSR
;Literals
USRLIT: XLIST
LIT
LIST
;Get globular symbols
GGLOBS
END