Trailing-Edge
-
PDP-10 Archives
-
BB-BT99T-BB_1990
-
10,7/acct/react.mac
Click 10,7/acct/react.mac to
see without markup as text/plain
There are 14 other files named react.mac in the archive. Click here to see a list.
TITLE REACT - PROGRAM TO MANIPULATE THE ACCOUNTING FILE
;COPYRIGHT (C) 1973,1978,1979,1980,1981,1984,1985,1986,1987,1990
;BY DIGITAL EQUIPMENT CORPORATION, MAYNARD, MASS. 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 WHICH IS NOT SUPPLIED BY DIGITAL.
; THANKS GIVEN TO C.MORRISON AT THE UNIVERSITY OF TENNESSEE FOR A COPY
; OF HIS EDACT, WHICH PROVIDED INSPIRATION, EXAMPLES.
; VERSION NUMBERS
REAVER==33 ;VERSION NUMBER
REAMIN==2 ;MINOR VERSION NUMBER
REAEDT==246 ;EDIT NUMBER
REAWHO==0 ;WHO EDITED LAST
%%REAC==:<BYTE(3)REAWHO(9)REAVER(6)REAMIN(18)REAEDT>
SEARCH ACTPRM,ORNMAC
MODULE (REACT)
;THE OBLIGATORY .EXE FILE COPYRIGHT
COPYRIGHT (c) 1973,1990 DIGITAL EQUIPMENT CORPORATION. ALL RIGHTS RESERVED.
\;END OF COPYRIGHT MACRO
; LOOSE ENDS
REPEAT 0,<
1. ASK FOR PSW ON CHANGES BY UNPRIV'ED USERS
2. FIX UP PROCESSING OF DEFAULTED FIELDS. FETCH DEFAULT PROFILE
AND CALL A$PDEF.
3. SUPPORT NEW SELECT FUNCTIONS .GE. AND .LE. .
4. TEACH PURGE HOW TO ADD A SELECT BLOCK ON .AEEXP SO THAT WE
DON'T GET (SO MANY) UNEXPIRED ENTRIES BACK FROM A$QWLD
THAT WE JUST HAVE TO SKIP OVER.
5. ADD A /FAST (AND QUIET) SWITCH TO PURGE AND DELETE THAT WILL
PUT THE SELECT AND WILDCARD BLOCKS IN THE UGCUP$ LIST,
THUS AVOIDING THE EXTRA IPCF PER DELETE, BUT AT THE
EXPENSE OF LONGER ACTDAE PROCESSING TIME AND LESS
INDICATION OF WHAT WENT WRONG ON ERRORS. (OPTIONAL)
6. DO PASSWORD DEFAULTING (MUST STUFF DEFAULT PPN [SALT] IN
PROFILE).
7. ADD AN UNPRIV'ED TYPEOUT FLAG TO CONTROL WHICH FIELDS GET
DISPLAYED FOR UNPRIV'ED USERS.
>
SUBTTL TABLE OF CONTENTS
SUBTTL REVISION HISTORY
COMMENT |
200 Rewrite everything. REACT 33(200) and above must be used with
version 5 format of SYS:ACCT.SYS, now ACT:ACCT.ACT and ACTDAE
version 2(100) and later. /TARL
201 Add support for context and pid quotas.
12-Dec-84 /LWS
202 Add sub command mode for setting/clearing "TYPE of ACCESS". Add
LIST command when in one of the sub command modes. Make sure password
is set in account if specified by user.
26-Jan-85 /LWS
203 Add "multiple PPN" insert code. Add code to generate random password.
28-Jan-85 /LWS
204 Random bug fixes. Add "acks" when functions complete successfully
so user knows what is going on. Start fixing up UPDATE code.
1-Feb-85 /LWS
205 Finish making UPDATE code work. Add LOCK/UNLOCK commands. Remove
alot of IFDIEs, more still to go.
13-Feb-85 /LWS
206 Add REQUIRE command. Random bug fixes, more clean up.
7-Mar-85 /LWS
207 Fix device defaulting when specifying "program-to-run".
5-Apr-85 /LWS
210 Insert support for "distribution box" and "personal name".
RMS ACCT.ACT changes. /TL
211 Make UPDATE work with RMS. ACCT file is now SYS:ACTDAE.SYS in
RMS format. Will we ever make up our minds? /LWS
212 Include password block in UG.ADD message. ACTDAE now knows how
to deal with a password block and a profile block. Also,
when doing INSERT FOO=BAR, clear .AEFLG, .AEFAI, .AELPC, and
.AEPNM in FOO's new profile.
29-Apr-85 /LWS
213 Add new entry to PRTBTS, PRTBTX. If entered at PRTBTX,
don't type "-none-" if no bits typed.
QAR #868073 30-Apr-85 /LWS
214 Get rid of REEnter routine to set version. ACTRMS just needs
to be loaded before REACT. Don't allow non-alpha to be 1st
char of username. Allow trailing "]" to be omitted on INSERT
command.
13-May-85 /LWS
215 Correct size of FD blocks to be FDXSIZ instead of FDMSIZ.
23-Jul-85 /DPM
216 Fix up SPOOL and WATCH bit comparison routines to use the correct
AC when calling GENCMP.
23-Jul-85 /DPM
217 Add new options to allow a site to prohibit a user from changing
his password. Note that the system administrator can always
change the password.
23-Jul-85 /DPM
220 Allow REACT to be run by anyone with administrative privs (JP.ADM).
24-Jul-85 /DPM
221 Massive cleanup.
10-Aug-85 /DPM
222 Give up on trying to clean the thing up. Rewrite 95% of it.
Major changes include:
1. Use of wildcarding facilites in ACTDAE.
2. A little consistancy in the command syntax.
3. Make CHANGE smarter (wildcards, etc.).
4. Add HELP command and internal on-line documentation.
5. Remove PRINT command (see LIST).
6. Give all sub-command modes the same common commands.
7. Do nice things with customer-defined commands and
profile entries.
21-Aug-85 /DPM
223 Miscellaneous buggers. UPDATE still doesn't work.
6-Sep-85 /DPM
224 Make UPDATE work. Selective restore isn't implemented yet although
the command will accept a wildcarded user-id. Implement suggestion
to change name of UPDATE command to VERIFY since the command syntax
UPDATE/LIST-ONLY doesn't make a whole lot of sense.
225 Update to know about profile format version 6 and the corresponding
changes to UGCUP$.
19-Nov-85 /RCB
226 Fix some bugs in SELECT logic.
24-Nov-85 /RCB
227 Correctly delete extensible blocks rather than truncating them to
then to two words. Add the PURGE command that works like the old
REACT P command in days of old. Fix off-by-one bug in mail address
block length computation.
2-Dec-85 /DPM
230 Correct deficiencies with INSERT and CHANGE having to do with
defaulting of profiles and detecting which entries we really did
modify.
17-Jan-86 /RCB
231 Fix some bugs with SELECT, wildcard changes, and changes to .AEPCT
and .AEPRX.
7-Mar-86 /RCB
232 Fix up VERIFY for debugging.
7-Mar-86 /RCB
233 The special privilege fields (DSKPRI, HPQ, & OPR) could not be modified
in isolation, since they didn't SETOM @CHGADR. They do now.
14-Mar-86 /RCB
234 Add routine PROFSP which will correctly detect null filespec blocks.
Used by PRGGET routine (program to run).
18-Aug-86 /DPM
235 Fix more SELECT logic for bit-masked fields. If the bit mask shows that
no keywords were typed, don't insert the change block.
1-Dec-86 /RCB
236 Fix the automatic generation of passwords to finish the syllable rather
than simply truncating at the requested length. This way, maybe we can
restore the original goal of a pronouncable password.
1-Dec-86 /RCB
237 Change to use new STOPCD macro rather than old $STOP macro.
2-Dec-86 /RCB
240 Fix bug with VERIFY where an account is missing from the master file at
EOF. While both files should probably have had [%,%] records, we still
shouldn't loop trying to re-insert the last ppn that was in the file.
Besides, we were using signed comparisons on what RMS considers to be
unsigned keys, so even if both files had contained [%,%] records, we
would only have done stupid things if there was a discrepancy with
the last positive ppn.
While we're at it, display the right profile when one is missing from
the working file, and interpret the "NO" answer to "Preserve changes?"
as meaning not to preserve the deletion.
10-Feb-87 /RCB
241 Fix bug where short .AEAUX blocks (not even multiples of .AULEN) stay
short ever after, even if we want to modify the bits of the last str.
15-May-87 /RCB
242 Fix bug where a user's expiry date is printed incorrectly when
attempting to delete the profile, and the date is non-infinite.
18-Aug-87 /JJF SPR:35717
243 Correct problems with inserting PPNs with 1B18 turned on.
5-Jan-89 /DPM (SPR 10-35597)
244 Do not use %CNDAE for checking the monitor version; that is for
use only by DAEMON. Use %CNDVN instead.
29-Nov-89 /DPM
245 Rich tells me that if MX ever gets fixed to handle non-local forwarding
via .AEMAI that it will really want to see "user@node" rather than the
current "node::user", so fix how handle the entry. "node::user" will be
accepted, but converted to "user@node". "user@node" will also be valid
for typein.
246 Non-standard profile defaults cannot be assigned to accounts
where the project numbers differ (i.e. [10,56] cannot have a
profile default of [1,%]). Include CM%WLA in the parse block.
27-Mar-90 /DPM
02-Jan-90 /RCB
END REVISION HISTORY |
SUBTTL ASSEMBLY PARAMETERS
; ASSEMBLY PARAMETERS
XP PDLSIZ,400 ;SIZE OF STACK
XP ACTFMT,6 ;ACCOUNTING FILE FORMAT WE KNOW ABOUT
XP CATMAX,^D20 ;CATALOG RESPONSE BLOCK LENGTH
XP DEFPSZ,^D6 ;NUMBER OF CHARACTERS IN GENERATED PASSWORD
XP ZZTIME,^D60 ;MAXIMUM TIME TO WAIT FOR QUEUE. UUO RESPONSE
XP DEFPCI,^D365 ;MAXIMUM PASSWORD CHANGE INTERVAL
XP PTMHRS,1777B17 ;PRIME TIME HOURS
;WEEKDAYS 08-17
XP NPTHRS,<-1^!PTMHRS> ;NON-PRIME TIME HOURS
;WEEKDAYS 00-07, 18-23; WEEKENDS 00-23
XP ALLPRV,-1 ;DEFAULT PRIV WORD FOR ALL PRIVS
XP REMOPR,2 ;REMOTE OPERATOR PROGRAMMER NUMBER
XP SYSPRJ,10 ;PROJECT ALLOWED SYSTEM OPR PRIVS
XP HSTPRJ,30 ;PROJECT ALLOWED HOST OPR PRIVS
XP GLXPRJ,50 ;PROJECT NUMBER FOR GALACTIC WIZARDS
XP DEFQTA,^D1000 ;DEFAULT QUOTA
XP DEFQTO,DEFQTA ;DEFAULT 'OUT' QUOTA
XP STATBT,0 ;DEFAULT STRUCTURE STATUS BITS
SUBTTL LOWSEG
RELOC 0
PDL: BLOCK PDLSIZ ;STACK
UNPRIV::BLOCK 1 ;NON-ZERO FOR UNPRIV'ED USERS
MONVER::BLOCK 1 ;MONITOR VERSION
OLDMON::BLOCK 1 ;MONVER INDICATES NO QUEUE. UUO TIMEOUT SUPPORT
FFAPPN::BLOCK 1 ;[1,2]
MYPPN:: BLOCK 1 ;GETPPN RESULT
ALTRBK::BLOCK UW$MIN ;ALTERNATE WILDCARD BLOCK
ALTRAK::BLOCK .AANLW ;ALTERNATE ACK TEXT
ALTRBP::BLOCK 1 ;ALTERNATE BYTE POINTER TO ACK TEXT
ALTRPP::BLOCK 2 ;ALTERNATE WILD PPN BASE
WILDBK::BLOCK PAGSIZ ;WORKING WILDCARD BLOCK
WILDAK::BLOCK .AANLW ;WORKING ACK TEXT
SELPTR: BLOCK 1 ;AOBJN POINTER TO SELECTION BLOCK
ZBEG:!
INSFLG: BLOCK 1 ;NON-ZERO IF DOING INSERT
SELFLG: BLOCK 1 ;NON-ZERO IF BUILDING SELECTION CRITERIA
SELFNC: BLOCK 1 ;SELECT FUNCTION
PARBUF: BLOCK PAGSIZ ;SCRATCH BLOCK FOR PARSER
PARBLK: BLOCK PAR.SZ ;PARSER BLOCK
HELPBF: BLOCK <^D80/5>+1 ;TEMPORARY STORAGE FOR 80 CHARACTER HELP BANNER
LISTFL: BLOCK 1 ;LIST FLAG
LSTIFN: BLOCK 1 ;SAVED IFN FOR LIST FILE
PROARG: BLOCK 2 ;PROFILE COMMAND TABLE AND PROMPT
DEFUSR::BLOCK 5 ;DEFAULT USER-ID STRING
DEFTX1::BLOCK 5 ;DEFAULT TEXT STRING #1
DEFTX2::BLOCK 5 ;DEFAULT TEXT STRING #2
DEFTX3::BLOCK 5 ;DEFAULT TEXT STRING #3
PPNTXT: BLOCK 4 ;SCRATCH PAD STORAGE FOR ASCIZ PPN
STRNAM: BLOCK 1 ;STRUCTURE NAME FOR CATALOG
AUXBLK: BLOCK .AULEN ;AUXACC BLOCK FOR PARSER DEFAULTING
AUXPTR: BLOCK 1 ;AOBJN POINTER TO AUXBLK
AUXTMP: BLOCK .AUMAX+.AULEN ;[241] AUXACC STORAGE FOR ADD/REMOVE
WILDBP::BLOCK 1 ;WORKING BYTE POINTER TO ACK TEXT
WILDPP::BLOCK 2 ;WORKING WILD PPN BASE
DEFSRC: BLOCK 1 ;NON-ZERO IF DEFAULT PROFILE SEARCHING WANTED
DEFPPN: BLOCK 1 ;DEFAULT PPN FOUND FLAG
WLDINS: BLOCK 1 ;NON-ZERO IF WILDCARDED INSERT
PROFAI: BLOCK 1 ;COUNT OF PROCESSED PROFILE FAILURES
PROSUC: BLOCK 1 ;COUNT OF PROCESSED PROFILE SUCCESSES
QUEBLK: BLOCK .AEMAX ;GIVE ROOM FOR A PROFILE
QUEBLN==.-QUEBLK ;UUO BLOCK LENGTH (FOR QINIT)
QUEPTR: BLOCK 1 ;AOBJN POINTER FOR FILLING QUEBLK
RSPBLK: BLOCK .AEMAX ;RESPONSE BLOCK
CATACK: BLOCK CATMAX ;CATALOG RESPONSE BLOCK
PMRINC: BLOCK 1 ;PROGRAMMER NUMBER INCREMENT FOR INSERT
PMRCNT: BLOCK 1 ;COUNT OF PPN'S TO GENERATE
PMRPRT: BLOCK 1 ;PROMPT FOR USER NAME FLAG ON WILD INSERT
PMRPSW: BLOCK 1 ;PROMPT FOR PASSWORD FLAG ON WILD INSERT
PMRPWD: BLOCK 1 ;DEFAULT PASSWORD IF NON-ZERO
DELASK: BLOCK 1 ;FLAG FOR CONFIRM ON DELETE
EXPDTM: BLOCK 1 ;EXPIRATION DATE/TIME FOR PURGE COMMAND
FDBLK:: BLOCK FDXSIZ ;RANDOM FD FOR PROFILE ENTRY PROCESSING
SWTTAB:! ;SWITCH STORAGE TABLE
SWTASK: BLOCK 1 ;/ASK
SWTDET: BLOCK 1 ;/DETAIL /FAST
SWTCLR: BLOCK 1 ;/CLEAR
SWTRPT: BLOCK 1 ;/REPORT
SWTUPD: BLOCK 1 ;/UPDATE
SWTLEN==.-SWTTAB ;LENGTH OF TABLE
FNASIZ==<<<6+1+6+1+3+1+6+1+6>+<5*<6+1>+1>>/5>+1
MASTFN: BLOCK FNASIZ ;MASTER FILE NAME
WORKFN: BLOCK FNASIZ ;WORKING FILE NAME
TEMPFN: BLOCK FNASIZ ;TEMPORARY FILE NAME
MASTFD: BLOCK FDXSIZ ;MASTER FILE NAME
WORKFD: BLOCK FDXSIZ ;WORKING FILE NAME
TEMPFD: BLOCK FDXSIZ ;TEMPORARY FILE NAME
MASTWB: BLOCK UW$MIN ;MASTER WILDCARD BLOCK
WORKWB: BLOCK UW$MIN ;WORKING FILE WILDCARD BLOCK
TEMPWB: BLOCK UW$MIN ;TEMPORARY FILE WILDCARD BLOCK
MASTEF: BLOCK 1 ;MASTER FILE EOF FLAG
WORKEF: BLOCK 1 ;WORKING FILE EOF FLAG
VERRFB: BLOCK FOB.SZ ;A FOB FOR READING
VERWFB: BLOCK FOB.SZ ;A FOB FOR WRITING
VERALL: BLOCK 1 ;NON-ZERO IF VERIFYING ALL PROFILES
VERDIF: BLOCK 1 ;NON-ZERO IF VERIFY ENCOUNTERED DIFFERENCES
VERABO: BLOCK 1 ;NON-ZERO IF VERIFY ABORTED
ZEND:!
ZSIZ==.-ZBEG
CMDPTR: BLOCK 1 ;ADDRESS OF COMMAND TABLE
CMDKEY: BLOCK PB%SIZ ;PARSER BLOCK (KEYWORDS)
CMDHLP: BLOCK PB%SIZ ;PARSER BLOCK (HELP)
ENTKPT::BLOCK 1 ;ADDRESS OF PROFILE ENTRY TABLE
ENTHPT::BLOCK 1 ;ADDRESS OF PROFILE HELP TABLE
ENTKEY::BLOCK PB%SIZ ;PARSER BLOCK (KEYWORDS)
ENTDEF::BLOCK PB%SIZ ;PARSER BLOCK ("DEFAULT")
ENTHLP::BLOCK PB%SIZ ;PARSER BLOCK ("HELP")
ENTRST::BLOCK PB%SIZ ;PARSER BLOCK ("RESTORE")
ENTSLC::BLOCK PB%SIZ ;PARSER BLOCK ("SELECT")
CHGCTR::BLOCK 1 ;CHANGE TABLE WORD COUNT
CHGPTR::BLOCK 1 ;CHANGE TABLE ADDRESS
CHGADR::BLOCK 1 ;CHANGE TABLE INDEX FOR CURRENT PROFILE ENTRY
CHGMSK::BLOCK .AEMIN ;BLOCK OF CHANGE FLAGS
CHGMS2: BLOCK .AEMIN ;COPY OF CHGMSK DURING PROUPD
PRSDFV::BLOCK 1 ;LOCATION TO TWEAK FOR CG.DFL CALLS
MAICNT: BLOCK 1 ;MAILING ADDRESS BYTE COUNT
MAIPTR: BLOCK 1 ;MAILING ADDRESS BYTE POINTER
TEMP: BLOCK .AEMAX ;TEMPORARY PROFILE STORAGE
USER: BLOCK .AEMAX ;CURRENT USER'S PROFILE
USER2: BLOCK .AEMAX ;DEFAULT USER'S PROFILE
USER0: BLOCK .AEMAX ;PROFILE TO SETUP .AEMAP CORRECTLY
PASSHD: BLOCK ARG.DA ;PARSER DATA BLOCK HEADER
PASSWD: BLOCK .APWLW ;PASSWORD
ROOT: BLOCK 1 ;RANDOM NUMBER GENERATOR SEED
RESPPN: BLOCK 1 ;RESERVED PROFILE BEING INSERTED
DEBUGQ: BLOCK 1 ;DON'T TIME OUT QUEUE. UUOS
ACTPID: BLOCK 1 ;PID TO STUFF INTO .QUPID WHEN DEBUGGING
QUETMP: BLOCK 2 ;BI-WORD FOR QUECHG TO INSERT MASKED VALUES
RELOC ;BACK TO HISEG
PDLPTR: IOWD PDLSIZ,PDL ;STACK POINTER
IB: $BUILD (IB.SZ) ;SIZE OF INIIALIZATION BLOCK
$SET (IB.PRG,,%%.MOD);PROGRAM NAME
$SET (IB.OUT,,OUTLST);TERMINAL OUTPUT
$SET (IB.FLG,IT.OCT,1);REQUIRE COMMAND TERMINAL
$SET (IB.FLG,IB.NPF,1);NO TIMER TRAPS!!!
$EOB
LST: $BUILD (FOB.SZ) ;SIZE OF FILE OPEN BLOCK
$SET (FOB.CW,FB.BSZ,7);BYTE SIZE IS ASCII
$EOB ;END OF BLOCK
;FD's for current ACCT file and temp ACCT file for VERIFY command
CURFD: $BUILD (FDXSIZ)
$SET (.FDLEN,FD.LEN,FDXSIZ) ;SIZE OF FD
$SET (.FDLEN,FD.TYP,.FDNAT) ;NATIVE FILESPEC
$SET (.FDSTR,,SIXBIT\SYS\) ;"SYS:ACTDAE.SYS"
$SET (.FDNAM,,SIXBIT\ACTDAE\)
$SET (.FDEXT,,SIXBIT\SYS\)
$EOB
TMPFD: $BUILD (FDXSIZ)
$SET (.FDLEN,FD.LEN,FDXSIZ) ;SIZE OF FD
$SET (.FDLEN,FD.TYP,.FDNAT) ;NATIVE FILESPEC
$SET (.FDSTR,,SIXBIT\DSK\) ;"DSK:REACT.TMP"
$SET (.FDNAM,,SIXBIT\REACT\)
$SET (.FDEXT,,SIXBIT\TMP\)
$EOB
; USER NAME BREAK MASK
NAMBRK: 777777,,777760 ;BREAK ON ALL CONTROL
777554,,001750 ;ALLOW * - ? AND 0-9
400000,,000760 ;ALLOW UC A-Z
400000,,000760 ;ALLOW LC A-Z
; PASSWORD BREAK MASK
PSWBRK: 777777,,777760 ;BREAK ON ALL CONTROL
000000,,000000 ;ALLOW ALL PUNCTUATION AND DIGITS
000000,,000000 ;ALLOW UC A-Z
000000,,000000 ;ALLOW LC A-Z
; TEXT BREAK MASK FOR UNQUOTED STRINGS
TXTBRK: 777777,,777760 ;BREAK ON ALL CONTROL
777754,,001760 ;ALLOW - AND 0-9
400000,,000760 ;ALLOW UC A-Z
400000,,000760 ;ALLOW LC A-Z
; ARBITRARY NODE NAME BREAK MASK
NNMBRK: 777777,,777760 ;BREAK ON ALL CONTROL
777744,,001760 ;ALLOW - AND . AND 0-9
400000,,000760 ;ALLOW UC A-Z
400000,,000760 ;ALLOW LC A-Z
;SET TO DEFINE THE TABLE USED TO QUEUE THE CHANGES FOR ACTDAE
DEFINE AE (NAM,LEN,BITS,RTN),<IFN <LEN>,<EXP .AE'NAM>>
QUETAB: AEPROF
QUETBL==.-QUETAB ;LENGTH OF TABLE
PURGE AE ;DUMP THE SYMBOL TABLE SPACE
;Tables describing the format of USER. Byte pointers defined where
;appropriate, offsets defined elsewhere.
;
;The use of these values is entirely voluntary, but highly recommended so
;as to provide a single place to change when fiddling with formats.
USRNAM: POINT 8,.AENAM(U) ;INITIAL BPT TO USERNAME
USRNM2: POINT 8,.AENAM(X) ;ALTERNATE NAME (USED DURING BACKUP)
CORPHY: POINTR .AECOR(U),AE.NPP ;PHYSICAL CORE LIMIT
CORVRT: POINTR .AECOR(U),AE.NVP ;VIRTUAL CORE LIMIT
IPCFS: POINTR .AEIPC(U),AE.SND ;IPCF SEND QUOTA
IPCFR: POINTR .AEIPC(U),AE.RCV ; RECEIVE QUOTA
IPCFP: POINTR .AEIPC(U),AE.PID ; MAXIMUM NUMBER OF PIDS
CTXCNQ: POINTR .AECTX(U),AE.CNQ ;MAXIMUM NUMBER OF CONTEXTS
CTXCPQ: POINTR .AECTX(U),AE.CPQ ;MAXIMUM NUMBER OF IDLE CONTEXT PAGES
SCHED: POINTR .AESCD(U),AE.SCD ;SCHEDULAR TYPE
NONE7:: ASCIZ /-none-/
NONE8:: BYTE(8) "-","n","o","n","e","-",0
SUBTTL PROGRAM INITIALIZATION
LOC 137
EXP <%%REAC==:%%REAC>
RELOC
REACT: JFCL ;NO CCL
RESET ;CLEAR THE WORLD'S STATUS
MOVE P,PDLPTR ;GET POINTER TO PUSH DOWN LIST
MOVEI S1,IB.SZ ;SIZE OF IB
MOVEI S2,IB ;POINTER TO INITIALIZATION BLOCK
PUSHJ P,I%INIT## ;INITIALIZE GLXLIB
MOVEI S1,'REA' ;REACT PREFIX
MOVEI S2,0 ;NO ERROR SUBROUTINE
PUSHJ P,A$ERRI## ;INIT ERROR PROCESSOR
SETZB S1,S2 ;NO TIMER TRAPS
PUSHJ P,P$INIT## ;INITIALIZE PARSER
MOVE T1,[%CNDVN] ;GETTAB ARGUMENT
GETTAB T1, ;GET MONITOR VERSION
SETZ T1, ;ANCIENT MONITOR
LDB T1,[POINT 9,T1,11] ;GET MONITOR VERSION
MOVEM T1,MONVER ;SAVE MONITOR VERSION
CAIGE T1,703 ;IS IT A MONITOR WITH QUEUE. UUO TIMEOUTS?
SETOM OLDMON ;NO, FLAG THE DEFICIENCY
SETOM UNPRIV ;ASSUME AN UNPRIVILEGED USER
MOVE T1,[%LDFFA] ;ARGS
GETTAB T1, ;GET FFA PPN
MOVE T1,[1,,2] ;DEFAULT
MOVEM T1,FFAPPN ;SAVE FOR LATER PRIV TESTS
HRROI T2,.GTPPN ;ARGS
GETTAB T2, ;GET OUR PPN
SETZ T2, ;???
MOVEM T2,MYPPN ;SAVE FOR LATER USE
HRROI T3,.GTPRV ;ARGS
GETTAB T3, ;GET OUR PRIV WORD
SETZ T3, ;???
; CAME T1,T2 ;FULL FILE ACCESS?
TXNE T3,JP.ADM ; OR ADMINISTRATIVE PRIVS?
SETZM UNPRIV ;ALLOW ACCESS TO PRIV'ED KEYWORDS
PUSHJ P,CMDINI ;INITIALIZE COMMAND TABLE
PUSHJ P,ENTINI ;INITIALIZE PROFILE ENTRY TABLE
SETZM USER0 ;CLEAR A WORD
MOVE S1,[USER0,,USER0+1] ;TRANSFER WORD
BLT S1,USER0+.AEMAX-1 ;CLEAR OUT PROTOTYPE PROFILE
MOVX S1,FLD(ACTFMT,AE.VRS)!FLD(.AEMIN,AE.LEN) ;GET OVERHEAD WORD
MOVEM S1,USER0+.AEVRS ;SET IT UP
SETOM USER0+.AEMAP ;START OFF WITH ALL DEFAULTS
MOVE S1,[USER0+.AEMAP,,USER0+.AEMAP+1] ;DITTO
BLT S1,USER0+.AEMAP+.AMPLW-1 ;SMEAR SOME BITS
MOVEI T1,USER0 ;POINT TO PROFILE TO USE
MOVEI T2,USER0 ;SOURCE & DESTINATION
PUSHJ P,A$PDEF## ;MAKE THE BITS BE CONSISTENT WITH CHGTAB
MOVEI S1,SP.ACT ;ACTDAE'S SYSTEM PID INDEX
$CALL C%RPRM ;GET ITS PID
MOVEM S1,ACTPID ;SAVE FOR .QUPID
PUSHJ P,SELINI ;INITIALIZE SELECTION AOBJN POINTER
JRST MAIN ;GO ENTER TOP LEVEL COMMAND LOOP
CMDINI: PUSHJ P,.SAVE1 ;SAVE P1
HLRZ S1,CMDDEC ;GET COUNT OF DEC-DEFINED COMMANDS
HLRZ S2,CMDCUS## ;GET COUNT OF CUSTOMER-DEFINED COMMANDS
SKIPN UNPRIV ;UNPRIV'ED USER?
JRST CMDIN1 ;NO
HLRZ S1,CMDDUP ;GET COUNT OF DEC-DEFINED COMMANDS
HLRZ S2,CMDCUP## ;GET COUNT OF CUSTOMER-DEFINED COMMANDS
CMDIN1: ADDI S1,1(S2) ;TOTAL THEM UP
PUSHJ P,M%GMEM ;GET SOME CORE
MOVEM S2,CMDPTR ;SAVE FOR PARSING
SUBI S1,1 ;DON'T COUNT THE OVERHEAD WORD
MOVEM S1,@CMDPTR ;SAVE WORD COUNT TOO
MOVEI P1,CMDDUP ;POINT TO DEC-DEFINED UNPRIV'ED TABLE
SKIPN UNPRIV ;TEST
MOVEI P1,CMDDEC ;POINT TO DEC-DEFINED PRIV'ED TABLE
PUSHJ P,CMDIN2 ;LOAD WORKING COMMAND TABLE
MOVEI P1,CMDCUP## ;POINT TO CUSTOMER-DEFINED UNPRIV'ED TABLE
SKIPN UNPRIV ;TEST
MOVEI P1,CMDCUS## ;POINT TO CUSTOMER-DEFINED TABLE
CMDIN2: HLRZ S1,(P1) ;GET NUMBER OF ENTRIES IN TABLE
JUMPE S1,.RETT ;RETURN IF TABLE IS EMPTY
MOVNS S1 ;NEGATE
HRL P1,S1 ;GET -LENGTH
HRRI P1,1(P1) ;MAKE AN AOBJN POINTER
CMDIN3: MOVE S1,CMDPTR ;POINT TO TABLE HEADER
MOVE S2,(P1) ;GET KEYWORD ADDRESS
PUSHJ P,S%TBAD ;INSERT INTO TABLE
SKIPT ;CHECK FOR ERRORS
STOPCD (CIF,HALT,,<Command table initialization failure>)
AOBJN P1,CMDIN3 ;LOOP
MOVE S1,[CMDKBK,,CMDKEY] ;SET UP BLT
BLT S1,CMDKEY+PB%SIZ-1 ;COPY
MOVE S1,CMDPTR ;GET TABLE ADDRESS
MOVEM S1,CMDKEY+1+.CMDAT ;SAVE
MOVE S2,[CMDHBK,,CMDHLP] ;SET UP BLT
BLT S2,CMDHLP+PB%SIZ-1 ;COPY
MOVEM S1,CMDHLP+1+.CMDAT ;UPDATE WITH CORRECT TABLE ADDRESS
$RETT ;AND RETURN
; DUMMY PARSER DATA BLOCK FOR COMMANDS
CMDKBK: $KEYDSP (.)
BLOCK PB%SIZ-<.-CMDKBK>
; DUMMY PARSER DATA BLOCK FOR HELP
CMDHBK: $KEY (CONFRM,.,<$ALTER(CONFRM)>)
BLOCK PB%SIZ-<.-CMDHBK>
SUBTTL COMMAND PROCESSING -- MAIN - TOP LEVEL DISPATCH
MAIN: MOVE P,PDLPTR ;GET STACK POINTER
SETZM ZBEG ;CLEAR A WORD
MOVE S1,[ZBEG,,ZBEG+1] ;XFER VECTOR
BLT S1,ZEND-1 ;CLEAR THE ZEROABLE STORAGE
MOVEI S1,CMDTAB ;PARSER TABLE
MOVEI S2,[ASCIZ \REACT>\] ;PROMPT STRING
PUSHJ P,PRSCMD ;PARSE THE COMMAND
JUMPF MAIN ;IF FAILS, TRY AGAIN
PUSHJ P,P$KEYW## ;GET A KEYWORD
JUMPF PRSERR ;COMPLAIN IF PROBLEMS
PUSHJ P,(S1) ;DISPATCH
JRST MAIN ;AND DO IT AGAIN
SUBTTL COMMAND PROCESSING -- CMDDEC - DEC-DEFINED COMMAND TABLES
; PRIVILEGED ADMINISTRATIVE COMMANDS
CMDDEC: $STAB
DSPTAB ( ,CTRLZ ,\"32,CM%INV)
DSPTAB (CHAN00,CHANGE,<CHANGE>)
DSPTAB (DELE00,DELETE,<DELETE>)
DSPTAB (EXIT00,EXIT ,<EXIT>)
DSPTAB (HELP00,HELP ,<HELP>)
DSPTAB (INSE00,INSERT,<INSERT>)
DSPTAB (LIST00,LIST ,<LIST>)
DSPTAB (LOCK00,LOCK ,<LOCK>)
DSPTAB (SELE00,SELECT,<SELECT>)
DSPTAB (SHOW00,SHOW ,<SHOW>)
DSPTAB (PURG00,PURGE ,<PURGE>)
DSPTAB (LOCK00,UNLOCK,<UNLOCK>)
DSPTAB (VERI00,VERIFY,<VERIFY>)
$ETAB
; UNPRIVILEGED USER COMMANDS
CMDDUP: $STAB
DSPTAB ( ,CTRLZ ,\"32,CM%INV)
DSPTAB (CHAN00,CHANGE,<CHANGE>)
DSPTAB (EXIT00,EXIT ,<EXIT>)
DSPTAB (HELP00,HELP ,<HELP>)
DSPTAB (LIST00,LIST ,<LIST>)
DSPTAB (SHOW00,SHOW ,<SHOW>)
$ETAB
; GENERIC USER-ID PARSER DATA BLOCKS
USR000::$INIT (USR010)
USR010: $NOISE (USR020,<user-id>)
USR020: $USER (CONFRM,<$PDATA (CM%WLA+ALTRPP),$FLAGS(CM%SDH),$ALTER(USR030)>)
USR030: $QUOTE (CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(USR040)>)
USR040: $FIELD (CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
; ACTION ROUTINE CALLED TO DETERMINE IF USER THE THE OPERATOR
; AND SUPPLY THE APPROPRIATE DEFAULTS FOR A USER-ID
USRACT::DMOVE S1,[ASCIZ /[*,*]/] ;ASSUME OPERATOR
DMOVEM S1,DEFUSR ;SAVE FOR PARSER
MOVE S2,MYPPN ;FETCH OUR PPN
CAMN S2,FFAPPN ;ARE WE THE OPERATOR?
$RETT ;YES--DONE
MOVEI S1,[ITEXT (<[*,^O/S2,RHMASK/]>)] ;ASSUME INDPPN OFF
MOVE TF,[%CNSTS] ;GETTAB ARGUMENT
GETTAB TF, ;FETCH WORD
SETZ TF, ;SICK MONITOR
TXNE TF,ST%IND ;INDPPN TURNED ON?
MOVEI S1,[ITEXT (<^U/S2/>)] ;YES
$TEXT (<-1,,DEFUSR>,<^I/(S1)/^0>) ;GENERATE DEFAULT STRING
$RETT ;NO
CMDTAB: $INIT (CMDKEY,<$ACTION (USRACT)>)
CHAN00: $NOISE (CHAN01,<user-id>)
CHAN01: $USER (CONFRM,<$PDEFAULT(DEFUSR),$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(CHAN05)>)
CHAN05: $QUOTE (CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(CHAN10)>)
CHAN10: $FIELD (CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
DELE00: $NOISE (DELE01,<user-id>)
DELE01: $USER (DELE15,<$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(DELE05)>)
DELE05: $QUOTE (DELE15,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(DELE10)>)
DELE10: $FIELD (DELE15,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
DELE15: $SWITCH (CONFRM,DELE20,<$ALTER (CONFRM)>)
DELE20: $STAB
KEYTAB (1,<ASK>)
KEYTAB (0,<NOASK>)
$ETAB
CONFRM::!
EXIT00: $CRLF
HELP00: $NOISE (CMDHLP,<with>)
INSE00: $NOISE (INSE01,<new user-id>)
INSE01: $USER (INSE15,<$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(INSE05)>)
INSE05: $QUOTE (INSE15,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(INSE10)>)
INSE10: $FIELD (INSE15,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
INSE15: $TOKEN (INSE20,<=>,<$ALTER (CONFRM)>)
INSE20: $USER (CONFRM,<$PDATA (CM%WLA+ALTRPP),$FLAGS(CM%SDH),$ALTER(INSE25)>)
INSE25: $QUOTE (CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(INSE30)>)
INSE30: $FIELD (CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
LIST00: $NOISE (LIST01,<user-id>)
LIST01: $USER (LIST15,<$PDEFAULT(DEFUSR),$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(LIST05)>)
LIST05: $QUOTE (LIST15,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(LIST10)>)
LIST10: $FIELD (LIST15,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
LIST15: $NOISE (LIST20,<to file>)
LIST20: $OFILE (LIST25,<listing filespec>,<$DEFAULT (<DSK:ACCT.LST>)>)
LIST25: $SWITCH (CONFRM,LIST30,<$ALTER (CONFRM)>)
LIST30: $STAB
KEYTAB (0,<DETAIL>)
KEYTAB (1,<FAST>)
$ETAB
LOCK00: $NOISE (CONFRM,<user account file>)
SELE00: $NOISE (SELE10,<profile criteria>)
SELE10: $SWITCH (CONFRM,SELE20,<$ALTER (CONFRM)>)
SELE20: $STAB
KEYTAB (0,<CLEAR>)
$ETAB
SHOW00: $NOISE (SHOW01,<user-id>)
SHOW01: $USER (LIST25,<$PDEFAULT(DEFUSR),$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(SHOW05)>)
SHOW05: $QUOTE (LIST25,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(SHOW10)>)
SHOW10: $FIELD (LIST25,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
PURG00: $NOISE (PURG01,<user-id>)
PURG01: $USER (CONFRM,<$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(PURG05)>)
PURG05: $QUOTE (CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(PURG10)>)
PURG10: $FIELD (CONFRM,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
VERI00: $NOISE (VERI05,<file from>)
VERI05: $FILE (VERI10,<master file>,$DEFAULT(<DSK:MASTER.SYS>))
VERI10: $NOISE (VERI15,<for users>)
VERI15: $USER (VERI30,<$PDATA (CM%WLA+WILDPP),$FLAGS(CM%SDH),$ALTER(VERI20),$DEFAULT(<[*,*]>)>)
VERI20: $QUOTE (VERI30,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$ALTER(VERI25)>)
VERI25: $FIELD (VERI30,,<$PREFI(P$8BIT##),$FLAGS(CM%SDH),$BREAK(NAMBRK)>)
VERI30: $SWITCH (NEXT,VERI35,<$ACTION(SHRSWT),$ALTER(CONFRM)>)
VERI35: $STAB
KEYTAB (<[0,,SWTRPT]>,<NOREPORT>)
KEYTAB (<[0,,SWTUPD]>,<NOUPDATE>)
KEYTAB (<[1,,SWTRPT]>,<REPORT>)
KEYTAB (<[1,,SWTUPD]>,<UPDATE>)
$ETAB
SUBTTL CHANGE COMMAND
XWD CHGHLP,[ASCIZ /Change profile entries/]
CHANGE: PUSHJ P,.SAVE1 ;SAVE P1
PUSHJ P,PROZCH ;CLEAR OUT CHANGE FLAG TABLE
PUSHJ P,PRSWLD ;PARSE A USER ID
$RETIF ;IF NOT THERE, MERELY RETURN
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,WLDWCK ;CHECK FOR WILDCARDING
JUMPF CHANG1 ;JUMP IF NOT
MOVEI X,USER2 ;USER2 WILL CONTAIN THE CHANGED DATA
MOVE U,X ;SET UP WORKING PROFILE POINTER
HLRE S1,WILDBK+UW$PPM ;GET PROJECT MASK
CAME S1,[EXP -1] ;WILD?
TDZA S1,S1 ;YES--USE SYSTEM DEFAULT PPN
MOVE S1,WILDBK+UW$PPN ;GET PPN
MOVEM S1,.AEPPN(U) ;STORE IN PROFILE
SKIPN UNPRIV ;DON'T DEFAULT PROFILE UNLESS PRIV'ED
PUSHJ P,PRODEF ;FETCH DEFAULT PROFILE
MOVSI S1,(U) ;GET ADDR
HRRI S1,1(U) ;MAKE A BLT POINTER
SETZM (U) ;CLEAR FIRST WORD
BLT S1,.AEMAX-1(U) ;CLEAR OUT BLOCK
MOVE S1,[ACTFMT,,.AEMIN] ;SETUP OVERHEAD WORD
MOVEM S1,.AEVRS(U) ;SO EXTENSIBLE BLOCKS WORK
$TEXT (,< Enter all data to be changed>)
MOVEI S1,ENT000 ;COMMAND TABLES
MOVEI S2,[ASCIZ /USER>/] ;PROMPT
SETOM INSFLG ;ALL CHANGES ARE SIGNIFICANT HERE
PUSHJ P,PROFIL ;BUILD PROTOTYPE BLOCK
SETZM INSFLG ;NO LONGER DOING SOMETHING STRANGE
$RETIF ;CHECK FOR ERRORS
MOVEI U,USER ;SET UP WORKING PROFILE POINTER
CHANG1: PUSHJ P,WLDUSR ;GET FIRST/NEXT POSSIBLY WILDCARDED USER
JUMPF CHANG5 ;JUMP IF NO MORE PROFILES
PUSHJ P,WLDWCK ;CHECK FOR WILDCARDING
JUMPT CHANG2 ;DON'T PROMPT FOR EACH PROFILE
PUSHJ P,PROZCH ;ZERO CHANGE TABLE
MOVE S1,[USER,,USER2] ;SET UP BLT
BLT S1,USER2+.AEMAX-1 ;COPY
MOVEI U,USER ;POINT TO BUFFER TO CHANGE
MOVEI X,USER2 ;POINT TO ORIGINAL FOR "RESTORE"
MOVEI S1,ENT000 ;COMMAND TABLES
MOVEI S2,[ASCIZ /USER>/] ;PROMPT
PUSHJ P,PROFIL ;PROCESS A SINGLE PROFILE
$RETIF ;CHECK FOR ERRORS
JRST CHANG3 ;GO PROCESS CHANGES
CHANG2: PUSHJ P,PROUPD ;UPDATE WORKING PROFILE
$RETIF ;CHECK FOR ERRORS
SETOM INSFLG ;ALL CHANGES ARE REAL WHEN WILDCARDING
CHANG3: PUSHJ P,PROCHG ;PERFORM ALL CHANGES TO PROFILE
SETZM INSFLG ;NO LONGER DOING SOMETHING STRANGE
JUMPF CHANG4 ;CHECK FOR ERRORS
PUSH P,S1 ;SAVE COUNT OF CHANGES TO THIS PROFILE
PUSHJ P,CVTPPD ;CONVERT PPN
POP P,S2 ;GET COUNT BACK
SKIPN S2 ;SOMETHING HAPPEN?
WARN (NCH,<No changes made to ^T/(S1)/ ^Q/USRNAM/>,,CHANG1)
$TEXT (,< User ^T/(S1)/ ^Q/USRNAM/ changed>)
AOS PROSUC ;COUNT THE SUCCESS
JRST CHANG1 ;LOOP FOR MORE
CHANG4: AOS PROFAI ;COUNT THE FAILURE
PUSHJ P,CVTPPD ;CONVERT PPN
WARN (CFU,<Change failed for ^T/(S1)/ ^Q/USRNAM/>,,CHANG1)
CHANG5: MOVEI S1,[ASCIZ/changed/]
PJRST WLDSUM ;GO SUMMARIZE AND RETURN
CHGHLP: ASCIZ \
The CHANGE command enables you to enter user mode and modify user
profiles. The syntax is: CHANGE user-id.
\
SUBTTL DELETE COMMAND -- DELETE - ENTRY POINT
XWD DELHLP,[ASCIZ /Delete a profile/]
DELETE: PUSHJ P,PRSWLD ;PARSE A USER ID
$RETIF ;RETURN ON ERRORS
SETOM DELASK ;DEFAULT TO /ASK
PUSHJ P,P$SWIT## ;CHECK FOR A SWITCH
JUMPF DELET1 ;NOT YET
CAIE S1,0 ;/NOASK?
CAIN S1,1 ;/ASK?
SKIPA ;YES TO EITHER
FATAL (IVS,<Invalid switch specified>)
MOVEM S1,DELASK ;SET FLAG ACCORDINGLY
DELET1: PUSHJ P,P$CFM## ;NEED EOL
JUMPF PRSERR ;CHECK FOR ERRORS
DELET2: PUSHJ P,WLDUSR ;GET FIRST/NEXT POSSIBLY WILDCARDED USER
JUMPF DELET3 ;DONE?
MOVEI U,USER ;POINT TO THE USER PROFILE
PUSHJ P,DELCHK ;CHECK PARANOIA LEVEL
PJRST @DELTAB(S1) ;YES, DISPATCH
DELET3: MOVEI S1,[ASCIZ /deleted/]
PUSHJ P,WLDSUM ;DISPLAY SUMMARY
$RETT
DELTAB: IFIW DELET2 ;"NO"
IFIW DELET3 ;"QUIT"
IFIW DELSHO ;"SHOW"
IFIW DELPRO ;"YES"
DELMAX==.-DELTAB ;LENGTH OF TABLE
SUBTTL DELETE COMMAND -- DELCHK - SEE IF OK TO DELETE PROFILE
DELCHK: SKIPE DELASK ;PARANOID?
JRST DELCH1 ;YES
MOVEI S1,3 ;SET INDEX FOR "YES"
$RETT ;AND RETURN
DELCH1: MOVEI S2,[ITEXT (<^H/.AEEXP(U)/>)]
MOVE S1,.AEEXP(U) ;GET EXPIRATION DATE/TIME
CAIN S1,0 ;SET?
MOVEI S2,[ITEXT (<not set>)]
CAMN S1,[-1] ;NEVER?
MOVEI S2,[ITEXT (<never>)]
PUSH P,S2 ;SAVE ITEXT BLOCK ADDRESS
PUSHJ P,CVTPPD ;CONVERT PPN
POP P,S2 ;GET ITEXT BACK
$TEXT (,<User ^T/(S1)/ ^Q/USRNAM/, expiration date: ^I/(S2)/>)
DELCH2: MOVEI S1,DELU00 ;COMMAND TABLE
MOVEI S2,[ASCIZ /Are you sure? /]
PUSHJ P,PRSCMD ;SCAN THE COMMAND
JUMPF DELCH2 ;CHECK FOR ERRORS
PUSHJ P,P$KEYW## ;GET A KEYWORD
JUMPF DELCH2 ;TRY AGAIN
CAILE S1,DELMAX ;RANGE CHECK RETURNED INDEX
JRST DELCH2 ;STRANGE ...
$RETT ;RETURN WITH ANSWER IN S1
DELU00: $INIT (DELU10)
DELU10: $KEYDSP (DELU20,<$DEFAULT (<YES>)>)
DELU20: $STAB
DSPTAB (CONFRM,0,<NO>)
DSPTAB (CONFRM,1,<QUIT>)
DSPTAB (CONFRM,2,<SHOW>)
DSPTAB (CONFRM,3,<YES>)
$ETAB
SUBTTL DELETE COMMAND -- DELHLP - HELP TEXT
DELHLP: ASCIZ \
The DELETE command removes the specified profile from the accounting
file. The syntax is: DELETE user-id /switches.
\
SUBTTL DELETE COMMAND -- MISCELLANEOUS
; DISPLAY PROFILE ("SHOW")
DELSHO: PUSHJ P,TYPUSR ;DISPLAY PROFILE
PUSHJ P,DELCH2 ;ASK FOR CONFIRMATION AGAIN
PJRST @DELTAB(S1) ;DISPATCH IT AGAIN
; DELETE PROFILE ("YES")
DELPRO: PUSHJ P,CVTPPD ;CONVERT PPN
PUSH P,S1 ;SAVE TEXT ADDRESS
PUSHJ P,DELUSR ;DELETE THIS PROFILE
POP P,S1 ;GET PPN TEXT ADDRESS BACK
JUMPF DELPR1 ;CHECK FOR ERRORS
AOS PROSUC ;COUNT THE SUCCESS
$TEXT (,< User ^T/(S1)/ ^Q/USRNAM/ deleted>)
JRST DELET2 ;LOOP
DELPR1: WARN (DPF,<Delete of profile failed for ^T/(S1)/>)
AOS PROFAI ;COUNT THE FAILURE
JRST DELET2 ;AND LOOP
SUBTTL EXIT COMMAND
XWD CTZHLP,[ASCIZ /Exit program/]
CTRLZ: PJRST EXIT ;SAME AS EXIT COMMAND
CTZHLP: ASCIZ \
Control-Z (^Z) is the same as the EXIT command. It stops the REACT
program and returns you to monitor command level.
\
XWD EXIHLP,[ASCIZ /Exit program/]
EXIT: MONRT. ;EXIT
JRST REACT ;THE FOOL TYPED CONTINUE
EXIHLP: ASCIZ \
The EXIT command stops the REACT program and returns you to monitor
command level.
\
SUBTTL HELP COMMAND -- ENTRY POINT
XWD HLPHLP,[ASCIZ /Gives information on commands/]
HELP: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
SETZ P1, ;ASSUME QUICK HELP WANTED
PUSHJ P,P$KEYW## ;GET A KEYWORD
SKIPF ;CHECK FOR ERRORS
MOVE P1,S1 ;COPY DISPATCH ADDRESS
PUSHJ P,P$CFM## ;GET CRLF
JUMPF HLPERR ;CHECK FOR ERRORS
JUMPN P1,HLPCMD ;JUMP IF HELP DESIRED ON A COMMAND
$TEXT (<-1,,HELPBF>,<Help for REACT %^V/.JBVER/^0>)
$TEXT (,<^T72C /HELPBF/^M^J>)
MOVE P1,CMDPTR ;POINT TO WORKING COPY OF COMMAND TABLE
HLRZ P2,(P1) ;GET NUMBER OF WORDS IN THE TABLE
MOVNS P2 ;NEGATE
HRLZS P2 ;PUT IN LH
HRRI P2,1(P1) ;MAKE AN AOBJN POINTER
HELP1: HLRZ S1,(P2) ;GET A KEYWORD
SKIPE S2,(S1) ;MUST CHECK
TLNE S2,(177B6) ;FIRST CHARACTER ZERO AND WORD NOT ALL ZERO?
TDZA S2,S2 ;NO--MAKE FLAGS ALL ZERO
AOJ S1, ;YES--ADJUST TEXT POINTER
TXNE S2,CM%NOR!CM%INV ;TEST FLAGS
JRST HELP2 ;PROBABLY A POINTER OR INVISIBLE
HRRZ S2,(P2) ;GET POINTER TO DISPATCH ADDRESS
HLRZ S2,(S2) ;GET DISPATCH ADDRESS
HRRZ S2,-1(S2) ;GET ONE-LINE HELP TEXT ADDRESS
$TEXT (,<^T12L /(S1)/ ^T/(S2)/>)
HELP2: AOBJN P2,HELP1 ;LOOP THROUGH THE TABLE
$RETT ;YES--ALL DONE
SUBTTL HELP COMMAND -- HLPCMD - GIVE HELP FOR A COMMAND
HLPCMD: MOVE P2,CMDPTR ;POINT TO WORKING COPY OF COMMAND TABLE
HLRZ S1,(P2) ;GET NUMBER OF WORDS IN THE TABLE
MOVNS S1 ;NEGATE
HRLZS S1 ;PUT IN LH
HRRI S1,1(P2) ;MAKE AN AOBJN POINTER
HLPCM1: HRRZ S2,(S1) ;GET A POINTER
CAME S2,P1 ;MATCH?
AOBJN S1,HLPCM1 ;LOOP
JUMPGE S1,HLPERR ;POINTER RUN OUT?
HLPCM2: HLRZ S1,(S1) ;GET ADDRESS OF COMMAND NAME
SKIPE S2,(S1) ;IF FIRST WORD NON-NULL,
TLNE S2,(177B6) ;BUT FIRST CHARACTER IS,
CAIA ;(NO)
AOJ S1, ;YES--SKIP OVER FLAGS WORD
HLRZ S2,(P1) ;GET DISPATCH ADDRESS
HLRZ S2,-1(S2) ;AND THE TEXT BLOCK ADDRESS
$TEXT (<-1,,HELPBF>,<Help for REACT %^V/.JBVER/ - ^T/(S1)/^0>)
$TEXT (,<^T72C /HELPBF/^M^J^T/(S2)/>)
$RETT ;RETURN
SUBTTL HELP COMMAND -- HLPERR - ERROR PROCESSING
; HERE WHEN NO HELP IS AVAILABLE. THIS SITUATION SHOULD NEVER ARISE.
; IF IT DOES, IT INDICATES SOME SORT OF INTERNAL COMMAND PARSING
; PROBLEM EXISTS. SINCE THE LACK OF HELP TEXT IS HARDLY FATAL, WE'LL
; JUST SPIT OUT A WARNING AND GO AWAY RATHER THAN JUMP OFF TO PRSERR.
HLPERR: WARN (NIO,<No information available on the specified topic>,,.RETT)
SUBTTL HELP COMMAND -- HLPHLP - HELP TEXT
HLPHLP: ASCIZ \
The HELP command enables you to obtain information about REACT. The
valid keywords are any REACT command name. If you do not specify a
command name REACT displays a brief listing of each REACT command on the
terminal.
\
SUBTTL INSERT COMMAND -- INSERT - ENTRY POINT
XWD INSHLP,[ASCIZ /Insert a profile into the accounting file/]
INSERT: MOVEI U,USER2 ;POINT TO PROTOTYPE PROFILE BLOCK
PUSHJ P,PROZPB ;CLEAR IT
MOVEI U,USER ;POINT TO WORKING PROFILE BLOCK
PUSHJ P,PROZPB ;CLEAR IT
MOVEI X,USER2 ;SET POINTER TO PROTOTYPE
SETOM DEFSRC ;SEARCH FOR DEFAULT PROFILE
SETOM DEFPPN ;INIT DEFAULT PPN FLAG
PUSHJ P,INSPRS ;PARSE ALL ARGUMENTS
$RETIF ;CHECK FOR ERRORS
INSER1: MOVE S1,WILDBK+UW$PPN ;GET PPN
MOVEM S1,.AEPPN(X) ;SAVE IN PROTOTYPE
PUSHJ P,INSWLD ;GATHER UP ALL WILDCARD PARAMETERS
$RETIF ;GIVE UP IF USER ABORTED INSERT
EXCH U,X ;SWAP PROFILE POINTERS
PUSHJ P,PROCLR ;CLEAR USER SPECIFIC DATA
EXCH U,X ;RESTORE PROFILE POINTERS
INSER2: SETZM INSFLG ;NOT INSERTING YET (FOR COMPAR)
PUSHJ P,INSPPN ;ASK FOR PPN IF NEEDED
$RETIF ;USER ABORTED INSERT
PUSHJ P,INSNAM ;ASK FOR A NAME IF NEEDED
$RETIF ;USER ABORTED INSERT
PUSHJ P,INSPSW ;ASK FOR OR GENERATE A PASSWORD
$RETIF ;USER ABORTED INSERT
MOVSI S1,(X) ;POINT TO PROTOTYPE
HRRI S1,(U) ;AND TO WORKING COPY
BLT S1,.AEMAX-1(U) ;COPY
SKIPE WLDINS ;WILDCARDED INSERT?
JRST INSER3 ;YES--JUST UPDATE WHAT WE HAVE NOW
MOVEI S1,ENT000 ;COMMAND TABLES
MOVEI S2,[ASCIZ /USER>/] ;PROMPT
PUSHJ P,PROFIL ;PROCESS A SINGLE PROFILE
$RETIF ;CHECK FOR ERRORS
INSER3: SETOM INSFLG ;GOING TO INSERT NOW
PUSHJ P,CVTPPD ;CONVERT PPN
PUSH P,S1 ;SAVE TEXT POINTER
PUSHJ P,INSQUE ;GO DO THE QUEUE. UUO
POP P,S1 ;RESTORE PPN TEXT ADDRESS
JUMPF INSER4 ;JUMP IF FAILED
MOVEI T1,[ITEXT (<password ^Q/T2/>)]
MOVE T2,[POINT 8,PASSWD] ;BYTE POINTER TO PASSWORD
SKIPE PMRPWD ;PASSWORD DEFAULTED?
MOVEI T1,[ITEXT (<default password>)]
$TEXT (,< User ^T/(S1)/ ^Q/USRNAM/ inserted with ^I/(T1)/>)
AOS PROSUC ;COUNT THE SUCCESS
JRST INSER5 ;ONWARD
INSER4: FATAL (INF,<Insert failed for user ^T/(S1)/ ^Q/USRNAM/>,,.+1)
AOS PROFAI ;COUNT THE FAILURE
INSER5: AOS WILDBK+UW$FND ;COMPENSATE FOR SUMMARY NONSENSE
MOVEI S1,[ASCIZ /inserted/]
SOSG PMRCNT ;ANY MORE TO DO?
PJRST WLDSUM ;DISPLAY SUMMARY AND RETURN
MOVE S2,PMRINC ;GET PROGRAMMER INCREMENT
ADD S2,.AEPPN(X) ;ADVANCE TO NEXT PPN
TRNE S2,400000 ;MAKE SURE WE'RE GENERATING A VALID PPN
WARN (PNO,<Project number overflow; insertion terminated>,,WLDSUM)
MOVEM S2,.AEPPN(X) ;UPDATE
SETZM .AENAM(X) ;ZAP THE NAME SO A NEW ONE WILL DEFAULT
JRST INSER2 ;LOOP BACK
SUBTTL INSERT COMMAND -- INSQUE - INSERT THE PROFILE
;CALL:
; U/ PROFILE POINTER
INSQUE: PUSHJ P,.SAVE4 ;PRESERVE SOME ACS
PUSHJ P,QINITA ;SETUP TO ADD AN ENTRY
MOVX P4,PD.NMD ;NO-MODIFY BIT
MOVSI P3,-QUETBL ;AOBJN POINTER
INSQ.1: MOVE S1,QUETAB(P3) ;GET NEXT PROFILE OFFSET
TDNE P4,CHGTAB##(S1) ;CAN IT BE MODIFIED?
JRST INSQ.3 ;NO, SO DON'T
CAIN S1,.AEPSW ;IF THE PASSWORD,
JRST INSQ.3 ;WAIT UNTIL LATER (IT'S IN A DIFFERENT BLOCK)
CAIE S1,.AENAM ;IS IT THE NAME?
JRST INSQ.2 ;NO, DON'T SECOND-GUESS IT
MOVX S2,AE.NCH ;NAME-CHANGE BIT
TDNN S2,.AEFLG(U) ;IF WE THINK IT SHOULD BE ON,
SKIPE RESPPN ;OR IF ACTDAE ALREADY KNOWS THE NAME,
JRST INSQ.3 ;THEN DON'T SEND A NAME
INSQ.2: PUSHJ P,QUECHG ;INSERT QUANTITY INTO THE UUO LIST
JUMPF INSQ.4 ;HOPE THIS WORKED
INSQ.3: AOBJN P3,INSQ.1 ;LOOP OVER ALL AVAILABLE PROFILE OFFSETS
DMOVE P1,[EXP .AEPSW,<.APWLW,,PASSWD>] ;PASSWORD BLOCK
PUSHJ P,QUEINS ;STUFF INTO THE BLOCK
JUMPF INSQ.4 ;HOPE IT WORKED
PJRST QUEUUO ;DO THE UUO AND RETURN THE PROGNOSIS
INSQ.4: WARN (ROS,<Ran out of space trying to build the INSERT list>,,.RETF)
SUBTTL INSERT COMMAND -- INSHLP - HELP TEXT
INSHLP: ASCIZ \
The INSERT command enables you to enter user mode and create new user
profiles. You can supply an optional existing user-id to use as a model
for the new profile. The syntax is:
INSERT new-user-id [=existing-user-id]
If you omit the existing-user-id, REACT looks for the default profile
for the project. If a default project profile does not exist, REACT
looks for the default profile for the system.
\
SUBTTL INSERT COMMAND -- INSNAM - NAME PARAMETER
INSNAM: SKIPE WILDBK+UW$WST ;IS A NAME NEEDED?
JRST INSNA2 ;NO
MOVE S1,.AEPPN(X) ;GET NEW PPN
PUSHJ P,A$CKPP## ;CHECK IF IT'S RESERVED
JUMPT INSNA1 ;NO, MUST ASK FOR NAME
$TEXT (<POINT 8,.AENAM(X),-1>,<^T/(S1)/^0>)
JRST INSNA4 ;GOT OUR NAME
INSNA1: SKIPN PMRPRT ;PROMPT FOR NAME?
JRST INSNA2 ;NO
MOVEI S1,USR000 ;COMMAND TABLE
MOVEI S2,[ASCIZ /New user name: /]
PUSHJ P,PRSCMD ;SCAN A COMMAND
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,PRSALT ;PARSE A USER-ID
JUMPF INSNA1 ;TRY AGAIN
SKIPN ALTRBK+UW$WST ;WAS A NAME GIVEN?
WARN (PGN,<PPN given when a name requested; ^Q/ALTRBP/>,,INSNA1)
SKIPN ALTRBK+UW$NAM ;NAME MUST BE NON-ZERO
JRST INSNA1 ;TRY AGAIN
PUSHJ P,WLDACK ;CHECK FOR WILDCARDING
SKIPF ;SKIP IF NOT
WARN (WNI,<Wildcarded name illegal; ^Q/ALTRBP/>,,INSNAM)
MOVSI S1,ALTRBK+UW$NAM ;POINT TO NAME JUST PARSED
HRRI S1,.AENAM(X) ;AND TO WORKING PROFILE BLOCK
BLT S1,.AENAM+.AANLW-1(X) ;COPY
MOVSI S1,ALTRBK+UW$NAM ;PONT TO NAME AGAIN
HRRI S1,WILDBK+UW$NAM ;AND TO WORKING BLOCK
BLT S1,WILDBK+UW$NAM+.AANLW-1 ;COPY
INSNA2: MOVEI S1,.AENAM(X) ;POINT TO NAME
PUSHJ P,A$CKNM## ;CHECK IT FOR LEGALITY
JUMPT INSNA5 ;IT'S NOT RESERVED
CAMN S1,.AEPPN(X) ;DID INSPPN AGREE WITH THIS?
JRST INSNA5 ;YES
MOVEI S1,.AENAM(X) ;POINT TO NAME AGAIN
HRLI S1,(POINT 8,) ;IN CASE OF ERROR
WARN (RNI,<Reserved name illegal; ^Q/S1/>,,INSNA3)
INSNA5: MOVEI S1,.AENAM(X) ;POINT TO TARGET NAME
MOVEI S2,TEMP ;WHERE TO STORE PROFILE
PUSHJ P,QUSRIN ;SEE IF THIS PPN EXISTS
JUMPF INSNA4 ;NO--ALMOST DONE
PUSH P,U ;SAVE U
MOVEI U,TEMP ;POINT TO TEMPORARY PROFILE BLOCK
PUSHJ P,CVTPPD ;CONVERT PPN
POP P,U ;RESTORE U
MOVEI S2,TEMP+.AENAM ;POINT TO NAME
HRLI S2,(POINT 8,) ;MAKE A BYTE POINTER
WARN (NAE,<Name ^Q/S2/ is already taken by ^T/(S1)/>)
INSNA3: SKIPE PMRPRT ;PROMPT FOR NAME?
SKIPE WILDBK+UW$WST ;WAS A NAME NEEDED?
$RETF ;NO--GIVE UP
JRST INSNA1 ;ELSE TRY AGAIN
INSNA4: MOVE S1,NAM+CG.IDX ;GET NAME INDEX
ADD S1,CHGPTR ;INDEX INTO CHANGE TABLE
SETOM @S1 ;MARK NAME AS "CHANGED"
SETOM CHGMSK+.AENAM ;IN BOTH PLACES
$RETT ;RETURN
SUBTTL INSERT COMMAND -- INSPPN - PPN PARAMETER
INSPPN: SETZM RESPPN ;ASSUME NOT RESERVED
SKIPN WILDBK+UW$WST ;IS A PPN NEEDED?
JRST INSPP3 ;NO
MOVEI S1,.AENAM(X) ;YES, POINT TO NAME THAT USER TYPED
PUSHJ P,A$CKNM## ;SEE IF IT IS RESERVED
JUMPT INSPP1 ;NO, DON'T SET A PPN FROM IT
MOVEM S1,.AEPPN(X) ;YES, SET ITS PPN
SETOM RESPPN ;REMEMBER THAT IT'S RESERVED
JRST INSPP3 ;AND DON'T ASK
INSPP1: MOVEI S1,USR000 ;COMMAND TABLE
MOVEI S2,[ASCIZ /New user PPN: /]
PUSHJ P,PRSCMD ;SCAN A COMMAND
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,PRSALT ;PARSE A USER-ID
JUMPF INSPP1 ;TRY AGAIN
SKIPN ALTRBK+UW$WST ;MUST BE A PPN
JRST INSPP2 ;GOT ONE
SKIPE ALTRBK+UW$NAM ;IS NAME REALLY BLANK?
WARN (NGP,<Name given when a PPN requested; ^Q/ALTRBP/>)
JRST INSPP1 ;TRY AGAIN
INSPP2: PUSHJ P,WLDACK ;CHECK FOR WILDCARDING
SKIPF ;SKIP IF NOT
WARN (WPI,<Wildarded PPN illegal; ^Q/ALTRBP/>,,INSPPN)
MOVE S1,ALTRBK+UW$PPN ;GET PPN
MOVEM S1,WILDBK+UW$PPN ;SAVE IN WORKING BLOCK
MOVEM S1,.AEPPN(X) ;SAVE IN PROFILE
INSPP3: MOVE S1,.AEPPN(X) ;GET TARGET PPN
MOVEM S1,WILDBK+UW$PPN ;SAVE FOR DISPLAY
SETOM WILDBK+UW$PPM ;NOT WILDCARDED
MOVEI S2,TEMP ;WHERE TO STORE PROFILE
PUSHJ P,QPPNIN ;SEE IF THIS PPN EXISTS
JUMPF INSPP4 ;PPN SHOULD NOT EXIST
HRRZ S1,.AEPPN(X) ;GET TARGET PROGRAMMER NUMBER
HRRZ S2,TEMP+.AEPPN ;AND RETURNED PROGRAMMER NUMBER
TRNE S1,1B18 ;POSSIBLY A UNIQUE PPN?
CAIN S1,(S2) ;WAS GENERIC ANSWER RETURNED (10,#)?
CAIA ;THEN TRYING TO INSERT DUPLICATE PPN
JRST INSPP4 ;ATTEMPT INSERTION
PUSH P,U ;SAVE U
MOVEI U,TEMP ;POINT TO TEMPORARY PROFILE BLOCK
PUSHJ P,CVTPPD ;CONVERT PPN
POP P,U ;RESTORE U
MOVEI S2,TEMP+.AENAM ;POINT TO NAME
HRLI S2,(POINT 8,) ;MAKE A BYTE POINTER
FATAL (PAE,<PPN ^T/(S1)/ is already taken by ^Q/S2/>,,.RETF)
INSPP4: SKIPE WILDBK+UW$WST ;HAVE A NAME?
JRST INSPP5 ;YES
EXCH U,X ;SWAP PROFILE POINTERS
PUSHJ P,PRONAM ;DEFAULT NAME
EXCH U,X ;RESTORE PROFILE POINTERS
INSPP5: AOSN DEFPPN ;BEEN HERE BEFORE?
SKIPE .AETIM(X) ;HAVE A PROFILE FOR INPUT?
$RETT ;YES--DONE
MOVE S1,.AEPPN(X) ;GET OUR PPN
MOVEM S1,.AEPPN(U) ;SET FOR PRODEF
PUSHJ P,PRODEF ;FETCH DEFAULT PROFILE
MOVEI T1,(X) ;USER PROFILE
MOVEI T2,(U) ;DEFAULT PROFILE
PUSHJ P,A$PDEF## ;APPLY THE DEFAULTS
MOVSI S1,(X) ;SOURCE
HRRI S1,(U) ;WORKING BLOCK
BLT S1,.AEMAX-1(U) ;COPY FOR CHANGES
$RETT ;RETURN
SUBTTL INSERT COMMAND -- INSPRS - PARSE ALL ARGUMENTS
INSPRS: PUSHJ P,PRSWLD ;PARSE A PPN OR NAME
$RETIF ;CHECK FOR ERRORS
PUSHJ P,WLDWCK ;CHECK FOR WILDCARDING
SKIPF ;SKIP IF NOT
SETOM WLDINS ;YES--REMEMBER FOR LATER
PUSHJ P,P$CFM## ;EOL?
JUMPT INSPR1 ;YES
PUSHJ P,P$TOK## ;GET "="
JUMPF PRSERR ;CHECK FOR ERRORS
MOVSI S2,(ASCIZ/=/) ;MUST BE AN EQUALS SIGN
CAME S2,ARG.DA(S1) ;CHECK IT
JRST PRSERR ;NO GOOD
PUSHJ P,PRSALT ;PARSE A PPN OR NAME
$RETIF ;CHECK FOR ERRORS
PUSHJ P,WLDACK ;CHECK FOR WILDCARDING
SKIPF ;SKIP IF NOT
FATAL (WIU,<Wildcarded input user-id illegal; ^Q/ALTRBP/>)
PUSHJ P,ALTUSR ;FETCH INPUT PROFILE
JUMPF WLDSUM ;GO REPORT ERROR AND RETURN
MOVSI S1,(U) ;POINT TO DEFAULT PROFILE
HRRI S1,(X) ;ADDRESS OF PROTOTYPE BLOCK
BLT S1,.AEMAX-1(X) ;SET UP PROTOTYPE
INSPR1: MOVE S1,WILDBK+UW$WST ;GET WILDCARD SEARCH TYPE
JUMPN S1,INSPR2 ;JUMP IF A NAME
HLRE S2,WILDBK+UW$PPM
CAME S2,[EXP -1] ;YES--WILD PROJECT NUMBER?
FATAL (WPI,<Wildcarded project number illegal on insert; ^Q/WILDBP/>)
MOVE S1,WILDBK+UW$PPN ;GET PPN
MOVEM S1,.AEPPN(X) ;SAVE IN PROTOTYPE PROFILE BLOCK
$RETT ;RETURN
INSPR2: CAIN S1,1 ;WILD NAME?
FATAL (WNI,<Wildcarded name illegal on insert; ^Q/WILDBP/>)
MOVSI S1,WILDBK+UW$NAM ;POINT TO NAME
HRRI S1,.AENAM(X) ;AND TO PROTOTYPE STORAGE
BLT S1,.AENAM+.AANLW-1(X) ;COPY
$RETT ;RETURN
SUBTTL INSERT COMMAND -- INSPSW - PASSWORD PARAMETER
INSPSW: SKIPN PMRPSW ;PROMPT FOR PASSWORD?
JRST INSPS1 ;NO
MOVEI S1,PASS00 ;COMMAND TABLE
MOVEI S2,[ASCIZ /Password: /]
PUSHJ P,PRSCMD ;SCAN THE COMMAND
JUMPF INSPSW ;TRY AGAIN
PUSHJ P,PSWGET ;PARSE A PASSWORD
$RETT ;RETURN
INSPS1: SKIPE PMRPWD ;DEFAULTING PASSWORD?
JRST INSPS2 ;YES
PUSHJ P,PROPSW ;GENERATE A PASSWORD
SETOM .AEPCT(X) ;FORCE A PASSWORD CHANGE ON FIRST LOGIN
MOVX S1,DF.PCT ;DEFAULT BIT FOR THIS FIELD
ANDCAM S1,DF$PCT(X) ;MAKE SURE WE SEND OUR VALUE
$RETT ;RETURN
INSPS2: MOVX S1,DF.PCT ;DEFAULT BIT FOR THIS FIELD
IORM S1,DF$PCT(X) ;FORCE FIELD DEFAULTING
PJRST PSWDFL ;DEFAULT PASSWORD FIELD AND RETURN
SUBTTL INSERT COMMAND -- INSWLD - WILDCARD PARAMETER PARSING
INSWLD: PUSHJ P,.SAVE1 ;SAVE P1
MOVE S1,.AEPPN(X) ;GET INITIAL PPN
TRNN S1,-1 ;ZERO?
HRRI S1,1 ;BE MORE REALISTIC
MOVEM S1,.AEPPN(X) ;UPDATE
MOVEI S1,1 ;NICE SMALL NUMBER
MOVEM S1,PMRINC ;DEFAULT INCREMENT
MOVEM S1,PMRCNT ;DEFAULT COUNT
SETOM PMRPRT ;DEFAULT TO PROMPTING FOR NAME
SKIPL WLDINS ;DOING WILD INSERT?
JRST INSWL6 ;GO CHECK OUT PASSWORD DEFAULTING
INSWL1: MOVEI S1,PGMR00 ;COMMAND TABLE
MOVEI S2,[ASCIZ/Base programmer number: /]
PUSHJ P,PRSCMD ;SCAN THE COMMAND
JUMPF PRSERR ;COMPLAIN IF PROBLEMS
PUSHJ P,P$NUM## ;FETCH A NUMBER
JUMPF INSWL1 ;TRY AGAIN
SKIPLE S1 ;RANGE
CAILE S1,377777 ; CHECK
WARN (BOR,<Base programmer number out of range 1 to 377777>,,INSWL1)
HRRM S1,.AEPPN(X) ;SAVE IT
MOVEI P1,377777 ;GET MAXIMUM PROGRAMMER NUMBER
SUBI P1,(S1) ;COMPUTE NUMBER OF PPNS WHICH CAN BE ADDED
JUMPLE P1,INSWL3 ;DON'T ASK FOR INCREMENT IF AT TOP OF RANGE
INSWL2: MOVEI S1,INCR00 ;COMMAND TABLE
MOVEI S2,[ASCIZ/Programmer number increment: /]
PUSHJ P,PRSCMD ;SCAN THE COMMAND
JUMPF PRSERR ;COMPLAIN IF PROBLEMS
PUSHJ P,P$NUM## ;FETCH A NUMBER
JUMPF INSWL2 ;TRY AGAIN
SKIPLE S1 ;RANGE
CAILE S1,(P1) ; CHECK
WARN (IOR,<Increment out of range 1 to ^O/P1/>,,INSWL2)
MOVEM S1,PMRINC ;SAVE THE INCREMENT
MOVEI S1,(P1) ;GET MAX INCREMENT (MAX # OF PPNS CAN GENERATE)
IDIV S1,PMRINC ;COMPUTE MAXIMUM COUNT TO INSERT
MOVEI P1,(S1) ;SAVE AWAY
INSWL3: MOVEI S1,COUN00 ;COMMAND TABLE
MOVEI S2,[ASCIZ/Count of PPN's to insert: /]
PUSHJ P,PRSCMD ;SCAN THE COMMAND
JUMPF PRSERR ;COMPLAIN IF PROBLEMS
PUSHJ P,P$NUM## ;FETCH A NUMBER
JUMPF INSWL3 ;TRY AGAIN
SKIPLE S1 ;RANGE
CAILE S1,(P1) ; CHECK
WARN (COR,<Count of PPNs out of range 1 to ^D/P1/>,,INSWL3)
MOVEM S1,PMRCNT ;SAVE COUNT
INSWL4: MOVEI S1,NAME00 ;COMMAND TABLE
MOVEI S2,[ASCIZ/Prompt for user name? /]
PUSHJ P,PRSCMD ;SCAN A COMMAND
JUMPF PRSERR ;COMPLAIN IF PROBLEMS
PUSHJ P,P$KEYW## ;FETCH A KEYWORD
JUMPF INSWL4 ;TRY AGAIN
MOVEM S1,PMRPRT ;SAVE PROMPT VALUE
INSWL5: MOVEI S1,NAME00 ;COMMAND TABLE
MOVEI S2,[ASCIZ/Prompt for password? /]
PUSHJ P,PRSCMD ;SCAN THE COMMAND
JUMPF PRSERR ;COMPLAIN IF PROBLEMS
PUSHJ P,P$KEYW## ;FETCH A KEYWORD
JUMPF INSWL5 ;TRY AGAIN
MOVEM S1,PMRPSW ;SAVE FLAG
JUMPN S1,.RETT ;RETURN IF THE ANSWER WAS "YES"
INSWL6: $RETT ;RETURN FOR NOW
MOVEI S1,NAME00 ;COMMAND TABLE
MOVEI S2,[ASCIZ/Default password? /]
PUSHJ P,PRSCMD ;SCAN THE COMMAND
JUMPF PRSERR ;COMPLAIN IF ERRORS
PUSHJ P,P$KEYW## ;FETCH A KEYWORD
JUMPF INSWL6 ;TRY AGAIN
MOVEM 1,PMRPWD ;SAVE FLAG
$RETT ;RETURN
SUBTTL INSERT COMMAND -- MISCELLANEOUS
PGMR00: $INIT (PGMR10)
PGMR10: $NUMBER (CONFRM,^D8,<octal number>)
COUN00: $INIT (COUN10)
COUN10: $NUMBER (CONFRM,^D10,<decimal number of PPNs to generate>)
INCR00: $INIT (INCR10)
INCR10: $NUMBER (CONFRM,^D8,<octal number for increment>)
NAME00: $INIT (NAME10)
NAME10: $KEYDSP (NAME20,$DEFAULT(<NO>))
NAME20: $STAB
DSPTAB (CONFRM,0,<NO>)
DSPTAB (CONFRM,1,<YES>)
$ETAB
SUBTTL LIST AND SHOW COMMANDS
XWD SHOHLP,[ASCIZ /Display profile information on the terminal/]
SHOW: JRST LIST ;ENTER COMMON CODE
XWD LISHLP,[ASCIZ /Write profile information to a file/]
LIST: PUSHJ P,PRSWLD ;PARSE A USER-ID
$RETIF ;CHECK FOR ERRORS
PUSHJ P,P$OFIL## ;GET OUTPUT FILESPEC
JUMPF LIST1 ;MUST BE A SHOW COMMAND
MOVEM S1,LST+FOB.FD ;SAVE FD ADDRESS
MOVEI S1,FOB.SZ ;FOB SIZE
MOVEI S2,LST ;FD ADDRESS
PUSHJ P,F%OOPN ;OPEN FILE FOR OUTPUT
SKIPT ;CHECK FOR ERRORS
FATAL (COL,<Can't open listing file ^F/@LST+FOB.FD/; ^E/[-1]/>)
MOVEM S1,LSTIFN ;SAVE IFN
MOVNI S2,1 ;-1 FOR ACTUAL FILESPEC
PUSHJ P,F%FD ;GET FILESPEC
JUMPF LIST1 ;SHOULDN'T FAIL
LOAD S2,.FDLEN(S1),FD.LEN ;GET RETURNED FD LENGTH
HRLZS S1 ;POINT FD IN LH
HRR S1,LST+FOB.FD ;AND TO OUR STORAGE
ADD S2,LST+FOB.FD ;COMPUTE END OF BLT
BLT S1,-1(S2) ;CPY RETURNED FD
INFO (LIS,<Listing to ^F/@LST+FOB.FD/>)
LIST1: MOVEI S1,0 ;DEFAULT TO /DETAIL
MOVEM S1,LISTFL ;SAVE INCASE NO SWITCH TYPED
PUSHJ P,P$SWIT## ;TRY FOR A SWITCH
JUMPF LIST2 ;NOT THERE
CAIE S1,0 ;/DETAIL?
CAIN S1,1 ;/FAST?
SKIPA ;SHOULDN'T HAPPEN
JUMPF PRSERR ;SHOULDN'T HAPPEN
MOVEM S1,LISTFL ;SAVE FLAG
LIST2: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
LIST3: PUSHJ P,WLDUSR ;GET FIRST/NEXT POSSIBLY WILDCARDED USER
JUMPF LIST5 ;DONE?
AOS PROSUC ;COUNT THE PROFILE
MOVEI U,USER ;POINT AT THE USER BLOCK
SKIPN LISTFL ;QUICK DISPLAY?
JRST LIST4 ;NO
PUSHJ P,CVTPPF ;CONVERT PPN
$TEXT (,< ^T/(S1)/ ^Q/USRNAM/>)
JRST LIST3 ;LOOP
LIST4: SKIPE LSTIFN ;OUTPUT TO A FILE?
$TEXT (,<^T/FORMFD/^A>) ;YES
$TEXT (,<^T/CRLFS/^A>)
PUSHJ P,TYPUSR ;DISPLAY THE PROFILE
JRST LIST3 ;LOOP
LIST5: SKIPE S1,LSTIFN ;OUTPUT TO A FILE?
PUSHJ P,F%REL ;YES--CLOSE IT NOW
SETZM LSTIFN ;ZAP IFN
MOVEI S1,[ASCIZ /listed/]
PUSHJ P,WLDSUM ;DISPLAY SUMMARY
$RETT ;AND RETURN
CRLFS: BYTE (7).CHCRT,.CHLFD,.CHCRT,.CHLFD,.CHCRT,.CHLFD,0
FORMFD: BYTE (7).CHFFD,.CHCRT,0
LISHLP: ASCIZ \
The LIST command writes profile information to a disk file. The syntax
is:
LIST user-id filespec/switch
The default filespec is DSK:ACCT.LST[-]. The switches are:
/DETAIL (default) lists all profile information
/FAST lists only PPNs and user names
\
SHOHLP: ASCIZ \
The SHOW command displays profile information on the terminal. The
syntax is:
SHOW user-id /switch
The switches are:
/DETAIL (default) lists all profile information
/FAST lists only PPNs and user names
\
SUBTTL LOCK AND UNLOCK COMMANDS
XWD UNLHLP,[ASCIZ /Unlock accounting file to allow updates/]
UNLOCK: MOVNI S1,1 ;UNLOCK ENTRY POINT
JRST LOCK1 ;ENTER COMMON CODE
XWD LOCHLP,[ASCIZ /Lock accounting file against updates/]
LOCK: SETZ S1, ;LOCK ENTRY POINT
LOCK1: PUSH P,S1 ;SAVE FLAG
;.QUFNC and .QUNOD
MOVE S1,[QF.RSP!.QUMAE] ;TALK TO ACTDAE
SETZ S2, ;CENTRAL SITE
DMOVEM S1,QUEBLK+.QUFNC ;SAVE AS FUNCTION CODE
;.QURSP
MOVE S1,[.AEMAX,,RSPBLK] ;RESPONSE BLOCK
MOVEM S1,QUEBLK+.QURSP
;.QUTIM
MOVEI S1,3 ;ASSUME STANDARD HEADER OFFSET
SKIPE OLDMON ;NON-FANCY UUO?
JRST LOCK2 ;YES, DON'T BE FANCY
SKIPE DEBUGQ ;WANT TO WAIT?
TDZA S2,S2 ;NO, LOAD ZERO TIME
MOVEI S2,ZZTIME ;YES, SET MAX. WAIT TIME
MOVEM S2,QUEBLK+3 ;SET FOR TIMEOUT
SKIPE S2,DEBUGW ;RUNNING PRIVATELY?
MOVE S2,ACTPID ;YES, USE THIS PID
MOVEM S2,QUEBLK+4 ;SET PID OR ZERO
SKIPE S2 ;DID WE SET A PID?
AOSA S1 ;YES, BUMP TWICE
SKIPE QUEBLK+3 ;NO, DID WE SET A TIMEOUT?
AOS S1 ;YES, BUMP HEADER LENGTH
STORE S1,QUEBLK,QF.HLN ;SET HEADER LENGTH FOR UUO
LOCK2:
;.QBAFN
MOVX S2,UGLOK$ ;ASSUME LOCK
SKIPE (P) ;WAS IT?
MOVX S2,UGUNL$ ;NO, WAS UNLOCK
TRO S2,AF.PRV ;MAKE SURE ACTDAE CHECKS OUR PRIVS
MOVEM S2,QUEBLK+1(S1) ;SET ACTDAE FUNCTION CODE
MOVE S2,[QA.IMM!1B17!.QBAFN] ;SUBFUNCTION CODE
MOVEM S2,QUEBLK(S1) ;STORE THE SUBFUNCTION TYPE
MOVSI S1,2(S1) ;GET LENGTH OF ARG BLOCK
HRRI S1,QUEBLK ;POINT TO THE BLOCK
POP P,S2 ;GET ENTRY BACK
QUEUE. S1,
FATAL (LSF,<Accounting file status change failed; ^T/RSPBLK/>,,.RETF)
SKIPN S2
INFO (LOK,<Accounting file locked; changes are prohibited>,,.RETT)
INFO (UNL,<Accounting file unlocked; changes are permitted>,,.RETT)
LOCHLP: ASCIZ \
The LOCK command instructs ACTDAE to open the accounting file in
read-only mode. When this is done, the accounting file will not be
updated by ACTDAE. Therefore, users will not be allowed to change
unprivileged fields in their profiles. A privileged user will not be
allowed to make any changes that would modify the accounting file. This
command is used mainly to support the VERIFY command, or in a situation
where you might want to supersede the accounting file.
\
UNLHLP: ASCIZ \
The UNLOCK command instructs ACTDAE to re-open the accounting file in
update mode. This command restores ACTDAE to its normal mode of
operation.
\
SUBTTL PURGE COMMAND
XWD DELHLP,[ASCIZ /Purge expired profiles/]
PURGE: PUSHJ P,PRSWLD ;PARSE A USER ID
$RETIF ;RETURN ON ERRORS
PUSHJ P,P$CFM## ;NEED EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,I%NOW ;GET CURRENT DATE/TIME
MOVEM S1,EXPDTM ;SAVE FOR EXPIRATION DATE/TIME COMPARRISONS
PURGE1: PUSHJ P,WLDUSR ;GET FIRST/NEXT POSSIBLY WILDCARDED USER
JUMPF PURGE3 ;DONE?
MOVEI U,USER ;POINT TO THE USER PROFILE
SKIPLE S1,.AEEXP(U) ;GET DATE/TIME FROM PROFILE
CAMLE S1,EXPDTM ;EXPIRED PPN?
JRST PURGE1 ;NO
PUSHJ P,CVTPPD ;CONVERT PPN
PUSH P,S1 ;SAVE TEXT ADDRESS
PUSHJ P,DELUSR ;DELETE THIS USER
POP P,S1 ;GET PPN TEXT ADDRESS BACK
JUMPF PURGE2 ;CHECK FOR ERRORS
AOS PROSUC ;COUNT THE SUCCESS
$TEXT (,< User ^T/(S1)/ ^Q/USRNAM/ purged>)
JRST PURGE1 ;LOOP
PURGE2: WARN (DPF,<Purge of profile failed for ^T/(S1)/>)
AOS PROFAI ;COUNT THE FAILURE
JRST PURGE1 ;LOOP
PURGE3: MOVEI S1,[ASCIZ /purged/]
PUSHJ P,WLDSUM ;DISPLAY SUMMARY
$RETT
PURHLP: ASCIZ \
The PURGE command removes the specified expired profile(s) from the
accounting file. The syntax is: PURGE user-id.
\
SUBTTL SELECT COMMAND
XWD SELHLP,[ASCIZ /Select wildcarding criteria/]
SELECT: PUSHJ P,P$SWIT## ;TRY FOR A SWITCH
SKIPT ;SKIP IF GOT ONE
MOVNI S1,1 ;ELSE REMEMBER THERE'S NO SWITCH
PUSH P,S1 ;SAVE
PUSHJ P,P$CFM## ;GET EOL
POP P,S1 ;GET SWITCH VALUE OR FLAG BACK
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,SELINI ;INIT SELECTION STORAGE
JUMPE S1,.RETT ;RETURN IF JUST CLEARING SELECTION CRITERIA
SETOM SELFLG ;FLAG SELECTION IN PROGRESS
MOVEI U,USER ;POINT TO PROFILE BLOCK
MOVEI X,(U) ;ALWAYS NEED BOTH SETUP
MOVSI S1,(U) ;GET ADDR
HRRI S1,1(U) ;MAKE A BLT POINTER
SETZM (U) ;CLEAR FIRST WORD
BLT S1,.AEMAX-1(U) ;CLEAR OUT BLOCK
MOVE S1,[ACTFMT,,.AEMIN] ;INITIALIZE OVERHEAD WORD
MOVEM S1,.AEVRS(U) ;SO EXTENSIBLE BLOCKS WILL WORK
MOVEI S1,SEL000 ;COMMAND TABLE
MOVEI S2,[ASCIZ /SELECT>/] ;PROMPT
PUSHJ P,PROFIL ;PROCESS AS IF IT WERE A PROFILE
$RETT ;RETURN
SUBTTL SELECT COMMAND -- SELCHK - CHECK FOR SELECTION IN PROGRESS
SELCHK: SKIPN SELFLG ;SELCTION IN PROGRESS?
$RETT ;NO
SETZM SELFNC ;CLEAR OUT ANY OLD FUNCTION CODE
PUSHJ P,P$KEYW## ;GET A KEYWORD
$RETIF ;CHECK FOR ERRORS
CAIL S1,400001 ;RANGE
CAILE S1,400003 ; CHECK
JRST SELCH1 ;NO GOOD
ANDI S1,777 ;MAKE SURE THERE'S NO JUNK
LSH S1,17 ;POSITION
MOVEM S1,SELFNC ;STORE AS FUNCTION CODE
$RETT ;AND RETURN
SELCH1: PUSHJ P,P$PREV## ;NOT A SELECT KEYWORD
$RETF ;GIVE UP
SUBTTL SELECT COMMAND -- SELHLP - HELP TEXT
SELHLP: ASCIZ \
Select command
\
SUBTTL SELECT COMMAND -- SELINI - INITIALIZE SELECTION STORAGE
SELINI: PUSH P,S1 ;SAVE S1
MOVSI S1,WILDBK+UW$SEL ;POINT TO START OF SELECTION DATA
HRRI S1,WILDBK+UW$SEL+1 ;MAKE A BLT POINTER
SETZM WILDBK+UW$SEL ;CLEAR FIRST WORD
BLT S1,WILDBK+PAGSIZ-1 ;CLEAR SELECTION STORAGE
; ***
; REPLACE NEXT INSTUCTION WITH ONES THAT WILL COMPUTE THE NUMBER
; OF AVAILABLE WORDS FOR SELECTION CRITERIA AS FOLLOWS:
; FREE SPACE = MAX - UUO - UW$DAT - OH
;
; WHERE MAX - MAXIMUM QUEUE. UUO PACKET LENGTH (^D510)
; UUO - QUEUE. UUO FUNCTION WORDS AND SUB-BLOCKS NEEDED
; TO SET UP THE WILDCARD CALL
; UW$DAT - WILDCARD DATA (PPN, MASK, NAME, ETC.)
; OH - MONITOR OVERHEAD WORDS APPENDED TO THE MESSAGE
;
; THIS CAN BE DONE IF VALUES FOR "MAX" AND "OH" ARE GETTABABLE.
; ***
ND Q.MAX,^D510 ;LONGEST NON-PAGE MESSAGE
ND Q.OH,2+3+9+2+.OHDRS ;NODE+NAME+ACCOUNT+.QBFNC+GALAXY
Q.UUO==2+1+UW$DAT ;.QBAFN+.QBAET
MOVSI S1,Q.OH+Q.UUO-Q.MAX ;MAKE A BAD GUESS FOR NOW
HRRI S1,WILDBK+UW$DAT ;MAKE AN AOBJN POINTER
MOVEM S1,SELPTR ;SAVE
PUSHJ P,PROZQM ;CLEAR OUT THE MODIFY MASKS
POP P,S1 ;RESTORE S1
POPJ P, ;RETURN
SUBTTL SELECT COMMAND -- MISCELLANEOUS
SEL000: $INIT (SEL010)
SEL010: $KEYDSP (SEL020,<$ALTER (ENT020)>)
SEL020: $STAB
DSPTAB (ENTSLC,400001,<AND>)
DSPTAB (ENTSLC,400003,<NOT>)
DSPTAB (ENTSLC,400002,<OR>)
$ETAB
SUBTTL VERIFY COMMAND -- VERIFY - ENTRY POINT
XWD VERHLP,[ASCIZ /Verify the accounting file from a master file/]
VERIFY: PUSHJ P,.SAVE4 ;SAVE SOME ACS
MOVE S1,[CHGMSK,,CHGMSK+1] ;BLT XFER WORD
SETOM CHGMSK ;TO FAKE OUT COMPAR
BLT S1,CHGMSK+.AEMIN-1 ;ALL MASKABLE WORDS CHANGED IN ALL BITS
PUSHJ P,INITIO## ;INIT RMS-10 INTERFACE
PUSHJ P,VERPRS ;PARSE ALL ARGUMENTS
PUSHJ P,VEROPN ;OPEN ALL NECESSARY FILES
$RETIF ;GIVE UP ON FAILURES
MOVEI U,USER ;MASTER PROFILE
MOVEI X,USER2 ;WORKING PROFILE
SETZM VERABO ;CLEAR ABORTED FLAG
SETZM VERDIF ;INIT DIFFERENCE COUNTER
PUSHJ P,VERUSR ;VERIFY USER PROFILES
SKIPE VERABO ;VERIFICATION ABORTED?
FATAL (AUA,<Accounting file verification aborted>,,VERIF1)
VERIF1: PUSHJ P,VERCLS ;CLOSE FILES
SKIPE SWTUPD ;SKIP IF /NOUPDATE
SKIPE VERABO ;ABORTING VERIFY?
JRST VERIF2 ;YES--DON'T SUPERSEDE WORKING FILE
MOVEI S1,TEMPFD ;FD FOR INPUT
MOVEI S2,WORKFD ;FD FOR OUTPUT
PUSHJ P,VERCPY ;COPY TEMPORARY FILE TO WORKING FILE
VERIF2: SKIPE SWTUPD ;SKIP IF /NOUPDATE
PUSHJ P,ERSC## ;ERASE (DELETE) TEMPORARY FILE "C"
SKIPE VERABO ;ABORTING VERIFY?
$RETT ;YES--ALL DONE
MOVE S1,VERDIF ;ANY DIFFERENCES?
CAIN S1,1 ;ONLY ONE
SKIPA S2,[[ITEXT (<; one difference>)]]
MOVEI S2,[ITEXT (<; ^D/S1/ differences>)]
SKIPN S1 ;UNLESS THERE WERE NONE
MOVEI S2,[ITEXT (<; no differences>)]
$TEXT (,<^M^J Accounting file verified^I/(S2)/>)
$RETT ;DONE
SUBTTL VERIFY COMMAND -- VERASK - ASK USER ABOUT DIFFERENCES
VERASK: SKIPG SWTUPD ;SKIP IF /UPDATE
JRST VERNO ;YES, TREAT AS NOT PRESERVING CHANGES
VERAS1: MOVEI S1,DELU00 ;PARSE TABLE SAME AS DELETE OPTIONS
MOVEI S2,[ASCIZ /Preserve changes? /] ;POINT TO PROMPT STRING
PUSHJ P,PRSCMD ;PARSE THE COMMAND
JUMPF VERAS1 ;CHECK FOR ERRORS
PUSHJ P,P$KEYW## ;GET KEYWORD
JUMPF VERAS1 ;CHECK FOR ERRORS
CAILE S1,VERLEN ;VALID KEYWORD?
JRST VERAS1 ;NO PROMPT AGAIN
JRST @VERTAB(S1) ;YES, DISPATCH
; KEYWORD DISPATCH TABLE
VERTAB: IFIW VERNO ;"NO"
IFIW VERQUI ;"QUIT"
IFIW VERSHO ;"SHOW"
IFIW VERYES ;"YES"
VERLEN==.-VERTAB ;LENGTH OF TABLE
; "NO" KEYWORD PROCESSOR
VERNO: $RETF ;DO NOT INCLUDE CHANGES
; "QUIT" KEYWORD PROCESSOR
VERQUI: SETOM VERABO ;FLAG TERMINATION
$RETF ;RETURN
; "SHOW" KEYWORD PROCESSOR
VERSHO: $TEXT (,< Profile from accounting file:>)
EXCH U,X ;POINT TO THE WORKING FILE
PUSHJ P,TYPUSR ;DISPLAY PROFILE
EXCH U,X ;RESTORE
JRST VERASK ;LOOP BACK AND ASK AGAIN
; "YES" KEYWORD PROCESSOR
VERYES: $RETT ;INCLUDE CHANGES
SUBTTL VERIFY COMMAND -- VERCLS - CLOSE FILES
VERCLS: PUSHJ P,CLSA## ;CLOSE FILE "A"
PUSHJ P,CLSB## ;CLOSE FILE "B"
SKIPE SWTUPD ;SKIP IF /NOUPDATE
PUSHJ P,CLSC## ;CLOSE FILE "C"
$RETT ;YES--DONE
SUBTTL VERIFY COMMAND -- VERCMP - COMPARE PROFILES
VERCMP: PUSHJ P,.SAVE3 ;SAVE SOME ACS
MOVSI P1,-QUETBL ;AOBJN LIMIT FOR QUETAB
VERUP1: MOVE S1,QUETAB(P1) ;GET THE PROFILE ENTRY
MOVE S2,CHGTAB##(S1) ;GET BITS FOR THIS OFFSET
TXNN S2,PD.NMD ;IF CAN'T MODIFY
TXNN S2,PD.UNP ;OR IF PRIV'ED
JRST VERUP0 ;THEN SKIP THIS ONE
TXNN S2,PD.EXT ;IF NOT EXTENSIBLE,
JRST VERUP2 ;GO HANDLE IT ELSEWHERE
MOVEI T1,(U) ;WHICH PROFILE TO MODIFY
MOVEI T3,(S1) ;OFFSET TO CHANGE
ADDI T3,(X) ;WHENCE TO FETCH
SKIPE T3,(T3) ;IF THERE,
ADDI T3,(X) ;DE-RELATIVIZE IT
HLLZ T2,T3 ;COPY LH
HRRI T2,(S1) ;INCLUDE PROFILE OFFSET IN CORRECT PLACE
ADJBP S1,[POINT 1,.AEMAP(X),0] ;POINT TO ITS 'DEFAULTED' BIT
LDB T4,S1 ;GET THAT, AS WELL
PUSHJ P,A$EBLK## ;UPDATE MASTER ENTRY FROM WORKING COPY
JRST VERUP0 ;LOOP OVER ALL UNPRIV'ED ENTRIES
VERUP2: LOAD S2,S2,PD.WRD ;GET LENGTH OF ENTRY
MOVNS S2 ;MAKE SUITABLE FOR AOBJN
HRLI S1,(S2) ;MAKE RELATIVE POINTER FOR LOOPING
MOVX P2,<IFIW (S1)> ;LH OF INDIRECTION
MOVE P3,P2 ;IN BOTH INDIRECT WORDS
HRRI P2,(U) ;POINTER FOR MASTER
HRRI P3,(X) ;POINTER FOR WORKING COPY
VERUP3: MOVE S2,@P3 ;GET WORKING VALUE
MOVEM S2,@P2 ;UPDATE IN MASTER ENTRY
AOBJN S1,VERUP3 ;LOOP OVER ALL WORDS IN ENTRY
VERUP0: AOBJN P1,VERUP1 ;LOOP OVER ALL PROFILE ENTRIES
VERCM0: MOVSI P1,-.AEMIN ;-LENGTH OF STATIC PORTION OF PROFILE
VERCM1: HRRZ S1,P1 ;GET PROFILE OFFSET
PUSHJ P,COMPAR ;GET TRUE IFF SAME
JUMPF VERCM6 ;SOMETHING CHANGED
$FALL VERCM5 ;ONWARD
VERCM5: AOBJN P1,VERCM1 ;LOOP
$RETT ;RETURN
; HERE WHEN PROFILES DIFFER
VERCM6: AOS VERDIF ;FLAG THE DIFFERENCE
$RETF ;RETURN
SUBTTL VERIFY COMMAND -- VERCPY - COPY A FILE
; COPY A FILE
; CALL: MOVE S1, FD FOR INPUT
; MOVE S2, FD FOR OUTPUT
; PUSHJ P,VERCPY
VERCPY: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
DMOVE P1,S1 ;COPY ARGUMENTS
MOVE S1,[VERRFB,,VERRFB+1] ;ZERO FOB FOR READING
SETZM VERRFB
BLT S1,VERRFB+FOB.SZ-1
MOVE S1,[VERWFB,,VERWFB+1] ;ZERO FOB FOR WRITING
SETZM VERWFB
BLT S1,VERWFB+FOB.SZ-1
MOVEM P1,VERRFB+FOB.FD ;SAVE INPUT FD ADDRESS
MOVEM P2,VERWFB+FOB.FD ;SAVE OUTPUT FD ADDRESS
MOVEI S1,44 ;36-BIT BYTES
MOVEM S1,VERRFB+FOB.CW ;SAVE FOR INPUT
MOVEM S1,VERWFB+FOB.CW ;SAVE FOR OUTPUT
SETZB P1,P2 ;ZERO IFNS
MOVEI S1,FOB.SZ ;FOB SIZE
MOVEI S2,VERRFB ;FOB ADDRESS
PUSHJ P,F%IOPN ;OPEN FILE FOR INPUT
JUMPF VERCP2 ;CHECK FOR ERRORS
MOVE P1,S1 ;SAVE IFN FOR INPUT
MOVEI S1,FOB.SZ ;FOB SIZE
MOVEI S2,VERWFB ;FOB ADDRESS
PUSHJ P,F%OOPN ;OPEN FILE FOR OUTPUT
JUMPF VERCP3 ;CHECK FOR ERRORS
MOVE P2,S1 ;SAVE IFN FOR OUTPUT
; HERE WE CHEAT. SINCE WE'RE DOING AN IMAGE COPY, THE BYTE SIZE
; IS 36. GLXFIL WILL GIVE US AN BYTE POINTER TO THE DATA IN ITS
; INTERNAL BUFFER. WE'LL FIX UP THE ADDRESS (BYTE POINTER SET TO
; ILDB THROUGH THE BUFFER) AND GIVE IT RIGHT BACK TO GLXFIL FOR
; OUTPUT.
VERCP1: MOVE S1,P1 ;IFN FOR INPUT
PUSHJ P,F%IBUF ;READ A BUFFER
JUMPF VERCP4 ;CHECK FOR ERRORS
AOS S2 ;POINT TO FIRST DATA WORD
HRL S2,S1 ;GET NUMBER OF WORDS
MOVE S1,P2 ;IFN FOR OUTPUT
PUSHJ P,F%OBUF ;WRITE A BUFFER
JUMPF VERCP5 ;CHECK FOR ERRORS
JRST VERCP1 ;LOOP
; OPEN ERRORS
VERCP2: SKIPA S2,VERRFB+FOB.FD ;GET INPUT FD ADDRESS
VERCP3: MOVE S2,VERWFB+FOB.FD ;GET OUTPUT FD ADDRESS
WARN (OPE,<Open error on ^F/(S2)/; ^E/S1/>,,VERCP6)
; I/O ERRORS
VERCP4: SKIPA S2,VERRFB+FOB.FD ;GET INPUT FD ADDRESS
VERCP5: MOVE S2,VERWFB+FOB.FD ;GET OUTPUT FD ADDRESS
CAIE S1,EREOF$ ;END OF FILE?
WARN (IOE,<I/O error on ^D/(S2)/; ^E/S1/>,,VERCP6)
MOVE S1,P1 ;IFN FOR INPUT
PUSHJ P,F%REL ;RELEASE IT
MOVE S1,P2 ;IFN FOR OUTPUT
PUSHJ P,F%REL ;RELEASE IT
$RETT ;RETURN
; CLOSE FILES ON ERRORS
VERCP6: SETOM VERABO ;FLAG ABORT
SKIPE S1,P1 ;IFN FOR INPUT
PUSHJ P,F%RREL ;RELEASE IT
SKIPE S1,P2 ;IFN FOR OUTPUT
PUSHJ P,F%RREL ;RELEASE IT
$RETF ;RETURN
SUBTTL VERIFY COMMAND -- VERHLP - HELP TEXT
VERHLP: ASCIZ \
The VERIFY command enables you to maintain a master copy of the
accounting file in addition to the working copy on SYS. You can make
changes to the working copy of the accounting file without shutting down
the entire accounting system.
When you issue the VERIFY command, REACT displays the differences
between the master accounting file and the working accounting file. You
can preserve the changes in the working file or discard them. When the
update is complete, the working copy of the accounting file on SYS
reflect the changes you made.
\
SUBTTL VERIFY COMMAND -- VEROPN - OPEN FILES
; FILE "A" - MASTER FILE (DSK:MASTER.SYS)
; FILE "B" - WORKING FILE (SYS:ACTDAE.SYS)
; FILE "C" - TEMPORARY FILE (DSK:###REA.TMP)
VEROPN: MOVEI S1,MASTFN ;MASTER FILESPEC
MOVEI S2,0 ;READ-ONLY
PUSHJ P,OPNA## ;OPEN FILE "A"
SKIPT ;CHECK FOR ERROR
FATAL (OPF,<Open failed for ^T/MASTFN/>,,VEROP6)
MOVE S1,[MASTWB,,MASTWB+1] ;SET UP BLT
SETZM MASTWB ;CLEAR FIRST WORD
BLT S1,MASTWB+UW$MIN-1 ;CLEAR WILDCARD BLOCK
SKIPE DEBUGW ;DEBUGGING?
SKIPA S1,[SIXBIT/DSK/] ;YES
MOVSI S1,'SYS' ;NO
$TEXT (<-1,,WORKFN>,<^W/S1/:^W/[ACTFIL]/.SYS^0>)
MOVEI S1,WORKFN ;WORKING FILESPEC
MOVEI S2,0 ;READ-ONLY
PUSHJ P,OPNB## ;OPEN FILE "B"
SKIPT ;CHECK FOR ERROR
FATAL (OPF,<Open failed for ^T/WORKFN/>,,VEROP5)
MOVE S1,[WORKWB,,WORKWB+1] ;SET UP BLT
SETZM WORKWB ;CLEAR FIRST WORD
BLT S1,WORKWB+UW$MIN-1 ;CLEAR WILDCARD BLOCK
SKIPG SWTUPD ;SKIP IF /UPDATE
JRST VEROP1 ;ALMOST DONE
PJOB S1, ;GET OUR JOB NUMBER
$TEXT (<-1,,TEMPFN>,<DSK:^D3R0/S1/REA.TMP^0>)
MOVEI S1,TEMPFN ;TEMP FILE NAME STRING
MOVEI S2,1 ;ALLOW WRITING
PUSHJ P,OPNC## ;OPEN FILE "C"
SKIPT ;CHECK FOR ERROR
FATAL (OPE,<Open failed for ^T/TEMPFN/>,,VEROP3)
MOVEI S1,1 ;OPTION 1, SET LOAD FLAG
MOVEI S2,1 ;TURN ON LOAD FLAG FOR TEMP FILE
PUSHJ P,OPTC## ;PERFORM THE FUNCTION
MOVE S1,[TEMPWB,,TEMPWB+1] ;SET UP BLT
SETZM TEMPWB ;CLEAR FIRST WORD
BLT S1,TEMPWB+UW$MIN-1 ;CLEAR WILDCARD BLOCK
VEROP1: $TEXT (,<>) ;START WITH A BLANK LINE
MOVEI S1,4 ;OPTION NUMBER
PUSHJ P,OPTA## ;GET FILESPEC FOR FILE "A"
MOVEI T1,MASTFD ;FD STORAGE
MOVEI T2,[ASCIZ /Master file: /]
PUSHJ P,VEROP3 ;REPORT FILE
MOVEI S1,4 ;OPTION NUMBER
PUSHJ P,OPTB## ;GET FILESPEC FOR FILE "B"
MOVEI T1,WORKFD ;FD STORAGE
MOVEI T2,[ASCIZ /Accounting file:/]
PUSHJ P,VEROP3 ;REPORT FILE
SKIPG SWTUPD ;SKIP IF /UPDATE
JRST VEROP2 ;ELSE ALMOST DONE
MOVEI S1,4 ;OPTION NUMBER
PUSHJ P,OPTC## ;GET FILESPEC FOR FILE "C"
MOVEI T1,TEMPFD ;FD STORAGE
MOVEI T2,[ASCIZ /Temporary file: /]
PUSHJ P,VEROP3 ;REPORT FILE
VEROP2: MOVEI S1,[ASCIZ /Verifying: /]
MOVEI T1,[ASCIZ ./REPORT.]
SKIPG SWTRPT ;/REPORT?
MOVEI T1,[ASCIZ//] ;NO
MOVEI T2,[ASCIZ ./UPDATE.]
SKIPG SWTUPD ;/UPDATE?
MOVEI T2,[ASCIZ//] ;NO
$TEXT (,< ^T/(S1)/ ^Q/WILDBP/ ^T/(T1)/ ^T/(T2)/^M^J>)
$RETT ;RETURN
VEROP3: MOVEI T3,(T1) ;GET START OF FD STORAGE
HRRI T1,.FDSTR(T1) ;START OF ACTUAL FILESPEC DATA
HRLI T1,.FOFDV(S2) ;MAKE A BLT POINTER
BLT T1,FDXSIZ-1(T3) ;COPY FILESPEC
MOVSI S1,FDXSIZ ;GET LENGTH,,FILE TYPE (NATIVE)
MOVEM S1,.FDLEN(T3) ;SAVE IN FD
$TEXT (,< ^T/(T2)/ ^F/(T3)/>) ;REPORT FILE TO USER
$RETT ;RETURN
VEROP4: PUSHJ P,CLSB## ;CLOSE FILE "B"
VEROP5: PUSHJ P,CLSA## ;CLOSE FILE "A"
VEROP6: SETOM VERABO ;FLAG ABORT
$RETF ;RETURN
SUBTTL VERIFY COMMAND -- VERPRS - PARSE ARGUMENTS
VERPRS: SETOM VERALL ;ASSUME WILL VERIFY ALL PROFILES
SETZB S1,S2 ;WILDCARD PPN AND MASK FOR [*,*]
MOVEM S1,WILDBK+UW$PPN ;SAVE DEFAULT PPN
MOVEM S2,WILDBK+UW$PPM ;SAVE DEFAULT MASK
PUSHJ P,P$FILE## ;GET POINTER TO FILESPEC
$RETIF ;RETURN ON ERROR
MOVEI S2,.FDNAT ;NATIVE MODE FILESPEC
STORE S2,.FDLEN(S1),FD.TYP ;SET IN FD
$TEXT (<-1,,MASTFN>,<^F/(S1)/^0>)
PUSHJ P,PRSSWT ;PARSE SOME SWITCHES
$RETIT ;RETURN IF EOL
PUSHJ P,PRSWLD ;CAN ONLY BE A USER-ID AT THIS POINT
$RETIF ;RETURN ON ERROR
SKIPN S1,WILDBK+UW$WST ;GET WILDCARD SEARCH TYPE
SKIPE S2,WILDBK+UW$PPM ;GET PPN MASK
CAIA ;NEED TO CHECK HARDER
JRST VERPR3 ;STILL DOING ALL PROFILES, GET SWITCHES
SETZM VERALL ;NOT ALL PPNS, ASSUME SELECTIVE
CAIE S1,1 ;CORRECT ASSUMPTION?
JRST VERPR3 ;DEFINITELY, LOOK FOR SWITCHES
MOVEI TF,.AANLC ;MAXIMUM NUMBER OF CHARACTERS IN A NAME
MOVE S1,[POINT 8,WILDBK+UW$NAM] ;WHERE THE NAME WAS STORED
VERPR1: ILDB S2,S1 ;GET NEXT CHARACTER FROM NAME
JUMPE S2,VERPR2 ;DONE
CAIN S2,"*" ;IF STILL FULLY WILD,
SOJG TF,VERPR1 ;KEEP LOOKING
JRST VERPR3 ;SELECTIVE VERIFY GUESS WAS CORRECT
VERPR2: CAIE TF,.AANLC ;UNLESS NAME IS NULL,
SETOM VERALL ;NAME OF **... IS STILL FINDING ALL PROFILES
VERPR3: PUSHJ P,PRSSWX ;MAYBE MORE SWITCHES?
$RETIF ;NO SWITCHES OR EOL
MOVEI S1,1 ;GET A "YES"
SKIPGE SWTUPD ;/UPDATE?
MOVEM S1,SWTUPD ;DEFAULT TO YES
SKIPGE SWTRPT ;/REPORT?
MOVEM S1,SWTRPT ;DEFAULT TO YES
$RETT ;RETURN
SUBTTL VERIFY COMMAND -- VERRPT - REPORT DIFFERENCES IN PROFILE
VERRPT: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
PUSHJ P,CVTPPD ;CONVERT PPN
WARN (DIF,<Difference in profile for ^T/(S1)/ ^Q/USRNAM/>)
SKIPG SWTRPT ;/REPORT?
$RETT ;NO
MOVE S1,ENTKPT ;POINT TO PROFILE ENTRY TABLE
HLRZ P1,(S1) ;GET NUMBER OF ENTRIES IN TABLE
MOVNS P1 ;NEGATE
HRLZS P1 ;PUT IN LH
HRRI P1,1(S1) ;MAKE AOBJN POINTER TO FIRST ENTRY
VERRP1: HRRZ P2,(P1) ;GET PROFILE ENTRY VECTOR ADDRESS
SKIPGE S1,CG.PFL(P2) ;PROFILE OFFSET
JRST VERRP2 ;THERE IS NONE
MOVE S1,CHGTAB##(S1) ;FLAGS
TXNE S1,PD.UNP!PD.NMD ;UNPRIV'ED DATA OR INVALID FOR COMPARE?
JRST VERRP2 ;DON'T BOTHER LOOKING AT IT
PUSHJ P,@CG.CMP(P2) ;CALL THE COMPARE ROUTINE FOR THIS ITEM
JUMPT VERRP2 ;FIELD IS THE SAME
$TEXT (,< ^T/@CG.PRM(P2)/: >) ;TYPE OUT HEADER
$TEXT (,< Master file: ^A>)
MOVEI S1,(P2) ;VECTOR ADDRESS
PUSHJ P,PROTTL ;PRINT DATA
$TEXT (,< Accounting file: ^A>)
EXCH U,X ;SWAP POINTER
MOVEI S1,(P2) ;VECTOR ADDRESS
PUSHJ P,PROTTL ;PRINT DATA
EXCH U,X ;RESTORE
$TEXT (,<>) ;END ENTRY WITH A BLANK LINE
VERRP2: AOBJN P1,VERRP1 ;LOOP
$RETT ;RETURN
SUBTTL VERUSR COMMAND -- VERUSR - VERIFY USER PROFILES
VERUSR: MOVE S1,[USER,,USER+1] ;ZERO MASTER BUFFER
SETZM USER
BLT S1,USER+.AEMAX-1
MOVE S1,[USER2,,USER2+1] ;ZERO WORKING FILE BUFFER
SETZM USER2
BLT S1,USER2+.AEMAX-1
SKIPE VERALL ;VERIFYING ALL PROFILES
JRST VERUS1 ;YES
MOVE S1,[WILDBK,,MASTWB] ;SET UP BLT
BLT S1,MASTWB+UW$MIN ;COPY
MOVE S1,[WILDBK,,WORKWB] ;SET UP BLT
BLT S1,WORKWB+UW$MIN ;COPY
SKIPG SWTUPD ;SKIP IF /UPDATE
JRST VERUS1 ;DON'T NEED TEMP FILE STUFF
PUSHJ P,CLSC## ;CLOSE THE FILE
MOVEI S1,WORKFD ;POINT TO WORKING FILE
MOVEI S2,TEMPFD ;AND TO TEMPORARY FILE
PUSHJ P,VERCPY ;COPY TEMP=WORKING
MOVEI S1,TEMPFN ;POINT TO TEMP FILE NAME
MOVEI S2,1 ;WRITE
PUSHJ P,OPNC## ;OPEN FOR WRITING
JUMPT VERUS1 ;CONTINUE IF NO ERRORS
SETOM VERABO ;ABORT THE VERIFY
FATAL (OPE,<Open failed for ^T/TEMPFN/>,,.RETF)
VERUS1: SKIPE VERABO ;DID SOMEBODY ABORT?
$RETF ;YES, GIVE UP
SKIPE S1,MASTEF ;GET MASTER EOF FLAG
CAME S1,WORKEF ;EOF ON WORKING FILE TOO?
SKIPA S1,.AEPPN(U) ;GET MASTER FILE PPN
$RETT ;DONE
MOVE S2,.AEPPN(X) ;GET WORKING FILE PPN
TXC S1,1B0 ;FLIP SIGN BITS
TXC S2,1B0 ;FOR PROPER COMPARISONS
CAME S1,S2 ;FILES IN SYNCH?
JRST VERUS4 ;NO
PUSHJ P,VERRDM ;READ PROFILE FROM MASTER FILE
$RETIF ;RETURN ON I/O ERRORS
PUSHJ P,VERRDW ;READ PROFILE FROM WORKING FILE
$RETIF ;RETURN ON I/O ERRORS
VERUS2: SKIPE S1,MASTEF ;GET MASTER EOF FLAG
CAME S1,WORKEF ;EOF ON WORKING FILE TOO?
SKIPA S1,.AEPPN(U) ;GET MASTER FILE PPN
$RETT ;DONE
MOVE S2,.AEPPN(X) ;GET WORKING FILE PPN
TXC S1,1B0 ;FLIP SIGN BITS
TXC S2,1B0 ;FOR PROPER COMPARISONS
SKIPE MASTEF ;GET MASTER EOF FLAG
JRST VERUS8 ;WORKING FILE PROFILE IS NEW
SKIPE WORKEF ;GET WORKING EOF FLAG
JRST VERUS5 ;MASTER PROFILE IS MISSING
CAMGE S1,S2 ;SAME?
JRST VERUS5 ;NO
CAMLE S1,S2 ;CHECK AGAIN
JRST VERUS8 ;NO
PUSHJ P,VERCMP ;COMPARE PROFILES
JUMPT VERUS3 ;LOOP BACK IF SAME
PUSHJ P,VERRPT ;REPORT DIFFERENCES
PUSHJ P,VERASK ;INCLUDE CHANGES?
MOVEI S1,(X) ;POINT TO CHANGED PROFILE
SKIPT ;SKIP IF ANSWER WAS "YES"
MOVEI S1,(U) ;POINT TO MASTER PROFILE
SKIPG SWTUPD ;SKIP IF /UPDATE
JRST VERUS1 ;ELSE LOOP BACK
PUSHJ P,VERWTT ;COPY INTO TEMPORARY FILE
$RETIF ;CHECK FOR ERRORS
JRST VERUS1 ;LOOP BACK
VERUS3: MOVEI S1,(U) ;POINT TO MASTER PROFILE
SKIPE SWTUPD ;SKIP IF /NOUPDATE (TF ALWAYS TRUE HERE)
PUSHJ P,VERWTT ;COPY INTO TEMPORARY FILE
$RETIF ;CHECK FOR ERRORS
PUSHJ P,CVTPPF ;CONVERT PPN
$TEXT (,< ^T/(S1)/ ^Q/USRNAM/>)
JRST VERUS1 ;LOOP BACK
VERUS4: CAML S1,S2 ;A NEW PROFILE IN THE MASTER FILE?
JRST VERUS7 ;NO
VERUS5: PUSHJ P,CVTPPD ;CONVERT PPN
MOVEI S2,.AENAM(U) ;POINT TO NAME
HRLI S2,(POINT 8,) ;8-BIT ASCIZ
WARN (PNW,<Profile for ^T/(S1)/ ^Q/S2/ not in working file>)
AOS VERDIF ;COUNT THE DIFFERENCE
SKIPE SWTRPT ;SKIP IF /NOREPORT
PUSHJ P,TYPUSR ;DISPLAY PROFILE
EXCH U,X ;DISPLAY CORRECT PROFILE
PUSHJ P,VERASK ;INCLUDE CHANGES?
EXCH U,X ;RESTORE
JUMPT VERUS6 ;JUMP IF ANSWER WAS "YES"
MOVEI S1,(U) ;POINT TO MASTER PROFILE
SKIPG SWTUPD ;SKIP IF /UPDATE
JRST VERUS6 ;ELSE GO READ ANOTHER PROFILE
PUSHJ P,VERWTT ;WRITE INTO TEMPORARY FILE
$RETIF ;CHECK FOR ERRORS
VERUS6: PUSHJ P,VERRDM ;READ ANOTHER PROFILE FROM MASTER FILE
$RETIF ;RETURN ON I/O ERRORS
JRST VERUS2 ;LOOP BACK
VERUS7: CAMG S1,S2 ;A NEW PROFILE IN THE WORKING FILE?
JRST VERUS1 ;NO
VERUS8: EXCH U,X ;SWAP
PUSHJ P,CVTPPD ;CONVERT PPN
MOVEI S2,.AENAM(U) ;POINT TO NAME
HRLI S2,(POINT 8,) ;8-BIT ASCIZ
WARN (PNM,<Profile for ^T/(S1)/ ^Q/S2/ not in master file>)
AOS VERDIF ;COUNT THE DIFFERENCE
SKIPE SWTRPT ;SKIP IF /NOREPORT
PUSHJ P,TYPUSR ;DISPLAY PROFILE
EXCH U,X ;RESTORE
PUSHJ P,VERASK ;INCLUDE CHANGES?
JUMPF VERUS9 ;JUMP IF ANSWER WAS "NO"
MOVEI S1,(X) ;POINT TO WORKING PROFILE
SKIPG SWTUPD ;SKIP IF /UPDATE
JRST VERUS9 ;ELSE GO READ ANOTHER PROFILE
PUSHJ P,VERWTT ;WRITE INTO TEMPORARY FILE
$RETIF ;CHECK FOR ERRORS
VERUS9: PUSHJ P,VERRDW ;READ ANOTHER PROFILE FROM WORKING FILE
$RETIF ;RETURN ON I/O ERRORS
JRST VERUS2 ;LOOP BACK
SUBTTL VERIFY COMMAND -- MISCELLANEOUS
; READ A PROFILE FROM THE MASTER FILE
VERRDM: SKIPE MASTEF ;AT EOF?
$RETT ;YES
MOVEI S1,(U) ;MASTER PROFILE
MOVEI S2,MASTWB ;POINT TO MASTER WILDCARD BLOCK
PUSHJ P,GETA## ;GET A PROFILE FROM FILE "A"
$RETIT ;RETURN IF OK
MOVEI S1,3 ;OPTION NUMBER
PUSHJ P,OPTA## ;GET LAST I/O ERROR ON FILE "A"
MOVEI S2,MASTFD ;POINT TO FD INCASE OF ERROR
CAIE S1,ER$RNF## ;RECORD NOT FOUND?
JRST VERIER ;UNEXPECTED ERROR
SETOM MASTEF ;THAT'S END-OF-FILE
$RETT ;RETURN
; READ A PROFILE FROM THE WORKING FILE
VERRDW: SKIPE WORKEF ;AT EOF?
$RETT ;YES
MOVEI S1,(X) ;WORKING PROFILE
MOVEI S2,WORKWB ;POINT TO WORKING WILDCARD BLOCK
PUSHJ P,GETB## ;GET A PROFILE FROM FILE "B"
$RETIT ;RETURN IF OK
MOVEI S1,3 ;OPTION NUMBER
PUSHJ P,OPTB## ;GET LAST I/O ERROR ON FILE "B"
MOVEI S2,WORKFD ;POINT TO FD INCASE OF ERROR
CAIE S1,ER$RNF## ;RECORD NOT FOUND?
JRST VERIER ;UNEXPECTED ERROR
SETOM WORKEF ;THAT'S END-OF-FILE
$RETT ;RETURN
; UPDATE A PROFILE IN THE TEMPORARY FILE
VERUPT: PUSHJ P,UPDC## ;UPDATE THE PROFILE IN FILE "C"
$RETIT ;RETURN IF OK
MOVEI S1,3 ;OPTION NUMBER
PUSHJ P,OPTC## ;GET LAST I/O ERROR ON FILE "C"
MOVEI S2,TEMPFD ;POINT TO FD
JRST VERUER ;REPORT UPDATE ERROR AND ABORT
; WRITE A PROFILE INTO THE TEMPORARY FILE
VERWTT: MOVEI S2,PUTC## ;ASSUME WRITING A NEW FILE
SKIPN VERALL ;SELECTIVE VERIFY?
MOVEI S2,UPDC## ;YES--JUST DO AN UPDATE
PUSHJ P,(S2) ;STUFF A PROFILE INTO THE TEMP FILE
$RETIT ;RETURN IF OK
MOVEI S1,3 ;OPTION NUMBER
PUSHJ P,OPTC## ;GET LAST I/O ERROR ON FILE "C"
MOVEI S2,TEMPFD ;POINT TO FD
JRST VEROER ;REPORT OUTPUT ERROR AND ABORT
; REPORT I/O ERRORS AND ABORT
VERIER: WARN (IER,<Input error on ^F/(S2)/; RMS error ^OR0/S1/>,,VERIOX)
VEROER: WARN (OER,<Output error on ^F/(S2)/; RMS error ^OR0/S1/>,,VERIOX)
VERUER: WARN (UER,<Update error on ^F/(S2)/; RMS error ^OR0/S1/>,,VERIOX)
VERIOX: SETOM VERABO ;LITE THE ABORT FLAG
$RETF ;RETURN
; DUMMY ROUTINES FOR ACTCHG
UGAUX%::$RETF
SUBTTL PARSING ROUTINES -- PRSCMD - SCAN A COMMAND
;Call
; S1/ Parser table
; S2/ Prompt string
;Return
; RETT - Command parsed
; RETF - Otherwise, error message issued.
PRSCMD::MOVEM S1,PARBLK+PAR.TB ;PARSE TABLE ADDRESS
MOVEM S2,PARBLK+PAR.PM ;PROMPT STRING ADDRESS
PRSCM1: MOVE S1,[PARBUF,,PARBUF+1] ;SET UP BLT
SETZM PARBUF ;CLEAR FIRST WORD
BLT S1,PARBUF+PAGSIZ-1 ;CLEAR PARSER PAGE
MOVEI S1,PARBUF ;SCRATCH AREA FOR PARSING
MOVEM S1,PARBLK+PAR.CM
MOVEI S2,COM.SZ-1 ;SIZE OF SCRATCH HEADER
STORE S2,.MSTYP(S1),MS.CNT ;INITIALIZE SCRATCH BLOCK
SETZM PARBLK+PAR.SR ;INPUT COMES FROM TTY
MOVEI S1,PAR.SZ ;SIZE OF PARSER BLOCK
MOVEI S2,PARBLK ;LOCATION OF PARSER BLOCK
PUSHJ P,PARSER## ;PARSE A COMMAND
JUMPF PRSCM2 ;ON ERROR, BITCH.
MOVEI S1,COM.SZ+PARBUF ;POINT TO TOKENS
PUSHJ P,P$SETU## ;SET UP FOR RETRIEVAL
$RETIT ;AND RETURN IF ALL IS WELL
PRSCM2: WARN (CME,<Command error; ^T/@PRT.EM(S2)/>,,PRSCM1)
; HERE ON FATAL ERRORS
PRSERR::FATAL (CPF,<Command parse failure>)
SUBTTL PARSING ROUTINES -- PRSSWT - SWITCHES
PRSSWT: MOVE S1,[SWTTAB,,SWTTAB+1] ;SET UP BLT
SETOM SWTTAB ;INIT FIRST WORD
BLT S1,SWTTAB+SWTLEN-1 ;INIT SWITCH STORAGE
PRSSWX: PUSHJ P,P$SWIT## ;GET A SWITCH
JUMPF P$CFM## ;NOT THERE--TRY FOR EOL AND RETURN
HRRZ S2,(S1) ;GET SWITCH STORAGE ADDRESS
HLRZ S1,(S1) ;GET VALUE TO STORE
MOVEM S1,(S2) ;SAVE IT
JRST PRSSWX ;LOOP BACK FOR MORE
SUBTTL PARSING ROUTINES -- PRSWLD - USER ID
PRSWLD::MOVEI T1,WILDBK ;POINT TO WILDCARD BLOCK
MOVE T2,[POINT 8,WILDAK] ;BYTE POINTER TO ACK TEXT
MOVEM T2,WILDBP ;SAVE FOR SUMMARY
PUSHJ P,A$PWLD## ;PARSE A USER-ID
$RETIF ;CHECK FOR ERRORS
SETZM PROFAI ;ZERO FAILURE COUNTER
SETZM PROSUC ;ZERO SUCCESS COUNTER
$RETT ;RETURN
PRSALT::MOVEI T1,ALTRBK ;POINT TO WILDCARD BLOCK
MOVE T2,[POINT 8,ALTRAK] ;BYTE POINTER TO ACK TEXT
MOVEM T2,ALTRBP ;SAVE FOR SUMMARY
PUSHJ P,A$PWLD## ;PARSE A USER-ID
$RETIF ;CHECK FOR ERRORS
$RETT ;RETURN
SUBTTL UTILITY ROUTINES -- CVTPPD - CONVERT A PPN FOR DETAILED LISTING
; CALL: MOVE U, PROFILE BLOCK ADDRESS
; PUSHJ P,CVTPPD
;
; ON RETURN, S1 CONTAINS THE ADDRESS OF THE ASCIZ TEXT
CVTPPD: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVEI P1,[ITEXT (<^O/S1/>)]
MOVEI P2,[ITEXT (<^O/S2/>)]
HLRZ S1,.AEPPN(U) ;GET PROJECT NUMBER
HRRZ S2,.AEPPN(U) ;AND PROGRAMMER NUMBER
CAIN S1,-1 ;DEFAULT PROJECT?
MOVEI P1,[ITEXT (<%>)] ;YES
CAIN S2,-1 ;DEFAULT PROGRAMMER?
MOVEI P2,[ITEXT (<%>)] ;YES
CAIN S2,-2 ;WILD PROGRAMMER?
MOVEI P2,[ITEXT (<#>)] ;YES
$TEXT (<-1,,PPNTXT>,<[^I/(P1)/,^I/(P2)/]^0>)
MOVEI S1,PPNTXT ;POINT TO TEXT
POPJ P, ;AND RETURN
SUBTTL UTILITY ROUTINES -- CVTPPF - CONVERT A PPN FOR FAST LISTING
; CALL: MOVE U, PROFILE BLOCK ADDRESS
; PUSHJ P,CVTPPF
;
; ON RETURN, S1 CONTAINS THE ADDRESS OF THE ASCIZ TEXT
CVTPPF: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVEI P1,[ITEXT (<^O6R /S1/>)]
MOVEI P2,[ITEXT (<^O6L /S2/>)]
HLRZ S1,.AEPPN(U) ;GET PROJECT NUMBER
HRRZ S2,.AEPPN(U) ;AND PROGRAMMER NUMBER
CAIN S1,-1 ;DEFAULT PROJECT?
MOVEI P1,[ITEXT (< %>)] ;YES
CAIN S2,-1 ;DEFAULT PROGRAMMER?
MOVEI P2,[ITEXT (<% >)] ;YES
CAIN S2,-2 ;WILD PROGRAMMER?
MOVEI P2,[ITEXT (<# >)] ;YES
$TEXT (<-1,,PPNTXT>,<^I/(P1)/,^I/(P2)/^0>)
MOVEI S1,PPNTXT ;POINT TO TEXT
POPJ P, ;AND RETURN
SUBTTL UTILITY ROUTINES -- PRTBTS - BIT TABLE DRIVEN OUTPUT
; PRTBTS - PRINT OUT NAMES OF BITS WHICH ARE ON
; PRTBTX - SAME AS ABOVE, EXCEPT, IF NONE, DON'T TYPE "-NONE-"
; CALL: MOVE S1, IOWD TO TABLE OF BYTE POINTERS,,ASCIZ NAMES
PRTBTX::TDZA S2,S2
PRTBTS::SETOM S2 ;INDICATE ENTRY
JUMPGE S1,.POPJ ;RETURN IF TABLE IS EMPTY
PUSHJ P,.SAVET ;SAVE T ACS
SETO T3, ;COUNT ARGS TYPED OUT
PRTBT1: HLRZ T1,1(S1) ;GET POINTER TO BYTE POINTER
LDB T2,(T1) ;GET BYTE
JUMPE T2,PRTBT2 ;NOTHING THERE, IGNORE
HRRZ T1,1(S1) ;GET POINTER TO ASCIZ NAME
AOSE T3 ;INCREMENT NUMBER OF ARGS TYPED OUT
$TEXT (,<, ^A>) ;SEPARATE FROM PREVIOUS ARBUMENT
$TEXT (,<^T/(T1)/^A>) ;TYPE IT OUT
PRTBT2: AOBJN S1,PRTBT1 ;LOOP
SKIPGE T3 ;DID WE TYPE ANYTHING?
JUMPE S2,.POPJ ;NO, RETURN IF WE DON'T SAY SO
SKIPGE T3 ;TYPE ANYTHING?
$TEXT (,<-none-^A>) ;NO, INDICATE THE FACT
$TEXT (,<>) ;END IT WITH A CRLF
POPJ P, ;RETURN
SUBTTL UTILITY ROUTINES -- TYPUSR - DISPLAY A PROFILE
; HERE TO DUMP A PROFILE ON THE TERMINAL OR TO A FILE
; CALL: MOVE U, PROFILE BLOCK ADDRESS
; PUSHJ P,TYPUSR
TYPUSR: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVEI S1,ENTDEC ;POINT TO DEC-DEFINED PROFILE ENTRY TABLE
PUSHJ P,TYPUS1 ;DISPLAY
MOVEI S1,ENTCUS## ;POINT TO CUSTOMER-DEFINED PROFILE ENTRY TABLE
TYPUS1: HLRZ P1,(S1) ;GET NUMBER OF ENTRIES IN TABLE
MOVNS P1 ;NEGATE
HRLZS P1 ;PUT IN LH
HRRI P1,1(S1) ;MAKE AOBJN POINTER TO FIRST ENTRY
JUMPGE P1,.RETT ;RETURN IF TABLE IS EMPTY
TYPUS2: HRRZ P2,(P1) ;GET A PROFILE ENTRY VECTOR ADDRESS
MOVE T1,CG.FLG(P2) ;GET FLAGS
TXNE T1,FL.NTY ;NO TYPEOUT?
JRST TYPUS3 ;SKIP IT
MOVEI S1,(P2) ;VECTOR ADDRESS
PUSHJ P,PROTTL ;PRINT DATA
TYPUS3: MOVX T1,FL.XCR ;BIT TO TEST
TDNE T1,CG.FLG(P2) ;WANT AN EXTRA CRLF?
$TEXT (,<>) ;YES
AOBJN P1,TYPUS2 ;AND LOOP
$RETT ;DONE
SUBTTL UTILITY ROUTINES -- WLDWCK - CHECK FOR WILDCARDED USER-ID
WLDACK: MOVE S1,ALTRBK+UW$WST ;GET WILDCARD SEARCH TYPE
MOVE S2,ALTRBK+UW$PPM ;GET POSSIBLE PPN MASK
JRST WLDCH1 ;ENTER COMMON CODE
WLDWCK: MOVE S1,WILDBK+UW$WST ;GET WILDCARD SEARCH TYPE
MOVE S2,WILDBK+UW$PPM ;GET POSSIBLE PPN MASK
WLDCH1: CAIN S1,2 ;NON-WILD NAME?
$RETF ;YES
CAIE S1,1 ;WILD NAME?
AOSE S2 ;NO--WILD PPN?
$RETT ;WILD
$RETF ;NON-WILD
SUBTTL UTILITY ROUTINES -- WLDUSR - FETCH A PROFILE
; QUEUE UP A REQUEST TO THE ACCOUNTING DAEMON FOR A PROFILE
WLDUSR::HRRZ T1,SELPTR ;GET POINTER TO FIRST FREE
SKIPN T1 ;IF NONE,
MOVEI T1,WILDBK+UW$MIN ;ASSUME MINIMAL
SUBI T1,WILDBK ;COMPUTE WORDS OF SELECTION DATA
HRLM T1,WILDBK+UW$TYP ;SAVE MESSAGE LENGTH
MOVEI T1,WILDBK ;POINT TO WILDCARD BLOCK
MOVEI T2,USER ;POINT TO RESPONSE BLOCK
SKIPE T3,DEBUGW ;IF DEBUGGING,
MOVSI T3,ACTPID ;TRY TO USE THE ALTERNATE PID
SKIPN DEBUGQ ;WANT TIMING?
HRRI T3,ZZTIME ;YEP
SETCM T4,UNPRIV ;GET PRIV FLAG
PJRST A$QWLD## ;RETURN RESULT OF WILDCARD REQUEST
ALTUSR::MOVEI T1,UW$MIN ;LENGTH OF BLOCK
HRLM T1,ALTRBK+UW$TYP ;SAVE IN MESSAGE
MOVEI T1,ALTRBK ;POINT TO WILDCARD BLOCK
MOVEI T2,USER ;POINT TO RESPONSE BLOCK
SKIPE T3,DEBUGW ;IF DEBUGGING,
MOVSI T3,ACTPID ;TRY TO USE THE ALTERNATE PID
SKIPN DEBUGQ ;WANT TIMING?
HRRI T3,ZZTIME ;YEP
SETCM T4,UNPRIV ;GET PRIV FLAG
PJRST A$QWLD## ;RETURN RESULT OF WILDCARD REQUEST
SUBTTL UTILITY ROUTINES -- WLDSUM - GENERATE A WILDCARD SUMMARY
WLDSUM: MOVEI T1,WILDBK ;POINT TO WILDCARD MESSAGE BLOCK
MOVE T2,WILDBP ;GET BYTE POINTER TO ACK TEXT
MOVE T3,S1 ;GET TEXT
HRLZ T4,PROSUC ;GET SUCCESS COUNT
HRR T4,PROFAI ;AND FAILURE COUNT
PUSHJ P,A$SWLD## ;GENERATE SUMMARY TEXT
SKIPT ;AT LEAST ONE PROFILE FOUND?
FATAL (NSU,<^T/(S1)/>,,.RETF)
$TEXT (,<^M^J ^T/(S1)/>)
$RETT ;RETURN
SUBTTL PROFILE PROCESSING -- PROFIL - MAIN LOOP
PROFIL: DMOVEM S1,PROARG ;SAVE COMMAND TABLE AND PROMPT
PROFI1: DMOVE S1,PROARG ;GET COMMAND TABLE AND PROMPT
PUSHJ P,PRSCMD ;SCAN THE COMMAND
JUMPF PROFI1 ;TRY AGAIN
SETZM PRSDFV ;NOT A DEFAULT VALUE YET
PUSHJ P,SELCHK ;CHECK FOR SELECTION IN PROGRESS
PUSHJ P,P$KEYW## ;GET A KEYWORD
JUMPF PROFI1 ;TRY AGAIN
CAIG S1,PROLEN ;IS THIS AN ADDRESS OR NUMBER
JRST PROFI3 ;GO PROCESS A COMMON COMMAND
MOVE P1,S1 ;COPY PROFILE ENTRY VECTOR ADDRESS
MOVE S1,CG.IDX(P1) ;GET PROFILE ENTRY INDEX
ADD S1,CHGPTR ;INDEX INTO CHANGE TABLE
MOVEM S1,CHGADR ;SAVE FOR SUBROUTINE
PUSHJ P,@CG.GET(P1) ;CALL PARSE ROUTINE IN ENTRY
SKIPE SELFLG ;SELCTION IN PROGRESS?
PUSHJ P,@CG.CHG(P1) ;YES--STORE DATA AWAY
JRST PROFI1 ;AND ASK FOR ANOTHER KEYWORD
PROFI3: PUSHJ P,@PROTAB-1(S1) ;DISPATCH
JUMPT PROFI1 ;LOOP BACK
$RETF ;GIVE UP
; KEYWORD DISPATCH TABLE
PROTAB: IFIW PRODFL ;"DEFAULT"
IFIW PRODON ;"DONE"
IFIW PROHEL ;"HELP"
IFIW PROQUI ;"QUIT"
IFIW PRORES ;"RESTORE"
IFIW PROSHO ;"SHOW"
PROLEN==.-PROTAB ;LENGTH OF TABLE
SUBTTL PROFILE PROCESSING -- PRODFL - COMMON TOPLEVEL "DEFAULT" COMMAND
PRODFL: PUSHJ P,.SAVE1 ;SAVE P1
PUSHJ P,P$KEYW## ;GET A KEYWORD
JUMPF PRSERR ;CHECK FOR ERRORS
MOVE P1,S1 ;COPY PROFILE ENTRY VECTOR ADDRESS
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
MOVE S1,CG.IDX(P1) ;GET CHANGE BLOCK INDEX
ADD S1,CHGPTR ;INDEX INTO CHANGE TABLE
MOVEM S1,CHGADR ;SET FOR ROUTINE
PJRST @CG.DFL(P1) ;DEFAULT THE FIELD & RETURN
PRODFZ::WARN (MND,<Entry may not be defaulted>,,.RETT)
SUBTTL PROFILE PROCESSING -- PRODON - COMMON TOPLEVEL "DONE" COMMAND
PRODON: PUSHJ P,P$KEYW## ;SEE IF CONTROL-Z
JUMPF PRODO1 ;PERHAPS NOT
$TEXT (,<>) ;PUT OUT A BLANK LINE
JRST PRODO2 ;AND FINISH UP
PRODO1: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PRODO2: POP P,(P) ;POP OFF CALLER
$RETT ;RETURN TO TOP LEVEL
SUBTTL PROFILE PROCESSING -- PROHEL - COMMON TOPLEVEL "HELP" COMMAND
PROHEL: PUSHJ P,P$KEYW## ;GET A KEYWORD
JUMPF PRSERR ;FAILED
CAIG S1,PROLEN ;IS THIS AN ADDRESS OR NUMBER
$RETF ;SHOULD NEVER GET HERE
PUSH P,S1 ;SAVE
PUSHJ P,P$CFM## ;GET EOL
POP P,S1 ;RESTORE
JUMPF PRSERR ;CHECK FOR ERRORS
MOVE S2,CG.HLP(S1) ;GET ADDRESS OF HELP TEXT
$TEXT (,<^T/(S2)/>) ;DISPLAY TEXT
$RETT ;RETURN
SUBTTL PROFILE PROCESSING -- PROQUI - COMMON TOPLEVEL "QUIT" COMMAND
PROQUI: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPE SELFLG ;SELECTION IN PROGRESS?
JRST PROQU1 ;YES
PUSHJ P,PRORE1 ;GET ORIGINAL PROFILE (NAME MIGHT HAVE CHANGED)
PUSHJ P,CVTPPD ;CONVERT PPN
INFO (UPT,<User ^T/(S1)/ ^Q/USRNAM/ profile processing aborted>)
$RETF ;RETURN
PROQU1: PUSHJ P,SELINI ;RESET SELECTION STORAGE
INFO (SAB,<Selection aborted>,,.RETF)
SUBTTL PROFILE PROCESSING -- PRORES - COMMON TOPLEVEL "RESTORE" COMMAND
PRORES: PUSHJ P,.SAVE1 ;SAVE P1
MOVNI P1,1 ;ASSUME NO KEYWORD SPECIFIED
PUSHJ P,P$KEYW## ;TRY FOR A KEYWORD
SKIPF ;CHECK FOR ERRORS
MOVE P1,S1 ;COPY PROFILE ENTRY VECTOR ADDRESS
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
JUMPL P1,PRORE1 ;JUMP IF NO KEYWORD
MOVE S1,CG.IDX(P1) ;GET PROFILE ENTRY INDEX
ADD S1,CHGPTR ;INDEX INTO CHANGE TABLE
MOVEM S1,CHGADR ;SAVE FOR PROFILE SUBROUTINE
PUSHJ P,@CG.RES(P1) ;RESTORE DATA
$RETT ;AND RETURN
PRORE1: MOVSI S1,(X) ;POINT TO OLD PROFILE
HRRI S1,(U) ;AND TO WORKING COPY
BLT S1,.AEMAX-1(U) ;RESTORE ORIGINAL
PUSHJ P,PROZCH ;ZERO CHANGE TABLE FLAGS
$RETT ;RETURN
SUBTTL PROFILE PROCESSING -- PROSHO - COMMON TOPLEVEL "SHOW" COMMAND
PROSHO: PUSHJ P,.SAVE1 ;SAVE P1
MOVNI P1,1 ;ASSUME NO KEYWORD SPECIFIED
PUSHJ P,P$KEYW## ;TRY FOR A KEYWORD
SKIPF ;GOT ONE
MOVE P1,S1 ;COPY PROFILE VECTOR ADDRESS
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
JUMPL P1,ENTSH1 ;JUMP IF NO KEYWORD
MOVEI S1,(P1) ;VECTOR ADDRESS
PUSHJ P,PROPRT ;PRINT DATA
$RETT ;RETURN
ENTSH1: PUSHJ P,TYPUSR ;TYPE THE PROFILE
$RETT ;RETURN
SUBTTL PROFILE PROCESSING -- PROBLK - EXTENSIBLE BLOCKS
; ROUTINE TO TO ADD OR DELETE EXTENSIBLE BLOCKS FROM A
; PROFILE GIVEN A PARSER DATA BLOCK POINTER
; CALL: MOVE S1, PARSER DATA BLOCK ADDRESS
; MOVE S2, PROFILE OFFSET
; PUSHJ P,PROBLK
;
; TRUE RETURN: BLOCK ADDED OR DELETED
; FALSE RETURN: NO ROOM IN PROFILE FOR BLOCK
PROBLK::PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,S1 ;COPY PARSER DATA BLOCK ADDRESS
MOVEI T1,(U) ;PROFILE ADDRESS
LOAD T2,ARG.HD(P1),AR.LEN ;GET LENGTH
SUBI T2,ARG.DA ;ACCOUNT FOR PARSER OVERHEAD WORDS
CAIN T2,1 ;DELETING?
SKIPE ARG.DA(P1) ;AND IS THERE ANY REAL DATA?
SKIPA ;SOMETHING VALID
JRST PROBL1 ;YES
MOVNS T2 ;NEGATE
HRLZS T2 ;PUT IN LH
HRRI T2,(S2) ;PROFILE OFFSET
MOVEI T3,ARG.DA(P1) ;ADDRESS OF DATA
JRST PROBL2 ;ENTER COMMON CODE
PROBL1: MOVEI T2,(S2) ;PROFILE OFFSET
SETZ T3, ;ZERO ADDRESS TO DELETE
PROBL2: MOVEI T4,0 ;CLEAR .AEMAP BIT
PJRST A$EBLK## ;ADD/DELETE EXTENSIBLE BLOCK AND RETURN
SUBTTL PROFILE PROCESSING -- PROCHG - PERFORM ALL CHANGES
PROCHG: PUSHJ P,.SAVE3 ;SAVE SOME ACS
MOVE S1,ENTKPT ;POINT TO PROFILE ENTRY TABLE
HLRZ P1,(S1) ;GET NUMBER OF ENTRIES IN TABLE
MOVNS P1 ;NEGATE
HRLZS P1 ;PUT IN LH
HRRI P1,1(S1) ;MAKE AOBJN POINTER TO FIRST ENTRY
SETZ P3, ;INIT CHANGE COUNTER
PUSHJ P,QINIT ;SETUP TO CHANGE A PROFILE
PROCH1: HRRZ P2,(P1) ;GET PROFILE ENTRY VECTOR ADDRESS
MOVE S1,CG.IDX(P2) ;AND ITS INDEX
ADD S1,CHGPTR ;INDEX INTO CHANGE TABLE
SKIPN (S1) ;CHANGING THIS PORTION OF THE PROFILE?
JRST PROCH3 ;NO
PUSHJ P,@CG.CHG(P2) ;EXECUTE THE CHANGE
JUMPT PROCH2 ;ONWARD IF NO ERRORS
MOVE S1,P3 ;GET NUMBER OF CHANGES
$RETF ;AND RETURN
PROCH2: AOS P3 ;COUNT THE CHANGE
PROCH3: AOBJN P1,PROCH1 ;LOOP
SKIPN S1,P3 ;IF NOTHING TO DO,
$RETT ;SUCCEED VACUOUSLY
PUSHJ P,QUEUUO ;DO THE UUO
MOVE S1,P3 ;GET NUMBER OF CHANGES
$RET ;PROPAGATE T/F BACK
SUBTTL PROFILE PROCESSING -- PROCLR - CLEAR USER SPECIFIC DATA
PROCLR: PUSHJ P,.SAVE1 ;SAVE P1
MOVE S1,[XWD PASSWD,PASSWD+1] ;SET UP BLT
SETZM PASSWD ;CLEAR FIRST WORD
BLT S1,PASSWD+.APWLW-1 ;ZERO PASSWORD BLOCK
MOVSI P1,-CLRLEN ;AOBJN POINTER
PROCL1: MOVE S1,CLRTAB(P1) ;GET PROFILE OFFSET
MOVE S2,CHGTAB##(S1) ;GET FLAGS
TXNN S2,PD.EXT ;EXTENSIBLE BLOCK?
JRST PROCL2 ;NO
MOVEI S2,(S1) ;COPY OFFSET
ADDI S2,(U) ;INDEX INTO PROFILE
SKIPL (S2) ;DATA AVAILABLE?
JRST PROCL3 ;NO
MOVEI T1,(U) ;PROFILE ADDRESS
MOVE T2,S1 ;PROFILE OFFSET
HLL T2,(S2) ;GET -LENGTH
MOVEI T3,0 ;ZERO OUT BLOCK ADDRESS
MOVEI T4,1 ;SET .AEMAP ENTRY
PUSHJ P,A$EBLK## ;DELETE BLOCK AND DEFAULT THE FIELD
JRST PROCL3 ;ONWARD
PROCL2: ADDI S1,(U) ;INDEX INTO PROFILE
LOAD S2,S2,PD.WRD ;GET WORD COUNT
SETZM (S1) ;CLEAR A WORD
ADDI S1,1 ;ADVANCE POINTER TO NEXT WORD
SOJG S2,.-2 ;DO ALL WORDS IN BLOCK
PROCL3: AOBJN P1,PROCL1 ;LOOP BACK
POPJ P, ;RETURN
CLRTAB: EXP .AEFLG ;PROFILE FLAGS
EXP .AEFAI ;LAST PSW VALIDATION FAILURE UDT
EXP .AELPC ;LAST PSW CHANGE UDT
EXP .AEPNM ;PERSONAL NAME
CLRLEN==.-CLRTAB ;LENGTH OF TABLE
SUBTTL PROFILE PROCESSING -- PRODEF - FETCH DEFAULT PROFILE
PRODEF: PUSHJ P,.SAVE1 ;SAVE P1
SKIPN P1,.AEPPN(U) ;SAVE PPN INCASE OF ERROR
JRST PRODE1 ;ONLY TRY FOR THE SYSTEM DEFAULT
HLLO S1,P1 ;MAKE DEFAULT PPN FOR PROJECT ([10,%])
MOVEI S2,(U) ;POINT TO STORAGE
PUSHJ P,QPPNIN ;FETCH IT
JUMPT PRODE2 ;GO REPORT FINDINGS
PRODE1: MOVNI S1,1 ;GET DEFAULT PPN FOR ALL PROJECTS ([%,%])
MOVEI S2,(U) ;POINT TO STORAGE
PUSHJ P,QPPNIN ;FETCH IT
JUMPT PRODE2 ;GO REPORT FINDINGS
MOVEI S1,(U) ;NOT FOUND,
HRLI S1,USER0 ;SO USE AN EMPTY PROFILE
BLT S1,.AEMAX-1(U) ;RATHER THAN ACTDAE ERROR MESSAGE
HLRZ S2,P1 ;PUT PROJECT NUMBER IN RH
MOVEI S1,[ITEXT (<project ^O/S2/>)]
SKIPN S2 ;HAVE A PROJECT?
MOVEI S1,[ITEXT (<system-wide>)] ;NO
WARN (NDF,<No default ^I/(S1)/ profile found>,,PRODE3)
PRODE2: PUSHJ P,CVTPPD ;CONVERT PPN
INFO (DPL,<Default profile loaded: ^T/(S1)/>)
PRODE3: PUSHJ P,PROCLR ;CLEAR USER SPECIFIC DATA
MOVEM P1,.AEPPN(U) ;REPLACE PPN
$RETT ;RETURN
SUBTTL PROFILE PROCESSING -- PROFSP - FETCH A FILESPEC
PROFSP::PUSHJ P,P$FILE## ;GET FD BLOCK
$RETIF ;RETURN ON ERRORS
MOVSI S2,'...' ;GET PLACE HOLDER VALUE
CAMN S2,.FDSTR(S1) ;DEVICE SPECIFIED?
SETZM .FDSTR(S1) ;NO, ZERO DEVICE WORD
LOAD S2,.FDLEN(S1),FD.LEN ;GET FD LENGTH
SUBI S2,ARG.DA ;ACCOUNT FOR OVERHEAD
MOVNS S2 ;NEGATE
HRLZS S2 ;PUT IN LH
HRRI S2,.FDSTR(S1) ;MAKE AN AOBJN POINTER
SKIPN (S2) ;NULL?
AOBJN S2,.-1 ;SEARCH ENTIRE FD
JUMPL S2,.RETT ;RETURN IF SOMETHING TYPED
MOVEI S2,ARG.DA+1 ;OVERHEAD + ZERO WORD
STORE S2,.FDLEN(S1),FD.LEN ;CUTE WAY TO SAY BLOCK IS EMPTY
$RETT ;RETURN
SUBTTL PROFILE PROCESSING -- PRONAM - GENERATE USER NAME BASED ON PPN
PRONAM: MOVSI S1,.AENAM(U) ;POINT TO STORAGE
HRRI S1,.AENAM+1(U) ;MAKE A BLT POINTER
SETZM .AENAM(U) ;CLEAR FIRST WORD
BLT S1,.AENAM+.AANLW-1(U) ;CLEAR ENTIRE BLOCK
MOVE S1,.AEPPN(U) ;GET PPN WE'RE HACKING
PUSHJ P,A$CKPP## ;MAKE A NAME FOR IT
SETCAM TF,RESPPN ;PROFILE IS FOR A RESERVED PPN
$TEXT (<POINT 8,.AENAM(U),-1>,<^T/(S1)/^0>)
POPJ P, ;DONE
SUBTTL PROFILE PROCESSING -- PROPSW - DEFAULT A PASSWORD
PROPSW: PUSHJ P,.SAVE4 ;SAVE SOME ACS
LOAD S1,.AEREQ(X),AE.PWL ;GET MINIMUM PASSWORD LENGTH
CAIN S1,0 ;ZERO ? (NONE SPECIFIED)
MOVEI S1,DEFPSZ ;USE DEFAULT
MOVEI S2,(S1) ;COPY
PUSHJ P,GENPSW ;GENERATE A PASSWORD
SUBB S2,S1 ;GET COUNT OF CHARACTERS GENERATED
IDIVI S2,.APWCW ;GET NUMBER OF WORDS REQUIRED
SKIPE T1 ;REMAINDER?
ADDI S2,1 ;YES
HRL S2,S1 ;MAKE IT #CHRS,,#WORDS
MOVEI T1,10 ;8-BIT ASCIZ
MOVE S1,[.APWLW+ARG.DA,,.CMFLD]
MOVEM S1,PASSHD+ARG.HD ;SAVE PARSER DATA BLOCK HEADER WORD
MOVEI S1,PASSHD ;POINT TO BLOCK
PUSHJ P,PROSTR ;FIX UP STRING AS NECESSARY
$RETT ;AND RETURN
; ROUTINE TO GENERATE A FULL LENGTH PASSWORD CONTAINING THINGS
; THAT LOOK LIKE SYLLABLES. THE PASSWORD WILL CONTAIN ALL
; UPPERCASE CHARACTERS.
GENPSW: MOVEI P3,.APWLC ;GET MAX PASSWORD SIZE
MOVE P4,[POINT 8,PASSWD] ;GET TARGET POINTER
RANPW0: PUSHJ P,RANDOM ;GET A RANDOM NUMBER
MOVEI T2,STRL
FSC T2,233
FMPR T2,T1
FIX T1,T2
MOVE P1,STRPTR(T1)
SETZ P2,
RANPW1: PUSHJ P,RANDOM ;GET A RANDOM NUMBER
HLRZ T2,(P1)
FSC T2,233
FMPR T2,T1
FIX T1,T2
HRRZ T2,(P1)
ADD T1,T2
LSH P2,6
ADD P2,(T1)
AOBJN P1,RANPW1
MOVE T2,P2 ;GET SIXBIT RESULT
GENPS3: LSHC T1,6 ;SHIFT IN A CHARACTER
ANDI T1,77 ;MASK OUT JUNK
JUMPE T1,GENPS4 ;LEADING BLANKS?
ADDI T1,40 ;MAKE ASCII
IDPB T1,P4 ;STORE
SOJLE P3,.POPJ ;COUNT DOWN
SOS S1 ;COUNT DOWN AGAINST USER LIMIT
GENPS4: JUMPN T2,GENPS3 ;LOOP BACK IF MORE CHARACTERS
SKIPLE S1 ;QUIT IF USER LIMIT FOUND
JUMPN P3,RANPW0 ;LOOP BACK IF PASSWORD INCOMPLETE
POPJ P,
RANDOM: SKIPE T1,ROOT ;HAVE A SEED?
JRST RAN1 ;YES
TIMER T1, ;GET TIME IN JIFFIES
FSC T1,211
MOVEM T1,ROOT
RAN1: FMPR T1,ROOT
FADRI T1,(47.)
FDVR T1,ROOT
FSC T1,-1
FSBRM T1,ROOT
MOVNS T1,ROOT
TLZ T1,777700
FSC T1,203
POPJ P,
; TABLE OF CONSONANTS
CON: 'B'
'C'
'D'
'F'
'G'
'H'
'J'
'K'
'L'
'M'
'N'
'P'
'R'
'S'
'T'
'V'
'W'
'X'
'Y'
'Z'
CONL==.-CON
; TABLE OF VOWELS
VOW: 'A'
'E'
'I'
'O'
'U'
VOWL==.-VOW
STR45: XWD CONL,CON
XWD VOWL,VOW
XWD CONL,CON
XWD VOWL,VOW
XWD CONL,CON
STR6: XWD CONL,CON
XWD VOWL,VOW
XWD CONL,CON
XWD CONL,CON
XWD VOWL,VOW
XWD CONL,CON
STRPTR: XWD -4,STR45
XWD -5,STR45
XWD -6,STR6
STRL==.-STRPTR
SUBTTL PROFILE PROCESSING -- PROSTR - STRING CHECKING
; ROUTINE TO CHECK STRING LENGTHS AND CLEAN UP POSSIBLE JUNK
; LEFT OVER BY THE PARSER.
; CALL: MOVE S1, PARSER DATA BLOCK ADDRESS
; MOVE S2, MAX # CHRS,,MAX # WORDS
; MOVE T1, BYTE SIZE
; PUSHJ P,PROSTR
PROSTR::PUSHJ P,.SAVE2 ;SAVE P1 AND P2
DMOVE P1,S1 ;COPY ARGS
MOVEI S1,^D36 ;36-BITS PER WORD
IDIVI S1,(T1) ;S2 GETS NUMBER OF JUNK BITS
IMULI S1,(P2) ;GET MAX. BYTES IN BLOCK
HRLI T1,(S1) ;SAVE
MOVSI S1,-1 ;WILL HANDLE UP TO 18 BIT BYTES
ROT S1,(S2) ;GET MASK FOR CLEARING JUNK BITS
HRRZS S1 ;ISOLATE MASK
PUSH P,S1 ;SAVE FOR A SECOND
HRRZ S2,P2 ;GET MAXIMUM WORD COUNT
LOAD TF,ARG.HD(P1),AR.LEN ;GET BLOCK LENGTH
CAILE TF,ARG.DA(S2) ;IMPOSE LENGTH RESTRICTIONS
MOVEI TF,ARG.DA(S2) ;MUST REDUCE
STORE TF,ARG.HD(P1),AR.LEN ;REDUCE
SUBI TF,ARG.DA ;ACCOUNT FOR GALACTIC OVERHEAD
MOVEI S1,ARG.DA(P1) ;POINT TO START OF DATA
POP P,S2 ;GET MASK BACK
ANDCAM S2,(S1) ;CLEAR JUNK BITS
ADDI S1,1 ;ADVANCE ADDRESS POINTER
SOJG TF,.-2 ;DO ALL WORDS
MOVEI S1,ARG.DA(P1) ;POINT TO START OF DATA
DPB T1,[POINT 6,S1,11] ;STORE BYTE SIZE IN BYTE POINTER
TLO S1,440000 ;FINISH IT
HLRZ S2,P2 ;GET BYTE COUNT
PROST1: ILDB TF,S1 ;GET A CHARACTER
SKIPE TF ;NUL?
SOJG S2,PROST1 ;LOOP
HLRZ TF,T1 ;GET MAX. BYTE COUNT
SUB TF,S2 ;NUMBER REMAINING TO ZERO
JUMPE TF,PROST2 ;DON'T PROCEED IF DONE
SETZ S2, ;TO CLEAR OUT REMAINDER
IDPB S2,S1 ;TERMINATE
SOJG TF,.-1 ;CLEAN OUT REMAINDER OF THE BLOCK
PROST2: POPJ P, ;RETURN
SUBTTL PROFILE PROCESSING -- PROPRT - PRINT PROFILE DATA
; PRINT DATA ABOUT PROFILE ENTRIES
; CALL: MOVE S1, ENTRY VECTOR ADDRESS
; PUSHJ P,PROPRT/PROTTL
PROPRT: TDZA S2,S2 ;PRINT DATA
PROTTL: MOVEI S2,1 ;PRINT TITLE AND DATA
PUSHJ P,.SAVET ;SAVE T1-T4
PUSH P,[EXP 0] ;SAVE A FLAG
PUSH P,S2 ;SAVE FLAG
MOVEI T1,(U) ;POINT TO PROFILE
SKIPGE T2,CG.PFL(S1) ;GET PROFILE OFFSET
JRST PROPR1 ;FIELD CANNOT BE DEFAULTED
MOVNI T3,1 ;FLAG
PUSHJ P,A$BMAP## ;CHECK STATUS
JUMPF PROPR1 ;JUMP IF NOT DEFAULTED
SETOM -1(P) ;REMEMBER DEFAULTED STATUS
SKIPA S2,["*"] ;ASTERISK FOR A DEFAULTED FIELD
PROPR1: MOVEI S2," " ;ELSE NON-DEFAULTED FIELD
$TEXT (,< ^7/S2/ ^A>) ;DISPLAY FLAG
POP P,S2 ;GET TITLE FLAG
SKIPE S2 ;WANT TITLE?
$TEXT (,<^T/@CG.PRM(S1)/: ^A>) ;YES
POP P,S2 ;GET DEFAULTED FLAG
JUMPE S2,PROPR2 ;JUMP IF NOT
MOVE S2,CG.IDX(S1) ;GET PROFILE ENTRY INDEX
ADD S2,CHGPTR ;INDEX INTO CHANGE TABLE
MOVE S2,(S2) ;GET CHANGE FLAG FOR THIS ENTRY
JUMPE S2,PROPR2 ;JUMP IF IT'S CHANGED
$TEXT (,<-unknown->) ;ELSE SAY WE DON'T KNOW
$RETT ;RETURN
PROPR2: PUSHJ P,@CG.PRT(S1) ;PRINT DATA
$RETT ;RETURN
SUBTTL PROFILE PROCESSING -- PROUPD - UPDATE A PROFILE FROM A STATIC BLOCK
PROUPD: PUSHJ P,.SAVE3 ;SAVE SOME ACS
MOVE S1,[CHGMSK,,CHGMS2] ;NEED TO SAVE THIS BECAUSE OF RESTORES
BLT S1,CHGMS2+.AEMIN-1 ;SO SAVE IT
MOVE S1,ENTKPT ;POINT TO PROFILE ENTRY TABLE
HLRZ P1,(S1) ;GET NUMBER OF ENTRIES IN TABLE
MOVNS P1 ;NEGATE
HRLZS P1 ;PUT IN LH
HRRI P1,1(S1) ;MAKE AOBJN POINTER TO FIRST ENTRY
SETZ P3, ;INIT CHANGE COUNTER
PROUP1: HRRZ P2,(P1) ;GET PROFILE ENTRY VECTOR ADDRESS
MOVE S1,CG.IDX(P2) ;AND ITS INDEX
ADD S1,CHGPTR ;INDEX INTO CHANGE TABLE
SKIPN (S1) ;CHANGING THIS PORTION OF THE PROFILE?
JRST PROUP3 ;NO
PUSHJ P,@CG.CMP(P2) ;COMPARE INCASE WAS CHANGED BACK TO ORIGINAL
JUMPT PROUP3 ;NOTHING REALLY CHANGED
PROUP2: PUSHJ P,@CG.RES(P2) ;RESTORE DATA
SETOM @CHGADR ;RESTORE FLAG TO "CHANGED" STATE
JUMPT PROUP3 ;ONWARD IF NO ERRORS
PUSHJ P,PROUP4 ;SETUP RETURN
$RETF ;AND RETURN FAILURE
PROUP3: AOBJN P1,PROUP1 ;LOOP
PROUP4: MOVE S1,[CHGMS2,,CHGMSK] ;BLT VECTOR
BLT S1,CHGMSK+.AEMIN-1 ;RESTORE MASKS
MOVE S1,P3 ;GET NUMBER OF CHANGES
$RETT ;AND RETURN
SUBTTL PROFILE PROCESSING -- PROZCH - ZERO PROFILE ENTRY CHANGE TABLE
PROZCH: MOVE S1,CHGPTR ;GET ADDRESS OF CHANGE TABLE
MOVSI S2,(S1) ;POINT TO START ADDRESS
HRRI S2,1(S1) ;MAKE A BLT POINTER
SETZM (S1) ;CLEAR FIRST WORD
ADD S1,CHGCTR ;COMPUTE END OF BLT
BLT S2,-1(S1) ;ZERO TABLE
PROZQM: MOVE S1,[CHGMSK,,CHGMSK+1] ;BLT POINTER
SETZM CHGMSK ;CLEAR FIRST WORD OF CHANGE MASKS
BLT S1,CHGMSK+.AEMIN-1 ;ZERO TABLE
POPJ P, ;RETURN
SUBTTL PROFILE PROCESSING -- PROZPB - ZERO PROFILE BLOCK
PROZPB: MOVSI S1,USER0 ;POINT TO INIT'ED USER BLOCK
HRRI S1,(U) ;AND TO CURRENT BLOCK
BLT S1,.AEMAX-1(U) ;RE-INIT PROFILE
POPJ P, ;RETURN
SUBTTL ENTRIES -- TABLE INITIALIZATION
ENTINI: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
HLRZ S1,ENTDEC ;GET COUNT OF DEC-DEFINED PROFILE ENTRIES
HLRZ S2,ENTCUS## ;GET COUNT OF CUSTOMER-DEFINED PROFILE ENTRIES
ADDI S1,1(S2) ;TOTAL THEM UP
PUSHJ P,M%GMEM ;GET SOME CORE
MOVEM S2,ENTKPT ;SAVE FOR PARSING
MOVEI S2,-1(S1) ;GET CORRECTED COUNT
MOVEM S2,@ENTKPT ;SAVE WORD COUNT TOO
PUSHJ P,M%GMEM ;GET MORE CORE
MOVEM S2,ENTHPT ;SAVE FOR HELP
SUBI S1,1 ;GET CORRECTED COUNT
MOVEM S1,@ENTHPT ;SAVE WORD COUNT TOO
PUSHJ P,M%GMEM ;GET MORE CORE
MOVEM S1,CHGCTR ;SAVE CHANGE TABLE WORD COUNT
MOVEM S2,CHGPTR ;SAVE CHANGE TABLE ADDRESS
MOVEI P1,ENTDEC ;POINT TO DEC-DEFINED TABLE
PUSHJ P,ENTIN1 ;LOAD WORKING COMMAND TABLE
MOVEI P1,ENTCUS## ;POINT TO CUSTOMER-DEFINED TABLE
ENTIN1: HLRZ S1,(P1) ;GET NUMBER OF ENTRIES IN TABLE
JUMPE S1,.RETT ;RETURN IF TABLE IS EMPTY
MOVNS S1 ;NEGATE
HRL P1,S1 ;GET -LENGTH
HRRI P1,1(P1) ;MAKE AN AOBJN POINTER
ENTIN2: HRRZ P2,(P1) ;GET PROFILE ENTRY VECTOR ADDRESS
SKIPL S1,CG.PFL(P2) ;AND PROFILE OFFSET
SKIPN UNPRIV ;UNPRIV'ED USER?
JRST ENTIN3 ;NO
MOVE S1,CHGTAB##(S1) ;FLAGS
TXNN S1,PD.UNP ;UNPRIV'ED PROFILE DATA?
JRST ENTIN4 ;NO--STUFF IN HELP TABLE INSTEAD
ENTIN3: MOVE S1,ENTKPT ;POINT TO TABLE HEADER
MOVE S2,(P1) ;GET KEYWORD ADDRESS
PUSHJ P,S%TBAD ;INSERT INTO TABLE
JUMPT ENTIN4 ;CHECK FOR ERRORS
CAIN S1,EREIT$ ;ENTRY ALREADY IN TABLE?
JRST ENTIN5 ;YES--PROBABLY THE NULL KEYWORD
STOPCD (EIF,HALT,,<Profile entry table initialization failure>)
ENTIN4: HLRZ S2,(P1) ;GET A KEYWORD
SKIPE S1,(S2) ;MUST CHECK
TLNE S1,(177B6) ;FIRST CHARACTER ZERO AND WORD NO ALL ZERO?
TDZA S1,S1 ;NO--MAKE FLAGS ALL ZERO
AOS S2 ;ADJUST TEXT POINTER
TXNE S1,CM%INV ;TEST FLAGS
JRST ENTIN5 ;DON'T INCLUDE
MOVE S1,ENTHPT ;POINT TO TABLE HEADER
HRLZS S2 ;POSITION KEYWORD
HRR S2,(P1) ;INCLUDE DATA
PUSHJ P,S%TBAD ;INSERT INTO TABLE
JUMPT ENTIN5 ;CHECK FOR ERRORS
STOPCD (HIF,HALT,,<Help table initialization failure>)
ENTIN5: AOBJN P1,ENTIN2 ;LOOP
; PARSING
MOVE S1,[ENTKBK,,ENTKEY] ;SET UP BLT
BLT S1,ENTKEY+PB%SIZ-1 ;COPY
MOVE S1,ENTKPT ;GET TABLE ADDRESS
MOVEM S1,ENTKEY+1+.CMDAT ;SAVE
; "DEFAULT"
MOVE S1,[ENTDBK,,ENTDEF] ;SET UP BLT
BLT S1,ENTDEF+PB%SIZ-1 ;COPY
MOVE S1,ENTKPT ;GET TABLE ADDRESS
MOVEM S1,ENTDEF+1+.CMDAT ;SAVE
; "HELP"
MOVE S1,[ENTHBK,,ENTHLP] ;SET UP BLT
BLT S1,ENTHLP+PB%SIZ-1 ;COPY
MOVE S1,ENTHPT ;GET TABLE ADDRESS
MOVEM S1,ENTHLP+1+.CMDAT ;SAVE
; "RESTORE"
MOVE S1,[ENTRBK,,ENTRST] ;SET UP BLT
BLT S1,ENTRST+PB%SIZ-1 ;COPY
MOVE S1,ENTKPT ;GET TABLE ADDRESS
MOVEM S1,ENTRST+1+.CMDAT ;SAVE
; "SELECT"
MOVE S1,[ENTSBK,,ENTSLC] ;SET UP BLT
BLT S1,ENTSLC+PB%SIZ-1 ;COPY
MOVE S1,ENTKPT ;GET TABLE ADDRESS
MOVEM S1,ENTSLC+1+.CMDAT ;SAVE
$RETT ;RETURN
; PARSER DATA BLOCK FOR PARSING
ENTKBK: $KEYDSP (.,<$NEXT(.),$ACTION(ENTAPR),$ALTER(ENT010)>)
BLOCK PB%SIZ-<.-ENTKBK>
; PARSER DATA BLOCK FOR "DEFAULT"
ENTDBK: $KEY (CONFRM,.,<$ACTION(ENTADF)>)
BLOCK PB%SIZ-<.-ENTDBK>
; PARSER DATA BLOCK FOR "HELP"
ENTHBK: $KEY (CONFRM,.,<$ACTION(ENTAHL)>)
BLOCK PB%SIZ-<.-ENTHBK>
; PARSER DATA BLOCK FOR "SELECT"
ENTSBK: $KEY (CONFRM,.,<$ACTION(ENTASL)>)
BLOCK PB%SIZ-<.-ENTSBK>
; PARSER DATA BLOCK FOR "RESTORE"
ENTRBK: $KEY (CONFRM,.,<$ACTION(ENTARS),$ALTER(CONFRM)>)
SUBTTL ENTRIES -- KEYWORD TABLES
ENT000: $INIT (ENTKEY)
ENT010: $KEYDSP (ENTCOM)
ENT020: $KEYDSP (ENTSEL)
; DEC-DEFINED ENTRY TYPES
ENTDEC: $STAB
KEYTAB (PPX,<PPN>,CM%NOR)
KEYTAB (NAM,<NAME>)
KEYTAB (PDF,<PROFILE-DEFAULT>)
KEYTAB (PNM,<PERSONAL-NAME>)
KEYTAB (DST,<DISTRIBUTION-LOCATION>)
KEYTAB (MAI,<MAILING-ADDRESS>)
KEYTAB (NUL,<NULL-ENTRY>,CM%NOR!CM%INV)
KEYTAB (PSW,<PASSWORD>)
KEYTAB (EXP,<EXPIRATION-DATE>)
KEYTAB (LTI,<LOGIN-TIMES>)
KEYTAB (ACC,<ACCESS-TYPES>)
KEYTAB (RQL,<REQUIREMENTS>)
KEYTAB (SCH,<SCHEDULAR-TYPE>)
KEYTAB (PRG,<PROGRAM-TO-RUN>)
KEYTAB (NUL,<NULL-ENTRY>,CM%NOR!CM%INV)
KEYTAB (CTX,<CONTEXT-QUOTAS>)
KEYTAB (COR,<CORE-LIMITS>)
KEYTAB (ENQ,<ENQ-DEQ-QUOTA>)
KEYTAB (IPC,<IPCF-QUOTAS>)
KEYTAB (PRV,<PRIVILEGES>)
KEYTAB (SPO,<SPOOLED-DEVICES>)
KEYTAB (WAT,<WATCH-BITS>)
KEYTAB (NUL,<NULL-ENTRY>,CM%NOR!CM%INV)
KEYTAB (STR,<STRUCTURE-QUOTAS>)
KEYTAB (NUL,<NULL-ENTRY>,CM%NOR!CM%INV)
KEYTAB (ADM,<ADMINISTRATIVE-DATA>,CM%NOR)
$ETAB
; DEC AND CUSTOMER COMMON KEYWORDS
ENTCOM: $STAB
DSPTAB ( ,2,\"32,CM%INV)
DSPTAB (ENTC10,1,<DEFAULT>)
DSPTAB (CONFRM,2,<DON>,CM%NOR)
DSPTAB (CONFRM,2,<DONE>)
DSPTAB (ENTC20,3,<HELP>)
DSPTAB (CONFRM,4,<QUI>,CM%NOR)
DSPTAB (CONFRM,4,<QUIT>)
DSPTAB (ENTRST,5,<RESTORE>)
DSPTAB (ENTC30,6,<SHOW>)
$ETAB
ENTC10: $NOISE (ENTDEF,<entry>)
ENTC20: $NOISE (ENTHLP,<with>)
ENTC30: $CRLF (<$ALTER(ENTHLP)>)
; DEC AND CUSTOMER SELECTION KEYWORDS
ENTSEL: $STAB
DSPTAB ( ,2,\"32,CM%INV)
; DSPTAB (CONFRM,1,<DEFAULT>)
DSPTAB (CONFRM,2,<DON>,CM%NOR)
DSPTAB (CONFRM,2,<DONE>)
DSPTAB (ENTC10,3,<HELP>)
DSPTAB (CONFRM,4,<QUI>,CM%NOR)
DSPTAB (CONFRM,4,<QUIT>)
; DSPTAB (ENTRST,5,<RESTORE>)
DSPTAB (ENTC20,6,<SHOW>)
$ETAB
; COMMON ENTRY ACTION ROUTINE TO SET THE NEXT PARSER DATA BLOCK
ENTASL:!
ENTAPR: HRRZ S1,@CR.RES(S2) ;GET ADDR OF TABLE ENTRY
HRRZ S1,CG.PRS(S1) ;GET ADDR OF NEXT PARSE BLOCK
PUSH P,S1 ;SAVE FOR A SECOND
LOAD S1,CR.PDB(S2),RHMASK ;GET CURRENT PDB
PUSHJ P,P$GPDB## ;GET ADDR WORKING COPY
POP P,PB%NXT(S1) ;POINT TO NEXT TABLE FOR PARSING
$RETT ;AND RETURN
; COMMON ENTRY ACTION ROUTINE FOR "DEFAULT", "HELP", AND "RESTORE"
ENTADF:!
ENTAHL:!
ENTARS: LOAD S1,CR.PDB(S2),RHMASK ;GET CURRENT PDB
PUSHJ P,P$GPDB## ;GET ADDR WORKING COPY
MOVEI S2,CONFRM ;TERMINATE
MOVEM S2,PB%NXT(S1) ; COMMAND
$RETT ;AND RETURN
SUBTTL ENTRIES -- ACC - ACCESS-TYPES
.ENTRY (ACC,.AEACC,<Access types>)
ACCPRS: $NOISE (CONFRM,<allowed>)
ACC000: $INIT (ACC010)
ACC010: $KEYDSP (ACC020,<$ALTER(ACC030)>)
ACC020: $STAB
DSPTAB (ACC010,[AE.ROP],<ANF-CTY>)
DSPTAB (ACC010,[AE.BAT],<BATCH>)
DSPTAB (ACC010,[AE.DST],<DATA-SET>)
DSPTAB (ACC010,[AE.FIO],<FILES-ONLY>)
DSPTAB (ACC010,[AE.LOC],<LOCAL>)
DSPTAB (ACC010,[AE.FAL],<NETWORK-FILE-ACCESS>)
DSPTAB (ACC010,[AE.CDR],<PHYSICAL-CARD-READER>)
DSPTAB (ACC010,[AE.RMT],<REMOTE>)
DSPTAB (ACC010,[AE.SBJ],<SUBJOB-OF-BATCH>)
$ETAB
ACC030: $KEYDSP (ACC040,$ALTER(CONFRM))
ACC040: $STAB
DSPTAB ( ,2,\"32,CM%INV)
DSPTAB (CONFRM,0,<ALL>)
DSPTAB (CONFRM,1,<DEFAULT>)
DSPTAB (CONFRM,2,<DON>,CM%NOR)
DSPTAB (CONFRM,2,<DONE>)
DSPTAB (CONFRM,3,<HELP>)
DSPTAB (ACC050,4,<NO>)
DSPTAB (CONFRM,5,<NONE>)
DSPTAB (CONFRM,6,<RESTORE>)
DSPTAB (CONFRM,7,<SHOW>)
$ETAB
ACC050: $KEYDSP (ACC020)
; GET ROUTINE
ACCGET: PUSHJ P,.SAVE1 ;SAVE P1
ACCGE1: MOVEI S1,ACC000 ;POINT TO SUB-COMMAND TABLES
MOVEI S2,[ASCIZ\ACCESS-TYPES>\]
PUSHJ P,PRSCMD ;PARSE THE COMMAND
JUMPF PRSERR ;CHECK FOR ERRORS
SETZ P1, ;CLEAR "NO" FLAG
ACCGE2: PUSHJ P,P$CFM## ;CRLF?
JUMPT ACCGE1 ;YES
PUSHJ P,P$KEYW## ;GET KEYWORD
JUMPF PRSERR ;CHECK FOR ERRORS
CAIG S1,ACCLEN ;ADDRESS OF BIT?
JRST ACCGE3 ;NO--KEYWORD
MOVE S2,(S1) ;YES, GET THE BIT
IORM S2,.AEACC(U) ;SET IT ALWAYS
SKIPE P1 ;SKIP IF SETTING VALUE
ANDCAM S2,.AEACC(U) ;ZERO THE BIT
SETZ P1, ;CLEAR "NO" FLAG
SETOM @CHGADR ;INDICATE CHANGING PROFILE ENTRY
IORM S2,CHGMSK+.AEACC ;LIGHT IN THE CHANGE MASK
JRST ACCGE2 ;AND LOOP
ACCGE3: PUSHJ P,@ACCTAB(S1) ;DISPATCH TO KEYWORD PROCESSOR
JRST ACCGE2 ;AND LOOP BACK
; COMPARE ROUTINE
ACCCMP: MOVEI S1,.AEACC ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
ACCCHG: MOVEI S1,.AEACC ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
ACCDFL: MOVX S1,DF.ACC ;DEFAULT BIT FOR FIELD
IORM S1,DF$ACC(U) ;LIGHT IN BIT MAP
SETOM PRSDFV ;REMEMBER WE CARE
SETOM @CHGADR ;WE CHANGED THIS ENTRY
SETOM CHGMSK+.AEACC ;AND THIS FIELD
$RETT ;WIN
; RESTORE ROUTINE
ACCRES: MOVE S1,.AEACC(X) ;GET ORIGINAL ACCESS BITS
MOVEM S1,.AEACC(U) ;RESTORE
MOVX S1,DF.ACC ;GET .AEACC DEFAULT BIT
ANDCAM S1,DF$ACC(U) ;CLEAR IN WORKING PROFILE
TDNE S1,DF$ACC(X) ;WAS IT SET IN ORIGINAL?
IORM S1,DF$ACC(U) ;YES, FIX IT
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AEACC ;IN BOTH PLACES
$RETT ;AND RETURN
; PRINT ROUTINE
ACCPRT: MOVE S1,[IOWD ACCBEN-ACCBIT,ACCBIT] ;POINTER TO LIST OF BITS
PUSHJ P,PRTBTS ;TYPE OUT BITS
$RETT
; HELP TEXT
ACCHLP: ASCIZ \
ACCESS-TYPES specifies the types of access allowed to the specified
user. ACCESS refers to any attempt by a user or in behalf of a user to
gain access to the system using a correct combination of user-id and
password.
\
; BIT STORAGE/DISPLAY TABLE
ACCBIT: XWD [POINTR .AEACC(U),AE.CDR],[ASCIZ \Card reader\]
XWD [POINTR .AEACC(U),AE.FAL],[ASCIZ \Network file access\]
XWD [POINTR .AEACC(U),AE.LOC],[ASCIZ \Local\]
XWD [POINTR .AEACC(U),AE.ROP],[ASCIZ \ANF CTY\]
XWD [POINTR .AEACC(U),AE.DST],[ASCIZ \Dataset\]
XWD [POINTR .AEACC(U),AE.RMT],[ASCIZ \Remote\]
XWD [POINTR .AEACC(U),AE.SBJ],[ASCIZ \Subjob of batch\]
XWD [POINTR .AEACC(U),AE.BAT],[ASCIZ \Batch\]
XWD [POINTR .AEACC(U),AE.FIO],[ASCIZ \Files only\]
ACCBEN:!
; KEYWORD DISPATCH TABLE
ACCTAB: IFIW ACCALL ;"ALL"
IFIW ACCDEF ;"DEFAULT"
IFIW ACCDON ;"DONE"
IFIW ACCHLX ;"HELP"
IFIW ACCNO ;"NO"
IFIW ACCNON ;"NONE"
IFIW ACCRES ;"RESTORE"
IFIW ACCPRT ;"SHOW"
ACCLEN==.-ACCTAB ;LENGTH OF TABLE
; "ALL" KEYWORD PROCESSOR
ACCALL: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
MOVX S1,^-AE.FIO ;ALL ACCESS BITS BUT NOT "FILES ONLY"
MOVEM S1,.AEACC(U) ;TURN ON ALL ACCESS METHODS
ACCGO: SETOM @CHGADR ;INDICATE CHANGING PROFILE ENTRY
SETOM CHGMSK+.AEACC ;BOTH PLACES
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;AND RETURN
; "DEFAULT" KEYWORD PROCESSOR
ACCDEF: PUSHJ P,ACCDFL ;DO DEFAULTING
PJRST ACCGO ;FINISH UP
; "DONE" KEYWORD PROCESSOR
ACCDON: PUSHJ P,P$KEYW## ;SEE IF CONTROL-Z
SKIPT ;IT'S NOT TERMINATED
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
ADJSP P,-1 ;WE WILL RETURN ON BEHALF OF CALLER
MOVEI S1,.AEACC ;PROFILE OFFSET WE'RE DOING
PJRST CMPVAL ;SET CHANGE FLAGS ACCORDINGLY AND RETURN
; "HELP" KEYWORD PROCESSOR
ACCHLX: PUSHJ P,P$CFM ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
MOVEI S1,@ACC+CG.HLP ;POINT TO HELP TEXT
$TEXT (,<^T/(S1)/>) ;GIVE HELP
SETZ P1, ;CLEAR "NO" FLAG
$RETT ;AND RETURN
; "NO" KEYWORD PROCESSOR
ACCNO: MOVNI P1,1 ;SET "NO" FLAG
$RETT ;RETURN
; "NONE" KEYWORD PROCESSOR
ACCNON: PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
PUSHJ P,P$PREV## ;BACKUP OVER THE CRLF
MOVX S1,AE.FIO ;NO ACCESS MEANS "FILES ONLY"
MOVEM S1,.AEACC(U) ;SAVE BIT
PJRST ACCGO ;GO SET THE MASKS
SUBTTL ENTRIES -- ADM - ADMINISTRATIVE DATA
.ENTRY (ADM,-1,<Administrative data>)
ADMPRS: $CRLF
; GET ROUTINE
ADMGET: $RETT
; COMPARE ROUTINE
ADMCMP: $RETT
; CHANGE ROUTINE
ADMCHG: $RETF
; DEFAULT ROUTINE
ADMDFL: PJRST PRODFZ ;NO CAN DO
; RESTORE ROUTINE
ADMRES: $RETF
; PRINT ROUTINE
ADMPRT: MOVE S1,.AEPAP(U) ;GET LAST CHANGE PPN
MOVE S2,.AETIM(U) ;GET LAST CHANGE DATE/TIME
$TEXT (,<^M^J Profile last changed by ^U/S1/ at ^H/S2/>)
SKIPE .AEFAI(U) ;ACCOUNT ACCESSED EVER?
JRST ADMPR1 ;YES
MOVEI T1,[ITEXT(<-never->)] ;NO
JRST ADMPR2
ADMPR1: MOVX S1,AE.FAI ;GET ACCESS FAILURE BIT
TDNE S1,.AEFLG(U) ;SUCCESS?
SKIPA S1,[[ASCIZ\failed\]] ;NOPE
MOVEI S1,[ASCIZ\succeeded\] ;YES
MOVEI T1,[ITEXT(<^T/(S1)/ on ^H/.AEFAI(U)/>)]
ADMPR2: $TEXT (,< Last access ^I/(T1)/>)
SKIPN .AELPC(U) ;LAST PASSWORD CHANGE?
SKIPA T1,[[ITEXT(<-none->)]] ;NO
MOVEI T1,[ITEXT(< at ^H/.AELPC(U)/>)] ;YES
$TEXT (,< Last password change ^I/(T1)/>)
$RETT ;RETURN
; HELP TEXT
ADMHLP: ASCIZ \
ADMINISTRATIVE DATA are those quantities maintained by the accounting
system to track profile changes. These values cannot be changed using
REACT, nor can they be defaulted.
\
SUBTTL ENTRIES -- CTX - CONTEXT-QUOTAS
.ENTRY (CTX,.AECTX,<Context-quotas>)
CTXPRS: $NUMBER (CTX010,^D10,<saved contexts>,<$PDEFAULT(DEFTX1),$PREFIL(CTXACT)>)
CTX010: $NUMBER (CONFRM,^D10,<saved pages>,<$PDEFAULT(DEFTX2)>)
CTXACT: MOVE S1,[%CTJCQ] ;GETTAB ARGUMENT
GETTAB S1, ;GET DEFAULT CONTEXT QUOTA
MOVEI S1,4 ;ANCIENT MONITOR
$TEXT (<-1,,DEFTX1>,<^D/S1/^0>)
MOVE S1,[%CTJPQ] ;GETTAB ARGUMENT
GETTAB S1, ;GET DEFAULT SAVED PAGE QUOTA
MOVEI S1,^D1000 ;ANCIENT MONITOR
$TEXT (<-1,,DEFTX2>,<^D/S1/^0>)
$RETT ;RETURN
; GET ROUTINE
CTXGET: PUSHJ P,P$NUM## ;GET NUMBER OF CONTEXTS
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPGE T1,S1 ;COPY
MOVEI T1,0 ;CAN'T BE NEGATIVE
PUSHJ P,P$NUM## ;GET IDLE CONTEXT PAGE LIMIT
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPGE T2,S1 ;COPY
MOVEI T2,0 ;CAN'T BE NEGATIVE
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPN T1 ;UNLIMITED?
WARN (NCL,<No context limit>)
MOVEI S1,<MASK.(<WID(AE.CNQ)>,35)> ;GET LIMIT
CAIG T1,(S1) ;RANGE CHECK
JRST CTXGE1 ;REASONABLE NUMBER
WARN (RCL,<Reducing context limit from ^D/T1/ to ^D/S1/>)
MOVEI T1,(S1) ;ADJUST
CTXGE1: DPB T1,CTXCNQ ;STORE CONTEXT LIMIT
SKIPN T2 ;UNLIMITED?
WARN (NPL,<No saved page limit>)
DPB T2,CTXCPQ ;STORE PAGE LIMIT
MOVEI S1,.AECTX ;OFFSET TO CHECK
PJRST CMPVLC ;SET CHANGE FLAGS & RETURN
; COMPARE ROUTINE
CTXCMP: MOVEI S1,.AECTX ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
CTXCHG: MOVEI S1,.AECTX ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
CTXDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.CTX ;DEFAULT BIT FOR FIELD
IORM S1,DF$CTX(U) ;LIGHT IN PROFILE
SETOM @CHGADR ;CHANGED IT
SETOM CHGMSK+.AECTX ;WHOLE WORD
$RETT ;WIN
; RESTORE ROUTINE
CTXRES: MOVE S1,.AECTX(X) ;GET OLD CTX VALUES
MOVEM S1,.AECTX(U) ;RESTORE
MOVX S1,DF.CTX ;CTX DEFAULT BIT
ANDCAM S1,DF$CTX(U) ;CLEAR IN WORKING COPY
TDNE S1,DF$CTX(X) ;WAS IT CLEAR BEFORE?
IORM S1,DF$CTX(U) ;NO, FIX IT
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AECTX ;BOTH PLACES
$RETT ;AND RETURN
; PRINT ROUTINE
CTXPRT: LDB T1,CTXCNQ
LDB T2,CTXCPQ
$TEXT (,<Contexts ^D/T1/, Total pages ^D/T2/>)
$RETT
; HELP TEXT
CTXHLP: ASCIZ \
CONTEXT-QUOTAS specify the limits governing the use of job contexts.
The context quota is the number of contexts a user may have at any one
time. Each logged in job has at least one (current) context. The
maximum is 511. A quota of zero indicates no limit. The saved page
quota is the number of pages of swapping space a user may occupy with
idle contexts. A quota of zero indicates no limit. Refer to the
description of job contexts in the TOPS-10 Operating System Commands
Manual for more information.
\
SUBTTL ENTRIES -- COR - CORE-LIMITS
.ENTRY (COR,.AECOR,<Core Limits>)
CORPRS: $NUMBER (COR010,^D10,<physcal page limit>,<$DEFAULT(<512>)>)
COR010: $NUMBER (CONFRM,^D10,<virtual page limit>,<$DEFAULT(<512>)>)
; GET ROUTINE
CORGET: PUSHJ P,P$NUM## ;GET A NUMBER FROM COMMAND BLOCK
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPGE T1,S1 ;COPY
MOVEI T1,0 ;CAN'T BE NEGATIVE
PUSHJ P,P$NUM## ;GET THE NEXT NUMBER FROM COMMAND BLOCK
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPGE T2,S1 ;COPY
MOVEI T2,0 ;CAN'T BE NEGATIVE
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
MOVE S1,T1 ;GET PHYSICAL LIMIT
PUSHJ P,CORGE1 ;CHECK IT
DPB S1,CORPHY ;STORE NEW PHYSICAL LIMIT
MOVE S1,T2 ;GET VIRTUAL LIMIT
PUSHJ P,CORGE2 ;CHECK IT
DPB S1,CORVRT ;STORE NEW VIRTUAL LIMIT
MOVEI S1,.AECOR ;OFFSET TO CHECK
PJRST CMPVLC ;SET CHANGE FLAGS & RETURN
CORGE1: SKIPA T3,[[ASCIZ /physical/]]
CORGE2: SKIPA T3,[[ASCIZ /virtual/]]
SKIPA S2,[MASK.(<WID(AE.NPP)>,35)] ;GET PHYSICAL LIMIT
MOVEI S2,<MASK.(<WID(AE.NVP)>,35)> ;GET VIRTUAL LIMIT
CAIG S1,(S2) ;RANGE CHECK
POPJ P, ;REASONABLE NUMBER
WARN (RCL,<Reducing ^T/(T3)/ limit from ^D/S1/ to ^D/S2/ pages>)
MOVEI S1,(S2) ;ADJUST
POPJ P, ;RETURN
; COMPARE ROUTINE
CORCMP: MOVEI S1,.AECOR ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
CORCHG: MOVEI S1,.AECOR ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
CORDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.COR ;DEFAULT BIT FOR FIELD
IORM S1,DF$COR(U) ;LIGHT IN PROFILE
SETOM @CHGADR ;CHANGED THE ENTRY
SETOM CHGMSK+.AECOR ;BOTH FIELDS
$RETT ;WIN
; RESTORE ROUTINE
CORRES: MOVE S1,.AECOR(X) ;GET ORIGINAL CORE VALUES
MOVEM S1,.AECOR(U) ;RESTORE
MOVX S1,DF.COR ;DEFAULT BIT FOR CORE WORD
ANDCAM S1,DF$COR(U) ;ASSUME CLEAR IN WORKING COPY
TDNE S1,DF$COR(X) ;DOES THIS MATCH THE ORIGINAL?
IORM S1,DF$COR(U) ;NO, FIX UP FOR WRONG GUESS
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AECOR ;IN BOTH PLACES
$RETT ;AND RETURN
; PRINT ROUTINE
CORPRT: LDB T1,CORPHY ;GET PHYSICAL LIMIT
LDB T2,CORVRT ;GET VIRTUAL LIMIT
$TEXT (,<Physical ^D/T1/, Virtual ^D/T2/>)
$RETT ;RETURN
; HELP TEXT
CORHLP: ASCIZ \
CORE-LIMITS specifies a decimal value for the physical and virtual
page limits. The maximum number of pages is 16,384.
\
SUBTTL ENTRIES -- DST - DISTRIBUTION-LOCATION
.ENTRY (DST,.AEBOX,<Distribution location>)
DSTPRS: $QUOTE (CONFRM,<optionally quoted string>,<$PREFI(P$8BIT##),$ALTER(DST010)>)
DST010: $FIELD (CONFRM,,<$PREFI(P$8BIT##),$BREAK(TXTBRK),$FLAGS(CM%SDH)>)
; GET ROUTINE
DSTGET: PUSHJ P,.SAVE1 ;SAVE P1
PUSHJ P,P$QSTR## ;GET A QUOTED STRING
SKIPT ;CHECK FOR ERRORS
PUSHJ P,P$FLD## ;MAYBE JUST A FIELD
JUMPF PRSERR ;CHECK FOR ERRORS
MOVE P1,S1 ;SAVE STRING ADDRESS
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
MOVEI S1,(P1) ;POINT TO PARSER DATA BLOCK
MOVE S2,[.ADLLC,,.ADLLW] ;GET LENGTH IN CHARACTERS,,LENGTH IN WORDS
MOVEI T1,10 ;8-BIT BYTES
PUSHJ P,PROSTR ;CHECK STRING LENGTH AND CONTENT
MOVEI S1,(P1) ;PARSER DATA BLOCK ADDRESS
MOVE S2,DST+CG.PFL ;PROFILE OFFSET
PUSHJ P,PROBLK ;ADD/DELETE EXTENSIBLE BLOCK
SKIPT ;CHECK FOR ERRORS
WARN (NRM,<No room in profile for DISTRIBUTION LOCATION>,,DSTRES)
MOVEI S1,.AEBOX ;OFFSET TO CHECK
PJRST CMPVLC ;SET CHANGE FLAGS & RETURN
; COMPARE ROUTINE
DSTCMP: MOVEI S1,.AEBOX ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
DSTCHG: MOVEI S1,.AEBOX ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
DSTDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.BOX ;DEFAULT BIT FOR FIELD
IORM S1,DF$BOX(U) ;SET IN PROFILE
SETOM @CHGADR ;WE CHANGED IT
SETOM CHGMSK+.AEBOX ;WHOLE THING
$RETT ;WIN
; RESTORE ROUTINE
DSTRES: MOVEI T1,(U) ;POINT TO PROFILE
HLLZ T2,.AEBOX(X) ;-LENGTH
HRRI T2,.AEBOX ;OFFSET
SKIPE T3,.AEBOX(X) ;ORIGINAL OFFSET POINTER
ADDI T3,(X) ;INDEX INTO PROFILE
MOVX T4,DF.BOX ;DEFAULT BIT FOR FIELD
TDNN T4,DF$BOX(X) ;WAS IT DEFAULTED BEFORE?
TDZA T4,T4 ;NO, CLEAR THE BIT
MOVEI T4,1 ;YES, SET THE BIT
PUSHJ P,A$EBLK## ;RESTORE ORIGINAL DISTRIBUTION LOCATION
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AEBOX ;IN BOTH PLACES
$RETT ;RETURN
; PRINT ROUTINE
DSTPRT: SKIPN S1,.AEBOX(U) ;GET AOBJN POINTER
SKIPA S1,[NONE8] ;THERE IS NONE
ADDI S1,(U) ;INDEX INTO PROFILE
HRLI S1,(POINT 8,) ;MAKE A BYTE POINTER
$TEXT (,<^Q/S1/>) ;DISPLAY
$RETT
; HELP TEXT
DSTHLP: ASCIZ \
DISTRIBUTION-LOCATION specifies text to be displayed on the banner
page(s) of spooled output. The text indicates where the operator should
distribute the user's output.
\
SUBTTL ENTRIES -- ENQ - ENQ-DEQ-QUOTA
.ENTRY (ENQ,.AEENQ,<ENQ/DEQ quota>)
ENQPRS: $NUMBER (CONFRM,^D10,<quota>,<$PDEFAULT(DEFTX1),$PREFIL(ENQACT)>)
ENQACT: MOVE S1,[%EQDEQ] ;GETTAB ARGUMENT
GETTAB S1, ;GET DEFAULT ENQ/DEQ QUOTA
MOVEI S1,^D511 ;SICK MONITOR
$TEXT (<-1,,DEFTX1>,<^D/S1/^0>)
$RETT ;RETURN
; GET ROUTINE
ENQGET: PUSHJ P,P$NUM## ;GET A NUMBER FROM
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPGE T1,S1 ;COPY
MOVEI T1,0 ;CAN'T BE NEGATIVE
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
MOVEI T2,^D511 ;GET LIMIT
CAIG T1,(T2) ;TOO BIG?
JRST ENQGE1 ;YES
WARN (REL,<Reducing ENQ/DEQ limit from ^D/T1/ to ^D/T2/>)
MOVEI T1,(T2) ;ADJUST
ENQGE1: MOVEM T1,.AEENQ(U) ;STORE AS NEW ENQ/DEQ QUOTA
MOVEI S1,.AEENQ ;OFFSET TO CHECK
PJRST CMPVLC ;SET CHANGE FLAGS & RETURN
; COMPARE ROUTINE
ENQCMP: MOVEI S1,.AEENQ ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
ENQCHG: MOVEI S1,.AEENQ ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
ENQDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.ENQ ;DEFAULT BIT FOR FIELD
IORM S1,DF$ENQ(U) ;LIGHT IN PROFILE
SETOM @CHGADR ;WE CHANGED THE ENTRY
SETOM CHGMSK+.AEENQ ;WHOLE THING
$RETT ;WIN
; RESTORE ROUTINE
ENQRES: MOVE S1,.AEENQ(X) ;GET ORIGINAL ENQ/DEQ QUOTAS
MOVEM S1,.AEENQ(U) ;RESTORE
MOVX S1,DF.ENQ ;DEFAULT BIT FOR ENQ/DEQ WORD
ANDCAM S1,DF$ENQ(U) ;ASSUME CLEAR IN WORKING COPY
TDNE S1,DF$ENQ(X) ;DOES THIS MATCH THE ORIGINAL?
IORM S1,DF$ENQ(U) ;NO, FIX UP FOR WRONG GUESS
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AEENQ ;IN BOTH PLACES
$RETT ;AND RETURN
; PRINT ROUTINE
ENQPRT: MOVE T1,.AEENQ(U) ;GET ENQ/DEQ QUOTAS
$TEXT (,<^D/T1/>) ;DISPLAY
$RETT
; HELP TEXT
ENQHLP: ASCIZ \
ENQ-DEQ-QUOTA specifies a decimal value for the number of outstanding
ENQ locks. The maximum number is 511.
\
SUBTTL ENTRIES -- EXP - EXPIRATION-DATE
.ENTRY (EXP,.AEEXP,<Expiration date>)
EXPPRS: $KEYDSP (EXP010,<$ALTER(EXP020)>)
EXP010: $STAB
DSPTAB (CONFRM,0,<NEVER>)
DSPTAB (CONFRM,1,<NOW>)
$ETAB
EXP020: $TAD (CONFRM)
; GET ROUTINE
EXPGET: PUSHJ P,P$TIME## ;GET THE TIME FIELD FROM COMMAND BLOCK
JUMPT EXPGE1 ;IF WE GOT IT, O.K.
PUSHJ P,P$KEYW## ;FIND OUT IF KEYWORD
JUMPF PRSERR ;CHECK FOR ERRORS
JUMPE S1,EXPGE1 ;JUMP IF "NEVER"
CAIE S1,1 ;ELSE BETTER BE "NOW"
JRST PRSERR ;GIVE UP
PUSHJ P,I%NOW ;GET CURRENT UDT
EXPGE1: MOVE T1,S1 ;COPY RESULT
PUSHJ P,P$CFM## ;GET CRLF
JUMPF PRSERR ;CHECK FOR ERRORS
MOVEM T1,.AEEXP(U) ;SAVE EXPIRATION DATE/TIME IN USER BLOCK
MOVEI S1,.AEEXP ;OFFSET TO CHECK
PJRST CMPVLC ;SET CHANGE FLAGS & RETURN
; COMPARE ROUTINE
EXPCMP: MOVEI S1,.AEEXP ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
EXPCHG: MOVEI S1,.AEEXP ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
EXPDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.EXP ;DEFAULT BIT FOR FIELD
IORM S1,DF$EXP(U) ;LIGHT IN PROFILE
SETOM @CHGADR ;WE CHANGED IT
SETOM CHGMSK+.AEEXP ;WHOLE THING
$RETT ;WIN
; RESTORE ROUTINE
EXPRES: MOVE S1,.AEEXP(X) ;GET ORIGINAL EXPIRATION DATE/TIME
MOVEM S1,.AEEXP(U) ;RESTORE
MOVX S1,DF.EXP ;DEFAULT BIT FOR EXPIRATION WORD
ANDCAM S1,DF$EXP(U) ;ASSUME CLEAR IN WORKING COPY
TDNE S1,DF$EXP(X) ;DOES THIS MATCH THE ORIGINAL?
IORM S1,DF$EXP(U) ;NO, FIX UP FOR WRONG GUESS
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AEEXP ;IN BOTH PLACES
$RETT ;AND RETURN
; PRINT ROUTINE
EXPPRT: PUSHJ P,I%NOW ;GET CURRENT DATE/TIME
MOVE T1,.AEEXP(U) ;GET EXPIRATION DATE
MOVEI T2,[ITEXT (<^H/T1/>)] ;ASSUME NORMAL DATE
CAMG T1,S1 ;EXPIRED?
MOVEI T2,[ITEXT (<expired on ^H/T1/>)] ;YES
SKIPG T1 ;NEVER?
MOVEI T2,[ITEXT (<never>)] ;YES
$TEXT (,<^I/(T2)/>) ;DISPLAY
$RETT ;AND RETURN
; HELP TEXT
EXPHLP: ASCIZ \
EXPIRATION-DATE specifies the date when LOGINs to this account are no
longer allowed. This date is also written into the UFD for all mounted
structures for disk maintenance purposes.
\
SUBTTL ENTRIES -- IPC - IPCF-QUOTAS
.ENTRY (IPC,.AEIPC,<IPCF quotas>)
IPCPRS: $NUMBER (IPC010,^D10,<send>,<$PDEFAULT(DEFTX1),$PREFIL(IPCACT)>)
IPC010: $NUMBER (IPCF20,^D10,<receive>,<$PDEFAULT(DEFTX2)>)
IPCF20: $NUMBER (CONFRM,^D10,<PID quota>,<$PDEFAULT(DEFTX3)>)
; ACTION ROUTINE TO GENERATE DEFAULT QUOTA STRINGS
IPCACT: MOVE S1,[%IPCDQ] ;GETTAB ARGUMENT
GETTAB S1, ;GET DEFAULT SEND/RECEIVE QUOTA
MOVEI S1,2005 ;SICK MONITOR
LDB S2,[POINT 9,S1,26] ;GET SEND
$TEXT (<-1,,DEFTX1>,<^D/S2/^0>)
LDB S2,[POINT 9,S1,35] ;GET RECEIVE
$TEXT (<-1,,DEFTX2>,<^D/S2/^0>)
MOVE S1,[%IPDPQ] ;GETTAB ARGUMENT
GETTAB S1, ;GET DEFAULT PID QUOTA
MOVEI S1,2 ;ANCIENT MONITOR
$TEXT (<-1,,DEFTX3>,<^D/S1/^0>)
$RETT ;RETURN
; GET ROUTINE
IPCGET: PUSHJ P,P$NUM## ;GET SEND QUOTA
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPGE T1,S1 ;COPY
MOVEI T1,0 ;CAN'T BE NEGATIVE
PUSHJ P,P$NUM## ;GET THE RECEIVE QUOTA
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPGE T2,S1 ;COPY
MOVEI T2,0 ;CAN'T BE NEGATIVE
PUSHJ P,P$NUM## ;GET NUMBER OF PIDS
JUMPF PRSERR ;CHECK FOR ERRORS
SKIPGE T3,S1 ;COPY
MOVEI T3,0 ;CAN'T BE NEGATIVE
PUSHJ P,P$CFM## ;GET EOL
JUMPF PRSERR ;CHECK FOR ERRORS
MOVEI S1,(T1) ;GET SEND QUOTA
PUSHJ P,IPCGE1 ;CHECK IT
DPB S1,IPCFS ;STORE
MOVEI S1,(T2) ;GET RECEIVE QUOTA
PUSHJ P,IPCGE2 ;CHECK IT
DPB S1,IPCFR ;STORE
MOVEI S1,(T3) ;GET PID QUOTA
PUSHJ P,IPCGE3 ;CHECK IT
DPB S1,IPCFP ;STORE
MOVEI S1,.AEIPC ;OFFSET TO CHECK
PJRST CMPVLC ;SET CHANGE FLAGS & RETURN
IPCGE1: MOVEI T4,[ASCIZ /send/]
MOVEI S2,<MASK.(<WID(AE.SND)>,35)> ;GET LIMIT
JRST IPCGE4 ;GO COMPARE
IPCGE2: MOVEI T4,[ASCIZ /receive/]
MOVEI S2,<MASK.(<WID(AE.RCV)>,35)> ;GET LIMIT
JRST IPCGE4 ;GO COMPARE
IPCGE3: MOVEI T4,[ASCIZ /PID/]
MOVEI S2,<MASK.(<WID(AE.PID)>,35)> ;GET LIMIT
IPCGE4: CAIG S1,(S2) ;TOO BIG?
POPJ P, ;NO
WARN (RIQ,<Reducing IPCF ^T/(T4)/ quota from ^D/S1/ to ^D/S2/>)
MOVEI S1,(S2) ;ADJUST
POPJ P, ;RETURN
; COMPARE ROUTINE
IPCCMP: MOVEI S1,.AEIPC ;PROFILE OFFSET
PJRST COMPAR ;GO COMPARE
; CHANGE ROUTINE
IPCCHG: MOVEI S1,.AEIPC ;PROFILE OFFSET
PJRST QUECHG ;QUEUE UP THE CHANGE
; DEFAULT ROUTINE
IPCDFL: SETOM PRSDFV ;REMEMBER WE CARE
MOVX S1,DF.IPC ;DEFAULT BIT FOR FIELD
IORM S1,DF$IPC(U) ;LIGHT IN PROFILE
SETOM @CHGADR ;WE CHANGED IT
SETOM CHGMSK+.AEIPC ;WHOLE THING
$RETT ;WIN
; RESTORE ROUTINE
IPCRES: MOVE S1,.AEIPC(X) ;GET ORIGINAL IPCF VALUES
MOVEM S1,.AEIPC(U) ;RESTORE
MOVX S1,DF.IPC ;DEFAULT BIT FOR IPCF WORD
ANDCAM S1,DF$IPC(U) ;ASSUME CLEAR IN WORKING COPY
TDNE S1,DF$IPC(X) ;DOES THIS MATCH THE ORIGINAL?
IORM S1,DF$IPC(U) ;NO, FIX UP FOR WRONG GUESS
SETZM @CHGADR ;INDICATE NOT CHANGING PROFILE ENTRY
SETZM CHGMSK+.AEIPC ;IN BOTH PLACES
$RETT ;AND RETURN
; PRINT ROUTINE
IPCPRT: LDB T1,IPCFS ;SEND QUOTA
LDB T2,IPCFR ;RECEIVE QUOTA
LDB T3,IPCFP ;PID QUOTA
$TEXT (,<Send ^D/T1/, Receive ^D/T2/, PIDs ^D/T3/>)
$RETT
; HELP TEXT
IPCHLP: ASCIZ \
IPCF-QUOTAS specifies a decimal value for the SEND, RECEIVE, and PID
quotas. The maximum value for each quota is 511.
\
SUBTTL ENTRIES -- LTI - LOGIN-TIMES
.ENTRY (LTI,.AELGT,<LOGIN times>)
LTIPRS: $NOISE (CONFRM,<allowed>)
LTI000: $INIT (LTI010)
LTI010: $