Trailing-Edge
-
PDP-10 Archives
-
BB-F493Z-DD_1986
-
10,7/actdae.mac
Click 10,7/actdae.mac to
see without markup as text/plain
There are 9 other files named actdae.mac in the archive. Click here to see a list.
TITLE ACTDAE - Accounting Daemon for TOPS10
SUBTTL B.A.HUIZENGA/BAH/Tarl/LWS/DPM/RCB 26-Jan-86
SEARCH ACTPRM,QSRMAC,ORNMAC
MODULE (ACTDAE)
.REQUIR ACTRCD ;USAGE RECORDS
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979,1980,1981,1984,1985,1986.
;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.
AC.VER==2 ;VERSION NUMBER
AC.EDT==140 ;EDIT NUMBER
AC.WHO==0 ;WHO EDITED LAST
AC.MIN==0 ;MINOR VERSION NUMBER
%%.ACV==:<VRSN. (AC.)>
;AC DEFINITIONS OTHER THAN GLXLIB
DEFADR==15 ;CURRENT ADDRESS OF DEFUS DATA ITEM BEING WORKED UPON.
; NEEDS TO BE PRESERVED OVER DATFIL ROUTINES.
LENGTH==16 ;LENGTH OF CURRENT DATA ITEM BEING WORKED UPON.
; NEEDS TO BE PRESERVED OVER CONVERT ROUTINES.
;CUSTOMER CHANGABLE PARMETERS
IFNDEF FILPRO,<FILPRO==177> ;USAGE/FAILURE FILE PROTECTION
IFNDEF FILBSZ,<FILBSZ==^D7> ;USAGE/FAILURE FILE BYTE SIZE FOR NEW FILES
IFNDEF WTOINT,<WTOINT==^D5> ;INTERVAL TIME (MINUTES) BETWEEN RETRY WTO'S
IFNDEF SLPSEC,<SLPSEC==^D15> ;SECONDS TO SLEEP BETWEEN RETRIES
;SHOULD EVENLY DIVIDE ^D60 OR WTOINT WON'T
;BE CALCULATED CORRECTLY. MAXIMUM IS ^D60.
IF1,<IFG <SLPSEC-^D60>,<PRINTX ?SLPSEC GREATER THAN ^D60.>>
IFNDEF CHKINT,<CHKINT==^D10> ;INTERVAL FOR CHECKPOINTING USAGE FILES
;DONE ON THE FULL MINUTE SO MUST BE
;EVENLY DIVISIBLE INTO 60. I.E. WITH 15
;MINUTE INTERVAL, CHECKPOINTING WILL BE
;DONE AT xx:00, xx:15, xx:30, AND xx:45
COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979,1986. ALL RIGHTS RESERVED.
\;END COPYRIGHT MACRO
LOC 137
EXP %%.ACV
RELOC
SUBTTL EDIT HISTORY
;1) Implement Account validation
;2) Convert to use GLXLIB
;3) Use extended channels and the new FILOP. for I/O
;4) Implement Checkpointing for active jobs
;5) Take action when LOGIN sends LOGIN, SESSION, and ATTACH messages
;6) When disk space is too low for allocating checkpoint files, limit
; the number of jobs to be logged in
;7) Implement Usage file handling code
;10) Validation routine doesn't do enough checking for whom to validate
;11) Verify routine didn't handle PPNs less than the first
; PPN in PROJCT.SYS. Also, verify couldn't handle more than one
; block of validation data in PROJCT.SYS
;12) Make ACTDAE know about ACCT.SYS. Build a table of first PPNs
; in every block and search ACCT.SYS for any PPN validation error
;13) Teach ACTDAE about the 7.01 MOnitor LOGOUT message from [SYSTEM]GOPHER
;14) Since the 70017 monitor starts up the ACTDAE via FRCLIN, the job
; must run detached. Also teach ACTDAE about wild card ppns in ACCT.SYS.
;15) Write MAKENT routine that generally writes an entry
; given an entry number and address of DEFUS data.
;16) Imement the QUEUE. UUO validation function.
;17) Implement the QUEUE. UUO make an entry function.
;20) Use PSI for IPCF traffic and begin timer code
;21) Complete Job checkpoint code and timers for running same.
;22) Make Session entries for jobs after a reload or ACTDAE restart
;23) Implement code for closing sessions and the usage file
;24) Implement device checkpoint files and entries.
;25) Implement Disk Usage accounting from BACKUP
;26) ORIONs messages for SET USAGE FILE/BILLING commands changed
;27) Would you believe ORIONs message changed again
;30) Wild-card in Account string support missing, add it (req PROJCT V1(2)).
; Also, could only find first account for wild-card'ed ppns, fix that.
;31) Space wasted by PHASE/DEPHASE assembly, also bum SKIPT/$RETF pairs.
;32) $FATAL doesn't type on OPR if detached, define $BOMB that always uses OPR
;33) LOGIN sends -1 if no Account or Remark specified at LOGIN time
;34) Physical device name not provided in magtape and DECtape entries
;35) Bad BLT for text fields for STRUCTURE/MAGTAPE/DECTAPE mount IPCF messages.
;36) GLXLIB will DETACH if on FRCLIN, remove code from ACTDAE
;37) Add code and range checks for user defined entries (5000-9999)
;40) Make system restart a little faster
;41) Fix problems with finding entries in PROJCT.SYS
;42) Bad "Make An Entry" messages caused lost free space
;43) Do case conversion when verifying account if FTCASECONVERT is on.
; Return account string (may be modified if FTCASECONVERT is on) in IPCF
; message or in response block of QUEUE. on successful validation.
;44) Implement /NO-SESSION-ENTRIES on the SET USAGE FILE-CLOSURE command to
; over-ride the implicit SET USAGE BILLING-CLOSURE that occurs when the
; file is closed.
;45) Edit 37 broke Disk Utilization records, fix that.
;46) Use assembly parameter PRJWPB for PROJCT.SYS instead of 200s
;47) Implement Default account strings from PROJCT.SYS. The default is
; used if asked to verify a null account string and a default exists.
; The default is returned in the IPCF message or QUEUE. response block.
;50) Allow PPN entries to cross block boundries in PROJCT.SYS. This change
; becomes format version 2. Implement code such that version 1 PROJCT.SYS
; still works. With this change, making PRJWPB larger simply becomes a
; performance gain.
;51) Jobs doing QUEUE. UUO to make an entry hang in EW if not privileged or
; specify an unknown entry type. Un-stick them.
;52) Implement QUEUE. UUO subfunctions UGACC$ and UGOUP$
; for access control requests.
;53) Complete implementation of Date/Time change
;54) Assume account string is NOT required if a ppn isn't in ACCT.SYS
;55) Random fixes from random QARs
;56) Remove our definition of the job field in the LOGOUT message and
; use QUASAR's definition from QSRMAC.
;57) Correct sense of check in ACTLIN so we dont send a bogus error
; message to the OPR if the PID we send to is gone.
;60) Check for PROJCT.SYS being created from a zero-length PROJCT.ACT
; and assume [*,*]=*
;61) Always call ALLDEV on LOGOUT to insure nnnDEV.BIN gets deleted.
;Start version 2 here, to be shipped with TOPS10 7.03.
;
;This version implements SYS:ACCT.SYS version 5, now ACT:ACCT.ACT (See
; ACTCIO.MAC). Only ACTDAE should be reading/writing ACCT.ACT.
; ACTDAE depends on the fact that only it can change the file.
;
;100) Up the version number to 2. Start massive changes. /Tarl
;
;101) Add "context limit" and "idle contexts page limit" UGCHG$
; subfunctions. /LWS
;
;102) Add new "profile flag" word and last access UDT word. Fix various
; bugs in ACCTIO from page boundary problems to miscalculating
; number of customer defined words and program to run words. /LWS
;
;103) Add rudimentary "validation failure log" file support. Fix bugs
; in ACCTIO dealing with page boundaries. /LWS
;
;104) Add LOCK and UNLOCK user account file functions. /LWS
;
;105) Rewrite FNDIDX in ACCTIO and add IDXINI. /LWS
;
;106) Add support for synonym-to-account string translation. This is
; useful for sites which frequently change account strings and do
; not want to inconvience their users by making them change their
; SWITCH.INIs, control files, or MIC file. A file called SYN.ACT
; resides on ACT: and contains one or more lines equating synonym
; strings with account strings. The format is synonym=account.
; Every time we validate an account string, we first check to see
; if the string in question is a synonym. If it is, then the
; string is changed to the appropriate account string.
;
; For example, the account string for user [10,56] changes on a
; monthly basis, but the user has "TOPS10-DEVELOPMENT" as his
; synonym. The system administrator may change the entry in SYN.ACT
; for TOPS10-DEVELOPMENT at any time, and the user remains unaffected.
; After the synonynm translation occurs, the final account string is
; still checked for legality.
;
; Note: This feature is controlled by the setting of SYNONYM, and
; is normally turned off.
;
;107) Allow LOGIN, SESSION, and ATTACH messages via QUEUE. UUO /DPM
;
;110) Fix bug where error messages were being sent back with various
; incorrect lengths. Preserve "T" ACs in LOGUSR. /LWS
;
;111) Username storage was only 1 word. Copying a maxium of 39 8-bit
; characters there would clobber what ever followed.
; QAR #868037 /LWS
;
;112) Rip out the ACCTIO interface and replace with ACTRMS. /TL
;
;113) Add UGVUP$ function, "validate account string and return user
; profile. /LWS
;
;114) Move calls to SCDINI and SCDCLS from ACTRMS to ACTDAE. Add code
; to support new function UGSCD$. User account file is now
; SYS:ACTDAE.SYS and PROJCT.SYS now should reside on SYS:. /LWS
;
;115) Fix bug where CHKACT was calling GETPRO without PPN in T1. /LWS
;
;116) Turn on code that supports a password along with profile to
; insert. REACT now knows how to do it. /LWS
;
;117) Remove VERSET to set version. ACTRMS must be loaded before ACTDAE. /LWS
;
;120) Add code to prevent password changes if AE.PCP is set in the
; profile flag word (.AEFLG).
; 23-Jul-85 /DPM
;
;121) Implement administrative priveleges.
; 24-Jul-85 /DPM
;
;122) Let owner obtain his/her own profile and not require a password
; to change unpriv'ed fields in the profile. If the PPN or project
; number (depending of the setting of INDPPN) of the sender matches
; that of the profile, then access is granted.
; 15-Aug-85 /DPM
;
;123) Move all PPN and user name wildcarding out of REACT and into ACTDAE
; (actually ACTRMS). Support new wildcard message UGWLD$ either from
; a QUEUE. UUO or direct IPCF. See ACTSYM for a definition of the
; message offsets (UW$xxx).
; 26-Aug-85 /DPM
;
;124) Move CHGTAB and friends into ACTCHG module of ACTLIB. Make the
; writing of 8-bit usage/failure files an option. Set FILBSZ to
; the desired byte size (default is 7-bit).
; 29-Aug-85 /DPM
;
;125) Convert all old-style calls for a [next] profile to internal
; wildcard calls. Start converting error ACKing to use ACTLIB's
; error facilities. Other miscellaneous changes made to conform
; to changes in the RMS-10 interface module of ACTLIB.
; 6-Sep-85 /DPM
;
;126) Convert more error ACKs. Almost done!
; 13-Sep-85 /DPM
;
;127) Add support for new accounting function UGMAP$ to map PPNs to user
; names.
; 16-Sep-85 /DPM
;
;130) Change format of FAILUR.LOG to record ANF/DECNET/LAT node/line
; number on a LOGIN failure.
; 15-Oct-85 /CJA
;
;131) Fix ACTMAP to always update name. Since user may have supplied
; a unique abbreviation, he might be interested in the complete
; name too.
;
;132) PUSH and POP of .AEPPN isn't enough in ACTMAP. Copy PPN and
; name to temporary storage.
;
;133) Update UGCUP$ for profile format version 6. This also changes
; the format of select blocks. Also start to enable setting
; ACOPRV via the function code, and turning on the new acking
; code via the function code bits. The UG.xxx symbols of the
; old UGCUP$ are going away sometime. If possible, we'll make
; .UGPRV go away too.
; 18-Nov-85 /RCB
;
;134) Fix some bugs with the defaulting code.
; 24-Nov-85 /RCB
;
;135) Fix undeserved invalid account string problems.
; 4-Dec-85 /DPM
;
;136) Fix some minor bugs in UGCUP$ and UGMAP$.
; 17-Dec-85 /RCB
;
;137) Fix up some bugs in UGCUP$.
; 13-Jan-86 /RCB
;
;140) Fix up password change time when changing a password even if the
; .AEPCT value was orginally defaulted.
; 7-Mar-86 /RCB
;
; End of Revision History
;LOOSE ENDS
REPEAT 0,<
1. THE CODED ERROR ACKS AREN'T FINISHED, DUE TO LACK OF ERROR CODE
DEFINITIONS IN ACTSYM.
2. THE ERROR CODES (TO BE DEFINED BY 1. ABOVE) NEED TO BE PUT INTO
THE FAILURE LOG (RATHER THAN THE CURRENT JUNK).
>
SUBTTL DEFINITIONS AND DATA STORAGE
;GENERAL DEFINITIONS
ACTLNG==100 ;LENGTH OF PUSH DOWN LIST
ND SYNONYM,0 ;DEFAULT SYNONYM TO ACCOUNT STRING TRANSLATION
; 0 = OFF, 1 = ON
SYNFLG: EXP SYNONYM ;SYNONYM FLAG
SYNIFN: BLOCK 1 ;IFN FOR SYNONYM FILE
SYNLIN: BLOCK 1 ;SYNONYM FILE LINE NUMBER
SYNTAB: BLOCK 1 ;POINTER TO SYNONYM TABLE
SYNTMP: BLOCK 10 ;TEMPORARY SYNONYM STRING STORAGE
SYNARG: BLOCK 1 ;SYNONYM-ADDR,,ACCOUNT-STRING-ADDR
ACKEFL: BLOCK 1 ;NON-ZERO IF NEW-STYLE ACKS WANTED
ACKETX: BLOCK 1 ;ADDRESS OF ACK TEXT ON USER ERRORS
ACKITX: BLOCK 1 ;ADDRESS OF ACK ITEXT BLOCK
MVBFLG: BLOCK 1 ;FLAG TO MOVE WHOLE VALIDATION BLOCK
STATE2: BLOCK 1 ;SECOND STATES WORD (CONTAINS VALIDATION FLAG)
ACTDEV: BLOCK 1 ;USUALLY ERSATZ DEVICE ACT:, DSK: IF DEBUGGING
; (E.G., .JBOPS CONTAINS NON-ZERO)
PRJDEV: BLOCK 1 ;FOR PROJCT.SYS NOW USE SYS: OR DSK: IF DEBUG
ACNDEV: BLOCK 1 ;DEVICE FOR ACTDAE.SYS (SYS: OR DSK: IF DEBUG)
ACTUSE: BLOCK 2 ;USETI/O BLOCK FOR POSITIONING ANY FILE
ACTPDL: BLOCK ACTLNG ;PUSH DOWN LIST
ACCTFN: BLOCK 16 ;STORAGE FOR ASCIZ ACCOUNTING FILE NAME
;INITIALIZATION BLOCK
IB: $BUILD (IB.SZ) ;INITIALIZATION BLOCK
$SET (IB.PIB,,PIB) ;ADDRESS OF PID BLOCK
$SET (IB.PRG,,%%.MOD) ;PROGRAM NAME
$SET (IB.INT,,ACTPSI) ;INTERRUPT VECTOR BASE
$EOB
PIB: $BUILD (PB.MXS) ;PID BLOCK
$SET (PB.HDR,PB.LEN,PB.MXS) ;LENGTH OF THIS BLOCK
$SET (PB.FLG,IP.JWP,1) ;JOB-WIDE PID
$SET (PB.FLG,IP.SPF,1) ;BE A SYSTEM PID
$SET (PB.FLG,IP.SPB,1) ;SEE IF SENDER SET IP.CFP
$SET (PB.FLG,IP.PSI,1) ;CONNECT THIS PID TO PSI SYSTEM
$SET (PB.INT,IP.SPI,SP.ACT) ;SPECIAL PID INDEX [SYSTEM]ACCOUNT
$SET (PB.INT,IP.CHN,<IPCPSI-ACTPSI>) ;CHANNEL
$SET (PB.SYS,IP.MNP,1) ;ONLY 1 PID ALLOWED FOR THIS JOB
$SET (PB.SYS,IP.SQT,-1) ;INFINITE SEND QUOTA
$SET (PB.SYS,IP.RQT,-1) ;INFINITE RECEIVE QUOTA
$EOB
;IPCF SEND/RECEIVE MESSAGE DEFINITIONS
IPS.BL: BLOCK SAB.SZ ;IPCF SEND BLOCK
IPR.BL: BLOCK MDB.SZ ;IPCF RECEIVE BLOCK
MDBADR: BLOCK 1 ;MESSAGE DESCRIPTOR BLOCK OF LAST RECEIVE
MMSADR: BLOCK 1 ;RECEIVE DATA ADDRESS
DATADR: BLOCK 1 ;ADDRESS OF DATA FOR ADTDAE FUNCIONS
SABADR: BLOCK 1 ;ADDRESS OF SEND DATA PAGE
;PSI INTERRUPT BLOCKS
ACTPSI:
IPCPSI: EXP IPCTRP
BLOCK 3
IPCTRP: $BGINT 1,
$CALL C%INTR
$DEBRK
SUBTTL ERROR CODE GENERATOR
;USAGE:
; DEFINE LOCAL ERROR CODES, ERRA%=0, ERRB%=1, ...
; DEFINE LOCAL LABELS WHICH CORRESPOND TO EACH ERROR CODE.
; FOR EACH ERROR CODE, LABEL PAIR, ERCODE(LABEL,CODE)
ECDMAX==11 ;MAXIMUM NUMBER OF ERROR TYPES IN ACTDAE
DEFINE ERCODE(NAME,CODE)<
.DIRECTIVE .XTABM
ERRCOD (NAME,CODE,\CODE)
.DIRECTIVE .ITABM>
DEFINE ERRCOD(NAME,CODE,ACODE)<
IFG <CODE+1-ECDMAX>,<
PRINTX %ECOD'ACODE is undefined, define ECDMAX in ACTDAE.MAC to be ACODE+1>
NAME==ECOD'ACODE>
DEFINE ERCALC(N)<
.N==0
REPEAT N,<ERRJSP (\.N)
.N=.N+1>
ECOD: SUBI T1,ECOD0+1
HRRZS T1
JRST ERRPRO>
DEFINE ERRJSP(N)<
ECOD'N: JSP T1,ECOD>
ERCALC (ECDMAX)
SUBTTL MACROS
;DEFINE A MACRO TO PUT STANDARD ACTDAE HEADER AROUND A MESSAGE TO THE OPERATOR
DEFINE $WTOXX (TEXT),<
$WTO (<Message from the Accounting System>,<TEXT>,,<$WTFLG(WT.SJI)>)
>
;DEFINE A MACRO TO OUTPUT FATAL ERRORS TO OPERATOR THEN STOP
DEFINE $BOMB (TEXT),<
JRST [$WTO(<Fatal error in the Accounting System>,<TEXT>)
$FATAL(<TEXT>)]
>
SUBTTL ACTDAE - PRIMARY MODULE FOR TOPS10 ACCOUNTING DAEMON
ACTDAE: RESET
MOVE P,[IOWD ACTLNG,ACTPDL] ;SET UP OUR PDL
MOVEI S1,IB.SZ ;LOAD SIZE OF INITIALIZATION BLOCK (IB)
MOVEI S2,IB ;LOAD ADDRESS OF IB
$CALL I%INIT ;INITIALIZE THE WORLD OF GLXLIB
$CALL I%ION ;TURN ON THE PSI SYSTEM
PUSHJ P,ACTINI ;INITIALIZE THE WORLD
ACTDA1: $CALL C%RECV
JUMPF ACTDA2 ;NO MESSAGES YET. WAIT FOR AN EVENT TO HAPPEN
MOVEM S1,MDBADR ;SAVE THE MESSAGE DESCRIPTOR ADDRESS
MOVE T1,MDB.MS(S1) ;GET THE ADDRESS OF THE MESSAGE
ANDX T1,MD.ADR ;MASK OUT THE ADDRESS
MOVEM T1,MMSADR ;SAVE IT FOR LATER
MOVEM T1,DATADR ;DATA MESSAGE IF NOT FROM A QUEUE. UUO
MOVEM T1,SABADR ;AND IN CASE OF ERROR MESSAGES
PUSHJ P,QUECHK ;CHECK IF MESSAGE CAME FROM QUEUE.
JUMPF [PUSHJ P,IGNORE
JRST ACTDA1]
MOVE T1,DATADR ;USE DATADR IN CASE IT WAS A QUEUE. MESSAGE
HRRZ T1,UV$TYP(T1) ;GET THE IPCF MESSAGE TYPE
ANDI T1,AF.FUN ;MASK IT DOWN
CAILE T1,IPCMAX ;IS IT A LEGAL MESSAGE?
SETZ T1, ;NO, MAKE IT 0 = ILLEGAL
HLRZ T2,ACTDSP(T1) ;GET PRIV CHECKING ROUTINE
SKIPE T2 ;SKIP IF NO CHECKING NEEDED
PUSHJ P,(T2) ;CHECK PRIVILEGES
HRRZ T2,ACTDSP(T1) ;GET MESSAGE PROCESSOR ROUTINE
PUSHJ P,(T2) ;DISPATCH
JRST ACTDA1
ACTDA2: PUSHJ P,CHKIVL ;COMPUTE TIME UNTIL NEXT CHECKPOINT
$CALL I%SLP ;AND SLEEP THAT LONG
JRST ACTDA1 ;GO BACK AND SEE WHAT WOKE US UP
;DISPATCH TABLE FOR ACCOUNT DAEMON EVENTS
ACTDSP: XWD PRVOPR,IGNORE ;(0) ILLEGAL
XWD 0,ACTVER ;(1) REQUEST FOR ACCOUNT VALIDATION
XWD PRVOPR,ACTLIN ;(2) USER IS LOGGING IN
XWD PRVOPR,ACTSES ;(3) USER TYPED A SESSION COMMAND
XWD PRVOPR,ACTATT ;(4) USER TYPED AN ATTACH COMMAND
XWD PRVOPR,ACTCHD ;(5) SET DATE/TIME MESSAGE FROM DAEMON
XWD PRVOPR,IGNORE ;(6) RESPONSE TO A VALIDATION MESSAGE
XWD PRVOPR,USGMAK ;(7) MAKE A USAGE ENTRY (QUEUE. UUO only)
XWD PRVOPR,DOUBC ;(10) DO BILLING CLOSURE
XWD PRVOPR,DOUFC ;(11) DO FILE CLOSURE
XWD PRVOPR,ACTFDM ;(12) USER FILE STRUCTURE MOUNT MESSAGE
XWD PRVOPR,ACTFDD ;(13) USER FILE STRUCTURE DISMOUNT MESSAGE
XWD PRVOPR,ACTMGM ;(14) USER MAGTAPE MOUNT MESSAGE
XWD PRVOPR,ACTMGD ;(15) USER MAGTAPE DISMOUNT MESSAGE
XWD PRVOPR,ACTDTM ;(16) USER DECTAPE MOUNT MESSAGE
XWD PRVOPR,ACTDTD ;(17) USER DECTAPE DISMOUNT MESSAGE
XWD PRVOPR,ACTSPM ;(20) DISK PACK SPINDLE SPIN-UP MESSAGE
XWD PRVOPR,ACTSPD ;(21) DISK PACK SPINDLE SPIN-DOWN MESSAGE
XWD PRVOPR,IGNORE ;(22) ACK (SENT FROM ACTDAE, NEVER RECEIVED)
XWD PRVOPR,ACTDUE ;(23) DISK USAGE DATA
XWD PRVOPR,ACTACC ;(24) ACCESS CONTROL CHECK (QUEUE. UUO only)
XWD 0,ACTOUP ;(25) OBTAIN USER PROFILE (QUEUE. UUO only)
XWD PRVOPR,IGNORE ;(26) UNDEFINED
XWD PRVOPR,ACTOUT ;(27) A LOGOUT UUO WAS DONE
XWD 0,ACTACC ;(30) ACC BUT RETURN PROFILE (QUEUE. UUO only)
XWD 0,ACTCUP ;(31) CHANGE USER PROFILE (QUEUE. UUO only)
XWD PRVOPR,ACTPSW ;(32) VALIDATE PASSWORD (QUEUE. UUO only)
XWD PRVADM,ACTLOK ;(33) LOCK USER ACCOUNT FILE (QUEUE. UUO only)
XWD PRVADM,ACTUNL ;(34) UNLOCK USER ACCOUNT FILE (QUEUE. UUO only)
XWD PRVOPR,ACTVER ;(35) VALIDATE ACCOUNT AND RETURN PROFILE
XWD PRVADM,ACTSCD ;(36) CLOSE AND REOPEN SCDMAP.INI (QUEUE. UUO only)
XWD 0,ACTWLD ;(37) GET POSSIBLY WILDCARDED PPN/NAME
XWD 0,ACTMAP ;(40) MAP PPNS/NAMES
IPCMAX==:.-ACTDSP-1
IGNORE: $CALL C%REL ;JRST RELEASE THE MESSAGE
$RETF
SUBTTL PRIVILEGE CHECKING
PRVADM: PUSHJ P,CHKADM ;CHECK ADMINISTRATIVE PRIVS
JUMPF NOPRV ;NO ACCESS ALLOWED
$RETT ;RETURN
PRVOPR: PUSHJ P,CHKOPR ;CHECK FOR [1,2] OR JACCT PRIVS
JUMPF NOPRV ;NO ACCESS ALLOWED
$RETT ;RETURN
; CHECK FOR ADMINISTRATIVE PRIVS OR JACCT
CHKADM: MOVE T2,MDBADR ;POINT TO MESSAGE DESCRIPTOR
LOAD T3,MDB.PV(T2),MD.PJB ;GET JOB NUMBER
HRLZS T3 ;PUT IN LH
HRRI T3,.GTPRV ;INCLUDE GETTAB TABLE
GETTAB T3, ;GET PRIV WORD
SETZ T3, ;FAILED?
TXNE T3,JP.ADM ;ADMINISTRATIVE PRIVS?
$RETT ;YES
; CHECK FOR [1,2] OR JACCT PRIVS
CHKOPR: MOVE T2,MDBADR ;POINT TO MESSAGE DESCRIPTOR
MOVE T3,MDB.PV(T2) ;GET SENDER'S PRIVS AND JOB NUMBER
MOVE T4,MDB.SD(T2) ;GET SENDER'S PPN
CAME T4,MYPPN ;SAME AS US (NORMALLY [1,2])
TXNE T3,MD.PWH ;NO--JACCT'ED JOB?
$RETT ;YES
$RETF ;NO ACCESS ALLOWED
; CHECK FOR OWNER
CHKOWN: SKIPE ACOPRV ;IF PRIV'ED
$RETT ;THEN AN OWNER
PUSHJ P,CHKOPR ;TEST FOR OPR
$RETIT ;OWNER IF FFA PRIVS
MOVE T2,MDBADR ;POINT TO MESSAGE DESCRIPTOR
MOVE T3,MDB.SD(T2) ;GET SENDER'S PPN
CAMN T3,S1 ;IS THIS AN EXACT MATCH?
$RETT ;YES, HE OWNS IT
$SAVE T1 ;PRESERVE AN AC
MOVE T2,S1 ;GET TARGET PPN
MOVE T1,[.ACCPR,,<777>B26+<077>B35] ;SETUP FOR CHKACC
MOVEI T4,T1 ;POINT TO UUO ARG BLOCK
CHKACC T4, ;TRY IT
$RETF ;SICK MONITOR
CAIE T4,0 ;IS HE A WINNER?
$RETF ;NO
$RETT ;OR YES
NOPRV: SKIPN QUEFLG ;DID THIS COME FROM THE QUEUE UUO
JRST NOPRV1 ;NO, JUST IGNORE (CAN'T TRUST USERS DATA)
PUSHJ P,M%GPAG ;BUT CAN TRUST THE MONITOR, GET A MESSAGE
MOVEM S1,SABADR ;STORE WHERE COMMON ROUTINES CAN FIND IT
PUSHJ P,ERROR3 ;SAY "JOB NOT PRIVILEGED"
PUSHJ P,FIXQUE ;MOVE ACK CODE AND FORMAT THE MESSAGE
PUSHJ P,RSPSAB ;SEND RESPONSE FROM SABADR TO THE MONITOR
NOPRV1: SETZ T1, ;RETURN FUNCTION = 0 = ILLEGAL
$RETF ;AND PITCH IT
SUBTTL ACTDAE - INITIALIZATION
ACTINI: MOVEI S1,'ACT' ;ACTDAE PREFIX
MOVEI S2,ERRACK ;ROUTINE TO ACK USER ERRORS
PUSHJ P,A$ERRI## ;INIT ERROR PROCESSOR
PUSHJ P,ACGTAB ;AREA TO DO ALL THE GENERAL GETTABS
MOVX S1,ACTFIL ;GET ACCOUNTING FILE NAME
$TEXT (<-1,,ACCTFN>,<^W/ACNDEV/:^W/S1/.SYS^0>) ;GENERATE ACCT FILESPEC
PUSHJ P,USGSAU ;APPEND TO USAGE.OUT
PUSHJ P,SYSINI ;SYSTEM RESTARTED. DO PRELIMINARY WORK
PUSHJ P,ACDINI ;INITIALIZE ALL DISK STUFF
MOVE T1,STATE2 ;GET STATES WORD
TXNN T1,ST%ACV ;ACCOUNT VALIDATION REQUIRED?
$WTOXX (<Account validation is not required>)
PUSHJ P,SYNFIL ;READ SYNONYM FILE
SETOM CHKNDX ;FORCE A CHECKPOINT WHEN IPCF QUEUE IS EMPTY
POPJ P,
;ACGTAB - ROUTINE TO DO ALL GENERAL GETTABS AND STORE THE RESULTS FOR
; LATER USE.
ACGTAB: SKIPE .JBOPS ;ARE WE DEBUGGING?
SKIPA T1,[' DSK'] ;YES. LOOK IN OUR OWN AREA
MOVEI T1,'ACT' ;NO. USE ERSATZ DEVICE
MOVEM T1,ACTDEV ;SAVE IT
SKIPE .JBOPS ;ARE WE DEBUGGING?
SKIPA T1,[' DSK'] ;YES. LOOK IN OUR OWN AREA
MOVEI T1,'SYS' ;NO. USE SYS: FOR PROJCT.SYS
MOVEM T1,PRJDEV ;SAVE IT
MOVSM T1,ACNDEV ;SETUP FOR ACTDAE.SYS
MOVX T1,%CNTIC ;GET NUMBER OF JIFFIES/SECOND ON THIS MACHINE
GETTAB T1,
MOVEI T1,^D60 ;DEFAULT TO 60
MOVEM T1,JIFSEC
MOVX T1,%CNST2
GETTAB T1,
MOVEI T1,0 ;ERROR. DON'T DO VALIDATION.
MOVEM T1,STATE2 ;SAVE IT
TXNN T1,ST%ERT ;IS THERE EBOX/MBOX RUNTIME?
JRST ACGTA1 ;NO. SKIP KL-ONLY STUFF
MOVX T1,%CVETJ ;GET CPU0'S EBOX TICKS/JIFFY
GETTAB T1,
MOVEI T1,0
MOVEM T1,ETICKS
MOVX T1,%CVNTJ ;GET CPU0'S MBOX TICKS/JIFFY
GETTAB T1,
MOVEI T1,0
MOVEM T1,MTICKS
ACGTA1: MOVX T1,%CNSJN ;GET NUMBER OF JOBS FROM MONGEN
GETTAB T1,
MOVEI T1,^D201 ;ERROR. DEFAULT TO A 200 JOB MONITOR
MOVEI T1,-1(T1) ;REMOVE NULL JOB
MOVEM T1,JOBMAX ;ONLY ALLOW THIS MANY JOBS TO LOGIN
GETPPN T1, ;GET OUR PPN
JFCL ;SILLY SKIP
MOVEM T1,MYPPN ;STORE FOR JUNK MAIL CHECK
POPJ P,
;SYSINI - ROUTINE CALLED AT SYSTEM STARTUP TO MAKE INCOMPLETE SESSION ENTRIES
SYSINI: $CALL .SAVE1 ;GET A WORKING (AND SAFE) AC
PUSHJ P,CPJSAU ;OPEN THE CHECKPOINT FILE
MOVE T1,JOBMAX ;GET NUMBER OF JOBS ALLOWED TO LOGIN
IMULI T1,CPJIOB ;*BLOCKS PER CHECKPOINT AREA FOR EACH JOB
ADDI T1,1+JBOFFS ;ADJUST + ACCOUNT FOR GENERAL BLOCK
MOVE T2,CPJCHN ;THE CHANNEL NUMBER
PUSHJ P,AUSETO ;CREATE/EXTEND THE FILE, ZEROING AS WE GO
JUMPT SYSIN1 ;SO FAR SO GOOD
TXNN T1,IO.BKT ;OUT OF DISK SPACE
$BOMB <ACTECE Error (^O/T1/) while Creating or Extending the checkpoint file>
PUSHJ P,CPJCLS ;CLOSE THE FILE
PUSHJ P,CPJSAU ;RE-OPEN
MOVE T1,USEJOB+.RBSIZ ;AMOUNT THAT GOT CREATED
ADDI T1,177 ;CONVERT TO BLOCKS
LSH T1,-7 ;...
SUBI T1,JBOFFS ;ACCOUNT FOR THE GENERAL BLOCK
IDIVI T1,CPJIOB ;COMPUTE NUMBER OF JOBS THAT CAN BE DESCRIBED
SKIPG T1 ;HOPE SO
SETZ T1, ;WHOOPS?
MOVEM T1,JOBMAX ;SAVE AS MAX JOBS WE WILL ALLOW
$WTOXX <Disk is too full, only ^D/JOBMAX/ jobs will be allowed to log in>
SYSIN1: PUSHJ P,READJG ;READ IN THE FILE HEADER
PUSHJ P,DATIM ;SET UP CURRENT DATE/TIME
SKIPN USGOSZ ;IF ZERO, THE WE JUST CREATED USAGE.OUT
PUSHJ P,MAKUFH ; SO MAKE A USAGE FILE HEADER RECORD
PUSHJ P,MAKRES ;MAKE A SYSTEM RESTART ENTRY
MOVN P1,CPJGEN+FILMJB ;MAXIMUM NUMBER OF JOBS IN THE FILE
JUMPE P1,SYSIN4 ;DONE IT JUST CREATED THE FILE
MOVE T1,CPJGEN+FILBPJ ;GET NUMBER OF BLOCKS REQUIRED FOR EACH JOB
MOVE T2,CPJGEN+FILBPD ;GET NUMBER OF BLOCKS REQUIRED FOR DEVICES
CAIN T2,CPDIOB ;BETTER MATCH
CAIE T1,CPJIOB ;BETTER MATCH
$BOMB <ACTCFF Checkpoint File Format doesn't match this version of ACTDAE>
HRLZS P1 ;FORM AOBJN
HRRI P1,1 ;SKIP THE NULL JOB
SETZM SYSINC ;CLEAR COUNT OF JOBS STILL AROUND (ACTDAE RESTART)
SYSIN2: HRRZM P1,JOBNUM ;STORE JOB NUMBER
PUSHJ P,READJP ;READ IN THE CHECKPOINT INFORMATION
SKIPN CPJBUF+CJOB ;DO WE HAVE DATA FOR THIS JOB
JRST SYSIN3 ;NO, TRY THE NEXT JOB
HRL T1,P1 ;THE JOB NUMBER AGAIN
HRRI T1,.GTJLT ;JOB LOGIN TIME
GETTAB T1, ;THIS MIGHT BE AN ACTDAE RESTART INSTEAD OF
SETZ T1, ; A SYSTEM RESTART, ONLY SOME WILL GET INCOMPLETE
JUMPE T1,SYSIN5 ;JOB NOT THERE IF NO LOGIN TIME
CAMN T1,CPJBUF+CJLGTM ;THIS JOB STILL AROUND
JRST [AOS SYSINC ;YES, COUNT IT TO INDICATE ACTDAE RESTART
JRST SYSIN3] ;WILL CATCH THE JOB AT LOGOUT
SYSIN5: PUSHJ P,MKISES ;MAKE AN INCOMPLETE SESSION ENTRY
SKIPE CPJBUF+CDEVFL ;ANY DEVICES FOR THIS JOB
PUSHJ P,SYSIND ;GENERATE DEVICE ENTRIES
PUSHJ P,CBJZER ;CLEAR OUT THE JOB INFORMATION
PUSHJ P,CPJCOP ;IN BOTH PLACES
PUSHJ P,WRITJP ;CLEAN FILE NOW THAT WE ARE DONE WITH THIS JOB
SYSIN3: AOBJN P1,SYSIN2 ;DO ALL POSSIBLE JOBS
SETZM JOBNUM ;JOB NUMBER 0 = SPINDLE ENTRIES
SKIPN SYSINC ;IF ACTDAE RESTART, DONT DO SPINDLES HERE
PUSHJ P,SYSIND ;DO THEM NOW
SYSIN4: PUSHJ P,CPJCLS ;CLOSE OUT THE FILE NOW
POPJ P, ;AND ALL DONE WITH RESTART
SYSINC: BLOCK 1 ;COUNT/FLAG FOR ACTDAE-RESTART RATHER THAN SYSTEM RESTART
SYSIND: HRROI T1,INIDVS ;POINT TO ROUTINE
PUSHJ P,ALLDEV ;AND CALL IT FOR ALL DEVICES
POPJ P, ;AND RETURN
;FOLLOWING CO-ROUTINE CALLED BY ALLDEV FOR EACH DEVICE IN THE jjjDEV.BIN FILE
;P1 = THE DEVICE TYPE INDEX
INIDVS: PUSHJ P,@[EXP MAKFSR,MAKMAG,MAKDEC,MAKSPN]-1(P1) ;MAKE THE ENTRY
PUSHJ P,CBDZER ;CLEAR THE BLOCK
PUSHJ P,CPDCOP ;BOTH HALVES
PUSHJ P,WRITDP ;ZAP THE DISK AREA
POPJ P, ;AND RETURN FOR THE NEXT
;ACDINI - ROUTINE TO DO INITIALIZATION OF DISK (E.G., OPENING THE FILES
; PROJCT.SYS, USEJOB.BIN, ACTDAE.SYS
ACDINI: MOVE T1,STATE2 ;GET SECOND STATES WORD
TXNN T1,ST%ACV ;IF VALIDATION IS NOT REQUIRED DON'T DO
JRST ACDIN1 ; PROJCT.SYS INITIALIZATION
PUSHJ P,PRJRED ;PROJCT.SYS INITIALIZATION
SKIPF ;WHOOPS
PUSHJ P,BLDPRJ ;VERIFY VERSIONS, SIZES, BUILD TABLES
ACDIN1: PUSHJ P,INITIO## ;INIT FILE I/O (RMS-10 INTERFACE)
SKIPT ;CHECK FOR ERRORS
$STOP (IOF,<File I/O interface initialization failure>)
MOVEI S1,ACCTFN ;GET FILENAME FOR RMS TO OPEN
MOVEI S2,1 ;WANT TO WRITE THE FILE
PUSHJ P,OPNA## ;OPEN FILE "A" FOR I/O
SKIPT ;MAKE SURE IT WORKED
$STOP (AFF,<Accounting file initialization failure>)
PUSHJ P,A$ISCD## ;INITIALIZE CLASS SCHEDULER MAPPING
PUSHJ P,CPJSAU ;INITIALIZE THE PRIMARY JOB CHECKPOINT FILE
POPJ P,
SUBTTL ACTDAE - GENERAL ROUTINES
;AUSETI - ROUTINE TO POSITION A FILE WHICH IS OPEN ON THE CHANNEL STORED IN T2
; TO THE BLOCK NUMBER STORED IN T1 FOR INPUT
;CALL: MOVE T1,BLOCK NUMBER
; HRL T2,CHANNEL NUMBER (PUT CHANNEL NUMBER IN LEFT HALF)
; PUSHJ P,AUSETI
; ONLY RETURN (TRUE OR FALSE)
AUSETI: MOVEM T1,ACTUSE+1 ;STORE THE BLOCK #
HRRI T2,.FOUSI ;GET THE USETI FUNCTION CODE
MOVEM T2,ACTUSE ;STORE IT
MOVE T1,[2,,ACTUSE]
FILOP. T1,
$RETF ;ERROR. GIVE A FALSE RETURN
$RETT ;GIVE A TRUE RETURN
;AUSETO - ROUTINE TO POSITION A FILE WHICH IS OPEN ON THE CHANNEL STORED IN T2
; TO THE BLOCK NUMBER STORED IN T1 FOR OUTPUT
;CALL: MOVE T1,BLOCK NUMBER
; HRL T2,CHANNEL NUMBER (PUT CHANNEL NUMBER IN LEFT HALF)
; PUSHJ P,AUSETO
; ONLY RETURN (TRUE OR FALSE)
AUSETO: MOVEM T1,ACTUSE+1 ;STORE THE BLOCK #
HRRI T2,.FOUSO ;GET THE USETO FUNCTION CODE
MOVEM T2,ACTUSE ;STORE IT
MOVE T1,[2,,ACTUSE]
FILOP. T1,
$RETF ;ERROR. GIVE A FALSE RETURN
$RETT ;GIVE A TRUE RETURN
SUBTTL ACTQUE - MODULE FOR QUEUE. UUO ROUTINES
;GENERAL DEFINITIONS
MYPPN: BLOCK 1 ;MY PPN FOR PRIV CHECKING
QUECNT: 0 ;COUNT OF QUEUE ARGUMENT BLOCKS LEFT
QUEFLG: 0 ;SET IF MESSAGE WAS FROM A QUEUE. UUO
QUEBLK: 0 ;ADDRESS OF NEXT QUEUE. ARGUMENT BLOCK
QUEEND: 0 ;ADDRESS JUST OFF THE END OF QUEUE. BLOCK
;***DESCRIPTOR
ACONMD: EXP -1 ;THIS IS A NAME
EXP ACOUSR ;POINT TO NAME BUFFER
;***
;****DESCRIPTOR
ACOPPD: EXP 0 ;THIS IS A PPN
ACOPPN: BLOCK 1 ;PPN WE ARE TALKING ABOUT
;****
ACOPRV: BLOCK 1 ;INDICATES USER IS PRIVED
VALZER: ;BEGINNING OF BLOCK TO ZERO (MAINTAIN ORDER)
VALBLK: BLOCK UV$ACE+1 ;REBUILT QUEUE. VALIDATION MESSAGE
VALACT: BLOCK 1 ;FLAG THAT .UGACT BLOCK WAS GIVEN
ACOPSW: BLOCK .APWLW ;PASSWORD FOR ACCESS CONTROL
ACOTYP: BLOCK 1 ;TYPE OF ACCESS (0 = REGULAR, NON-0 = SPRINT)
ACOUXP: BLOCK 1 ;INDICATES USERNAME VS PPN BEING USED
ACOUSR: BLOCK .AANLW ;NAME WE ARE TALKING ABOUT
ACOPTR: BLOCK 1 ;POINTER TO A WILDCARD BLOCK
ACOWLD: BLOCK UW$MIN ;INTERNAL WILDCARD BLOCK
ACOACK: BLOCK .AANLW ;WILDCARD ACK BLOCK
ACOMAP: BLOCK 1 ;ADDRESS OF PPN/NAME MAPPING BLOCK
TMPMAP: BLOCK UU$LEN ;TEMPORARY MAPPING BLOCK
TMPLEN: BLOCK 1 ;LENGTH OF SUPPLIED NAME
TMPCNT: BLOCK 1 ;NUMBER OF MAPPING BLOCKS SUPPLIED
;***ACTRMS INTERFACE
ACOPRO: BLOCK .AEMAX ;BLOCK FOR USER PROFILE
ACODEF: BLOCK .AEMAX ;DEFAULT PROFILE STORAGE
ACODWL: BLOCK UW$MIN ;WILDCARD BLOCK FOR DEFAULTING
ACOBIT: BLOCK .AMPLW ;DEFAULTING BIT MAP
ACOBMP: BLOCK 1 ;POINTER INTO BIT MAP
;***
VALZND==.-1 ;LAST WORD TO ZERO FOR VALIDATION REQUESTS
QUEADR: BLOCK 1 ;ADDRESS OF THE REBUILT DEFUS LIST FOR MAKING AN ENTRY
QUELEN: BLOCK 1 ;LENGTH OF THE CONTENTS OF QUEADR
QEXTRA==7 ;EXTRA WORDS NEEDED TO COMPLETE AN ENTRY'S
; INTERNAL DEFUS LIST BUILT AT THE CONTENTS OF
; QUEADR:. 1) DISPATCH (UGENT$) 2. ENTRY TYPE
; 3. TERMINATED WITH A ZERO WORD AND 4-7. PROVIDE
; DEFUS'S FOR ACTDAE VERSION NUMBER AND THE DATE
; AND TIME THE ENTRY IS MADE. SEE QUEENT ROUTINE.
SUBTTL ACTQUE - GENERAL ROUTINES FOR QUEUE. UUO SECTION
;QUECHK - ROUTINE TO CHECK IF MESSAGE IF FROM A QUEUE. UUO. IF SO, MESSAGE
; HAS A DIFFERENT FORMAT THAN THE MESSAGES DEFINED IN ACTSYM.MAC.
QUECHK: SETZM QUEFLG ;INITALIZE
SETZM QUEBLK ;NO POINTER YET
MOVE T1,MDBADR ;MESSAGE DESCRIPTOR BLOCK
MOVE T2,MDB.FG(T1) ;GET THE FLAGS
TXNE T2,IP.CFE!IP.CFM ;CHECK FOR ERRORS OR RETURNED MAIL
$RETF ;PITCH THE MESSAGE
SETZM ACOPRV ;ASSUME NO DESIRE FOR PRIVS
SETZM ACKEFL ;ASSUME WANTS OLD ERROR ACKS
ANDX T2,IP.CFC ;SYSTEM SENDER CODE
LSH T2,-3 ;RIGHT JUSTIFY THE CODE
CAIE T2,.IPCCG ;IS IT FROM SYSTEM GOPHER?
JRST QUECH7 ;NO. CHECK FUNCTION FOR FLAGS
MOVE T1,MMSADR ;MESSAGE ADDRESS
MOVE T2,.MSTYP(T1)
ANDX T2,MS.TYP ;MESSAGE TYPE
CAIE T2,.IPCQU ;IS THIS FROM A QUEUE. UUO?
$RETT ;NO. ASSUME ANOTHER FORMAT (E.G., LOGOUT MESSAGE)
SETOM QUEFLG ;REMEMBER IT'S A QUEUE. UUO
; SETZM QUEBLK ;INDICATE THE START OF NEW MESSAGE
QUECH1: MOVE T1,MMSADR ;MESSAGE ADDRESS
PUSHJ P,GETBLK ;GET NEXT QUEUE BLOCK
JUMPF .POPJ ;NO MORE BLOCKS, ASSUME BAD MESSAGE
CAIE T1,.QBFNC ;IS THIS THE FUNCTION BLOCK?
JRST QUECH1 ;NO. LOOP UNTIL IT'S FOUND
MOVE T1,(T3) ;GET THE FUNCTION
CAIN T1,.QUVAL ;IS IT A VALIDATION MESSAGE?
PJRST QUEVAL ;YES. SET UP THE MESSAGE AND VALIDATE
CAIE T1,.QUMAE ;IS IT SOME KIND OF ACCOUNTING MESSAGE?
$RETF ;NO. ASSUME ILLEGAL MESSAGE
QUECH2: MOVE T1,MMSADR ;GET THE NEXT QUEUE. BLOCK
PUSHJ P,GETBLK ; FOR ACCOUNTING SUBFUNCTION
JUMPF .POPJ ;ILLEGAL ACCOUNTING MESSAGE
CAIE T1,.QBAFN ;IS THIS THE RIGHT BLOCK?
$RETF ;NO. DECLARE IT ILLEGAL ACCOUNTING MESSAGE
MOVE T1,(T3) ;GET THE SUBFUNCTION
PUSHJ P,QUECH8 ;ANALYZE THE FLAGS
$RETIF ;PROPAGATE FAILURE
MOVSI S1,-QUESIZ ;AOBJN POINTER
QUECH3: HLRZ S2,QUETAB(S1) ;GET ACCT MSG TYPE CODE
CAIE S2,(T1) ;A MATCH?
AOBJN S1,QUECH3 ;SEARCH THE TABLE
JUMPGE S1,.RETF ;NO SUCH BEAST
HRRZ S2,QUETAB(S1) ;GET QUEUE. UUO CONVERSION ROUTINE ADDR
PJRST (S2) ;DISPATCH
QUECH7: MOVE T3,MMSADR ;GET MESSAGE ADDRESS
LOAD T1,(T3),MS.TYP ;GET FUNCTION CODE
QUECH8: TRZE T1,AF.CEA ;WANT NEW ERROR ACKS?
SETOM ACKEFL ;YES, REMEMBER THAT
TRZN T1,AF.PRV ;WANT PRIVS?
JRST QUECH9 ;NO, SKIP IT
PUSH P,T1 ;SAVE BITS
PUSHJ P,PRVADM ;CHECK FOR PRIVS
POP P,T1 ;RESTORE
$RETIF ;PROPAGATE FAILURE
SETOM ACOPRV ;YES, HE GETS PRIVS
QUECH9: TRNN T1,^-AF.FUN ;ANY RESERVED BITS ON?
$RETT ;NO, HE WINS
$RETF ;YES, HE LOSES
QUETAB: UGVAL$,,QUEVLX ;VALIDATION
UGLGN$,,QUELGN ;LOGIN
UGSES$,,QUESES ;SESSION
UGATT$,,QUEATT ;ATTACH
UGENT$,,QUEENT ;MAKE AN ENTRY
UGOUP$,,QUEACC ;ACCESS CONTROL
UGACC$,,QUEACC ;ACCESS CONTROL
UGCUP$,,QUECUP ;CHANGE USER PROFILE
UGVRP$,,QUEACC ;CHANGE USER PROFILE
UGPSW$,,QUEACC ;VERIFY PASSWORD
UGLOK$,,QUEACC ;LOCK ACCOUNTING FILE
UGUNL$,,QUEACC ;UNLOCK ACCOUNTING FILE
UGSCD$,,QUEACC ;REREAD SCDMAP.INI
UGWLD$,,QUEACC ;GET POSSIBLY WILDCARDED PPN OR NAME
UGMAP$,,QUEACC ;MAP PPN/NAMES
QUESIZ==.-QUETAB ;LENGTH OF TABLE
; QUEATT - ATTACH MESSAGE
QUEATT: MOVEI T1,UA$ACK ;ACK CODE OFFSET
PJRST QUECOM ;ENTER COMMON CODE
; QUELGN - LOGIN MESSAGE
QUELGN: MOVEI T1,UL$ACK ;ACK CODE OFFSET
PJRST QUECOM ;ENTER COMMON CODE
; QUESES - SESSION MESSAGE
QUESES: MOVEI T1,US$ACK ;ACK CODE OFFSET
; PJRST QUECOM ;ENTER COMMON CODE
; QUECOM - COMMON ROUTINE TO CONVERT QUEUE. UUO MESSAGES TO NORMAL IPCF FORMAT
; CALL: MOVE T1, ACK CODE OFFSET IN QUEUE MSG
; PUSHJ P,QUECOM
;
; TRUE RETURN: MESSAGE CONVERTED
; FALSE RETURN: JUNK MESSAGE
QUECOM: PUSH P,T1 ;SAVE ACK CODE OFFSET
PUSHJ P,GETBLK ;GET THE NEXT QUEUE. BLOCK
JUMPF QUECMF ;CHECK FOR ERRORS
CAIE T1,.QBAET ;ACCOUNTING ENTRY BLOCK?
JUMPF QUECMF ;BAD MESSAGE FORMAT
MOVE T1,DATADR ;POINT TO MESSAGE
MOVE T1,.MSCOD(T1) ;GET ACK CODE
EXCH T1,(P) ;SWAP ACK CODE WITH OFFSET
ADDI T1,(T3) ;INDEX INTO MESSAGE
POP P,(T1) ;MOVE ACK CODE
MOVSI T1,(T3) ;POINT TO DATA PORTION OF MESSAGE
HRR T1,DATADR ;AND TO START OF ACTUAL MESSAGE
ADD T2,DATADR ;COMPUTE END OF BLT
BLT T1,-1(T2) ;SLIDE MSG UP SO IT'S LIKE AN IPCF MSG
$RETT ;AND RETURN
QUECMF: POP P,(P) ;PRUNE STACK
$RETF ;RETURN
; ACK A QUEUE. UUO
; CALL: PUSHJ P,QUEACK
;
; TRUE RETURN: OLD MESSAGE RELEASED, ACK SENT
; FALSE RETURN: OLD MESSAGE RELEASED, GLXLIB ERROR CODE IN AC S1
QUEACK: $CALL C%REL ;RELEASE OLD CRUFTY MESSAGE
MOVE T1,ACKCOD ;GET ACK CODE
MOVEM T1,ACKMSG+.MSCOD ;SAVE
MOVEI S1,SAB.SZ ;SEND ARGUMENT BLOCK LENGTH
MOVEI S2,IPS.BL ;SEND ARGUMETN BLOCK ADDRESS
MOVE T1,MDBADR ;GET MESSAGE DISCRIPTOR BLOCK
MOVE T1,MDB.SP(T1) ;SENDER'S PID
MOVEM T1,SAB.PD(S2)
MOVEI T1,ACKLEN ;LENGTH OF MESSAGE
MOVEM T1,SAB.LN(S2)
MOVEI T1,ACKMSG ;MESSAGE ADDRESS
MOVEM T1,SAB.MS(S2)
$CALL C%SEND ;ACK THE USER
$RETIT ;RETURN IF NO ERRORS
MOVE T1,MDBADR ;POINT TO MDB
$WTOXX <^I/ACKTXT/>
$RETF ;GIVE UP
ACKMSG: $BUILD (.OHDRS+ARG.SZ) ;SIZE OF MESSAGE
$SET (.MSTYP,MS.CNT,ACKLEN) ;LENGTH OF MESSAGE
$SET (.MSTYP,MS.TYP,.OMTXT) ;TEXT MESSAGE
$SET (.MSFLG,MF.NOM,1) ;NO DATA IN MESSAGE (JUST AN ACK)
$SET (.MSCOD,,0) ;ACK CODE (FILLED IN LATER)
$SET (.OHDRS+ARG.HD,AR.LEN,2);TWO WORDS OF DATA
$SET (.OHDRS+ARG.HD,AR.TYP,.CMTXT) ;TYPE OF DATA (TEXT)
$SET (.OHDRS+ARG.DA,,0) ;NO TEXT
$EOB ;END OF BLOCK
ACKLEN==.-ACKMSG ;LENGTH OF MESSAGE
ACKTXT: ITEXT (<Cannot ACK job ^D/MDB.PV(T1),MD.PJB/ ^U/MDB.SD(T1)/
Error: ^E/S1/>)
;QUEVAL - ROUTINE TO CONVERT A QUEUE. UUO VALIDATION MESSAGE INTO A FORMAT THE
; ACCOUNT DAEMON AND FRIENDS ALREADY KNOW ABOUT.
;CALL: MDBADR/ADDRESS OF MESSAGE DESCRIPTOR BLOCK
; MMSADR/ADDRESS OF IPCF MESSAGE DATA
; QUEBLK/POINTS TO NEXT QUEUE. ARGUMENT BLOCK TO BE READ
QUEVAL: MOVEI T1,UGVAL$ ;TYPE OF ACCOUNT MESSAGE
PUSHJ P,PREVAL ;PREPARE VALIDATION BLOCKS
QUEVA1: MOVE T1,MMSADR ;MESSAGE ADDRESS
PUSHJ P,GETBLK ;GET THE NEXT QUEUE. BLOCK
JUMPF QUEVA3 ;END OF BLOCK, BEGIN VALIDATION
CAIE T1,.QBOID ;IS IT A PPN?
JRST QUEVA2 ;NO. SEE IF IT'S AN ACCOUNT BLOCK
MOVE T3,(T3) ;GET THE PPN
MOVEM T3,VALBLK+UV$PPN ;STORE THE PPN
JRST QUEVA1 ;LOOK AT NEXT BLOCK
QUEVA2: CAIE T1,.QBACT ;IS THIS BLOCK AN ACCOUNT?
JRST QUEVA1 ;NO. SEE IF WE'RE DONE
HRLZ S1,T3 ;BLT THE ACCOUNT INTO VALBLK
HRRI S1,VALBLK+UV$ACT
CAILE T2,UV$ACE+1-UV$ACT ;ONLY MOVE MAXIMUM AMOUNT
MOVEI T2,UV$ACE+1-UV$ACT ;QUEUE. UUO ALREADY DIS-ALLOWED 0 LENGTH
BLT S1,VALBLK+UV$ACT-1(T2) ;MOVE THE ACCOUNT STRING
JRST QUEVA1 ;LOOK AT NEXT BLOCK
QUEVA3: MOVEI T1,VALBLK
MOVEM T1,DATADR ;THE VALIDATION ROUTINE LOOKS HERE FOR DATA
$RETT
;SUBROUTINE TO PREPARE VALIDATION BLOCKS FOR QUEUE. FUNCTIONS
;CALL: T1/MESSAGE TYPE TO FILL INTO THE BLOCK
PREVAL: SETZM VALZER ;ZERO THE BLOCKS
MOVE S1,[VALZER,,VALZER+1]
BLT S1,VALZND ;CLEAR THE WHOLE THING
MOVEM T1,VALBLK+UV$TYP ;STORE TYPE OF MESSAGE
POPJ P, ;AND RETURN
;QUEACC - ROUTINE TO EXTRACT ACCESS CONTROL INFORMATION FROM THE QUEUE. BLOCKS
;CALL: T1/ FUNCTION CODE
; MDBADR/ADDRESS OF MESSAGE DESCRIPTOR BLOCK
; MMSADR/ADDRESS OF IPCF RECEIVE MESSAGE DATA
; QUEBLK/POINT SO NEXT QUEUE. ARGUMENT BLOCK TO BE READ
QUEACC:
PUSHJ P,PREVAL ;PREPARE THE INTERNAL BLOCK
QUEACT: MOVE T1,MMSADR ;MESSAGE ADDRESS
PUSHJ P,GETBLK ;GET THE NEXT QUEUE. BLOCK
JUMPF QUEACX ;END OF BLOCK, BEGIN VALIDATION
QUEAC0: CAIE T1,.UGTYP ;IS THIS BLOCK THE ACCESS TYPE
JRST QUEAC1 ;NO, LOOK AT NEXT BLOCK
MOVE T3,(T3) ;GET TYPE ARGUMENT
MOVEM T3,ACOTYP ;STORE
JRST QUEACT ;LOOK AT THE NEXT BLOCK
QUEAC1: CAIE T1,.UGACT ;IS THIS BLOCK AN ACCOUNT?
JRST QUEAC2 ;NO. SEE IF ITS A PPN BLOCK
HRLZ S1,T3 ;BLT THE ACCOUNT INTO VALBLK
HRRI S1,VALBLK+UV$ACT
CAILE T2,UV$ACE+1-UV$ACT ;ONLY MOVE MAXIMUM AMOUNT
MOVEI T2,UV$ACE+1-UV$ACT ;QUEUE. UUO ALREADY DIS-ALLOWED 0 LENGTH
BLT S1,VALBLK+UV$ACT-1(T2) ;MOVE THE ACCOUNT STRING
SETOM VALACT ;NOTE THAT WE GOT HERE
JRST QUEACT ;LOOK AT NEXT BLOCK
QUEAC2: CAIE T1,.UGPPN ;IS IT A PPN?
JRST QUEAC3 ;NO. SEE IF IT'S A PASSWORD BLOCK
MOVEM T1,ACOUXP ;INDICATE WE GOT A PPN
MOVE T3,(T3) ;GET THE PPN
MOVEM T3,VALBLK+UV$PPN ;STORE THE PPN
MOVEM T3,ACOPPN ;STASH HERE TOO
JRST QUEACT ;LOOK AT NEXT BLOCK
QUEAC3: CAIE T1,.UGPSW ;IS THIS BLOCK THE PASSWORD
JRST QUEAC4 ;NO. SEE IF ITS A USERNAME
HRLZ S1,T3 ;BLT THE PASSWORD INTO ACOPSW
HRRI S1,ACOPSW
CAILE T2,.APWLW ;MAKE SURE NOT LONGER THAN MAX
MOVEI T2,.APWLW ;MAKE MAXIMUM LENGTH IF SO
BLT S1,ACOPSW-1(T2) ;COPY THE PASSWORD
JRST QUEACT ;LOOK AT NEXT BLOCK
QUEAC4: CAIE T1,.UGUSR ;IS THIS BLOCK THE USERNAME
JRST QUEACT ;NOPE, IGNORE IT THEN
MOVEM T1,ACOUXP ;INDICATE WE GOT A USERNAME
HRLZ S1,T3 ;BLT THE USERNAME INTO ACOPSW
HRRI S1,ACOUSR
CAILE T2,.AANLW ;MAKE SURE NOT LONGER THAN MAX
MOVEI T2,.AANLW ;MAKE MAXIMUM LENGTH IF SO
BLT S1,ACOUSR-1(T2) ;COPY THE NAME
JRST QUEACT
QUEACX: MOVEI T1,VALBLK
MOVEM T1,DATADR ;THE VALIDATION ROUTINE LOOKS HERE FOR DATA
$RETT
;QUECUP - ROUTINE TO CONVERT A QUEUE. UUO UGCUP$ MESSAGE TO A NORMAL ONE
QUECUP: MOVE T2,QUEBLK ;POINTER TO NEXT DATA BLOCK
SUBI T2,.OHDRS ;BACK UP BY GALACTIC HEADER
MOVE T3,QUECNT ;NUMBER OF ARG BLOCKS REMAINING
MOVEM T3,.OARGC(T2) ;SETUP AS IF ORION HAD TOLD US
HRRM T1,(T2) ;STORE THE FUNCTION CODE
MOVE T3,DATADR ;GET MESSAGE ADDRESS
MOVE T3,1(T3) ;GET ACK CODE
MOVEM T3,1(T2) ;SAVE HERE
SETZM .OFLAG(T2) ;NO FLGS
MOVEM T2,DATADR ;SAVE FOR OTHERS
$RETT ;RETURN
;QUEENT - ROUTINE TO CONVERT A QUEUE. UUO 'MAKE AN ENTRY' MESSAGE INTO A
; FORMAT THE ACCOUNT DAEMON ALREADY KNOWS ABOUT (FORMAT IS CALLED A
; DEFUS DATA LIST).
;CALL: MDBADR/ADDRESS OF MESSAGE DESCRIPTOR BLOCK
; MMSADR/ADDRESS OF IPCF RECEIVE MESSAGE DATA
; QUEBLK/POINT SO NEXT QUEUE. ARGUMENT BLOCK TO BE READ
QUEENT: $CALL .SAVE1
MOVE T1,MMSADR ;GET THE TOTAL NUMBER OF QUEUE. BLOCKS
MOVE S1,.OARGC(T1) ;REBUILT MESSAGE WILL HAVE 2 WORDS/BLOCK,
IMULI S1,2
ADDI S1,QEXTRA ;SEE COMMENTS AT QEXTRA DEFINITION FOR EXTRA
; SPACE NEEDED
$CALL M%GMEM ;GET SPACE NEEDED TO BUILD AN INTERNAL DEFUS LIST
MOVEM S1,QUELEN ;STORE THE LENGTH FOR RELEASING MEMORY
MOVEM S2,QUEADR ;STORE THE ADDRESS
MOVEM S2,DATADR
MOVE P1,S2
MOVEI T1,UGENT$ ;"MAKE AN ENTRY" DISPATCH VALUE FOR ACTDSP
MOVEM T1,(P1)
AOS P1
MOVE T1,MMSADR ;GET THE NEXT QUEUE. BLOCK
PUSHJ P,GETBLK
JUMPF QUEEN3 ;ILLEGAL MESSAGE IF NO MORE
CAIE T1,.QBAET ;BLOCK TYPE MUST BE ENTRY TYPE BLOCK
JRST QUEEN3 ;OTHERWISE DECLARE IT AN ILLEGAL MESSAGE
MOVE T1,(T3) ;GET THE ENTRY TYPE
MOVEM T1,(P1) ;STORE IT
AOS P1 ;STEP TO THE NEXT WORD
QUEEN1: MOVE T1,MMSADR
PUSHJ P,GETBLK ;GET THE NEXT QUEUE. BLOCK
JUMPF QUEEN2 ;NO MORE BLOCKS. FINISH UP AND RETURN
CAIN T1,.USTAD ;CURRENT DATE/TIME IS ALWAYS PROVIDED BY ACTDAE
JRST QUEEN1 ;GO READ NEXT BLOCK
CAIN T1,.USAMV ;AS IS THE ACCOUNT DAEMON'S VERSION NUMBER
JRST QUEEN1 ;READ THE NEXT BLOCK
TXO T1,1B0 ;HANDLE THE ZERO DEFUS CASE
MOVEM T1,(P1) ;STORE THE DEFUS NUMBER
MOVEM T3,1(P1) ;THIS IS THE ADDRESS WHERE THE DATA IS FOUND
ADDI P1,2 ;COUNT THE TWO WORDS JUST FILLED
JRST QUEEN1 ;READ THE NEXT QUEUE. BLOCK
QUEEN2: PUSHJ P,QEXFIL ;PROVIDE THE ACTDAE-ONLY DATA
SETZM (P1) ;MUST TERMINATE WITH A ZERO WORD
$RETT
QUEEN3: MOVE S1,QUELEN ;MUST RETURN SPACE WE GOT FOR THE MESSAGE
MOVE S2,QUEADR ;...
$CALL M%RMEM ;GIVE IT BACK IF THE MESSAGE IS BAD
$RETF ;AND PITCH THE MESSAGE
;QUEVLX - ROUTINE TO CONVERT VALIDATION MESSAGES
;CALL: MDBADR/ADDRESS OF MESSAGE DESCRIPTOR BLOCK
; MMSADR/ADDRESS OF IPCF MESSAGE DATA
; QUEBLK/POINTS TO NEXT QUEUE. ARGUMENT BLOCK TO BE READ
QUEVLX: MOVEI T1,UGVAL$ ;TYPE OF ACCOUNT MESSAGE
PUSHJ P,PREVAL ;PREPARE VALIDATION BLOCKS
PUSHJ P,GETBLK ;GET THE NEXT QUEUE. BLOCK
$RETIF ;CHECK FOR ERRORS
CAIE T1,.QBAET ;ACCOUNTING ENTRY BLOCK?
$RETF ;BAD MESSAGE FORMAT
HRLZ T2,T3 ;POINT TO VALIDATION BLOCK IN MESSAGE
HRRI T2,VALBLK ;MAKE A BLT POINTER
BLT T2,VALBLK+UV$ACE ;COPY
MOVEI T1,VALBLK ;POINT TO OUR VALIDATION BLOCK
MOVEM T1,DATADR ;SAVE ADDRESS
SETOM MVBFLG ;REMEMBER TO MOVE THE WHOLE BLOCK
$RETT ;RETURN
;QEXFIL - ROUTINE TO PROVIDE ACCOUNT-DAEMON-ONLY DATA IN THE INTERNAL DEFUS LIST.
QEXFIL: MOVEI T1,.USTAD ;DATE/TIME ENTRY IS MADE IS ALWAYS GIVEN BY ACTDAE
MOVEM T1,(P1) ;STORE ITS DEFUS NUMBER
PUSHJ P,DATIM ;FILL IN CURRENT DATE AND TIME
MOVEI T1,CURDTM ;ADDRESS WHERE THE DATE/TIME WILL BE STORED
MOVEM T1,1(P1)
ADDI P1,2 ;ADJUST P1 FOR NEXT ITEM
MOVEI T1,.USAMV ;THE ACCOUNTING MODULE'S VERSION NUMBER
MOVEM T1,(P1) ;STORE THE DEFUS NUMBER
MOVEI T1,.JBVER ;ADDRESS WHERE IT'S STORED
MOVEM T1,1(P1)
ADDI P1,2 ;ADJUST P1
POPJ P,
;GETBLK - ROUTINE TO FIND THE NEXT QUEUE. ARGUMENT BLOCK (MATCHES A$GBLK IN QSRADM.MAC)
;CALL: T1/ THE MESSAGE ADDRESS
;RETURN T1/ THE BLOCK TYPE
; T2/ THE LENGTH OF THE DATA IN THE BLOCK
; T3/ THE ADDRESS OF THE DATA IN THE BLOCK
; FALSE IF NO MORE BLOCKS
GETBLK: SKIPE S1,QUEBLK ;GET THE BLOCK ADDRESS IF THERE IS ONE
JRST GETBL1 ;NOT FIRST TIME THROUGH,,SO SKIP INITLZN
MOVE S1,.OARGC(T1) ;GET THE MESSAGE BLOCK COUNT
MOVEM S1,QUECNT ;AND SAVE IT
LOAD S1,.MSTYP(T1),MS.CNT ;GET THE MESSAGE LENGTH
ADDI S1,(T1) ;POINT OFF THE END
MOVEM S1,QUEEND ;SAVE FOR LIMIT COMPUTATIONS
MOVE S1,MDBADR ;GET DESCRIPTOR BLOCK ADDRESS
LOAD T2,MDB.MS(S1),MD.CNT ;GET MESSAGE SIZE
LOAD S1,MDB.MS(S1),MD.ADR ;AND ADDRESS
ADD S1,T2 ;A DIFFERENT IDEA OF THE END
CAMGE S1,QUEEND ;IS THIS MORE RESTRICTIVE?
MOVEM S1,QUEEND ;YES, DON'T ILL MEM REF
MOVEI S1,.OHDRS+ARG.HD(T1) ;IF NOT,,GET THE FIRST ONE
GETBL1: CAMGE S1,QUEEND ;DON'T ADVANCE PAST THE END
SOSGE QUECNT ;CHECK THE BLOCK COUNT
$RETF ;NO MORE,,JUST RETURN
LOAD T1,ARG.HD(S1),AR.TYP ;GET THE BLOCK TYPE
LOAD T2,ARG.HD(S1),AR.LEN ;GET THE BLOCK LENGTH
MOVEI T3,ARG.DA(S1) ;POINT TO THE ACTUAL DATA
ADD S1,T2 ;POINT TO THE NEXT BLOCK
MOVEM S1,QUEBLK ;SAVE IT FOR THE NEXT TIME AROUND
CAMG S1,QUEEND ;BEYOND THE LIMIT?
SOJA T2,.RETT ;T2 NOW ONLY REFLECTS DATA LENGTH, GOOD RETURN
$RETF ;MESSAGE IS BAD
;GETBLF - ROUTINE TO RETURN BLOCK TYPE & FLAGS
;CALL: LIKE GETBLK
;RETURN: T1 HAS THE BLOCK TYPE, MASKED DOWN TO A PROFILE ENTRY OFFSET
; S2 HAS THE SELECTION FLAGS THAT WERE MASKED OFF OF T1
GETBLF: PUSHJ P,GETBLK ;GET THE BLOCK INFO
$RETIF ;PROPAGATE FAILURE
MOVE S2,T1 ;COPY BLOCK TYPE
ANDI T1,AF.OFS ;KEEP ONLY OFFSET HERE
TRZ S2,AF.OFS ;AND ONLY BITS HERE
POPJ P, ;RETURN GOODNESS
;FNDBLK - ROUTINE TO FIND ANY QUEUE. ARGUMENT BLOCK IN A MESSAGE
;CALL: T1/ THE MESSAGE ADDRESS
; T2/ THE TYPE OF BLOCK WE WANT
;RETURN T1/ THE ADDRESS WHERE THE BLOCK STARTS (OR FALSE IF NOT FOUND)
FNDBLK: $CALL .SAVE2 ;SAVE P1,P2
LOAD P1,.OARGC(T1) ;GET THE MESSAGE ARGUMENT COUNT
MOVE P2,T2 ;SAVE THE BLOCK TYPE
MOVEI S1,.OHDRS(T1) ;POINT TO THE FIRST BLOCK
LOAD TF,.MSTYP(T1),MS.CNT ;GET THE MESSAGE LENGTH
CAXLE TF,PAGSIZ ;CAN'T BE GREATER THEN A PAGE
$RETF ;ELSE THATS AN ERROR
ADD TF,T1 ;POINT TO THE END OF THE MESSAGE
FNDBL1: LOAD S2,ARG.HD(S1),AR.TYP ;GET THIS BLOCK TYPE
CAMN S2,P2 ;IS IT THE BLOCK HE WANTS ???
JRST [MOVE T1,S1 ;YES, MOVE ADDRESS TO RETURN AC
$RETT] ;AND RETURN GOOD
LOAD S2,ARG.HD(S1),AR.LEN ;NO,,GET THIS BLOCKS LENGTH
ADD S1,S2 ;POINT TO THE NEXT BLOCK
CAIG TF,0(S1) ;ARE WE STILL IN THE MESSAGE ???
$RETF ;NO,,RETURN BLOCK NOT FOUND
SOJG P1,FNDBL1 ;CONTINUE TILL DONE
$RETF ;NOT FOUND
SUBTTL ACTVER - GENERAL DEFINITIONS FOR ACCOUNT VALIDATION MODULE
;ACCOUNT VALIDATION MODULE DEFINITIONS
PPN: BLOCK 1 ;PPN TO BE VALIDATED
PRJCHN: BLOCK 1 ;LH=CHANNEL # FOR PROJCT.SYS, RH=0
PRJBLK: BLOCK 10 ;FILOP. BLOCK FOR PROJCT.SYS
PROJCT: BLOCK 36 ;LOOKUP BLOCK
PRJBUF: BLOCK PRJWPB ;BUFFER FOR READING PROJCT.SYS IN DUMP MODE
IOLIST: BLOCK 2 ;I/O LIST FOR READING PROJCT.SYS
Z.DATE: BLOCK 1 ;CREATION DATE/TIME OF PROJCT.SYS WHICH TABLE WAS BUILT FOR
Z.TADR: BLOCK 1 ;ADDRESS OF FIRST WORD OF TABLE IN LOW SEGMENT
Z.TLEN: BLOCK 1 ;LENGTH OF TABLE LAST READ (IN WORDS)
BLKNUM: BLOCK 1 ;LOCATION TO SAVE LAST BLOCK NUMBER READ FROM PROJCT.SYS
LSTBLK: BLOCK 1 ;BLOCK NUMBER OF LAST BLOCK WHERE ENTRIES ARE FOUND IN PROJCT.SYS
PRJIOW: BLOCK 1 ;NEGATIVE WORDS PER LOGICAL DISK BLOCK IN PROJCT.SYS
PRJMUL: BLOCK 1 ;MULTIPLIER FOR LOGICAL TO REAL DISK BLOCKS
PRJCON: BLOCK 1 ;CONSTANT FOR COMPUTING PHYS BLOCK FROM LOGICAL BLOCK
PRJVRS: BLOCK 1 ;VERSION NUMBER OF PROJCT.SYS WE ARE READING
ACKCOD: BLOCK 1 ;ACKNOWLEDGMENT CODE USED BY THE REQUESTOR
SUBTTL ACTVER - FORMAT OF PROJCT.SYS
BLKOFS==1 ;OFFSET INTO THE BLOCK WHERE THE FIRST ENTRY IS
PPNOFS==1 ;OFFSET INTO THE ENTRY WHERE PPN CAN BE FOUND
CNTOFS==2 ;OFFSET FROM THE PPN WHERE THE CHARACTER COUNT OF THE
; ACCOUNT STRING CAN BE FOUND
ACTOFS==3 ;OFFSET FROM THE PPN WHERE THE ACCOUNT STRING CAN BE FOUND
;FOLLOWING IS THE FORMAT OF THE FIRST BLOCK OF PROJCT.SYS. THIS BLOCK
; CONTAINS FILE AND DATA INFORMATION. THIS TOTAL BLOCK HAS BEEN
; RESERVED SPECIFICALLY FOR THIS PURPOSE.
A.VERS==0 ;(0) VERSION # OF FORMAT. MUST AGREE WITH ACVERS
A.TLEN==1 ;(1) LENGTH OF TABLE IN STORED IN PROJCT.SYS
A.FBLK==2 ;(2) BLOCK NUMBER OF TABLE IN FILE
A.WPBL==3 ;(3) NUMBER OF WORDS PER LOGICAL DISK BLOCK (PRJWPB)
;***************************************************************
; This is the format of the first block of PROJCT.SYS
;***************************************************************
; !=======================================================!
; ! Version # of PROJCT.SYS format !
; !-------------------------------------------------------!
; ! Length of table stored in PROJCT.SYS !
; !-------------------------------------------------------!
; ! Block number of table in PROJCT.SYS !
; !-------------------------------------------------------!
; ! Number of words per logical disk block !
; !=======================================================!
;***************************************************************
; End of the first block of PROJCT.SYS
;***************************************************************
;***************************************************************
; Format of table pointed to by third word of first block
;***************************************************************
; !=======================================================!
; ! First PPN found in first data block !
; !-------------------------------------------------------!
; ! Block number where PPN is !
; !-------------------------------------------------------!
; ! First PPN found in second data block !
; !-------------------------------------------------------!
; ! Block number where PPN is !
; !-------------------------------------------------------!
; \ \
; \ \
; \ \
; !-------------------------------------------------------!
; ! First PPN found in last data block !
; !-------------------------------------------------------!
; ! Block number where PPN is !
; !=======================================================!
;***************************************************************
; End of table format
;***************************************************************
;***************************************************************
; Format of a block of data pointed to by entries in the table
;***************************************************************
; !=======================================================!
; ! Number of words used in this block !
; !=======================================================!
; ! Length of PPN entry ! Length of account entry !
; !-------------------------------------------------------!
; ! PPN !
; !-------------------------------------------------------!
; ! Wild card mask !
; !-------------------------------------------------------!
; !Character count in account ! Flags !
; !-------------------------------------------------------!
; \ Account string \
; \ \
; \ \
; !-------------------------------------------------------!
; ! 0 ! Length of account entry !
; !-------------------------------------------------------!
; ! PPN !
; !-------------------------------------------------------!
; ! Wild card mask !
; !-------------------------------------------------------!
; !Character count in account ! Flags !
; !-------------------------------------------------------!
; \ Account string \
; \ \
; !=======================================================!
; ! Length of PPN entry ! Length of account entry !
; !-------------------------------------------------------!
; ! PPN !
; !-------------------------------------------------------!
; ! Wild card mask !
; !-------------------------------------------------------!
; !Character count in account ! Flags !
; !-------------------------------------------------------!
; \ Account string \
; \ \
; !-------------------------------------------------------!
; ! 0 ! Length of account entry !
; !-------------------------------------------------------!
; ! PPN !
; !-------------------------------------------------------!
; ! Wild card mask !
; !-------------------------------------------------------!
; !Character count in account ! Flags !
; !-------------------------------------------------------!
; \ Account string \
; \ \
; !=======================================================!
;***************************************************************
; End of format of a block of data
;***************************************************************
SUBTTL ACTVER - MAIN VALIDATION ROUTINE
ACTVER: $CALL M%GPAG ;GET A PAGE FOR THE RESPONSE MESSAGE
MOVEM S1,SABADR ;STORE THE ADDRESS OF THE PAGE/PACKET
MOVE T2,DATADR ;GET THE ADDRESS OF THE MESSAGE DATA
MOVE T1,UV$ACK(T2) ;GET THE ACK CODE FOR THE REQUESTOR
MOVEM T1,ACKCOD ; IN CASE HE IS ASYNCRONOUS (USUALLY QUASAR)
MOVE T1,UV$PPN(T2) ;GET THE PPN TO BE VALIDATED
MOVEM T1,PPN ;SAVE IT FOR LATER
JUMPG T1,ACTVCM ;IS IT A LEGAL PPN?
PUSHJ P,ERROR2 ;NO.
JUMPF ACTVE1 ;ERROR MESSAGE IS ALREADY BUILT IN IPCF MESSAGE
ACTVCM: MOVE T1,STATE2 ;GET THE SECOND STATES WORD
TXNN T1,ST%ACV ;IS VALIDATION REQUIRED?
JRST ACTVE1 ;NO. GIVE A SUCCESSFUL RETURN
MOVE T2,MDBADR ;ADDRESS OF MESSAGE DESCRIPTOR BLOCK
MOVE T1,MDB.FG(T2) ;FLAGS OF THE MESSAGE
TXNE T1,IP.CFP ;HAS THE SENDER SET THE PRIV BIT?
JRST ACTVE5 ;YES. ASSUME HE'S TRYING TO BREAK THE SYSTEM
MOVE T1,MDB.PV(T2) ;GET THE SENDER'S CPABILITIES
TXNE T1,MD.PWH!MD.POP ;IS THE SENDER J.ACCT'D OR A SYSTEM OPERATOR?
JRST ACTVE4 ;YES. ALLOW ALL KINDS OF VALIDATION
MOVE T1,MDB.SD(T2) ;GET THE SENDER'S PPN
CAMN T1,PPN ;DOES HE WANT TO VALIDATE FOR HIMSELF?
JRST ACTVE4 ;YES. ALLOW ONLY THAT
ACTVE5: PUSHJ P,ERROR3 ;UNPRIVILEGED USER CANNOT VALIDATE FOR OTHER PPNS
JUMPF ACTVE1
ACTVE4: MOVE T1,DATADR ;GET ADDRESS OF DATA
ADDI T1,UV$ACT ;BEGINNING ADDRESS OF ACCOUNT TO BE VALIDATED
LDB T1,[POINT 7,(T1),6] ;GET THE FIRST CHARACTER OF ACCOUNT
JUMPN T1,ACTVE6 ;ALWAYS VALIDATE A NON-NULL ACCOUNT
PUSHJ P,CHKDEF ;SEE IF DEFAULT EXISTS FOR NULL ACCOUNT, THIS PPN
JUMPT ACTVE1 ;THERE IS, MUST BE VALID, RETURN IT TO CALLER
PUSHJ P,CHKACT ;IF A NULL ACCOUNT, CHECK TO SEE IF VALIDATION IS REQUIRED
JRST ACTVE1 ;VALIDATION NOT REQUIRED FOR THIS PPN
; JUMPF ACTVXT ;VALIDATION IS REQUIRED. NULL ACCOUNT ILLEGAL
ACTVE6: PUSHJ P,CHKPRJ ;VALIDATE THE ACCOUNT
; JUMPF ACTVXT ;ERROR MESSAGE IS ALREADY BUILT IN IPCF MESSAGE
ACTVE1: SKIPE QUEFLG ;WAS THIS FROM A QUEUE. UUO?
JRST [JUMPF ACTVXT
MOVE T1,VALBLK+UV$TYP ;WHAT DOES HE WANT BACK?
CAIN T1,UGVRP$ ;USER PROFILE?
SKIPA T1,[-2] ;YES, "ERROR" -2, MOVE USER PROFILE
SETO T1, ;GET A -1 (NOT REALLY AN ERROR NUMBER)
AOSN MVBFLG ;MOVE WHOLE VALIDATION BLOCK?
MOVNI T1,3 ;YES
PUSHJ P,ERRQUE ;GENERATE NEGATIVE "ERROR"
PUSHJ P,FIXQUE ;COMPLETE THE MESSAGE
JRST ACTVE7] ;RELEASE MESSAGE AND SEND RESPONSE
MOVE S1,DATADR ;GET DATA ADDRESS
MOVEI T1,UGVUP$ ;GET VALIDATE ACCOUNT AND RETURN PROFILE CODE
MOVE T2,SABADR ;GET MESSAGE PAGE ADDRESS
CAME T1,UV$TYP(S1) ;WAS IT?
JRST [MOVE T1,UC$RES(T2) ;NO, GET RESPONSE
CAIE T1,UGFAL$ ;FAIL ALREADY?
JRST ACTVE3 ;NO
JRST ACTVXT] ;YES
MOVE T1,PPN ;YES, GET PPN
PUSHJ P,GETPRO ;FETCH PROFILE
JUMPF ACTVE3 ;IF IT FAILED, HE CAN'T HAVE IT
MOVEI T1,UC$PRO(T2) ;GET TARGET ADDRESS
HRLI T1,ACOPRO ;GET START OF PROFILE
BLT T1,UC$PRE(T2) ;COPY PROFILE
MOVE T1,UC$RES(T2) ;GET RESPONSE CODE
CAIN T1,UGFAL$ ;VALIDATION FAIL?
JRST ACTVXT ;YES, GO RETURN
ACTVE3: MOVEI T1,UGTRU$ ;VALIDATION WAS SUCCESSFUL
MOVEM T1,UC$RES(T2) ;STORE THE TRUE RESPONSE
MOVE T1,DATADR ;INCOMING MESSAGE
HRLI T1,UV$ACT(T1) ;ORIGINAL (OR MODIFIED) ACCOUNT STRING
HRRI T1,UC$ACT(T2) ;THE RESPONSE FIELD OF THE IPCF MESSAGE
BLT T1,UC$ACE(T2) ;RETURN IT TO THE SENDER
CAIA ;DONE
ACTVXX::PUSHJ P,UPDDSK ;PASWORD WAS (NOT) VALIDATED, SAVE DATE/TIME
ACTVXT::SKIPE QUEFLG ;WAS THIS FROM A QUEUE. UUO?
JRST [PUSHJ P,FIXQUE ;YES, BUILD THE REST OF THE MESSAGE
JRST ACTVE7] ;RELEASE MESSAGE AND SEND RESPONSE
MOVE T2,SABADR ;GET THE PAGE ADDRESS WE WANT TO SEND
MOVEI T1,UGVAC$ ;GET THE MESSAGE TYPE
MOVEM T1,UC$TYP(T2)
MOVE T1,ACKCOD ;GET THE ACK CODE
MOVEM T1,UC$ACK(T2) ;STORE IT FOR THE REQUESTOR
ACTVE7: $CALL C%REL ;RELEASE THE IPCF RECEIVE PAGE/PACKET
;HERE TO SEND RESPONSE POINTED TO BY SABADR TO THE USER OR THE MONITOR
RSPSAB: MOVE T1,MDBADR ;GET THE ADDRESS OF THE MDB
MOVE T1,MDB.SP(T1) ;GET THE PID OF THE SENDER
MOVEM T1,IPS.BL+SAB.PD;STORE IT IN THE SEND ARGUMENT BLOCK
MOVEI T1,1000 ;MAXIMUM LENGTH OF MESSAGE
MOVEM T1,IPS.BL+SAB.LN
MOVE T1,SABADR ;ADDRESS OF DATA
MOVEM T1,IPS.BL+SAB.MS
MOVEI S1,SAB.SZ ;LENGTH OF SEND ARGUMENT BLOCK
MOVEI S2,IPS.BL ;ADDRESS OF SEND ARGUMENT BLOCK
$CALL C%SEND ;SEND THE MESSAGE
JUMPT .POPJ ;RETURN IF SEND WENT OK
MOVE T1,MDBADR ;MESSAGE DESCRIPTOR BLOCK
MOVE T2,MDB.SD(T1) ;SENDER'S PPN
MOVE T3,MDB.PV(T1)
ANDX T3,MD.PJB ;JOB NUMBER OF SENDER
$WTOXX <Error (^E/S1/) sending response to job ^D/T3/ user ^P/T2/>
MOVE S1,SABADR ;ADDRESS OF PAGE TO RETURN TO POOL
$CALL M%RPAG ;RETURN THE PAGE
$RETT
;SUBROUTINE TO MAKE THE MESSAGE POINTED TO BY SABADR INTO A QUEUE. UUO RESPONSE
FIXQUE: MOVE T2,SABADR ;GET ADDRESS OF MESSAGE TO SEND
LOAD T1,.MSTYP(T2),MS.CNT ;GET THE CURRENT WORD COUNT
ADDI T1,.OHDRS ;ADD IN THE MESSAGE HEADER LENGTH
STORE T1,.MSTYP(T2),MS.CNT
MOVEI T1,.OMTXT ;MESSAGE TYPE TO RESPOND TO QUEUE. UUO
STORE T1,.MSTYP(T2),MS.TYP
MOVE T3,MMSADR ;ADDRESS OF MESSAGE QUEUE. UUO SEND US
MOVE T3,.MSCOD(T3) ;GET THE ACK CODE SEND TO US
MOVEM T3,.MSCOD(T2) ;MAKE SURE THE RIGHT USER GETS IT
$RETT
;ROUTINE TO UPDATE DISK WITH RECORD IN ACOPRO TO INDICATE THAT
;PASSWORD VALIDATION DID (NOT) SUCCEED. BE SURE WE GET HERE ONLY
;IF BUFFER IS VALID, ELSE RMS WILL HAPPILY REPLACE THE CURRENT REC...
UPDDSK: MOVEI S1,ACOPRO ;POINT AT THE PROFILE
PUSHJ P,UPDA## ;UPDATE FILE "A"
$RET ;NOT MUCH WE CAN DO
ACTACC: SKIPN QUEFLG ;ONLY DEFINED FROM QUEUE. UUO
JRST [$CALL C%REL ;WASN'T, RELEASE MESSAGE
$RETT] ;AND IGNORE IT
$CALL M%GPAG ;GET A PAGE FOR THE RESPONSE MESSAGE
MOVEM S1,SABADR ;STORE THE ADDRESS OF THE PAGE/PACKET
PUSHJ P,CVTWLD ;CONVERT TO WILDCARD BLOCK (S2 GETS ADDR)
MOVEI S1,ACOPRO ;WHERE TO READ THE RECORD
PUSHJ P,PROFIL ;FETCH PROFILE
JUMPF ACTACA ;NO SUCH USER
MOVEI S2,ACOPRO ;POINT TO THE RETURNED PROFILE
MOVE S1,.AEPPN(S2) ;GET THE PPN
MOVEM S1,ACOPPN ;SAVE IN PPN PLACE
MOVE T2,DATADR ;GET THE ADDRESS OF THE MESSAGE DATA
MOVE T1,UV$ACK(T2) ;GET THE ACK CODE FOR THE REQUESTOR
MOVEM T1,ACKCOD ; IN CASE HE IS ASYNCRONOUS (USUALLY QUASAR)
MOVE T1,ACOPPN ;GET THE PPN TO BE VALIDATED
MOVEM T1,UV$PPN(T2) ;STORE IT HERE
MOVEM T1,PPN ;SAVE IT FOR LATER
JUMPG T1,ACTAC1 ;IS IT A LEGAL PPN?
ACTACA: PUSHJ P,ERROR2 ;NO.
JUMPF ACTVXT ;ERROR MESSAGE IS ALREADY BUILT IN IPCF MESSAGE
ACTAC1: TRNN T1,1B18 ;WILD PPN?
JRST ACTAC2 ;NO
HRRZ S1,T1 ;GET PROGRAMMER NUMBER
CAIE S1,777776 ;VALID WILD PROGRAMMER NUMBER?
CAIN S1,777777 ;..
TRNA ;IT'S OK
FATAL (ILP,<Illegal PPN [^O/S1,LHMASK/,^O/S1,RHMASK/]>,,.RETF)
ACTAC2: MOVEI T1,ACOPRO ;POINT TO PROFILE
MOVE S1,ACOTYP ;GET TYPE OF CHECK TO MAKE
CAIN S1,UG.SPV ;SPRINT TYPE CHECK?
SKIPA T2,[AE.PRB] ;SPRINT, GET PASSWORD FOR BATCH BIT
MOVX T2,AE.PRT ;NORMAL, GET PASSWORD FOR TS BIT
TDNN T2,.AEREQ(T1) ;SEE IF PASSWORD IS REQUIRED
PJRST ACTVCM ;NO, SKIP THIS, GO CHECK ACCOUNT STRING
MOVEI S1,ACOPSW ;POINT TO THE PASSWORD
MOVE S2,T1 ;POINT TO BUFFER
$CALL CHKPSW## ;CHECK THE PASSWORD
MOVEI S1,ACOPRO ;POINT TO THIS PROFILE
PUSHJ P,FIXVLD ;UPDATE VALIDATION STATUS
; JUMPT ACTVCM ;PASSWORD MATCHES, CHECK ACCOUNT STRING
JUMPT [PUSHJ P,UPDDSK;UPDATE DISK RECORD
JRST ACTVCM] ;DONE
ILLPSW: PUSHJ P,LOGUSR ;LOG INITIAL USER STUFF
$TEXT (LOGFAI,<^O6R0/ACOPPN,LHMASK/^O6R0/ACOPPN,RHMASK/>)
PUSHJ P,FAIOUT ;FORCE BUFFERS OUT
MOVE S1,ACOPRO+.AEPPN ;GET PPN
FATAL (PSW,<Invalid password for ^U/S1/>,,ACTVXX)
SUBTTL PROCESSOR FOR "OBTAIN USER PROFILE" QUEUE. FUNCTION
ACTOUP: SKIPN QUEFLG ;ONLY DEFINED FROM QUEUE. UUO
JRST [$CALL C%REL ;WASN'T, RELEASE MESSAGE
$RETT] ;AND IGNORE IT
$CALL M%GPAG ;GET A PAGE FOR THE RESPONSE MESSAGE
MOVEM S1,SABADR ;STORE THE ADDRESS OF THE PAGE/PACKET
PUSHJ P,CVTWLD ;CONVERT TO WILDCARD BLOCK (S2 GETS ADDR)
ACTOU0: MOVEM S2,ACOPTR ;SAVE POINTER TO WILDCARD BLOCK
MOVEI S1,ACOPRO ;WHERE TO READ THE RECORD
PUSHJ P,PROFIL ;FETCH PROFILE
MOVEI S2,ACOPRO ;POINT TO THE RETURNED PROFILE
MOVE S1,.AEPPN(S2) ;GET THE PPN
MOVEM S1,ACOPPN ;STASH WHERE WE CAN FIND IT
JUMPF ACTOU1 ;NO SUCH USER
PUSHJ P,CHKOWN ; OR OWNER REQUESTING PROFILE?
JUMPT ACTOU2 ;JUMP IF WE FOUND THE PPN
ACTOU1: MOVE T1,ACOPTR ;GET ADDRESS OF WILDCARD BLOCK
MOVE T2,[POINT 8,ACOACK] ;AND TO ACK TEXT
PUSHJ P,A$WACK## ;GENERATE A WILDCARD ACK
MOVE T1,ACOPTR ;GET ADDR AGAIN
MOVE T2,[POINT 8,ACOACK] ;BYTE POINTER TO ACK TEXT
SKIPE UW$FND(T1) ;WAS AT LEAST ONE PROFILE FOUND?
FATAL (NAU,<No additional users matching ^Q/T2/>,,ACTVXT)
MOVEI T3,[ASCIZ /found/]
HLRZ T4,ACOWLD+UW$FND ;GET COUNT OF PROFILES FOUND
PUSHJ P,A$SWLD## ;GENERATE SUMMARY TEXT
FATAL (NUS,<^T/(S1)/>,,ACTVXT)
ACTOU2: MOVEI S2,ACOPRO ;SET UP POINTER TO PROFILE BLOCK
MOVX S1,AE.LOK ;GET FILE IS LOCKED BIT
SKIPE ACTLCK## ;IS FILE LOCKED?
IORM S1,ACOPRO+.AEFLG ;YES, LITE IN PROFILE
MOVEI S1,ACOPRO ;GET ADDRESS OF PROFILE
PUSHJ P,A$FSCD## ;GET SCHEDULAR CLASSES FROM SCDMAP
MOVE T2,DATADR ;GET THE ADDRESS OF THE MESSAGE DATA
MOVE T1,UV$ACK(T2) ;GET THE ACK CODE FOR THE REQUESTOR
MOVEM T1,ACKCOD ; IN CASE HE IS ASYNCRONOUS (USUALLY QUASAR)
MOVE T1,ACOPPN ;GET PPN WE WERE ASKED FOR
MOVEM T1,UV$PPN(T2) ;STASH HERE
MOVEM T1,PPN ;SAVE IT FOR LATER
MOVNI T1,2 ;GET A -2 (NOT REALLY AN ERROR NUMBER)
PUSHJ P,ERRPRO ;GENERATE "ERROR" -2 (MOVE ACTDAE.SYS ENTRY)
PJRST ACTVXT ;FINISH RESPONSE TO QUEUE. AND RETURN
; CONVERT OLD-STYLE "GET PROFILE" CALL TO NEW-STYLE WILDCARD CALL
CVTWLD: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
MOVEI P1,ACOWLD ;POINT TO INTERNAL WILDCARD BLOCK
MOVSI S1,0(P1) ;START ADDRESS
HRRI S1,1(P1) ;MAKE A BLT POINTER
SETZM (P1) ;CLEAR FIRST WORD
BLT S1,UW$MIN-1(P1) ;CLEAR ENTIRE BLOCK
MOVSI S1,UW$MIN ;LENGTH
MOVEM S1,UW$TYP(P1) ;SAVE
MOVE S1,ACOTYP ;GET TYPE FIELD
MOVE S2,ACOUXP ;FIND OUT WHAT WE WERE GIVE
CAIN S2,.UGUSR ;USER NAME?
JRST CVTWL3 ;YES
; PPN
CVTWL1: SETZM UW$WST(P1) ;SET WILDCARD SEARCH TYPE TO PPN
CAIE S1,UG.NXT ;WANT NEXT PROFILE?
SKIPA S1,ACOPPN ;PPN
TDZA S1,S1 ;WILD PPN
SKIPA S2,[EXP -1] ;NON-WILD MASK
TDZA S2,S2 ;WILD MASK
TDZA P2,P2 ;NON-WILD PREVIOUS RESULT
MOVE P2,ACOPPN ;WILD PREVIOUS RESULT
JUMPE P2,CVTWL2 ;ONWARD IF STARTING FROM FIRST PPN IN FILE
TRNN P2,-1 ;ELSE HAVE A PROGRAMMER NUMBER?
SOS P2 ;NO--BACK OFF ONE
CVTWL2: MOVEM S1,UW$PPN(P1) ;SAVE TARGET PPN
MOVEM S2,UW$PPM(P1) ;SAVE MASK
MOVEM P2,UW$BRE(P1) ;SAVE PREVIOUS RESULT
JRST CVTWL5 ;FINISH UP
; NAME
CVTWL3: MOVSI S2,ACOUSR ;POINT TO NAME
CAIN S1,UG.NXT ;WANT NEXT?
JRST CVTWL4 ;YES
HRRI S2,UW$NAM(P1) ;POINT TO STORAGE
BLT S2,UW$NAM+.AANLW-1(P1) ;COPY
MOVEI S2,2 ;CODE
MOVEM S2,UW$WST(P1) ;SET WILDCARD SEARCH TYPE NON-WILD NAME
JRST CVTWL5 ;FINISH UP
CVTWL4: HRRI S2,UW$BRE(P1) ;POINT TO STORAGE
BLT S2,UW$BRE+.AANLW-1(P1) ;COPY
MOVSI S2,(BYTE(8)"*",0) ;FAKING WILDCARD
MOVEM S2,UW$NAM(P1) ;SAVE IN MESSAGE
MOVEI S2,1 ;CODE
MOVEM S2,UW$WST(P1) ;SET WILDCARD SEARCH TYPE TO WILD NAME
CVTWL5: MOVE S2,P1 ;RETURN ADDRESS OF WILDCARD BLOCK
POPJ P, ;RETURN
WLDACK: PUSHJ P,.SAVE1 ;SAVE P1
MOVE P1,[POINT 8,ACOWLD+UW$NAM] ;POINT TO NAME
MOVE P2,[POINT 8,ACOACK] ;POINT TO ACK BLOCK
MOVEI P3,.AANLC ;NUMBER OF CHARACTERS
WLDAC1: ILDB S1,P1 ;GET A CHARACTER
IDPB S1,P2 ;PUT A CHARACTER
SKIPE S1 ;DONE?
SOJG P3,WLDAC1 ;LOOP IF MORE CHARACTERS
POPJ P, ;RETURN
;ACTCUP - Change a user profile
;Call
; ACOPRV/ Non-zero if invoking privs
;Return
; RETF Unprived or other problem
; RETT Change made
ACTCUP: $CALL M%GPAG ;GET A PAGE FOR THE RESPONSE MESSAGE
MOVEM S1,SABADR ;STORE THE ADDRESS OF THE PAGE/PACKET
SKIPE ACTLCK## ;IS THE FILE LOCKED?
FATAL (AFL,<Accounting file is locked>,,ACTVXT)
MOVE T1,MMSADR ;BASE MESSAGE ADDRESS
PUSHJ P,GETBLK ;MAKE SURE WE HAVE A FIRST BLOCK
JUMPF CUP.EF ;FORMAT ERROR IF NOT
SOS T3 ;YES, POINT TO BASE OF BLOCK
AOS T1,QUECNT ;AND GET TOTAL COUNT OF BLOCKS
MOVEM T1,CUPCNT ;STORE FOR TRANSACTION PROCESSING
MOVEM T3,CUPLIS ;REMEMBER START OF LIST
MOVEM T3,QUEBLK ;AND RESTORE IT FOR PREPROCESSING
MOVEI T1,UGCUP$ ;FUNCTION BEING PERFORMED
PUSHJ P,PREVAL ;PRESET THE VALIDATION BLOCK
SETZM CUPMEM ;ADDITION DYNAMIC MEMORY
MOVE S1,[CUPMEM,,CUPMEM+1]
BLT S1,CUPZND ;CLEAR IT OUT
MOVSI S1,UW$DAT ;LENGTH OF WILD BLOCK WITH NO SELECTIONS
MOVEM S1,CUPWLD ;INIT TO NO SELECT BLOCKS
$FALL CUP.1 ;OK, ENTER PARSE LOOP ON NEXT PAGE
CUP.1: PUSHJ P,GETBLF ;GET BLOCK, SEPARATING TYPE & FLAGS
JUMPF CUP.3 ;TIME TO PROCESS AT END OF LIST
CAIL T1,.AEMIN ;IN RANGE?
JRST CUP.EF ;FORMAT ERROR IF NOT
TXNN S2,AF.SEL ;DOING ANY SELECTION WITH THIS BLOCK?
JRST CUP.2 ;NO, CHECK MODIFIERS
LOAD S1,S2,AF.SEL ;YES, GET THE TYPE CODE
TXNN S2,AF.DEF ;MUST BE TESTING THE VALUE
CAIE S1,.AFAND ;VIA AN 'AND' SELECT
JRST CUP.10 ;NO TO EITHER, JUST STORE THE BLOCK
CAIE T1,.AEPPN ;SELECTING ON THE PPN?
JRST CUP.11 ;NO, KEEP LOOKING
CAIL T2,1 ;YES, IS THE BLOCK
CAILE T2,2 ; OF A VALID LENGTH?
JRST CUP.EF ;NO, COMPLAIN OF FORMAT ERROR
SKIPE CUPPPN ;HAVE WE ALREADY SEEN A PPN BLOCK?
JRST CUP.EF ;YES, COMPLAIN OF FORMAT ERROR
MOVEI S1,-1(T3) ;GET BASE ADDRESS OF BLOCK
MOVEM S1,CUPPPN ;STORE FOR PROFILE FETCHING
JRST CUP.1 ;PARSE ENTIRE MESSAGE
CUP.11: CAIE T1,.AENAM ;SELECTING ON USERNAME?
CAIN T1,.AENAM+1 ;OR FORCED NON-WILD?
CAIA ;YES, CHECK IT
JRST CUP.12 ;NO, KEEP LOOKING
SKIPE CUPNAM ;HAVE WE SEEN A NAME ALREADY?
JRST CUP.EF ;YES, COMPLAIN OF FORMAT ERROR
MOVEI S1,-1(T3) ;POINT TO BASE ADDRESS
MOVEM S1,CUPNAM ;SAVE FOR LATER
JRST CUP.1 ;PARSE ENTIRE MESSAGE
CUP.12: CAIE T1,.AEPSW ;SELECTING ON PASSWORD?
JRST CUP.10 ;NO, JUST ADD TO SELECT BLOCK
SKIPE CUPPWD ;YES, IS THIS A DUPLICATE?
JRST CUP.EF ;FORMAT ERROR IF SO
MOVEI S1,-1(T3) ;POINT TO BASE ADDRESS
MOVEM S1,CUPPWD ;SAVE FOR ACCESS CHECKING
JRST CUP.1 ;PARSE ENTIRE MESSAGE
CUP.10: MOVEI T1,-1(T3) ;POINT TO BASE ADDRESS OF BLOCK
AOS T2 ;AND MAKE LENGTH REFLECT REALITY
PUSHJ P,CUP.S1 ;INSERT INTO SELECTION LIST OF WILDCARD BLOCK
JRST CUP.1 ;PARSE ENTIRE MESSAGE
CUP.SL: LDB T2,[POINT 9,(T1),17] ;GET BLOCK LENGTH
HRRZ S2,(T1) ;AND FLAGS
CUP.S1: TXNE S2,AF.DEF ;IF SELECTING BASED ON .AEMAP,
MOVEI T2,1 ;FORGET THE VALUE
SKIPN S1,CUPSEL ;IS THIS FIRST INSERTION TO THE BLOCK?
MOVEI S1,CUPWLD+UW$DAT ;YES, POINT TO START OF SELECTION DATA
HRLI S1,(T1) ;MAKE TRANSFER WORD
HRRZ S2,S1 ;COPY DESTINATION POINTER
ADD S2,T2 ;POINT ONE BEYOND DESTINATION BLOCK
MOVEM S2,CUPSEL ;SAVE FOR NEXT TIME
BLT S1,-1(S2) ;MOVE THE DATA
AOS CUPWLD+UW$SEL ;UPDATE THE COUNT OF SELECTION BLOCKS
CAIN T2,1 ;IF SELECTING ON .AEMAP,
DPB T2,[POINT 9,-1(S2),17] ;UPDATE BLOCK LENGTH IN LIST
SUBI S2,CUPWLD ;GET CURRENT LENGTH OF WILDCARD BLOCK
HRLM S2,CUPWLD ;SET LENGTH IN HEADER FOR ACTRMS
POPJ P, ;RETURN
CUP.2: CAIE T1,.AEDEF ;WANT TO CHANGE THE DEFAULT PPN?
JRST CUP.21 ;NO, KEEP LOOKING
CAIL T2,1 ;DEMAND ONE WORD
CAIL T2,3 ;AND NOT MORE THAN TWO,
JRST CUP.EF ;ELSE IS FORMAT ERROR
TXNE S2,AF.DEF ;AND NOT BEING DEFAULTED
JRST CUP.EF ;ELSE IS FORMAT ERROR
MOVE S1,(T3) ;GET VALUE
MOVEM S1,CUPDEF ;SAVE FOR LATER
JRST CUP.1 ;EXAMINE ALL MESSAGE BLOCKS
CUP.21: CAIE T1,.AEPPN ;WANT TO CHANGE THE PPN?
JRST CUP.22 ;NO, KEEP LOOKING
TXNE S2,AF.DEF ;CAN'T SET PPN TO DEFAULT
JRST CUP.EF ;COMPLAIN OF FORMAT ERROR
CAIN T2,1 ;MUST BE JUST ONE DATA WORD
SKIPE CUPPPM ;SECOND PPN BLOCK FOUND?
JRST CUP.EF ;ALSO A FORMAT ERROR
MOVEI S1,-1(T3) ;POINT TO BASE OF BLOCK
MOVEM S1,CUPPPM ;REMEMBER PPN BEING MODIFIED
MOVE S1,(T3) ;GET PPN BEING SET
CAMN S1,[-1] ;IS THIS [%,%]?
JRST CUP.1 ;YES, IT'S OK
JUMPL S1,CUP.EI ;INVALID PPN IF NOT POSITIVE
TRNN S1,1B18 ;POSSIBLE WILD PPN?
JRST CUP.1 ;NO, PARSE NEXT BLOCK
HRRZS S1 ;YES, ISOLATE WILD HALF
CAIE S1,-1 ;IF DEFAULT
CAIN S1,-2 ;OR WILD
JRST CUP.1 ;THEN IT'S OK
JRST CUP.EI ;INVALID PPN OTHERWISE
CUP.22: CAIE T1,.AENAM ;WANT TO CHANGE THE NAME?
JRST CUP.23 ;NO, KEEP LOOKING
SKIPN CUPNMM ;MUST HAVE ONLY ONE
TXNE S2,AF.DEF ;CAN'T SET NAME TO DEFAULT
JRST CUP.EF ;FORMAT ERROR IF TRIED
MOVEI S1,-1(T3) ;POINT TO BASE OF BLOCK
MOVEM S1,CUPNMM ;SAVE NAME MODIFIER BLOCK
JRST CUP.1 ;PARSE ENTIRE MESSAGE
CUP.23: CAIE T1,.AEPSW ;CHANGING THE PASSWORD?
JRST CUP.24 ;NO, KEEP LOOKING
SKIPN CUPPWM ;MUST HAVE ONLY ONE
TXNE S2,AF.DEF ;CAN'T SET TO DEFAULT
JRST CUP.EF ;FORMAT ERROR EITHER WAY
MOVEI S1,-1(T3) ;POINT TO BASE OF BLOCK
MOVEM S1,CUPPWM ;SAVE PASSWORD MODIFIER ADDRESS
HRLI T3,(POINT 8) ;MAKE BYTE POINTER TO SUPPLIED PASSWORD
IMULI T2,.APWCW ;CHARACTER COUNT
CAILE T2,.APWLC ;TOO MANY?
MOVEI T2,.APWLC ;TRUNCATE
MOVE T1,[POINT 8,CUPPWB] ;PLACE TO STORE THE PASSWORD
PUSHJ P,CUPSTR ;MOVE THE STRING
JRST CUP.1 ;PARSE ENTIRE MESSAGE
CUP.24: CAIE T1,.AEVRS ;CHANGING THE VERSION NUMBER?
JRST CUP.20 ;NO, JUST VALIDATE
SKIPN CUPVRS ;MUST HAVE ONLY ONE
TXNE S2,AF.DEF ;AND NOT DEFAULTED
JRST CUP.EF ;OR IS FORMAT ERROR
CAIE T2,2 ;MUST HAVE EXACTLY TWO DATA WORDS
JRST CUP.EF ;FORMAT ERROR OTHERWISE
MOVX S1,AE.VRS ;VERSION MASK
CAME S1,1(T3) ;MAKE SURE RIGHT FIELD IS MODIFIED
JRST CUP.EF ;FORMAT ERROR IF NOT
LOAD S1,(T3),AE.VRS ;GET VALUE TO SET
CAIE S1,%AECVN ;IS IT IN PHASE WITH OURS?
FATAL (WFV,<Wrong format version specified>,,ACTVXT)
SETOM CUPVRS ;WE GOT THE VERSION WORD
JRST CUP.1 ;PARSE ENTIRE MESSAGE
CUP.20: MOVE S1,CHGTAB##(T1) ;GET CONTROL BITS
SKIPN ACOPRV ;PRIVED?
TXNE S1,PD.UNP ;NO, DO WE NEED TO BE?
CAIA ;NO, SKIP ON
JRST CUP.E3 ;YES, GIVE PRIVILEGE ERROR
TXNE S1,PD.NMD ;IS IT LEGAL TO MODIFY THIS FIELD AT ALL?
FATAL (FNM,<Value at offset ^O/T1/ is not modifiable>,,ACTVXT)
TXNE S1,PD.CND ;CAN IT BE DEFAULTED?
TXNN S2,AF.DEF ;NO, ARE WE ATTEMPTING IT?
AOSA CUPMFC ;NO, COUNT ANOTHER FIELD TO MODIFY
FATAL (FND,<Value at offset ^O/T1/ is not defaultable>,,ACTVXT)
LOAD T4,S1,PD.WRD ;GET MAXIMUM BLOCK LENGTH
TXNE S1,PD.MSK ;IF MASKABLE,
AOS T4 ;ALLOW ANOTHER
CAILE T2,(T4) ;IS THE SUPPLIED BLOCK TOO LONG?
JRST CUP.EF ;YES, GIVE A FORMAT ERROR
TXNN S2,AF.DEF ;UNLESS DEFAULTING,
JUMPE T2,CUP.EF ;REQUIRE SOME DATA
JRST CUP.1 ;OK, PARSE REST OF MESSAGE
CUP.3: SKIPN CUPVRS ;DID WE GET A VALID VERSION CHANGE WORD?
JRST CUP.EF ;FORMAT ERROR IF NOT
SKIPN T1,CUPPPM ;ARE WE TRYING TO CHANGE THE PPN?
JRST CUP.31 ;NO, DON'T WORRY ABOUT IT
SKIPN ACOPRV ;MUST BE PRIVED FOR THESE OPERATIONS
JRST CUP.E3 ;ERROR IF NOT
SKIPN 1(T1) ;MODIFYING IT TO ZERO?
JRST [SETOM CUPDEL ;YES, THAT'S HOW WE DELETE THINGS
JRST CUP.31] ;CHECK OTHER FIELDS
SKIPN CUPWLD+UW$SEL ;NO, ADDING, MUST HAVE NO SELECT BLOCKS
SKIPE CUPPPN ;OF ANY KIND
JRST CUP.EF ;FORMAT ERROR IF SO
SKIPN CUPNAM ;CHECK OTHER SELECT BLOCKS
SKIPE CUPPWD ;FOR ABSENCE
JRST CUP.EF ;FORMAT ERROR IF PRESENT
JRST CUP.AE ;ALL IS COPASETIC, GO ADD AN ENTRY
CUP.31: SKIPN CUPNAM ;WANT TO SELECT BY NAME?
JRST CUP.33 ;NO, SKIP NAME STUFF, CHECK FOR PPN
SKIPE T1,CUPPPN ;YES, WAS A PPN BLOCK ALSO GIVEN?
PUSHJ P,CUP.SL ;YES, ADD IT TO THE SELECTION DATA
SETZM CUPPPN ;MAKE SURE IT DOESN'T CONFUSE US IN THE FUTURE
MOVE T1,CUPNAM ;GET NAME SELECTION BLOCK
MOVE S1,(T1) ;GET OVERHEAD WORD
ANDI S1,AF.OFS ;KEEP .AENAM OR .AENAM+1
SUBI S1,.AENAM-1 ;MAKE 1 OR 2
MOVEM S1,CUPWLD+UW$WST ;SETUP WILDCARD SEARCH TYPE
MOVE T2,[POINT 8,1(T1)] ;POINT TO SUPPLIED NAME
MOVE T3,[POINT 8,CUPWLD+UW$NAM] ;POINT TO NAME FIELD OF WILD BLOCK
LDB S1,[POINT 9,(T1),17] ;GET WORD LENGTH OF BLOCK
SUBI S1,1 ;OFFSET FOR OVERHEAD WORD
IMULI S1,.APWCW ;TIMES CHARACTER PER WORD
CAILE S1,.APWLC ;WITHIN CHARACTER LENGTH LIMIT?
MOVEI S1,.APWLC ;NO, TRUNCATE
MOVE T4,S1 ;KEEP INITIAL SPACE COUNT
JUMPLE S1,CUP.EF ;FORMAT ERROR IF NULL NAME
CUP.32: LDB S2,T2 ;GET A SOURCE BYTE
DPB S2,T3 ;COPY TO WILDCARD BLOCK
SKIPE S2 ;DONE IF NULL
SOJG S1,CUP.32 ;LOOP OVER ALL CHARACTERS IN MESSAGE BLOCK
SUB T4,S1 ;FIND NUMBER OF CHARACTERS TRANSFERRED
JUMPE T4,CUP.EF ;FORMAT ERROR IF NULL NAME
JRST CUP.34 ;GOT A NAME, SKIP THE PPN CHECKING
CUP.33: SKIPN T1,CUPPPN ;MUST HAVE A PPN FOR SELECTION IF NO NAME
JRST CUP.EF ;FORMAT ERROR IF NOT
LDB T2,[POINT 9,(T1),17] ;GET TOTAL BLOCK LENGTH
MOVE S1,1(T1) ;GET PPN FROM MESSAGE
CAIL T2,3 ;IF MASK WAS SUPPLIED,
SKIPA S2,2(T1) ;THEN USE IT,
SETO S2, ;ELSE ASSUME NOT WILD
DMOVEM S1,CUPWLD+UW$PPN ;SETUP TO SEARCH BASED ON PPN
$FALL CUP.34 ;CONTINUE ON NEXT PAGE
CUP.34: SKIPE ACOPRV ;DO WE HAVE PRIVS?
JRST CUP.35 ;YES, DON'T NEED TO CHECK HERE
SKIPE CUPPWM ;IF MODIFYING PASSWORD,
SKIPE CUPPWD ;MUST HAVE OLD ONE
CAIA ;OK
JRST CUP.EP ;PASSWORD ERROR
MOVEI S1,2 ;GET NON-WILD NAME FLAG
SKIPE CUPWLD+UW$WST ;DOING A NAME PARSE?
MOVEM S1,CUPWLD+UW$WST ;YES, FORCE NON-WILD
SKIPN CUPWLD+UW$WST ;SEARCHING BY NAME?
JRST CUP.35 ;YES, DONE CHECKING
SETO S1, ;NO, GET A -1
CAME S1,CUPWLD+UW$PPM ;CHECK FOR NON-WILD PPN MASK
JRST CUP.E3 ;NOT PRIVILEGED
CUP.35: SKIPN T3,CUPPWD ;DO WE HAVE A PASSWORD?
JRST CUP.4 ;NO, START MODIFYING
LDB T2,[POINT 9,(T3),17] ;YES, GET BLOCK LENGTH
SOS T2 ;WANT ONLY DATA LENGTH
IMULI T2,.APWCW ;TIMES CHARACTERS PER WORD
CAILE T2,.APWLC ;TOO MANY CHARACTERS?
MOVEI T2,.APWLC ;TRUNCATE
ADD T3,[POINT 8,1] ;SOURCE BYTE POINTER
MOVE T1,[POINT 8,ACOPSW] ;DESTINATION B.P.
PUSHJ P,CUPSTR ;COPY THE STRING
$FALL CUP.4 ;START GETTING/MODIFYING, NEXT PAGE
CUP.4: SETZM CUPCHG ;NOTHING CHANGED THIS PASS
MOVEI S1,ACOPRO ;PROFILE BLOCK
MOVEI S2,CUPWLD ;WILDCARD BLOCK
PUSHJ P,PROFIL ;FETCH THE PROFILE IN QUESTION
JUMPF CUP.6 ;MIGHT BE DONE
AOS CUPWLD+UW$FND ;UPDATE COUNT OF ENTRIES MATCHED
MOVE S1,ACOPRO+.AEPPN ;GET THIS ENTRY'S PPN
MOVEM S1,ACOPPN ;SAVE FOR VARIOUS ROUTINES
MOVEM S1,PPN ;HERE TOO (JUST IN CASE)
SKIPE CUPDEL ;SUPPOSED TO DELETE THIS ENTRY?
JRST CUP.DE ;YES, DO SO
PUSHJ P,A$CKPP## ;NO, CHECK FOR RESERVED PPN
SETCAM TF,CUPRES ;REMEMBER IF DOING A RESERVED PROFILE
SKIPN CUPPWD ;NO, DO WE WANT TO VALIDATE THE PASSWORD?
JRST CUP.41 ;NO, SKIP IT
MOVEI S1,ACOPSW ;POINT TO (OLD) PASSWORD
MOVEI S2,ACOPRO ;AND PROFILE BUFFER
PUSHJ P,CHKPSW## ;MAKE SURE ITS VALID
MOVEI S1,ACOPRO ;POINT TO PROFILE AGAIN
PUSHJ P,FIXVLD ;UPDATE VALIDATION TIME IN PROFILE
JUMPF CUP.EL ;INVALID LOGIN INFORMATION
AOS CUPCHG ;WE CHANGED SOMETHING
JRST CUP.42 ;DON'T CHECK OWNERSHIP, WE HAVE THE PASSWORD
CUP.41: MOVE S1,PPN ;WHO WE'RE TRYING TO HACK
PUSHJ P,CHKOWN ;TEST OWNERSHIP IF NOT
JUMPF CUP.EI ;ILLEGAL PPN ERROR
CUP.42: MOVE S1,CUPLIS ;GET START OF MESSAGE BLOCKS
MOVEM S1,QUEBLK ;SAVE FOR GETBLK
MOVE S1,CUPCNT ;GET BLOCK COUNT
MOVEM S1,QUECNT ;ALSO FOR GETBLK
$FALL CUP.5 ;ENTER MODIFICATION LOOP, NEXT PAGE
CUP.5: MOVE T1,MMSADR ;POINT TO MESSAGE
PUSHJ P,GETBLF ;GET BLOCK TYPE AND FLAGS
JUMPF CUP.50 ;CHECK NEED TO UPDATE AT EOM
TXNE S2,AF.SEL ;IF A SELECTION BLOCK,
JRST CUP.5 ;IGNORE IT (ALREADY CHECKED BY GETA)
CAIN T1,.AEVRS ;DOING THE VERSION?
JRST CUP.5 ;GIMME A BREAK
MOVSI T4,-CUPTLN ;SET TO EXAMINE THE CHANGE TABLE
CUP.51: HLRZ S1,CUPTAB(T4) ;SEE IF WE CARE
CAIE S1,(T1) ;IS THERE A ROUTINE TO PROCESS THIS ENTRY?
AOBJN T4,CUP.51 ;NOT YET, KEEP LOOKING
JUMPGE T4,CUP.52 ;NOT AT ALL, HANDLE NORMALLY
HRRZ T4,CUPTAB(T4) ;YES, GET ITS ADDRESS
JRST (T4) ;LET IT PROCESS THE ENTRY
CUP.52: MOVE S1,CHGTAB##(T1) ;GET CONTROL BITS
TXNE S1,PD.EXT ;EXTENSIBLE BLOCK?
JRST CUP.53 ;YES, UPDATE IT
TXNE S1,PD.MSK ;NO, MASKABLE WORD?
TXNE S2,AF.DEF ;WITH A REAL VALUE?
JRST CUP.55 ;NO, UPDATE A STATIC BLOCK
CAIG T2,1 ;IF NO MASK,
JRST CUP.55 ;TREAT LIKE STATIC BLOCK (FULLWORD CHANGE)
MOVE S1,(T3) ;GET VALUE TO SET
MOVE T4,1(T3) ;AND CHANGE MASK
AND S1,T4 ;CHANGE ONLY REQUESTED BITS
ANDCA T4,ACOPRO(T1) ;GET BITS TO PRESERVE FROM OLD VALUE
IOR S1,T4 ;MAKE NEW VALUE WORD
MOVEM S1,(T3) ;RESET THE WORD
SOS T4,T2 ;MEET EXPECTATIONS OF LATER TESTS
PJRST CUP.55 ;THEN GO HANDLE AS A STATIC BLOCK
CUP.53: LOAD T4,S2,AF.DEF ;GET DEFAULTING BIT
JUMPN T4,CUP.54 ;GO DEFAULT IT IF REQUESTED
SKIPN (T3) ;IF THE FIRST WORD IS ZERO,
CAIE T2,1 ;AND THAT'S ALL THERE IS,
CAIA ;(NO)
JRST CUP.54 ;THEN GO DELETE THE BLOCK
MOVE S1,ACOPRO(T1) ;NO, GET ITS AOBJN POINTER
ADDI S1,ACOPRO ;DE-RELATIVIZE IT
MOVN S2,T2 ;GET MINUS LENGTH OF MESSAGE BLOCK
MOVSS S2 ;IN CORRECT HALFWORD
HRRI S2,(T3) ;AOBJN POINTER TO MESSAGE DATA
PUSHJ P,CUP.CW ;COMPARE THE DATA BLOCKS
PUSHJ P,CUP.CD ;NO CHANGE, CHECK IF DEFAULTED
CAIA ;CHANGED OR DEFAULTED
JRST CUP.5 ;NO CHANGE AT ALL
MOVNS T2 ;GET MINUS LENGTH
MOVSS T2 ;IN CORRECT HALFWORD
HRRI T2,(T1) ;ALSO GET ENTRY OFFSET
MOVEI T1,ACOPRO ;POINT TO PROFILE
SETZ T4, ;CLEARING DEFAULTED BIT
PUSHJ P,A$EBLK## ;MODIFY THE PROFILE
JUMPF CUP.EE ;NO ROOM
AOS CUPCHG ;WE CHANGED SOMETHING
JRST CUP.5 ;LOOP OVER ALL MESSAGE BLOCKS
CUP.54: PUSH P,T4 ;SAVE THE DESIRED VALUE
PUSHJ P,CUP.CD ;CHECK IF DEFAULTED ALREADY
TDZA S1,S1 ;ZERO IF ALREADY DEFAULTED
MOVEI S1,1 ;ONE IF NOT DEFAULTED (BACKWARDS VALUE OF T4)
POP P,T4 ;RESTORE REQUESTED SETTING
CAIE S1,(T4) ;IF THE OLD STATUS MATCHES THE NEW,
JUMPN T4,CUP.5 ;NOTHING TO DO IF DEFAULTING
SKIPN ACOPRO(T1) ;IF VALUE IS ALREADY ZERO,
SKIPN S1 ;AND NOT DEFAULTED,
CAIA ;(NO)
JUMPE T4,CUP.5 ;THEN NOTHING TO DO IF THAT'S THE DESIRED STATE
HRROI T2,(T1) ;NO, MAKE ENTRY DESCRIPTOR
MOVEI T1,ACOPRO ;CHANGING THIS PROFILE
SETZ T3, ;GIVING NO VALUE
PUSHJ P,A$EBLK## ;DELETE OLD BLOCK (SETTING BITMAP AS DESIRED)
JUMPF CUP.EE ;NO ROOM (SHOULD NEVER HAPPEN)
AOS CUPCHG ;CHANGE HAPPENED
JRST CUP.5 ;LOOP OVER ALL MESSAGE BLOCKS
CUP.55: TXNE S2,AF.DEF ;DEFAULTING?
JRST CUP.57 ;YES, GO DEFAULT IT
PUSHJ P,CUP.CD ;SEE IF DEFAULTED
SETZ T4, ;YES, MUST CHANGE
LOAD S1,CHGTAB##(T1),PD.WRD ;NO, GET BLOCK SIZE
MOVNS S1 ;MAKE MINUS SIZE
MOVSS S1 ;IN CORRECT HALFWORD
HRRI S1,ACOPRO(T1) ;AOBJN POINTER TO CURRENT VALUE
MOVN S2,T2 ;GET MINUS MESSAGE BLOCK LENGTH
MOVSS S2 ;IN LH
HRRI S2,(T3) ;AOBJN POINTER TO MESSAGE DATA
JUMPE T4,CUP.56 ;ALWAYS CHANGE IF MUST CLEAR BIT
PUSHJ P,CUP.CW ;COMPARE WORD VALUES IN THE BLOCKS
JRST CUP.5 ;NO CHANGE HERE
CUP.56: SKIPGE S2 ;ANYTHING LEFT IN MESSAGE DATA?
SKIPA T4,(S2) ;YES, USE IT
SETZ T4, ;NO, GET A ZERO
MOVEM T4,(S1) ;UPDATE PROFILE
AOBJP S2,.+1 ;ADVANCE USER POINTER
AOBJN S1,CUP.56 ;TRANSFER WORDS TO FILL THE BLOCK
PUSHJ P,CUP.CD ;CHECK PREVIOUS STATE OF DEFAULT BIT
ANDCAM T4,ACOPRO+.AEMAP(S1) ;CLEAR IT IF IT WAS SET
AOS CUPCHG ;SOMETHING CHANGED
JRST CUP.5 ;LOOP OVER ALL MESSAGE BLOCKS
CUP.57: PUSHJ P,CUP.CD ;CHECK WHETHER DEFAULTED
JRST CUP.5 ;YES, THIS IS NO CHANGE
IORM T4,ACOPRO+.AEMAP(S1) ;NO, LIGHT THE BIT
; LOAD S1,CHGTAB##(T1),PD.WRD ;GET BLOCK LENGTH
; MOVEI S2,ACOPRO(T1) ;AND BLOCK ADDRESS
; $CALL .ZCHNK ;CLEAR THE BLOCK
AOS CUPCHG ;WE CHANGED IT
JRST CUP.5 ;LOOP OVER ALL MESSAGE BLOCKS
CUP.NM: MOVX S2,AE.NCH ;NAME-CHANGE REQUIRED BIT
TDNN S2,ACOPRO+.AEFLG ;IS IT ON?
SKIPE ACOPRV ;OR ARE WE PRIVED?
CAIA ;YES, WE'RE GOLDEN
JRST CUP.E3 ;NOPE
MOVN S2,T2 ;GET MINUS LENGTH OF USER ARG
MOVSS S2 ;IN LH
HRRI S2,(T3) ;AOBJN POINTER TO USER DATA
MOVE S1,[-.AANLW,,ACOPRO+.AENAM] ;AOBJN POINTER TO PROFILE DATA
PUSHJ P,CUP.CW ;WORD-MODE BLOCK COMPARE
JRST CUP.5 ;NO CHANGE, DON'T BOTHER ME
MOVX S1,AE.NCH ;NAME-CHANGE REQUIRED BIT
ANDCAM S1,ACOPRO+.AEFLG ;CLEAR IT NOW
AOS CUPCHG ;WE'RE CHANGING THINGS
MOVE S1,[ACOPRO+.AENAM,,ACOPRO+.AENAM+1] ;BLT XFER WORD
SETZM ACOPRO+.AENAM ;CLEAR A WORD
BLT S1,ACOPRO+.AENAM+.AANLW-1 ;START OFF WITH CLEAN BLOCK
IMULI T2,.AANCW ;GET NUMBER OF CHARACTERS (MAX.) IN BLOCK
CAILE T2,.AANLC ;BEYOND MAXIMUM CHARACTER COUNT?
MOVEI T2,.AANLC ;TRUNCATE
HRLI T3,(POINT 8) ;AND A BYTE POINTER TO THE DATA
MOVE T1,[POINT 8,ACOPRO+.AENAM] ;AND A DESTINATION POINTER
PUSHJ P,CUPSTR ;COPY THE STRING
JRST CUP.5 ;LOOP OVER ALL CHANGE BLOCKS
CUP.PW: SKIPE CUPADD ;IF ALREADY DID THIS,
JRST CUP.5 ;DON'T DO IT AGAIN
SKIPE ACOPRV ;IF PRIVED,
JRST CUP.P1 ;THEN JUST DO IT
MOVX S1,AE.PCP ;PASSWORD CHANGE PROHIBITED BIT
TDNN S1,ACOPRO+.AEREQ ;TEST IT
JRST CUP.P1 ;CLEAR, GO CHANGE IT
SKIPL S1,ACOPRO+.AEPCT ;SKIP IF MUST CHANGE PSW NOW
$CALL I%NOW ;ELSE, GET CURRENT UDT
CAML S1,ACOPRO+.AEPCT ;HAS THE PASSWORD EXPIRED?
JUMPN S1,CUP.P1 ;CHANGE IT IF REQUIRED (DESPITE AE.PCP)
FATAL (PCP,<Password changes are prohibited for ^U/ACOPPN/>,,ACTVXT)
CUP.P1: SKIPE ACOPRV ;IGNORE LENGTH IF PRIVED
JRST CUP.P2 ;YES
MOVEI S1,ACOPRO ;THE PROFILE WE'RE MODIFYING
MOVEI S2,CUPPWB ;THE PROPOSED NEW PASSWORD
PUSHJ P,LENPSW## ;CHECK IT OUT
JUMPF CUP.EW ;PASSWORD LENGTH ERROR
CUP.P2: MOVX S1,AE.PCP ;CAN THE USER INITIATE PSW CHANGES?
TDNN S1,ACOPRO+.AEREQ ;TEST
JRST CUP.P3 ;YES, DON'T BOTHER TO CHECK IF SAME
REPEAT 0,<
LOAD S1,ACOPRO+.AEFLG,AE.PWE ;GET PREVIOUS ENCRYPTION ALGORITHM
CAME S1,CURALG## ;IS IT THE SAME AS WHAT WE WILL USE?
JRST CUP.P3 ;NO, DON'T CHECK FOR MATCH WITH OLD PSW
>
MOVEI S1,CUPPWB ;THE PROPOSED NEW PASSWORD
MOVEI S2,ACOPRO ;THE PROFILE WE'RE MODIFYING
PUSHJ P,CHKPSW## ;SEE IF THIS IS A REAL CHANGE
JUMPF CUP.P3 ;YES, JUST GO DO IT
FATAL (PMC,<Password must change>,,ACTVXT) ;NO
CUP.P3: MOVEI S1,CUPPWB ;THE PROPOSED NEW PASSWORD
MOVEI S2,ACOPRO ;THE PROFILE WE'RE MODIFYING
PUSHJ P,SETPSW## ;CHANGE THE PASSWORD PLEASE
JUMPF CUP.EA ;ENCRYPTION FAILURE?
MOVEI S1,ACOPRO ;PROFILE BUFFER
PUSHJ P,FIXPCR ;FIXUP REQUIRED PROFILE CHANGE
AOS CUPCHG ;SOMETHING CHANGED
JRST CUP.5 ;LOOP OVER ALL CHANGE ENTRIES
CUP.RQ: PUSH P,S2 ;SAVE FLAGS WORD
PUSHJ P,CUP.CD ;CHECK IF DEFAULTED
TDZA T4,T4 ;YES
MOVEI T4,1 ;OR NO
POP P,S2 ;RESTORE FLAGS
TXNN S2,AF.DEF ;SETTING TO DEFAULT?
TRCA T4,1 ;NO, CHANGE MATCH FLAG
SKIPA S1,ACODEF+.AEREQ ;YES, GET DEFAULT
SKIPA S1,(T3) ;NO, GET VALUE
MOVEI T2,1 ;YES, DEMAND A FULL-WORD CHANGE
CAIL T2,2 ;WAS A MASK GIVEN?
SKIPA T1,1(T3) ;YES, FETCH IT
SETO T1, ;NO, ASSUME FULLWORD
AND S1,T1 ;KEEP ONLY BITS TO CHANGE
ANDCA T1,ACOPRO+.AEREQ ;FETCH BITS TO LEAVE ALONE
IOR S1,T1 ;CONSTRUCT NEW WORD
CAMN S1,ACOPRO+.AEREQ ;IS THIS A CHANGE?
JUMPE T4,CUP.5 ;NO CHANGE AT ALL IF VALUES & BITS AGREE
EXCH S1,ACOPRO+.AEREQ ;YES, UPDATE, REMEMBERING OLD
XOR S1,ACOPRO+.AEREQ ;GET DIFFERENCE MASK
ANDI S1,AE.PCI ;ISOLATE CHANGES TO INTERVAL
JUMPE S1,CUP.R1 ;DON'T UPDATE PCT IF NO CHANGE HERE
MOVX S1,AE.PCI ;YES, GET FIELD MASK
AND S1,ACOPRO+.AEREQ ;GET NEW CHANGE INTERVAL
MOVSS S1 ;CORRECT FOR UDT FORMAT
ADD S1,ACOPRO+.AELPC ;GET NEW REQUIRED CHANGE TIME
CAMLE S1,ACOPRO+.AELPC ;IF USEFUL,
MOVEM S1,ACOPRO+.AEPCT ;SET IT IN THE PROFILE
CUP.R1: AOS CUPCHG ;WE MADE A CHANGE
LOAD T3,S2,AF.DEF ;GET DEFAULTING BIT
MOVEI T2,.AEREQ ;THIS IS WHAT WE CHANGED
MOVEI T1,ACOPRO ;POINT TO PROFILE
PUSHJ P,A$BMAP## ;SET THE BIT AS REQUESTED
JRST CUP.5 ;LOOP OVER ALL CHANGE BLOCKS
CUP.50: SKIPN CUPCHG ;HAS ANYTHING CHANGED?
JRST CUP.4 ;NO, JUST LOOP OVER ALL MATCHES
MOVEI S1,ACOPRO+.AENAM ;YES, POINT TO NAME (MAYBE MODIFIED)
PUSHJ P,A$CKNM## ;SEE IF IT'S RESERVED
XOR TF,CUPRES ;MAKE TRUE IFF NAME AND PPN AGREE ON RESERVATION
JUMPF CUP.EI ;WRONG STATE--SAY ILLEGAL PPN
SKIPE CUPRES ;IS PPN RESERVED?
CAMN S1,ACOPRO+.AEPPN ;YES, NAME BETTER BE FOR THIS PPN
CAIA ;IT IS
JRST CUP.EI ;WRONG. SAY ILLEGAL PPN
MOVE S1,MDBADR ;YES, GET MDB ADDRESS
SKIPE S1,MDB.SD(S1) ;GET SENDER'S PPN
MOVEM S1,ACOPRO+.AEPAP ;UPDATE PROFILE CHANGER'S PPN
$CALL I%NOW ;GET CURRENT UDT
MOVEM S1,ACOPRO+.AETIM ;SET LAST PROFILE CHANGE TIME
SKIPE CUPADD ;IS THIS AN UPDATE?
JRST CUP.A0 ;NO, FINISH UP AN INSERT INSTEAD
PUSHJ P,UPDDSK ;UPDATE THE CURRENT RECORD
JUMPF CKOPR ;RETURN FAILURES APPROPRIATELY
JRST CUP.4 ;LOOP OVER ALL MATCHING PROFILES
CUP.DE: DMOVE S1,ACOPPD ;POINT TO VANISHING USER BY PPN
SKIPE CUPWLD+UW$WST ;ARE WE SEARCHING BY PPN?
DMOVE S1,ACONMD ;NO, USE NAME DESCRIPTOR
PUSHJ P,DELA## ;DELETE FROM FILE "A"
JUMPF CKOPR ;RETURN FAILURES APPROPRIATELY
JRST CUP.4 ;LOOP OVER ALL MATCHING PROFILES
CUP.6: MOVEI T1,CUPWLD ;WILD BLOCK
MOVE T2,[POINT 8,ACOACK] ;WILDCARD ACK BLOCK
PUSHJ P,A$WACK## ;GENERATE THE ACK TEXT
MOVEI T1,CUPWLD ;WILD BLOCK AGAIN
MOVE T2,[POINT 8,ACOACK] ;B.P. TO ACK TEXT
MOVS T4,UW$FND(T1) ;GET XWD SUCCESS,FAILURE
MOVEI T3,[ASCIZ /modified/] ;ASSUME MODIFY DONE
SKIPE CUPDEL ;RIGHT ASSUMPTION?
MOVEI T3,[ASCIZ /deleted/] ;NO, GET RIGHT TEXT
MOVE S1,T3 ;SUMMARY ROUTINE USES WRONG AC
PUSHJ P,A$SWLD## ;GENERATE THE SUMMARY TEXT
SKIPF ;SEE IF OK
INFO (SUM,<^T/(S1)/>,,ACTVXT) ;RESPOND TO USER AND RETURN
FATAL (NSU,<^T/(S1)/>,,ACTVXT) ;GIVE ERROR TO USER
CUPTAB: .AEPSW,,CUP.PW ;NEED A ROUTINE TO MODIFY THE PASSWORD
.AENAM,,CUP.NM ;AND THE NAME
.AEREQ,,CUP.RQ ;AND THE PSW CHANGE INTERVAL
CUPTLN==.-CUPTAB ;LENGTH OF TABLE OF SPECIALS
CUP.AE: PUSHJ P,.SAVE2## ;GET SOME BREATHING ROOM
SETOM ACOPRO+.AEMAP ;START BY DEFAULTING THINGS
MOVE S1,[ACOPRO+.AEMAP,,ACOPRO+.AEMAP+1]
BLT S1,ACOPRO+.AEMAP+.AMPLW-1 ;TURN ON ALL DEFAULTING BITS
MOVEI T1,ACOPRO ;POINT TO PROFILE
SETZ T3, ;SETUP TO CLEAR SOME BITS
MOVSI P1,-.AEMIN ;HOW FAR INTO THE TABLE TO GO
MOVX P2,PD.CND ;CAN-NOT-DEFAULT BIT
CUP.A1: HRRZ T2,P1 ;COPY ENTRY OFFSET
TDNE P2,CHGTAB##(P1) ;CAN THIS ENTRY BE DEFAULTED?
PUSHJ P,A$BMAP## ;NO, FLAG IT IN THE BITMAP
AOBJN P1,CUP.A1 ;LOOP OVER PROFILE ENTRIES
MOVE S1,CUPPPM ;ADDRESS OF NEW PPN BLOCK
MOVE S1,1(S1) ;GET NEW PPN
MOVEM S1,ACOPPN ;SETUP FOR ERROR ROUTINES
MOVEM S1,PPN ;LIKEWISE
MOVEM S1,ACOPRO+.AEPPN ;AND SET IN PROFILE
MOVE S1,[%AECVN,,.AEMIN] ;CURRENT VERSION AND PROFILE SIZE
MOVEM S1,ACOPRO+.AEVRS ;INITIALIZE IN PROFILE BUFFER
MOVE S1,CUPDEF ;GET DEFAULT PPN
MOVEM S1,ACOPRO+.AEDEF ;SET FOR PRODEF
MOVEI S1,ACOPRO ;POINT TO PROFILE
PUSHJ P,PRODEF ;FETCH DEFAULT PROFILE ENTRIES
MOVE S1,PPN ;ENTRY TO BE ADDED
PUSHJ P,A$CKPP## ;GET A DEFAULT NAME
SETCAM TF,CUPRES ;REMEMBER IF IT'S A RESERVED PPN
SKIPN CUPNMM ;IF NONE WAS RECEIVED,
$TEXT (<POINT 8,ACOPRO+.AENAM,-1>,<^T/(S1)/^0>) ;DEFAULT IT
SETOM CUPADD ;REMEMBER THAT WE WANT TO ADD, NOT MODIFY
AOS CUPCHG ;WE DO WANT TO MAKE THE CALL TO ACTRMS
JRST CUP.42 ;MODIFY THE BLOCK, THEN COME BACK
CUP.A0: MOVEI S1,CUPPWB ;THE PROPOSED NEW PASSWORD
MOVEI S2,ACOPRO ;THE PROFILE WE'RE MODIFYING
PUSHJ P,SETPSW## ;SET THE ENCRYPTED PASSWORD IN THE BLOCK
JUMPF CUP.EA ;ENCRYPT FAILED
SKIPN CUPPWM ;WERE WE GIVEN A PASSWORD?
SETOM ACOPRO+.AEPCT ;NO, REQUIRE ONE UPON FIRST LOGIN
SKIPN CUPNMM ;WERE WE GIVEN A NAME?
SKIPE CUPRES ;OR DEFAULT NAME NOT CHANGEABLE?
JRST CUP.A2 ;YES, DON'T NEED TO CREATE ONE
MOVX S2,AE.NCH ;NO, GET NAME-CHANGE BIT
IORM S2,ACOPRO+.AEFLG ;REQUIRE A NEW NAME UPON FIRST LOGIN
CUP.A2: SKIPN CUPPWM ;WERE WE GIVEN A PASSWORD?
JRST CUP.A6 ;NO, CAN'T DO ANY OF THE FOLLOWING
MOVE S1,ACOPRO+.AETIM ;YES, GET LAST PROFILE CHANGE TIME
MOVEM S1,ACOPRO+.AELPC ;SET LAST PASSWORD CHANGE TIME
SKIPE ACOPRO+.AEPCT ;ALREADY HAVE A REQUIRED CHANGE TIME?
JRST CUP.A6 ;YES, DON'T INVENT ONE
LOAD S1,ACOPRO+.AEREQ,AE.PCI ;NO, GET CHANGE INTERVAL
JUMPE S1,CUP.A6 ;GIVE UP IF NO REQULAR CHANGES REQUIRED
MOVSS S1 ;INTERVAL IS SET, CORRECT FOR UDT FORMAT
ADD S1,ACOPRO+.AETIM ;OFFSET FROM CURRENT TIME
MOVEM S1,ACOPRO+.AEPCT ;THEN SETUP BASED ON CHANGE INTERVAL
CUP.A6:
REPEAT 0,< ;FOLLOWING CODE MIGHT BE CUTE, BUT IT'S NOT USEFUL
SKIPN ACOPRO+.AEPNM ;DO WE HAVE A PERSONAL NAME YET?
SKIPN CUPNMM ;CAN'T DO THIS IF DEFAULTED NAME
JRST CUP.A7 ;YES, DON'T DEFAULT ONE
MOVEI T1,ACOPRO ;POINT TO PROFILE
MOVEI T2,.AEPNM ;OFFSET TO TEST
SETO T3, ;CHECKING
PUSHJ P,A$BMAP## ;TEST IF DEFAULTED EMPTY
JUMPF CUP.A7 ;NO, DON'T CHANGE IT
MOVE T1,[POINT 8,ACOPRO+.AENAM] ;YES, POINT TO NAME
SETZ T2, ;INIT COUNT
ILDB T3,T1 ;GET CHAR FROM NAME
SKIPE T3 ;IF NOT AT END,
AOJA T2,.-2 ;KEEP COUNTING ITS LENGTH
IDIVI T2,.AANCW ;MAKE WORD COUNT
SETCA T2, ;NEGATE AND ROUND 'UP'
LDB T3,[POINT 9,@CUPNMM,17] ;GET LENGTH OF NAME BLOCK
MOVNI T3,-1(T3) ;GET MINUS DATA LENGTH
CAMGE T2,T3 ;IN RANGE?
MOVE T2,T3 ;NO, LIMIT OURSELVES
MOVSS T2 ;GET IN RIGHT HALFWORD
HRRI T2,.AEPNM ;FIELD WE WANT TO SET
MOVE T3,CUPNMM ;POINT TO NAME BLOCK
AOS T3 ;DATA FOR FETCHING
MOVEI T1,ACOPRO ;PROFILE TO MODIFY
SETZ T4, ;NOT FROM DEFAULT PROFILE
PUSHJ P,A$EBLK## ;TRY TO GIVE THE USER A MIXED-CASE NAME
> ;END OF REPEAT 0
CUP.A7: MOVEI S1,ACOPRO ;POINT TO NEW PROFILE
PUSHJ P,PUTA## ;FINISH THE CREATE
JUMPF CKOPR ;ANALYZE FAILURE OR ACK SUCCESS
INFO (INS,<User [^O/PPN,LHMASK/,^O/PPN,RHMASK/] inserted>,,ACTVXT)
CUP.EF: FATAL (IFM,<Illegally formatted message>,,ACTVXT)
CUP.E3: PUSHJ P,ERROR3 ;SET THE PRIVILEGE ERROR ACK
PJRST ACTVXT ;THEN DELIVER IT
CUP.EA: MOVE S1,CURALG## ;GET ALGORITHM INDEX
FATAL (EAF,<Encryption algorithm ^O/S1/ failed>,,ACTVXT)
CUP.EP: FATAL (MPR,<Missing password required>,,ACTVXT)
CUP.EL: SKIPE ACOPRV ;PRIVED USER?
PJRST ILLPSW ;YES, GO ADMIT TO BAD PASSWORD
PUSHJ P,LOGUSR ;LOG INITIAL USER STUFF
$TEXT (LOGFAI,<^O6R0/ACOPPN,LHMASK/^O6R0/ACOPPN,RHMASK/>)
PUSHJ P,FAIOUT ;FLUSH THE BUFFERS
PUSHJ P,UPDDSK ;RECORD THE VALIDATION FAILURE ON DISK
PJRST CUP.EI ;PRETEND IT WAS AN ILLEGAL PPN
CUP.EE: FATAL (PTF,<Profile is too full; user ^U/ACOPPN/>,,ACTVXT)
CUP.EW: FATAL (PLL,<Password length is less than ^D/S1/ characters>,,ACTVXT)
CUP.CW: PUSHJ P,.SAVE4## ;PRESERVE ALL ACS USED
DMOVE P3,S1 ;COPY POINTERS
CUP.C1: SKIPGE P3 ;IF STILL A BASE WORD,
SKIPA P1,(P3) ;THEN USE IT,
SETZ P1, ;ELSE FETCH ZERO
SKIPGE P4 ;SIMILARLY WITH
SKIPA P2,(P4) ;THE MESSAGE DATA
SETZ P2, ;FETCH WORD OR ZERO
CAME P1,P2 ;ARE THEY THE SAME?
JRST .POPJ1 ;NOPE, FLAG DIFFERENT
AOBJP P3,.+1 ;ADVANCE POINTER
AOBJN P4,CUP.C1 ;LOOP OVER ALL WORDS
JUMPL P3,CUP.C1 ;UNTIL BOTH POINTERS GIVE OUT
POPJ P, ;THE BLOCKS ARE THE SAME IF WE GET HERE
CUP.CD: MOVEI S1,(T1) ;COPY ENTRY OFFSET
IDIVI S1,^D36 ;GET WORD & BIT NUMBERS
MOVNS S2 ;GET SHIFT OFFSET
MOVSI T4,(1B0) ;GET BIT TO SHIFT
LSH T4,(S2) ;MAKE BIT TO TEST
TDNN T4,ACOPRO+.AEMAP(S1) ;IS THIS FIELD ALREADY DEFAULTED?
AOS (P) ;SKIP IF NOT
POPJ P, ;RETURN RESULT
CUPSTR: ILDB S1,T3 ;GET A SOURCE BYTE
JUMPE S1,.POPJ ;DONE AT END OF ASCIZ
IDPB S1,T1 ;STUFF A DESTINATION BYTE
SOJG T2,CUPSTR ;UNTIL EOS OR FULL BLOCK
POPJ P, ;THEN RETURN
CUPMEM:! ;BEGINNING OF UGCUP$-SPECIFIC STORAGE
CUPPWB: BLOCK .APWLW ;SPACE FOR A PASSWORD BLOCK
CUPWLD: BLOCK PAGSIZ ;SPACE FOR A WILDCARDING BLOCK
CUPSEL: BLOCK 1 ;CURRENT ALLOCATION OF SELECT BLOCKS
CUPADD: BLOCK 1 ;FLAG FOR CALLING PUTA RATHER THAN UPDA
CUPDEF: BLOCK 1 ;MODIFIED VALUE OF .AEDEF
CUPRES: BLOCK 1 ;FLAG FOR INSERTING RESERVED PROFILE
CUPDEL: BLOCK 1 ;FLAG FOR WHETHER ENTRY SHOULD BE DELETED
CUPPPN: BLOCK 1 ;POINTER TO SELECT BLOCK FOR PPN
CUPPPM: BLOCK 1 ;POINTER TO MODIFY BLOCK FOR PPN
CUPNAM: BLOCK 1 ;POINTER TO SELECT BLOCK FOR NAME
CUPNMM: BLOCK 1 ;POINTER TO MODIFY BLOCK FOR NAME
CUPPWD: BLOCK 1 ;POINTER TO SELECT BLOCK FOR PASSWORD
CUPPWM: BLOCK 1 ;POINTER TO MODIFY BLOCK FOR PASSWORD
CUPVRS: BLOCK 1 ;FLAG FOR WHETHER VERSION CHANGE WAS SEEN
CUPMFC: BLOCK 1 ;MODIFIABLE FIELD COUNT
CUPCHG: BLOCK 1 ;FLAG FOR WRITING OUT ACOPRO
CUPZND==.-1 ;LAST WORD TO ZERO ON UGCUP$
CUPCNT: BLOCK 1 ;MEMORY OF QUECNT
CUPLIS: BLOCK 1 ;MEMORY OF QUEBLK
CKOPR: JUMPT ACTVXT ;JUMP IF OK
MOVEI S1,3 ;IT DID NOT, SEE WHY
PUSHJ P,OPTA## ;GET STATUS OF FILE "A"
CAIE S1,ER$RNF## ;RECORD NOT FOUND?
FATAL (RMS,<Unexpected RMS error ^O6R0/S1/>,,ACTVXT)
CUP.EI: FATAL (ILP,<Illegal PPN [^O/PPN,LHMASK/,^O/PPN,RHMASK/]>,,ACTVXT)
;FIXUP REQUIRED PASSWORD CHANGE BITS
FIXPCR: $SAVE P1 ;SAVE AN AC
MOVE P1,S1 ;SAVE ADDRESS OF RECORD BUFFER
$CALL I%NOW ;GET CURRENT UDT
CAML S1,.AEPCT(P1) ;PERHAPS A REQUIRED CHANGE?
SETZM .AEPCT(P1) ;YES, CLEAR THE UT
MOVEM S1,.AELPC(P1) ;SAVE LAST PASSWORD CHANGE
LOAD S1,.AEREQ(P1),AE.PCI ;GET CHANGE INTERVAL
MOVSS S1 ;CORRECT FOR UDT FORMAT
ADD S1,.AELPC(P1) ;ADJUST CHANGE TIME BY INTERVAL
CAMLE S1,.AELPC(P1) ;IF INTERVAL IS PRESENT,
MOVEM S1,.AEPCT(P1) ;SETUP NEW REQUIRED CHANGE TIME
MOVX S1,1B<.AEPCT-<<.AEPCT/36>*36>> ;GET DEFAULT BIT
ANDCAM S1,.AEMAP+.AEPCT/^D36(P1) ;CLEAR IT, SINCE CHANGED VALUE
POPJ P,
;ROUTINE TO HANDLE SELECTION ON .AEAUX
;CALL: P1/ WILD BLOCK ADDRESS
; P2/ SELECTION BLOCK ADDRESS
; P3/ PROFILE BUFFER ADDRESS
UGAUX%::LDB T1,[POINT 9,(P2),17] ;NUMBER OF WORDS IN BLOCK
SOJLE T1,.RETF ;OFFSET FOR ONLY DATA WORDS
MOVNS T1 ;MAKE MINUS DATA LENGTH
MOVSS T1 ;IN LH FOR AOBJN
HRRI T1,1(P2) ;POINTER TO REQUESTOR'S DATA
MOVE T2,.AEAUX(P3) ;RELATIVE POINTER TO PROFILE DATA
ADDI T2,(P3) ;DE-RELATIVIZE IT
UGAUX1: MOVE T3,T2 ;GET WORKING COPY OF PROFILE POINTER
MOVE T4,.AUSTR(T1) ;AND CURRENT NAME TO MATCH
UGAUX2: CAMN T4,.AUSTR(T3) ;FOUND START OF SUBSTRING?
JRST UGAUX3 ;YES, PROCESS THE LIST
ADD T3,[.AULEN-1,,.AULEN-1] ;UPDATE FOR MULTI-WORD ENTRIES
AOBJN T3,UGAUX2 ;KEEP LOOKING THROUGH SEARCH LIST
LOAD T1,(P2),AF.SEL ;GET SELECTION TYPE
CAIN T1,.AFNOT ;ONLY SUCCEED
AOS (P) ;IF A 'NOT' BLOCK
POPJ P, ;RETURN THE DECISION
UGAUX3: MOVE T4,T1 ;COPY SEARCH POINTER
UGAUX4: MOVE T2,(T4) ;GET NEXT SEARCH WORD
CAMN T2,[-1] ;IS IT A DON'T CARE?
JRST UGAUX5 ;YES, IT SUCCEEDS
MOVE T1,(T3) ;NO, FETCH WORD FROM PROFILE
PUSHJ P,CMPINS## ;CHECK FOR MATCH
POPJ P, ;PROPAGATE FAILURE
UGAUX5: AOBJP T4,.POPJ1 ;SUCCEED IF END OF MATCH LIST
AOBJN T3,UGAUX4 ;KEEP SEARCHING
POPJ P, ;FAIL IF PROFILE LIST RUNS OUT FIRST
ACTPSW: SKIPN QUEFLG ;ONLY DEFINED FROM QUEUE. UUO
JRST [$CALL C%REL ;WASN'T, RELEASE MESSAGE
$RETT] ;AND IGNORE IT
$CALL M%GPAG ;GET A PAGE FOR THE RESPONSE MESSAGE
MOVEM S1,SABADR ;STORE THE ADDRESS OF THE PAGE/PACKET
PUSHJ P,CVTWLD ;CONVERT TO WILDCARD BLOCK (S2 GETS ADDR)
MOVEI S1,ACOPRO ;WHERE TO READ THE RECORD
PUSHJ P,PROFIL ;FETCH PROFILE
JUMPF ACTACA ;NO SUCH USER
MOVEI S2,ACOPRO ;POINT TO THE RETURNED PROFILE
MOVE S1,.AEPPN(S2) ;GET THE PPN
MOVEM S1,ACOPPN ;SAVE IN PPN PLACE
ACTPS0: MOVEI S1,ACOPSW ;POINT AT THE PASSWORD
MOVEI S2,ACOPRO ;RECORD HE WANTS TO CHECK
$CALL CHKPSW## ;CHECK THE PASSWORD, PLEASE
MOVEI S1,ACOPRO ;POINT TO THIS PROFILE
PUSHJ P,FIXVLD ;UPDATE VALIDATION STATUS
JUMPT ACTPS1 ;IT'S GOOD, CONTINUE
PJRST ILLPSW ;REPORT INVALID PASSWORD AND RETURN
ACTPS1: JRST ACTVXX ;AND RETURN
SUBTTL LOCK/UNLOCK USER ACCOUNT FILE
ACTLOK: TDZA S1,S1 ;INDICATE ENTRY
ACTUNL: SETOM S1
SKIPN QUEFLG ;ONLY DEFINED FROM QUEUE. UUO
PJRST C%REL ;WASN'T, RELEASE THE MESSAGE
MOVE T1,S1 ;SAVE ENTRY INDICATOR
$CALL M%GPAG ;GET A PAGE FOR THE RESPONSE MESSAGE
MOVEM S1,SABADR ;STORE THE ADDRESS OF THE PAGE/PACKET
JUMPL T1,UNLOCK ;JUMP IF UNLOCK FUNCTION
SKIPN ACTLCK## ;ALREADY LOCKED?
JRST LOCK ;NO, GO DO IT
FATAL (FAL,<File already locked>,,ACTVXT)
LOCK: PUSHJ P,CLSA## ;CLOSE FILE "A"
JUMPF LOCK.1 ;CHECK FOR ERRORS
MOVEI S1,ACCTFN ;GET ADDRESS OF FILENAME FOR RMS
MOVEI S2,0 ;READ-ONLY
PUSHJ P,OPNA## ;OPEN FILE "A" FOR INPUT
JUMPF LOCK.1 ;CAN'T GO OPEN REGULAR (TRY ANYWAY)
SETOM ACTLCK## ;FLAG FILE IS LOCKED
PJRST ACTVXT ;RETURN
LOCK.1: MOVEI S1,3 ;OPTION CODE
PUSHJ P,OPTA## ;GET STATUS FOR FILE "A"
PUSH P,S1 ;SAVE ERROR CODE
MOVEI S1,ACCTFN ;GET FILENAME ADDRESS
MOVEI S2,1 ;WANT TO WRITE THE FILE
PUSHJ P,OPNA## ;OPEN FILE "A" FOR I/O
JUMPT LOCK.2 ;GO COMPLAIN ABOUT PREVIOUS ERROR
MOVEI S1,3 ;UNLESS THIS FAILS TOO--GET OPTION CODE
PUSHJ P,OPTA## ;GET STATUS FOR FILE "A"
MOVEM S1,(P) ;SAVE
LOCK.2: POP P,S1 ;GET RMS ERROR CODE BACK
FATAL (RMS,<Unexpected RMS error ^O6R0/S1/>,,ACTVXT)
UNLOCK: SKIPN ACTLCK## ;FILE LOCKED?
FATAL (FNL,<File not locked>,,ACTVXT)
PUSHJ P,CLSA## ;CLOSE FILE "A"
JUMPF UNLO.2 ;CHECK FOR ERRORS
MOVEI S1,ACCTFN ;GET FILENAME ADDRESS
MOVEI S2,1 ;WANT TO WRITE THE FILE
PUSHJ P,OPNA## ;OPEN FILE "A" FOR I/O
JUMPF UNLO.2
SETZM ACTLCK## ;FLAG FILE IS NOW UNLOCKED
PJRST ACTVXT ;RETURN
UNLO.2: MOVEI S1,3 ;IT DID NOT, SEE WHY
PUSHJ P,OPTA## ;GET STATUS FOR FILE "A"
FATAL (RMS,<Unexpected RMS error ^O6R0/S1/>,,ACTVXT)
ACTSCD: SKIPN QUEFLG ;ONLY DEFINED FROM QUEUE. UUO
PJRST C%REL ;WASN'T, RELEASE THE MESSAGE
$CALL M%GPAG ;GET A PAGE FOR THE RESPONSE MESSAGE
MOVEM S1,SABADR ;STORE THE ADDRESS OF THE PAGE/PACKET
PUSHJ P,A$DSCD## ;DELETE SCDMAP.SYS DATA
SKIPF
PUSHJ P,A$ISCD## ;INITIALIZE CLASS SCHEDULER MAPPING
JUMPT ACTVXT ;JUMP IF OK
FATAL (SMF,<Class scheduler mapping failed>,,ACTVXT)
;ROUTINE TO UPDATE VALIDATION TIME AND FAILURE BIT
FIXVLD: $SAVE P1 ;FOR THE BUFFER ADDRESS
MOVE P1,S1 ;SAVE WHAT WE'RE UPDATING
SKIPF ;SKIP IF FAILED
SKIPA S2,[ANDCAM S1,.AEFLG(P1)] ;GET INSTR TO CLEAR AE.FAI
MOVE S2,[IORM S1,.AEFLG(P1)] ;GET INSTR TO SET AE.FAI
PUSH P,TF ;SAVE STATUS ON STACK
MOVX S1,AE.FAI ;GET FAILURE TIME VALID BIT
XCT S2 ;DO THE DESIRED OPERATION
$CALL I%NOW ;GET CURRENT UDT
MOVEM S1,.AEFAI(P1) ;SAVE IT ALSO
POP P,TF ;RESTORE STATUS
$RET
SUBTTL ACTMAP - PERFORM USER PPN/NAME MAPPING
ACTMAP: PUSHJ P,.SAVE2 ;SAVE P1 AND P2
PUSHJ P,M%GPAG ;GET A PAGE FOR THE RESPONSE MESSAGE
MOVEM S1,SABADR ;STORE THE ADDRESS OF THE PAGE/PACKET
PUSHJ P,MAPLGL ;CHECK FOR A LEGAL MESSAGE FORMAT
JUMPF ACTVXT ;ACK USER ON ERRORS
ACTMA1: PUSHJ P,MAPWLD ;BUILD WILDCARD BLOCK
MOVEI S1,ACOPRO ;WHERE TO READ THE RECORD
MOVEI S2,(P2) ;POINT TO WILDCARD BLOCK
PUSHJ P,GETA## ;FETCH PROFILE FROM FILE "A"
JUMPF ACTMA4 ;JUMP IF NO SUCH USER
MOVE T1,ACOPRO+.AEPPN ;GET PPN
MOVEM T1,TMPMAP+UU$PPN ;SAVE
MOVE T1,[ACOPRO+.AENAM,,TMPMAP+UU$NAM] ;SET UP BLT
BLT T1,TMPMAP+UU$LEN-1 ;SAVE NAME IN TEMPORARY STORAGE
SKIPE T1,UW$WST(P2) ;A PPN?
CAIN T1,2 ;OR NON-WILD NAME?
JRST ACTMA3 ;YES--NO AMBIGUITY EXISTS
MOVEI T1,TMPMAP+UU$NAM ;POINTER TO RETURNED NAME
HRLI T1,(POINT 8) ;FOR LOADING
SETZ T2, ;TO COUNT CHARACTERS
ACTMA2: ILDB T3,T1 ;GET NEXT CHARACTER
SKIPE T3 ;STOP AT END OF NAME
AOJA T2,ACTMA2 ;LOOP OVER ALL CHARACTERS
CAMN T2,TMPLEN ;NAMES OF THE SAME LENGTH?
JRST ACTMA3 ;YES, THEY ARE IDENTICAL (EXCEPT FOR CASE?)
MOVEI S1,ACOPRO ;WHERE TO READ THE RECORD
MOVEI S2,(P2) ;POINT TO WILDCARD BLOCK
PUSHJ P,GETA## ;FETCH PROFILE FROM FILE "A"
JUMPT ACTMA4 ;JUMP IF AMBIGUOUS NAME GIVEN
ACTMA3: MOVSI T1,TMPMAP ;POINT TO TEMPORARY STORAGE
HRRI T1,(P1) ;AND TO DESTINATION
BLT T1,UU$LEN-1(P1) ;COPY
ACTMA4: ADDI P1,UU$LEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN P1,ACTMA1 ;ONTO THE NEXT MAPPING BLOCK
MOVNI T1,4 ;GET A -4 (NOT REALLY AN ERROR NUMBER)
PUSHJ P,ERRPRO ;GENERATE "ERROR" -4 (MOVE MAPPING INFO)
PJRST ACTVXT ;FINISH RESPONSE TO QUEUE. AND RETURN
; CHECK FOR LEGAL MAPPING MESSAGE FORMAT
MAPLGL: MOVE P1,MMSADR ;POINT TO MESSAGE
MOVE T1,UU$ACK(P1) ;GET THE ACK CODE
MOVEM T1,ACKCOD ;SAVE
SKIPN QUEFLG ;QUEUE UUO?
JRST MAPLG2 ;NO
SETZM QUEBLK ;RESET POINTER TO SCAN FROM BEGINING
MOVE T1,MMSADR ;POINT TO MESSAGE
MAPLG1: PUSHJ P,GETBLK ;GET A BLOCK
SKIPT ;CHECK FOR ERRORS
FATAL (PEM,<Premature end of mapping message block>,,.RETF)
CAIE T1,.QBAET ;START OF INTERESTING DATA?
JRST MAPLG1 ;NOT YET
MOVEI P1,UU$MAP(T3) ;POINT TO START OF ACTUAL DATA
MAPLG2: MOVEM P1,ACOMAP ;SAVE ADDRESS
SKIPN T1,UU$CNT(T3) ;GET COUNT OF MAPPING BLOCKS
FATAL (MBZ,<Mapping block count is zero>,,.RETF)
MOVEM T1,TMPCNT ;SAVE FOR ERRMAP
MOVNS T1 ;NEGATE
HRL P1,T1 ;MAKE AN AOBJN POINTER
MOVE P2,P1 ;COPY MESSAGE POINTER
MAPLG3: HRRZ T1,P2 ;GET CURRENT MAPPING BLOCK ADDRESS
SUB T1,ACOMAP ;COMPUTE OFFSET INTO MESSAGE
IDIVI T1,UU$LEN ;GET BLOCK NUMBER
SKIPN UU$PPN(P2) ;HAVE A PPN?
SKIPE UU$NAM(P2) ;OR A NAME?
SKIPA ;YES TO EITHER
FATAL (MBF,<Mapping block format error; block = ^D/T1/>,,.RETF)
ADDI P2,UU$LEN-1 ;ACCOUNT FOR MULTI-WORD ENTRIES
AOBJN P2,MAPLG3 ;CHECK THE NEXT BLOCK
$RETT ;RETURN
; BUILD WILDCARD MESSAGE
MAPWLD: MOVEI P2,ACOWLD ;POINT TO INTERNAL WILDCARD BLOCK
MOVSI T1,0(P2) ;START ADDRESS
HRRI T1,1(P2) ;MAKE A BLT POINTER
SETZM (P2) ;CLEAR FIRST WORD
BLT T1,UW$MIN-1(P2) ;CLEAR ENTIRE BLOCK
MOVSI T1,UW$MIN ;LENGTH
HRRI T1,UGWLD$ ;FUNCTION CODE
MOVEM T1,UW$TYP(P2) ;SAVE
SKIPN T1,UU$PPN(P1) ;HAVE A PPN?
JRST MAPWL1 ;NO--A NAME
MOVEM T1,UW$PPN(P2) ;SAVE IN WILDCARD BLOCK
SETOM UW$PPM(P2) ;NON-WILD MASK
POPJ P, ;RETURN
MAPWL1: MOVEI T1,UU$NAM(P1) ;POINT TO NAME
HRLI T1,(POINT 8,) ;8-BIT ASCIZ
MOVEI T2,UW$NAM(P2) ;POINT TO STORAGE
HRLI T2,(POINT 8,) ;8-BIT ASCIZ
MOVSI T3,-.AANLC ;LENGTH IN CHARACTERS
MAPWL2: ILDB T4,T1 ;GET A CHARACTER
JUMPE T4,MAPWL4 ;DONE?
IDPB T4,T2 ;PUT A CHARACTER
TRZE T3,1B19 ;WAS PREVIOUS CHARACTER A QUOTE?
JRST MAPWL3 ;YES, DON'T DAMAGE THIS ONE
CAIE T4,"*" ;NO, CHECK FOR WILDCARD
CAIN T4,"?" ;OF EITHER TYPE
TRO T3,1B18 ;YES, REMEMBER IT
CAIE T4,.CHCNV ;OR IS IT THE MAGIC QUOTE CHARACTER?
JRST MAPWL3 ;NO, DON'T FUDGE FOR IT
TRO T3,1B19!1B20 ;YES, FLAG FOR NEXT TIME AROUND
SOS T3 ;DON'T COUNT CHARACTER AGAINST MATCH LENGTH
MAPWL3: AOBJN T3,MAPWL2 ;LOOP
MOVEI T1,2 ;CODE
MOVEM T1,UW$WST(P2) ;SET WILDCARD SEARCH TYPE TO NON-WILD NAME
POPJ P, ;RETURN
MAPWL4: TRZ T3,1B20 ;JUST IN CASE IT'S STILL ON
HRRZM T3,TMPLEN ;SAVE LENGTH OF NAME
MOVEI T4,"*" ;MAKE A WILD NAME
IDPB T4,T2 ;STORE CHARACTER
MOVEI T1,1 ;CODE
MOVEM T1,UW$WST(P2) ;SET WILDCARD SEARCH TYPE TO WILD NAME
POPJ P, ;RETURN
SUBTTL ACTWLD - GET PROFILE FOR POSSIBLY WILDCARDED PPN/NAME
ACTWLD: PUSHJ P,M%GPAG ;GET A PAGE FOR THE RESPONSE MESSAGE
MOVEM S1,SABADR ;STORE THE ADDRESS OF THE PAGE/PACKET
MOVE S2,MMSADR ;POINT TO MESSAGE
SKIPN QUEFLG ;FROM A QUEUE. UUO?
PJRST ACTOU0 ;NO CONVERSION NECESSARY
SETZM QUEBLK ;RESET POINTER TO SCAN FROM BEGINING
MOVE T1,MMSADR ;POINT TO MESSAGE
ACTWL1: PUSHJ P,GETBLK ;GET A BLOCK
JUMPF ACTWL2 ;CHECK FOR PREMATURE END OF MESSAGE
CAIE T1,.QBAET ;START OF INTERESTING DATA?
JRST ACTWL1 ;NOT YET
MOVE S2,T3 ;POINT TO DATA
PJRST ACTOU0 ;GO ENTER COMMON CODE
ACTWL2: FATAL (ILP,<Illegal PPN [^O/S1,LHMASK/,^O/S1,RHMASK/]>,,ACTVXT)
SUBTTL ACTVER - COMMON SUBROUTINES
;CHKPRJ - ROUTINE TO VERIFY ACCOUNT IN PROJCT.SYS.
;CALL: PUSHJ P,CHKPRJ
; RETURN HERE - NO FATAL ERRORS DETECTED
CHKPRJ: PUSHJ P,CHKCOM ;DO COMMON STUFF TO GET POSITIONED
JUMPF .POPJ ;WHOOPS, SOME ERROR TO RETURN TO THE USER
PJRST VERIFY ;DO VALIDATION
;CHKDEF - ROUTINE TO SEE IF DEFAULT ACCOUNT STRING EXISTS IN PROJCT.SYS
;CALL: PUSHJ P,CHKDEF
; RETURN HERE - NO FATAL ERROR DETECTED
CHKDEF: PUSHJ P,CHKCOM ;DO COMMON STUFF TO GET POSITIONED
JUMPF .POPJ ;WHOOPS, SAY NO DEFAULT EXISTS
PJRST FNDDEF ;GO FIND DEFAULT AND RETURN
;CHKCOM - PERFORM COMMON POSITIONING FOR CHKPRJ AND CHKDEF
CHKCOM: PUSHJ P,PRJRED ;LOOKUP PROJCT.SYS
JUMPF .POPJ ;IF NON-FATAL ERROR, MESSAGE IS ALREADY IN IPCF MESSAGE
PUSHJ P,BLDPRJ ;SEE IF WE NEED TO BUILD THE TABLE
JUMPF .POPJ ;IF NON-FATAL ERROR, MESSAGE IS ALREADY IN IPCF MESSAGE
PJRST SEARCH ;SEARCH PROJCT.SYS FOR BLOCK CONTAINING PPN
;CHKACT - ROUTINE TO LOOK IN ACTDAE.SYS.
; AND SEE IF THE USER IS REQUIRED TO HAVE AN ACCOUNT WHEN A NULL ACCOUNT
; HAS BEEN GIVEN IN THE IPCF MESSAGE. IF HE IS, GIVE HIM AN INVALID
; ACCOUNT ERROR MESSAGE.
;CALL: PUSHJ P,CHKACT
; RETURN HERE
CHKACT: MOVE T1,PPN ;GET PPN
PUSHJ P,GETPRO ;DO COMMON STUFF TO FIND PPN IN ACTDAE.SYS
JUMPF .RETT ;ASSUME ACCOUNT STRING IS NOT REQUIRED
MOVE T1,.AEREQ(T1) ;GET USER'S REQUIREMENT WORD
TXNN T1,AE.ACT ;IS AN ACCOUNT REQUIRED FOR THIS PPN?
$RETT ;NO. PRETEND NULL ACCOUNT IS VALID
INVPPN: SKIPA S2,.AEPPN(T1) ;GET PPN FROM PROFILE
INVACC: MOVE S2,PPN ;GET PPN FROM LOW CORE
PUSH P,S2 ;SAVE PPN
PUSHJ P,LOGUSR ;LOG THE ERROR
$TEXT (LOGFAI,<^O6R0/PPN,LHMASK/^O6R0/PPN,RHMASK/>) ;DEPENDENT INFO
PUSHJ P,FAIOUT ;WRITE OUT TO THE FAILURE LOG
POP P,S2 ;GET PPN BACK
MOVE S1,DATADR ;GET ADDRESS OF DATA
ADDI S1,UV$ACT ;BEGINNING ADDRESS OF ACCOUNT TO BE VALIDATED
FATAL (IVA,<Invalid account "^T/(S1)/ for ^U/S2/>,,.RETF)
;BLDPRJ - ROUTINE TO SEE IF PROJCT.SYS HAS DATA AND TO DETERMINE IF
; THE IN-CORE TABLE NEEDS TO BE REBUILT. IF NOT, JUST RETURN.
; OTHERWISE, REBUILD TABLE AND RETURN.
;CALL: PUSHJ P,BLDPRJ
; RETURN HERE ALWAYS. IF THERE'S AN ERROR, JRST TO AN ERROR ROUTINE
BLDPRJ: SKIPN T1,PROJCT+.RBSIZ ;IS THERE DATA IN PROJCT.SYS?
$BOMB <ACTNDA No data in PROJCT.SYS -- cannot validate>
MOVE T1,PROJCT+.RBTIM ;GET THE CREATION DATE
EXCH T1,Z.DATE ;STORE NEW, GET OLD
CAMN T1,Z.DATE ;HAS IT CHANGED?
$RETT ;NO, WE HAVE THE CURRENT FILE IN-CORE
SETZM BLKNUM ;FORCE READ OF DISK
MOVNI T1,200 ;SET LENGTH = 200 WORDS
MOVEM T1,PRJIOW ;FOR INITIAL READ OF INFORMATION BLOCK
MOVEI T1,1 ;READ THE FILE/DATA INFORMATION BLOCK
MOVEM T1,PRJMUL ;SET LOG TO PHYS MULTIPLIER TO 1 ALSO
MOVEM T1,PRJCON ;CONSTANT TOO SO THAT LOGICAL 1 = PHYSICAL 1
PUSHJ P,READ
SKIPT
$BOMB <ACTUXE Unexpected EOF in PROJCT.SYS when reading first block>
MOVE T1,PRJBUF+A.VERS ;CHECK THE VERSION NUMBER
CAIE T1,1 ;WE SPEAK VERSION 1
CAIN T1,2 ;AND VERSION 2 FORMATS
CAIA ;ONE OF THE ABOVE
$BOMB <ACTVSP Version skew of PROJCT.SYS>
MOVEM T1,PRJVRS ;SAVE FOR LATER CHECKS
MOVEI T2,2 ;CONSTANT = 2 FOR BLOCK CONVERSION
CAIN T1,1 ;UNLESS VERSION 1 FORMAT
MOVEI T2,1 ;THEN CONSTANT = 1
MOVEM T2,PRJCON ;STORE FOR LATER COMPUTATION
SKIPN T1,PRJBUF+A.WPBL ;GET WHAT PROJCT.EXE THINKS IS PRJWPB
MOVEI T1,200 ;OLD PROJCT.SYS WAS WRITTEN AT 200 WORDS PER
CAILE T1,PRJWPB ;ALWAYS OK IF WE KNOW ABOUT LARGER FORMATS
$BOMB <ACTPTS PRJWPB too small for whats in PROJCT.SYS>
MOVNM T1,PRJIOW ;SAVE - WORD COUNT FOR READING BLOCKS
LSH T1,-7 ;CONVERT TO REAL DISK BLOCKS PER LOGICAL ONE
MOVEM T1,PRJMUL ;SAVE MULTIPLIER FOR LOG TO PHYS CONVERSION
;FALL INTO BUILD TABLE ROUTINE
BLDPR1: SKIPN T1,PRJBUF+A.TLEN ;GET LENGTH OF TABLE
$RETT ;NULL TABLE, ASSUME [*,*]=*
CAMG T1,Z.TLEN ;IS THE TABLE LARGER THAN BEFORE?
JRST [MOVEM T1,Z.TLEN
JRST BLDPR3] ;NO. DON'T NEED MORE CORE. STORE LENGTH
SKIPN S2,Z.TADR ;HAVE WE BUILT THE TABLE BEFORE?
JRST BLDPR2 ;NO. JRST BUILD IT
MOVE S1,Z.TLEN ;THE SIZE OF CORE BLOCK TO GIVE UP
$CALL M%RMEM ;GET RID OF THE OLD TABLE
BLDPR2: MOVEM T1,Z.TLEN ;STORE LENGTH OF NEW TABLE
MOVE S1,T1 ;LENGTH OF NEW TABLE
$CALL M%GMEM ;GET ENOUGH CORE TO FIT THE NEW TABLE
MOVEM S2,Z.TADR ;SAVE THE BEGINNING ADDRESS
BLDPR3: MOVE T1,PRJBUF+A.FBLK ;GET BLOCK NUMBER NUMBER OF THE TABLE
SUBI T1,1 ;BACK OFF TO PREVIOUS BLOCK
MOVEM T1,LSTBLK ;AND STORE AS LAST BLOCK CONTAINING DATA
MOVE T1,Z.TADR ;READ TABLE INTO LOW SEGMENT
SUBI T1,1
MOVN T2,Z.TLEN
HRL T1,T2
MOVEM T1,IOLIST ;SET UP COMMAND LIST FOR READING TABLE
SETZM IOLIST+1
MOVE T1,PRJBUF+A.FBLK ;GET THE BLOCK # OF THE TABLE
SUB T1,PRJCON ;COMPUTE READ DISK BLOCK NUMBER
IMULI T1,@PRJMUL ;AS ((LOGICAL-CONSTANT)*MULTIPLIER)+CONSTANT
ADD T1,PRJCON ;...
MOVE T2,PRJCHN ;AND THE CHANNEL (STORED IN LH(PRJCHN))
PUSHJ P,AUSETI ;POSITION TO THE BLOCK #
SKIPT
$BOMB <ACTCUJ Cannot USETI to PROJCT.SYS block containing index table>
MOVEI T1,.FOINP ;INPUT
HLL T1,PRJCHN ;CHANNEL #
TXO T1,FO.PRV ;ALLOW FULL FILE ACCESS TO SYS:
MOVEM T1,PRJBLK+.FOFNC
MOVEI T1,IOLIST ;I/O LIST
MOVEM T1,PRJBLK+.FOIOS
MOVE T1,[2,,PRJBLK]
FILOP. T1,
SKIPA ;ERROR
$RETT ;RETURN OK
TXNE T1,IO.EOF ;IS AN END OF FILE?
$RETF ;YES.
$BOMB <ACTRFI Cannot read (^O/T1/) file information block of PROJCT.SYS>
;SEARCH - SEARCH THE TABLE FOR THE GIVEN PPN, READ IT IN
;CALL: PUSHJ P,SEARCH
; ONLY RETURN. IF ERROR, JRST TO THE ERROR ROUTINE
SEARCH: MOVE T4,PPN ;GET THE PPN TO VALIDATE FOR
MOVE T2,Z.TLEN ;GET LENGTH OF TABLE
MOVE T3,Z.TADR ;INITIALIZE ADDRESS
HLRZ T1,1(T3) ;GET POSSIBLE BLOCK NUMBER FOR ENTRY
CAMLE T4,(T3) ;IS IT IN THE FIRST BLOCK
SEARC1: CAMN T4,(T3) ;SAME AS FIRST PPN IN BLOCK
JRST SEARC2 ;GO SEARCH THIS BLOCK
CAMG T4,(T3) ;IS IT IN PREVIOUS BLOCK
SOJA T1,SEARC2 ;YES, GO SEARCH THAT BLOCK
ADDI T3,2 ;DOUBLE WORD ENTRIES
HLRZ T1,1(T3) ;GET BLOCK NUMBER FOR THIS ENTRY
SOS T2 ;BACK OFF THE LENGTH OF THE TABLE
SOJG T2,SEARC1 ;AND LOOK SOME MORE
MOVE T1,LSTBLK ;IF NOT FOUND, MUST BE IN THE LAST BLOCK
SEARC2: PUSHJ P,READ ;READ IT IN
JUMPT .POPJ
$BOMB <ACTUEP Unexpected EOF in PROJCT.SYS when searching for ^P/PPN/>
;VERIFY - ROUTINE TO VALIDATE IF THE GIVEN PPN CAN USE THE GIVEN
; ACCOUNT STRING
;CALL: PUSHJ P,VERIFY
; ONLY RETURN. IF AN ERROR, JRST TO ERROR ROUTINE
VERIFY: PUSHJ P,.SAVE4 ;SAVE P1-P4
MOVEI P2,BLKOFS ;GET THE WORD # OF FIRST ENTRY
MOVE S1,DATADR ;GET ADDRES OF THE VALIDATION MESSAGE
MOVEI S1,UV$ACT(S1) ;OFFSET INTO MESSAGE FOR ACCOUNT STRING
PUSHJ P,SYNCHK ;CHECK FOR AN ACCOUNT STRING SYNONYM IF ANY
IFN FTCASECONVERT,< ;IF CONVERTING LOWER TO UPPER
MOVE T1,DATADR ;GET THE ADDRESS OF THE VALIDATION MESSAGE
MOVEI T1,UV$ACT(T1) ;OFFSET INTO MESSAGE FOR ACCOUNT STRNG
HRLI T1,(POINT 7,0) ;MAKE A BYTE POINTER TO THE GIVEN ACCOUNT
MOVEI T2,.AACLC ;NUMBER OF CHARACTERS IN ACCOUNT STRING
VERIF0: ILDB T3,T1 ;GET A CHARACTER
JUMPE T3,VERIF1 ;QUIT AT END OF STRING
CAIG T3,"Z"+" " ;CHECK IF LOWER CASE LETTER
CAIGE T3,"A"+" " ;...
JRST VERIF5 ;NOT LOWER CASE LETTER
SUBI T3," " ;CONVERT TO UPPER CASE
DPB T3,T1 ;STORE BACK IN ACCOUNT STRING
VERIF5: SOJG T2,VERIF0 ;CONTINUE FOR ALL CHARACTERS
>
VERIF1: MOVE P1,PPN ;GET THE PPN WE'RE VEIFYING FOR AGAIN
XOR P1,PRJBUF+PPNOFS(P2) ;GET THE PPN IN THE ENTRY
AND P1,PRJBUF+PPNOFS+1(P2) ; AND THE WILD CARD MASK
JUMPE P1,VERIF2 ;HAVE WE FOUND A MATCH?
HLRZ T1,PRJBUF(P2) ;SET UP TO LOOK AT NEXT PPN ENTRY BY
ADD P2,T1 ; GETTING RIGHT OFFSET INTO THE BLOCK
CAMGE P2,PRJBUF ;ARE THERE ANY MORE ENTRIES?
JRST VERIF1 ;YES. KEEP SEARCHING
PUSHJ P,READNX ;READ NEXT BLOCK LOOKING FOR WILD CARDING
SKIPT ;CHECK FOR ERRORS
FATAL (NAP,<No defined account string for ^U/PPN/>,,.RETF)
MOVEI P2,BLKOFS ;GET THE WORD # OF FIRST ENTRY
JRST VERIF1 ;GO TRY TO FIND ANOTHER MATCH
VERIF2: MOVE P3,DATADR ;GET THE ADDRESS OF THE VALIDATION MESSAGE
MOVEI P3,UV$ACT(P3) ;OFFSET INTO MESSAGE FOR ACCOUNT STRING
HRLI P3,(POINT 7,0) ;MAKE A BYTE POINTER TO THE GIVEN ACCOUNT
HLRZ T1,PRJBUF+PPNOFS+CNTOFS(P2) ;GET THE CHARACTER COUNT OF ACCOUNT
MOVNS T1
MOVE T2,[POINT 7,PRJBUF+PPNOFS+ACTOFS(P2)] ;BYTE POINTER TO ACCOUNT IN ENTRY
VERIF3: ILDB T3,T2 ;GET A CHARACTER IN THE ENTRY ACCOUNT
ILDB T4,P3 ;GET A CHARACTER IN THE ARGUMENT ACCOUNT
CAIN T3,"*" ;WILDCARD THE REST OF THE USERS ACCOUNT STRING
$RETT ;YES, DECLARE IT VALID
CAIN T3,"?" ;WILDCARD THIS CHARACTER
MOVE T3,T4 ;YES, INSURE A MATCH
CAME T3,T4 ;DO THEY MATCH?
JRST VERIF4 ;NO. PROCEED TO NEXT ENTRY
AOJN T1,VERIF3 ;YES. CONTINUE COMPARING THE ACCOUNTS
ILDB T4,P3 ;GET THE NEXT CHARACTER OF THE ARGUMENT. IT
JUMPE T4,.RETT ; MUST BE NULL TO BE VALID
VERIF4: MOVE P1,PRJBUF+PPNOFS(P2) ;GET PPN ENTRY THAT MATCHED LAST TIME
HRRZ T1,PRJBUF(P2) ;HERE IF ACCOUNT WASN'T VALID FOR THIS ENTRY
ADD P2,T1 ;SO GO ON TO THE NEXT ENTRY IF IT EXISTS
CAMGE P2,PRJBUF ;DOES IT EXIST?
JRST VERIF6 ;YES, SEE IF STILL WITHIN SAME PPN
MOVE T1,PRJVRS ;GET VERSION OF PROJCT.SYS
CAIN T1,1 ;THIS VERSION 1
JRST INVACC ;YES, PPNS COULDNT CROSS BLOCKS IN VERSION 1
PUSHJ P,READNX ;READ NEXT BLOCK TO SEE IF PPN IS CONTINUED
JUMPF INVACC ;NO NEXT BLOCK, ACCOUNT STRING NOT FOUND
MOVEI P2,BLKOFS ;RESTART AT BEGINNING OF NEW DATA BLOCK
VERIF6: CAMN P1,PRJBUF+PPNOFS(P2) ;ARE THE PPN'S STILL THE SAME?
PJRST VERIF2 ;YES. COMPARE THE NEXT ACCOUNT STRING
JRST INVACC ;NO. VALIDATION ERROR
;FNDDEF - ROUTINE TO SEE IF DEFAULT ACCOUNT STRING EXISTS IN PROJCT.SYS
; FOR THE REQUESTED PPN. ALREADY KNOW THAT SPECIFIED STRING WAS NULL.
;CALL: PUSHJ P,FNDDEF
; RETURN TRUE WITH UV$ACT FILLED IN WITH THE DEFAULT
; RETURN FALSE IF NO DEFAULT FOUND
FNDDEF: PUSHJ P,.SAVE4 ;SAVE P1-P4
MOVEI P2,BLKOFS ;GET THE WORD # OF FIRST ENTRY
FNDEF1: MOVE P1,PPN ;GET THE PPN WE'RE VEIFYING FOR AGAIN
XOR P1,PRJBUF+PPNOFS(P2) ;GET THE PPN IN THE ENTRY
AND P1,PRJBUF+PPNOFS+1(P2) ; AND THE WILD CARD MASK
JUMPE P1,FNDEF2 ;HAVE WE FOUND A MATCH?
HLRZ T1,PRJBUF(P2) ;SET UP TO LOOK AT NEXT PPN ENTRY BY
ADD P2,T1 ; GETTING RIGHT OFFSET INTO THE BLOCK
CAMGE P2,PRJBUF ;ARE THERE ANY MORE ENTRIES?
JRST FNDEF1 ;YES. KEEP SEARCHING
PUSHJ P,READNX ;READ NEXT BLOCK (IF ANY) LOOKING FOR WILD CARDING
JUMPF .POPJ ;EOF. PPN DOESN'T EXIST IN PROJCT.SYS
MOVEI P2,BLKOFS ;GET THE WORD # OF FIRST ENTRY
JRST FNDEF1 ;GO TRY TO FIND ANOTHER MATCH
FNDEF2: MOVE T1,PRJBUF+PPNOFS+CNTOFS(P2) ;FETCH CHR COUNT AND FLAGS
TRNN T1,1B35 ;THIS THE DEFAULT
JRST FNDEF4 ;NO, TRY ANOTHER
HLRZS T1 ;ISOLATE STRING LENGTH
MOVE P3,DATADR ;GET THE ADDRESS OF THE VALIDATION MESSAGE
MOVEI P3,UV$ACT(P3) ;OFFSET INTO MESSAGE FOR ACCOUNT STRING
HRLI P3,(POINT 7,0) ;MAKE A BYTE POINTER TO THE GIVEN ACCOUNT
MOVE T2,[POINT 7,PRJBUF+PPNOFS+ACTOFS(P2)] ;BYTE POINTER TO ACCOUNT IN ENTRY
SETZM (P3) ;I KNOW IT IS A NULL ACCOUNT BUT...
HRLI T3,(P3) ;ZERO RECEIVING AREA ANYWAY
HRRI T3,1(P3) ;...
BLT T3,7(P3) ;...
ILDB T3,T2 ;MOVE DEFAULT ACCOUNT STRING TO RETURN BLOCK
IDPB T3,P3 ;...
SOJG T1,.-2 ;...
$RETT ;GIVE GOOD RETURN
FNDEF4: MOVE P1,PRJBUF+PPNOFS(P2) ;GET PPN ENTRY THAT MATCHED LAST TIME
HRRZ T1,PRJBUF(P2) ;HERE IF ACCOUNT WASN'T VALID FOR THIS ENTRY
ADD P2,T1 ;SO GO ON TO THE NEXT ENTRY IF IT EXISTS
CAMGE P2,PRJBUF ;DOES IT EXIST?
JRST FNDEF5 ;YES, SEE IF STILL WITHIN SAME PPN
MOVE T1,PRJVRS ;GET VERSION OF PROJCT.SYS
CAIN T1,1 ;THIS VERSION 1
$RETF ;YES, PPNS COULDNT CROSS BLOCKS IN VERSION 1
PUSHJ P,READNX ;READ NEXT BLOCK TO SEE IF PPN IS CONTINUED
JUMPF .POPJ ;NO NEXT BLOCK, DEFAULT NOT FOUND
MOVEI P2,BLKOFS ;RESTART AT BEGINNING OF NEW DATA BLOCK
FNDEF5: CAMN P1,PRJBUF+PPNOFS(P2) ;ARE THE PPN'S STILL THE SAME?
PJRST FNDEF2 ;YES. COMPARE THE NEXT ACCOUNT STRING
$RETF ;NO DEFAULT EXISTS
;SUBROUTINE TO READ THE NEXT BLOCK OF PROJCT.SYS.
;CALL: PUSHJ P,READNX
; RETURN FALSE IF NO NEXT BLOCK
; RETURN TRUE IF WITH BLOCK IN PRJBUF
READNX: MOVE T1,BLKNUM ;GET BLOCK NUMBER WE ARE LOOKING AT NOW
ADDI T1,1 ;DOES THE NEXT BLOCK OF THE FILE CONTAIN
CAMLE T1,LSTBLK ; DATA?
$RETF ;NO. THE PPN DOESN'T EXIST IN PROJCT.SYS
;FALL INTO READ ROUTINE
;READ - ROUTINE TO READ IN A SPECIFIED BLOCK OF PROJCT.SYS.
;CALL: MOVE T1,BLOCK #
; PUSHJ P,READ
; ERROR RETURN. EOF REACHED. IF OTHER ERROR JRST TO ERROR ROUTINE.
; GOOD RETURN
READ: CAMN T1,BLKNUM ;ALREADY HAVE THIS BLOCK IN CORE
$RETT ;YES, GOOD RETURN, AVOID DISK ACTIVITY
MOVEM T1,BLKNUM ;SAVE THE BLOCK NUMBER WE ARE GOING TO READ IN
SUB T1,PRJCON ;COMPUTE READ DISK BLOCK NUMBER
IMULI T1,@PRJMUL ;AS ((LOGICAL-CONSTANT)*MULTIPLIER)+CONSTANT
ADD T1,PRJCON ;...
MOVE T2,PRJCHN
PUSHJ P,AUSETI ;POSITION TO BLOCK IN T1
SKIPT
$BOMB <ACTCUB Could not USETI to a block in PROJCT.SYS>
MOVEI T1,.FOINP ;INPUT
HLL T1,PRJCHN ;GET THE CHANNEL
TXO T1,FO.PRV ;ALLOW FULL FILE ACCESS TO SYS:
MOVEM T1,PRJBLK+.FOFNC
MOVEI T1,IOLIST ;I/O LIST
MOVEM T1,PRJBLK+.FOIOS
HRL T1,PRJIOW ;GET - NUMBER OF WORDS TO READ
HRRI T1,PRJBUF-1 ;FORM REST OF IOWD
MOVEM T1,IOLIST ;SET UP THE LIST
SETZM IOLIST+1
MOVE T1,[2,,PRJBLK]
FILOP. T1,
SKIPA ;ERROR
$RETT
TXNN T1,IO.EOF ;IS IT AND END OF FILE?
$BOMB <ACTRBP Cannot READ (^O/T1/) PROJCT.SYS>
SETZM BLKNUM ;DON'T WANT TO KEEP BAD DATA AROUND
$RETF ;INDICATE EOF.
;GETPRO - ROUTINE TO FIND A PPN'S ENTRY IN ACTDAE.SYS
;CALL: MOVE T1,PPN
; PUSHJ P,GETPRO
; RETURN HERE--IF TRUE, T1/ADDR OF ACTDAE.SYS ENTRY FOR USER
; --IF FALSE, ERROR MESSAGE ALREADY BUILT
GETPRO: TDZA TF,TF ;EXTERNAL ENTRY POINT
GETPRX: MOVEI TF, ;INTERNAL ENTRY POINT
PUSH P,TF ;SAVE FLAG
TRNN T1,1B18 ;WILD PPN?
JRST GETP.1 ;NO
HRRZ S1,T1 ;GET PROGRAMMER NUMBER
CAIE S1,777776 ;VALID WILD PROGRAMMER NUMBER?
CAIN S1,777777 ;..
TRNA ;IT'S OK
JRST GETP.2 ;IT'S NOT
GETP.1: MOVEM T1,ACOPPN ;PPN TO GET
PUSH P,ACOUXP ;SAVE LOC
MOVEI S1,.UGPPN ;CODE FOR A PPN
MOVEM S1,ACOUXP ;SAVE TEMPORARILY
PUSHJ P,CVTWLD ;CONVERT TO WILDCARD BLOCK (S2 GETS ADDR)
MOVEI S1,ACOPRO ;WHERE TO READ THE RECORD
PUSHJ P,GETA## ;FETCH PROFILE FROM FILE "A"
POP P,ACOUXP ;RESTORE LOC
JUMPF GETP.2 ;IF FAIL, SAY NO SUCH PPN
POP P,(P) ;PHASE STACK
MOVEI T1,ACOPRO ;POINT AT BLOCK WHERE PROFILE IS
$RETT ; AND RETURN
GETP.2: POP P,TF ;GET ENTRY POINT FLAG
JUMPN TF,.RETF ;JUMP IF INTERNAL
FATAL (ILP,<Illegal PPN [^O/S1,LHMASK/,^O/S1,RHMASK/]>,,.RETF)
SUBTTL PROFIL - READ PROFILE AND PERFORM DEFAULTING
; THIS ROUTINE WILL FETCH A PROFILE AND DO DEFAULTING BASED ON
; THE CONTENTS OF .AEDEF AND .AEMAP.
; CALL: MOVE S1, ADDRESS OF BUFFER TO RETURN PROFILE
; MOVE S2, ADDRESS OF WILDCARD MESSAGE BLOCK
; PUSHJ P,PROFIL
;
; TRUE RETURN: PROFILE READ AND DEFAULTED AS NECESSARY
; FALSE RETURN: REQUESTED PROFILE OR DEFAULT PROFILE NOT FOUND
PROFIL: PUSHJ P,.SAVE4 ;SAVE SOME ACS
MOVE P1,S1 ;SAVE PROFILE BUFFER ADDRESS
PUSHJ P,GETA## ;FETCH REQUESTED PROFILE
$RETIF ;CHECK FOR ERRORS
PUSHJ P,PROFMT ;CHECK ACCOUNTING FILE/PROFILE FORMAT VERSION
JRST PROFI0 ;OK, GO DEFAULT IT
PRODEF: PUSHJ P,.SAVE4 ;SAVE SOME ACS
MOVE P1,S1 ;SAVE PROFILE BUFFER ADDRESS
PROFI0: MOVE S1,[ACODEF,,ACODEF+1] ;BLT WORD
SETZM ACODEF ;CLEAR START OF BLOCK
BLT S1,ACODEF+.AEMAX-1 ;START OFF WITH A CLEAN SLATE
MOVE S1,.AEDEF(P1) ;GET DEFAULT PPN WORD
CAIN S1,-1 ;WANT DEFAULTING?
$RETT ;NO--THAT'S EASY
MOVSI S1,-.AMPLW ;-LENGTH OF DEFAULT MAP
HRRI S1,.AEMAP(P1) ;MAKE AN AOBJN POINTER
SKIPN (S1) ;ANY FIELDS TO DEFAULT?
AOBJN S1,.-1 ;NO
JUMPGE S1,.RETT ;RETURN IF NO DEFAULTING NECESSARY
PUSHJ P,PROLOD ;GO LOAD DEFAULT PROFILE
JUMPF .RETT ;RETURN IF CAN'T FIND PROFILE FOR DEFAULTING
$SAVE <T1,T2> ;DON'T CLOBBER CALLER'S ACS
MOVE T1,P1 ;COPY USER PROFILE ADDRESS
MOVEI T2,ACODEF ;POINT TO DEFAULTING BLOCK
PJRST A$PDEF## ;GO APPLY THE DEFAULTS
; READ AND VERIFY ACCOUNTING FILE/PROFILE FORMAT VERSION NUMBER
PROFMT: HLRZ S1,.AEVRS(P1) ;GET VERSION
CAIN S1,6 ;KNOWN FORMAT?
POPJ P, ;YES
$STOP (WVR,<Wrong accounting file format>)
; DETERMINE DEFAULT PPN AND LOAD THAT PROFILE INTO ACODEF
PROLOD: MOVE S1,[ACODWL,,ACODWL+1] ;SET UP BLT
SETZM ACODWL ;CLEAR FIRST WORD
BLT S1,ACODWL+UW$MIN-1 ;ZERO OUT DEFAULTING WILDCARD BLOCK
HLLO S1,.AEPPN(P1) ;ASSUME [10,%] WANTED
SKIPN S2,.AEDEF(P1) ;CONVENTIONAL DEFAULTING?
JRST PROLO1 ;YES
MOVE S1,S2 ;COPY POSSIBLE PPN
TLNE S1,-1 ;FULL PPN SPECIFIED?
JRST PROLO1 ;YES
HRLZS S1 ;PUT PROJECT NUMBER IN PROPER PLACE
HRR S1,.AEPPN(P1) ;LOAD PROGRAMMER NUMBER
PROLO1: MOVEM S1,ACODWL+UW$PPN ;SAVE DEFAULT PPN
SETOM ACODWL+UW$PPM ;SET MASK
MOVEI S1,ACODEF ;PROFILE BUFFER
MOVEI S2,ACODWL ;WILDCARD BLOCK ADDRESS
PUSHJ P,GETA## ;FETCH DEFAULT PROFILE
JUMPT PROLO2 ;CONTINUE IF NO ERRORS
SKIPE .AEDEF(P1) ;DOING CONVENTIONAL DEFAULTING?
$RETF ;NO--CAN'T DO DEFAULTING
MOVE S1,ACODWL+UW$PPN ;GET PPN
AOJE S1,.RETF ;RETURN IF ALREADY TRIED [%,%]
MOVNI S1,1 ;ELSE GET PPN OF LAST RESORT
JRST PROLO1 ;AND TRY ONCE MORE
PROLO2: PUSHJ P,PROFMT ;CHECK ACCOUNTING FILE/PROFILE FORMAT VERSION
$RETT ;AND RETURN
SUBTTL ACTIPC - SECTION TO HANDLE ALL OTHER IPCF MESSAGES
;GENERAL DEFINITIONS FOR ACTIPC MODULE
JOBNUM: BLOCK 1 ;JOB NUMBER OF USER
JOBMAX: BLOCK 1 ;MAXIMUM NUMBER OF JOBS ALLOWED TO BE LOGGED IN
; (USUALLY THE NUMBER THE RUNNING MONITOR WAS
; BUILT FOR). THIS NUMBER WILL ONLY BE LESS
; IF THE CHECKPOINT FILES CANNOT BE ALLOCATED
; DUE TO DISK FULL PROBLEMS. SEE THE DSKLOW ROUTINE
DEVNUM: BLOCK 1 ;nTH DEVICE JUST READ IN A JOB'S DEVICE
; CHECKPOINT FILE
DEVAVL: BLOCK 1 ;LAST DEVICE SLOT AVAILABLE
DCHRBL: BLOCK .DCALT+1 ;BLOCK FOR DSKCHR TO FIND ALTERATE PORT
SUBTTL ACTIPC - ACTLIN--ROUTINE TO HANDLE LOGIN IPCF MESSAGE
;ACTLIN - ROUTINE TO TAKE ACTION WHEN A USER LOGS IN. ACTIONS ARE TO
; INITIALIZE A JOB SLOT IN THE PRIMARY JOB CHECKPOINT FILE AND TRANSFER
; INFORMATION FROM THE MESSAGE TO THE JOB SLOT. LOGIN IS BLOCKED UNTIL
; DATA IS WRITTEN AND AN ACK MESSAGE IS SEND BACK
;CALL: MMSADR CONTAINS THE ADDRESS OF LOGIN IPCF DATA RECEIVED
; MDBADR CONTAINS THE ADDRESS OF LOGIN IPCF MESSAGE DESCRIPTOR BLOCK
ACTLIN: PUSHJ P,IPCGEN ;FIND THE JOB NUMBER
MOVE T1,JOBNUM ;GET IT
CAMLE T1,JOBMAX ;CAN WE CHECKPOINT THIS JOB?
FATAL (JCE,<Job capacity exceeded>,,ACTVXT)
JUMPF [MOVE T2,MMSADR
MOVEM T2,IPS.BL+SAB.MS ;ADDRESS OF DATA
JRST ACTLI1]
PUSHJ P,CBJZER ;ZERO THE PRIMARY DATA AREA
PUSHJ P,GTTTYS ;GET INITIAL TTY STATISTICS NUMBERS
PUSHJ P,CPJCOP ;ZERO AND INCLUDE INIT TTY STATS IN AUX AREA
PUSHJ P,CPJLIN ;TRANSFER THE DATA RECEIVED
HRL T1,JOBNUM ;GET THE JOB NUMBER
HRRI T1,.GTJLT ;JOB LOGIN TIME
GETTAB T1, ;GET IT
SETZ T1, ;WHAT!
MOVEM T1,CPJBUF+CJLGTM ;RECORD FOR RESTART CHECK
PUSHJ P,WRITJP ;WRITE THE PRIMARY JOB SLOT
SKIPE QUEFLG ;QUEUE. UUO?
JRST [PUSHJ P,QUEACK ;YES--ACK DIFFERENTLY
JUMPF ACTLI2 ;CHECK FOR ERRORS
$RETT] ;ELSE RETURN
MOVE T2,MMSADR ;USE THE SAME PAGE WE RECEIVED
MOVEM T2,IPS.BL+SAB.MS ;ADDRESS OF DATA
MOVEI T1,UGTRU$ ;INDICATE ALL OK
MOVEM T1,UC$RES(T2)
ACTLI1: MOVE T1,ACKCOD ;GET THE UNIQUE MESSAGE IDENTIFIER
MOVEM T1,UC$ACK(T2) ;PUT IN THE MESSAGE
MOVEI T1,UGVAC$ ;INDICATE RESPONSE MESSAGE
MOVEM T1,UC$TYP(T2)
MOVE T1,MDBADR ;ADDRESS OF MESSAGE DESCRIPTOR BLOCK
MOVE T1,MDB.SP(T1) ;GET PID OF THE JOB LOGGING IN
MOVEM T1,IPS.BL+SAB.PD
MOVEI T1,1000 ;INDICATE A PAGE IS BEING SENT
MOVEM T1,IPS.BL+SAB.LN
MOVEI S1,SAB.SZ ;LENGTH OF SEND ARGUMENT BLOCK
MOVEI S2,IPS.BL ;ADDRESS OF SEND ARGUMENT BLOCK
$CALL C%SEND ;SEND THE MESSAGE, GLXLIB
JUMPT .POPJ ;PROPOGATE TRUE RETURN
CAIN S1,ERNSP$
JRST ACTLI2 ;IF NO PID, ASSUME USER CONTROL-C'D OUT OF LOGIN
MOVE T1,MDBADR ;MESSAGE DESCRIPTOR BLOCK
MOVE T2,MDB.SD(T1) ;SENDER'S PPN
MOVE T3,MDB.PV(T1)
ANDX T3,MD.PJB ;JOB NUMBER OF SENDER
$WTOXX <Error (^E/S1/) sending a LOGIN response to job ^D/T3/ user ^P/T2/>
ACTLI2: PUSHJ P,CBJZER ;ZERO THE JOB SLOT BUFFER OF PRIMARY FILE
PUSHJ P,WRITJP ;AND WRITE IT TO ENSURE DATA INTEGRITY
$CALL C%REL ;RELEASE THE PAGE
$RETT
;CPJLIN - ROUTINE TO TAKE DATA FROM THE LOGIN IPCF MESSAGE AND PUT IT INTO CPJBUF.
; NOTICE THAT THIS ROUTINE ASSUMES THAT PART OF THE LOGIN IPCF MESSAGE
; HAS THE SAME FORMAT AS CPJBUF.
CPJLIN: MOVE T1,DATADR ;GET ADDRESS OF DATA
MOVE T2,UL$ACK(T1) ;GET THE SENDER'S UNIQUE MESSAGE IDENTIFIER
MOVEM T2,ACKCOD ;AND SAVE IT FOR THE RESPONSE MESSAGE
HRLI T2,UL$LIN(T1)
HRRI T2,CPJBUF+CLINNO
BLT T2,CPJBUF+CTERDE ;MOVE LARGE CHUNK OF DATA
SETO T1, ;GET A -1
CAMN T1,CPJBUF+CACCT ;WAS THERE ONE SPECIFIED TO LOGIN
SETZM CPJBUF+CACCT ;NO, AVOID JUNK IN USAGE.OUT
CAMN T1,CPJBUF+CRMRK ;CHECK /REMARK TOO
SETZM CPJBUF+CRMRK
;NOW DO ITEMIZED DATA TRANSFER
MOVE T1,.JBVER ;ACCOUNT DAEMON VERSION NUMBER
MOVEM T1,CPJBUF+CACVER
MOVE T1,JOBNUM ;SENDERS JOB NUMBER
MOVEM T1,CPJBUF+CJOB
MOVE T1,CPJBUF+CSESST
MOVEM T1,CPJBUF+CLSTCK ;IN CASE SYSTEM CRASHES BEFORE CHECKPOINTING THIS JOB
POPJ P,
SUBTTL ACTIPC - ACTSES--ROUTINE TO HANDLE SESSION IPCF MESSAGE
;ACTSES - ROUTINE TO TAKE ACTION WHEN A USER TYPES A SESSION COMMAND. ACTIONS
; ARE TO MAKE A SESSION ENTRY, COPY THE PRIMARY BUFFER CPJBUF TO CAJBUF,
; THE AUXILLIARY BUFFER, UPDATE CPJBUF AND WRITE BOTH BUFFERS.
; LOGIN IS BLOCKED BECAUSE A CHECKPOINT MUST BE MADE.
;CALL: MDBADR CONTAINS THE MESSAGE DESCRIPTOR BLOCK ADDRESS
; MMSADR CONTAINS THE ADDRESS OF THE IPCF MESSAGE RECEIVED.
ACTSES: PUSHJ P,IPCGEN ;DO GENERAL DATA SETUP
PUSHJ P,CHKJOB ;GATHER ALL THE DATA
PUSHJ P,MAKSES ;NOW MAKE THE SESSION ENTRY
MOVEI T1,SESDVS ;POINT TO ROUTINE TO MAKE ENTRIES
SKIPE CPJBUF+CDEVFL ;ANY DEVICES FOR THIS JOB
PUSHJ P,ALLDEV ;CALL IT FOR ALL USER DEVICES
PUSHJ P,CPJCOP ;COPY THE PRIMARY DATA TO AUXILLIARY BUFFER
PUSHJ P,CPJSES ;COPY NEW DATA TO CPJBUF FROM IPCF MESSAGE
PUSHJ P,WRITJP ;WRITE THE BUFFER.
SKIPE QUEFLG ;QUEUE. UUO?
PJRST QUEACK ;YES--ACK AND RETURN
; JRST SNDRSP ;FALL INTO STANDARD RESPONSE STUFF
SNDRSP: MOVE T2,MMSADR ;USE THE SAME PAGE WE RECEIVED
MOVEM T2,IPS.BL+SAB.MS ;ADDRESS OF DATA
MOVE T1,ACKCOD ;GET THE UNIQUE MESSAGE IDENTIFIER
MOVEM T1,UC$ACK(T2)
MOVEI T1,UGTRU$ ;INDICATE ALL OK
MOVEM T1,UC$RES(T2)
MOVEI T1,UGVAC$ ;INDICATE RESPONSE MESSAGE
MOVEM T1,UC$TYP(T2)
MOVE T1,MDBADR ;ADDRESS OF MESSAGE DESCRIPTOR BLOCK
MOVE T1,MDB.SP(T1) ;GET PID OF THE JOB
MOVEM T1,IPS.BL+SAB.PD
MOVEI T1,1000 ;INDICATE A PAGE IS BEING SENT
MOVEM T1,IPS.BL+SAB.LN
MOVEI S1,SAB.SZ ;LENGTH OF SEND ARGUMENT BLOCK
MOVEI S2,IPS.BL ;ADDRESS OF SEND ARGUMENT BLOCK
$CALL C%SEND ;SEND THE MESSAGE, GLXLIB
JUMPT .POPJ ;PROPOGATE TRUE RETURN
MOVE T1,MDBADR ;MESSAGE DESCRIPTOR BLOCK
MOVE T2,MDB.SD(T1) ;SENDER'S PPN
MOVE T3,MDB.PV(T1)
ANDX T3,MD.PJB ;JOB NUMBER OF SENDER
$WTOXX <Error (^E/S1/) sending response to job ^D/T3/ user ^P/T2/>
$CALL C%REL
$RETT
;CPJSES - ROUTINE TO COPY DATA FROM THE IPCF MESSAGE (SENT BECAUSE OF A
; SESSION COMMAND TYPED BY A USER) TO THE PRIMARY CHECKPOINT BUFFER (CPJBUF).
CPJSES: MOVE T1,.JBVER ;ACCOUNT DAEMON VERSION NUMBER
MOVEM T1,CPJBUF+CACVER
MOVE T1,DATADR ;ADDRESS OF DATA
MOVE T2,US$ACK(T1) ;GET THE UNIQUE MESSAGE IDENTIFIER
MOVEM T2,ACKCOD ;AND SAVE IT FOR THE RESPONSE MESSAGE
MOVE T2,US$PRG(T1) ;PROGRAM NAME
MOVEM T2,CPJBUF+CPGNAM
MOVE T2,US$VER(T1) ;PROGRAM VERSION NUMBER
MOVEM T2,CPJBUF+CPGVER
MOVE T2,US$ACT(T1) ;GET FIRST WORD OF ACCOUNT STRING
AOJE T2,CPJSE1 ; (SENT AS -1 IS NO CHANGE IN ACCOUNT STRING)
MOVEI T2,CPJBUF+CACCT ;NEW ACCOUNT
HRLI T2,US$ACT(T1)
BLT T2,CPJBUF+CACCT+7
CPJSE1: MOVE T2,US$BEG(T1) ;SESSION START DATE/TIME
MOVEM T2,CPJBUF+CSESST
MOVEM T2,CPJBUF+CLSTCK ;IN CASE SYSTEM CRASHES BEFORE NEXT CHECKPOINT
MOVE T2,US$RMK(T1) ;GET REMARK
AOJE T2,.POPJ ; (SENT AS -1 IF NO CHANGE IN REMARK)
MOVEI T2,CPJBUF+CRMRK ;NEW SESSION REMARK
HRLI T2,US$RMK(T1)
BLT T2,CPJBUF+CRMRK+7
POPJ P,
;ROUTINE CALLED FROM ACTSES (VIA ALLDEV) TO MAKE DEVICE SESSION ENTRIES
SESDVS: PUSHJ P,@[EXP CHKFSR,CHKMTA,CHKDTA,CHKSPN]-1(P1) ;CHECKPOINT IT
PUSHJ P,@[EXP MAKFSR,MAKMAG,MAKDEC,MAKSPN]-1(P1) ;MAKE THE ENTRY
PUSHJ P,CPDCOP ;MOVE CURRENT DATA TO AUX AREA
MOVE T1,CURDTM ;GET CURRENT DATE/TIME
MOVEM T1,@[EXP CPDBUF+FSESST,CPDBUF+MSESST,CPDBUF+DSESST,CPDBUF+SCSHIF]-1(P1)
CAIN P1,SPNTYP ;NO SPINDLE RECORDS IN JOB FILES
PUSHJ P,ACTIDT ;CRASH CAUSE THERES NO ACCOUNT STRING FOR THEM
MOVE T2,DATADR ;NEW ACCOUNT STRING IN MESSAGE FROM LOGIN
MOVE T1,US$ACT(T2) ;GET FIRST WORD OF ACCOUNT STRING
AOJE T1,SESDV1 ;SENT AS -1 IF NO CHANGE IN ACCOUNT STRING
MOVSI T1,US$ACT(T2) ;SOURCE = NEW ACCOUNT STRING
HRR T1,[EXP CPDBUF+FACCT,CPDBUF+MACCT,CPDBUF+DACCT]-1(P1)
BLT T1,@[EXP CPDBUF+FACCT+7,CPDBUF+MACCT+7,CPDBUF+DACCT+7]-1(P1)
SESDV1: PUSHJ P,WRITDP ;WRITE IT BACK OUT
POPJ P, ;RETURN FOR NEXT DEVICE
;ACTATT - ROUTINE TO TAKE ACTION WHEN A USER ATTACHES TO HIS JOB WITH AN
; ATTACH COMMAND. ONLY THE NEW LINE NUMBER AND NODE NAME (IF ANY)
; ARE COPYED TO THE JOB SLOT OF THE PRIMARY JOB CHECKPOINT FILE (CPJBUF).
; NO SESSION ENTRY IS MADE. MMSADR AND MDBADR ARE ALREADY SET UP.
ACTATT: PUSHJ P,.SAVE1 ;SAVE P1
PUSHJ P,IPCGEN ;DO GENERAL DATA SETUP
MOVE P1,DATADR ;ADDRESS OF THE DATA FROM LOGIN
MOVE P1,UA$TJN(P1) ;GET TARGET JOB NUMBER
EXCH