Trailing-Edge
-
PDP-10 Archives
-
BB-BT99S-BB_1990
-
10,7/acct/actdae.mac
Click 10,7/acct/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 14-Nov-89
SEARCH ACTPRM,QSRMAC,ORNMAC
MODULE (ACTDAE)
.REQUIR ACTRCD ;USAGE RECORDS
;COPYRIGHT (c) DIGITAL EQUIPMENT CORPORATION 1979,1988,1990.
; 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==162 ;EDIT NUMBER
AC.WHO==0 ;WHO EDITED LAST
AC.MIN==3 ;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 RMGINT,<RMGINT==^D120> ;INTERVAL TIME (SECONDS) BETWEEN RMS MESSAGES
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,1990. 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
;
;141) If an attempt is made to insert a profile with a duplicate
; name, return a meaningful error message instead of the usual
; "unexpected RMS error xxxxxx" cruft.
; 15-Apr-86 /DPM
;
;142) Allow * to match null account strings like the documentation
; and the usage spec claims will work. Also match double quotes
; in invalid account error message.
; 17-Apr-86 /DPM
;
;143) Implement PSI on date/time change so that entrys have correct times
; and connect time if the system has USAGE FILE CLOSURES set for DAILY.
; 2-Jun-86 /BAH
;
;144) Make debugging easier by not using a job-wide pid.
; 3-Jul-86 /RCB
;
;145) Invent a bunch of error codes, and use them in the coded error acks and
; in the failure file.
; 28-Oct-86 /RCB
;
;146) Convert to use the new STOPCD macro in GLXMAC, rather than $STOP.
; 1-Dec-86 /RCB
;
;147) Fix privilege checking for AF.PRV.
; 3-Dec-86 /RCB
;
;150) Range-check program-supplied job numbers on various usage entries.
; SPR 10-35687
; 11-Feb-87 /RCB
;
;151) Fix the (unsupported) NCRYPT algorithm in ALGCUS so that it
; decrypts correctly (thus matching the original LOGIN routine).
; SPR 10-35694
; 19-Feb-87 /JJF
;
;152) Fix selection testing of .AEAUX entries to allow for wildcarded
; structures as well as wild quotas and bits.
; 15-May-87 /RCB
;
;153) Set UC$PRF accordingly if UGVUP$ function.
; SPR 10-36011
; 7-Sep-87 /LWS
;
;154) Try not to hang jobs in EW for EV.IPC. Always ACK all [SYSTEM]GOPHER
; messages, whether we like them or not.
; 29-Sep-87 /RCB
;
;155) Fix bug in checking for password change allowed. No change required
; is not the same as an expired password.
; 16-Jun-88 /RCB
;
;156) Correct problems with unique (10,#) PPNs.
; SPR 10-35597
; 5-Jan-89 /DPM
;
;157) MAPLGL doesn't fixup PPN/NAME block pointers correctly when
; processing an IPCF (not QUEUE. UUO) message to map PPNs to
; names.
; 10-Jan-89 /DPM
;
;160) Check for fatal RMS errors (ER$BUG and ER$UDF). When these
; errors are encountered, send messages to the operator and to
; the user.
; 30-Aug-89 /KDO
;
;161) Fix account ownership checking for [1,2]. It shouldn't be able
; to do so much without admin privs.
; 14-Nov-89 /RCB
;
;162) Don't start virtual timer traps until after we're done in ACTINI.
; We thrash too badly while reading the old USEJOB.BIN etc. Defer
; going virtual until we start accepting IPCF messages.
; 14-Nov-89 /RCB
;
; End of Revision History
;LOOSE ENDS
REPEAT 0,<
NONE
>
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
$SET (IB.FLG,IB.NPF,1) ;DON'T DO VIRTUAL TIMER TRAPS UNTIL ALL SET UP
$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
SABFLG: BLOCK 1 ;FLAG TO CHECK IF ACK STILL NEEDED
;PSI INTERRUPT BLOCKS
ACTPSI:
IPCPSI: EXP IPCTRP
BLOCK 3
DTCPSI: EXP DTCTRP
BLOCK 3
DTCTRP: $BGINT 1,
PUSHJ P,ACTCHD ;ADJUST ALL TIMES AND CHECKPOINT
$DEBRK
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
MOVX S1,IP.JWP ;[144] JOB-WIDE PID FLAG
SKIPE DEBUGW ;[144] IF DEBUGGING,
ANDCAM S1,PIB+PB.FLG ;[144] USE ONLY INIT-CLASS PID
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
MOVX T2,.PCDTC ;DATE/TIME CHANGE PSI CONDITION
MOVSI T3,<DTCPSI-ACTPSI>
SETZM T4 ;NO PRIORITY
MOVX T1,<PS.FAC+T2> ;SET UP CALL
PISYS. T1,
$WTOXX (<Date/time changes will not be adjusted in the USAGE files.
Please report PISYS. error >,^O/T1/)
PUSHJ P,ACTINI ;INITIALIZE THE WORLD
MOVE S1,[.STTVM,,^D1000] ;SETUP TO ATTEMPT VIRTUAL TIMER TRAPS
SETUUO S1, ;EVERY SECOND OF RUN TIME
TRN ;BUT I DON'T MIND IF NEVER GO VIRTUAL!
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
SETZM SABFLG ;NOT YET ACK'ED
SETZM RMGCOD ;NO FATAL RMS ERRORS SO FAR
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
SKIPN SABFLG ;DID WE EVER SEND THE ACK?
PUSHJ P,IGNORE ;NO--MAKE SURE
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,IGNORE ;(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 0,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: SKIPE GFRFLG ;IF THIS CAME FROM [SYSTEM]GOPHER,
JRST QUEACK ;RELEASE THE JOB
SKIPN SABFLG ;NO. DO WE NEED TO RELEASE THE MSG?
PUSHJ P,IPCREL ;YES. DO IT AND REMEMBER IT
$RETF
IPCREL: MOVE S1,MDBADR ;GET THE MDB ADDRESS
SKIPE MDB.MS(S1) ;HAS IT ALREADY BEEN RELEASED?
$CALL C%REL ;NO. DO IT NOW
SETOM SABFLG ;REMEMBER THAT WE CALLED C%REL
POPJ P, ;RETURN
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?
MOVE T4,MDB.PV(T2) ;GET SENDER'S PRIVS
TXNN T4,MD.PWH ;JACCT'ED JOB?
TXNE T3,JP.ADM ;ADMINISTRATIVE PRIVS?
$RETT ;YES OR YES, RETURN GOODNESS
$RETF ;NO TO BOTH, FAIL
; ([1,2] DOESN'T WIN FOR FREE)
; 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
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
CAMN T3,MYPPN ;IF [1,2],
TRCA T3,1 ;THEN FOOL THE CHKACC UUO,
TRNA ;(NOT [1,2])
TRC T2,1 ;BUT GIVE THE RIGHT ANSWER
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 GFRFLG ;DID THIS COME FROM [SYSTEM]GOPHER?
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 IF 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
STOPCD (IOF,HALT,,<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
STOPCD (AFF,HALT,,<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
GFRFLG: 0 ;FLAG FOR [SYSTEM]GOPHER AS THE SENDER
RMGUDT: 0 ;UNIVERSAL DATE/TIME OF LAST RMS MESSAGE
RMGCOD: 0 ;FATAL RMS ERROR CODE
;***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 GFRFLG ;ASSUME NOT FROM GOPHER
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
MOVE T2,MDB.SI(T1) ;GET THE SYSTEM INDEX WORD
TXNN T2,SI.FLG ;IS THIS FROM A SYSTEM PID?
JRST QUECH7 ;NO. CHECK FUNCTION FOR FLAGS
LOAD T2,T2,SI.IDX ;YES. FETCH THE S-PID INDEX
CAXE T2,SP.GFR ;IS IT FROM [SYSTEM]GOPHER?
JRST QUECH7 ;NO. JUST CHECK FUNCTION FOR FLAGS
SETOM GFRFLG ;YES. REMEMBER THAT IT'S FROM GOPHER
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: SKIPN SABFLG ;STILL NEED TO DO THIS?
PUSHJ P,IPCREL ;YES. DO IT AND REMEMBER IT
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 ACTVE8 ;[153]
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 ;NO DEFAULT, IS VALIDATION REQUIRED?
JUMPF ACTVE1 ;NOT REQUIRED
ACTVE6: PUSHJ P,CHKPRJ ;VALIDATE THE ACCOUNT
SKIPF ;[153]
ACTVE1: SKIPA T3,[UGTRU$] ;[153] GET SUCCESS CODE
ACTVE8: MOVEI T3,UGFAL$ ;[153] GET FAILURE CODE
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"
JRST ACTVXT] ;RELEASE OLD MSG AND SEND QUEUE UUO RESPONSE
MOVE T2,SABADR ;[153] GET MESSAGE PAGE ADDRESS
MOVEM T3,UC$RES(T2) ;[153] SAVE VALIDATION RESPONSE
MOVE S1,DATADR ;GET DATA ADDRESS
MOVEI T1,UGVUP$ ;GET VALIDATE ACCOUNT AND RETURN PROFILE CODE
CAME T1,UV$TYP(S1) ;WAS IT?
JRST ACTVE3 ;[153] NO
MOVEI T1,UGFAL$ ;[153] YES, ASSUME CANNOT GET PROFILE
MOVEM T1,UC$PRF(T2) ;[153]
MOVE T1,PPN ;YES, GET PPN
PUSHJ P,GETPRO ;FETCH PROFILE
JUMPF ACTVE3 ;[153]
MOVEI T1,UGTRU$ ;[153] GET SUCCESS CODE
MOVEM T1,UC$PRF(T2) ;[153] SAY THERE'S A PROFILE
MOVEI T1,UC$PRO(T2) ;GET TARGET ADDRESS
HRLI T1,ACOPRO ;GET START OF PROFILE
BLT T1,UC$PRE(T2) ;COPY PROFILE
ACTVE3: CAIE T3,UGTRU$ ;[153] ACCOUNT VALIDATION SUCCESSFUL?
JRST ACTVXT ;[153] NO
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: SKIPN SABFLG ;STILL NEED TO RELEASE THE MESSAGE?
PUSHJ P,IPCREL ;YES. DO IT AND REMEMBER IT
;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 IGNORE ;WASN'T. RELEASE MESSAGE 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 [SKIPN S1,RMGCOD ;CHECK FOR FATAL RMS ERRORS
JRST ACTACA ;NOT FATAL--NO SUCH USER
PJRST RMGERX] ;FATAL--SEND RESPONSE
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: 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: MOVEI T1,ACPSW% ;CALL WITH PROPER ERROR CODE
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/>,ACPSW%,ACTVXX)
SUBTTL PROCESSOR FOR "OBTAIN USER PROFILE" QUEUE. FUNCTION
ACTOUP: SKIPN QUEFLG ;ONLY DEFINED FROM QUEUE. UUO
JRST IGNORE ;WASN'T. RELEASE MESSAGE 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 [SKIPN S1,RMGCOD ;CHECK FOR FATAL RMS ERRORS
JRST ACTOU1 ;NOT FATAL--NO SUCH USER
PJRST RMGERX] ;FATAL-SEND RESPONSE
PUSHJ P,CHKOWN ;IS 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/>,ACNAU%,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)/>,ACNUS%,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>,ACAFL%,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 ;ADDITIONAL 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
SKIPGE S1,(T3) ;GET PPN BEING SET
JRST CUP.EI ;INVALID IF NOT POSITIVE
JRST CUP.1 ;ELSE LET IT THROUGH
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>,ACWFV%,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>,ACFNM%,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>,ACFND%,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
SKIPLE 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/>,ACPCP%,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>,ACPMC%,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: SKIPE S1,RMGCOD ;CHECK FOR FATAL RMS ERRORS
PJRST RMGERX ;FATAL--SEND RESPONSE
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)/>,ACSUM%,ACTVXT) ;RESPOND TO USER AND RETURN
FATAL (NSU,<^T/(S1)/>,ACNSU%,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>,ACINS%,ACTVXT)
CUP.EF: FATAL (IFM,<Illegally formatted message>,ACIFM%,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>,ACEAF%,ACTVXT)
CUP.EP: FATAL (MPR,<Missing password required>,ACMPR%,ACTVXT)
CUP.EL: SKIPE ACOPRV ;PRIVED USER?
PJRST ILLPSW ;YES, GO ADMIT TO BAD PASSWORD
MOVEI T1,ACPSW% ;NO, BUT TELL THE TRUTH IN THE ERROR FILE
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/>,ACPTF%,ACTVXT)
CUP.EW: FATAL (PLL,<Password length is less than ^D/S1/ characters>,ACPLL%,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"
CAIN S1,ER$DUP## ;WAS THE NAME ALREADY IN USE?
JRST [MOVE S1,[POINT 8,ACOPRO+.AENAM] ;YES, POINT TO NAME
FATAL (NAE,<Name already exists; ^Q/S1/>,ACNAE%,ACTVXT)]
CAIN S1,ER$RNF## ;RECORD NOT FOUND?
CUP.EI: FATAL (ILP,<Illegal PPN [^O/PPN,LHMASK/,^O/PPN,RHMASK/]>,ACILP%,ACTVXT)
PUSHJ P,RMGCH1 ;CHECK FOR FATAL RMS ERRORS
RMGERX: FATAL (RMS,<Unexpected RMS error ^O6R0/S1/>,ACRMS%,ACTVXT)
;CHECK FOR FATAL RMS ERRORS.
RMGCHK: $RETIT ;NO ERRORS--RETURN
MOVEI S1,3 ;
PUSHJ P,OPTA## ;GET STATUS OF FILE "A"
RMGCH1: CAIE S1,ER$BUG## ;INTERNAL ERROR?
CAIN S1,ER$UDF## ;UNDEFINED STATE?
TRNA ;YES--TELL THE OPERATOR (MAYBE)
$RETT ;NO--IGNORE IT
MOVEM S1,RMGCOD ;SAVE RMS ERROR CODE
PUSHJ P,I%NOW ;GET CURRENT UNIVERSAL DATE/TIME
SKIPN RMGUDT ;FIRST TIME THROUGH THIS CODE?
JRST RMGCH2 ;YES--SEND MESSAGE TO OPERATOR
MOVE S2,S1 ;NO--CALCULATE TIME SINCE LAST MESSAGE
SUB S2,RMGUDT ;
IMULI S2,^D24*^D3600 ;CONVERT TO SECONDS
HLRZ S2,S2 ;
CAIGE S2,RMGINT ;HAS ENOUGH TIME PASSED?
JRST RMGCH3 ;NO--DON'T BOTHER THE OPERATOR
RMGCH2: MOVEM S1,RMGUDT ;SAVE CURRENT UNIVERSAL DATE/TIME
MOVEI S1,4 ;
PUSHJ P,OPTA## ;GET FILESPEC FOR FILE "A"
$WTOXX <Fatal RMS error on ^F/(S2)/; RMS error ^OR0/RMGCOD/>
RMGCH3: MOVE S1,RMGCOD ;RESTORE RMS ERROR CODE
$RETF ;
;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: CAME T4,.AUSTR(T3) ;[152] FOUND START OF SUBSTRING?
CAMN T4,[-1] ;[152] OR A WILDCARD?
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
SKIPL T3 ;[152] IF NO MORE IN PROFILE,
TDZA T1,T1 ;[152] ZERO-FILL
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
JRST UGAUX4 ;[152] EVEN IF PROFILE IS SHORT
ACTPSW: SKIPN QUEFLG ;ONLY DEFINED FROM QUEUE. UUO
JRST IGNORE ;WASN'T. RELEASE MESSAGE 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 [SKIPN S1,RMGCOD ;CHECK FOR FATAL RMS ERRORS
JRST ACTACA ;NOT FATAL--NO SUCH USERS
PJRST RMGERX] ;FATAL--SEND RESPONSE
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 IGNORE ;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>,ACFAL%,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/>,ACRMS%,ACTVXT)
UNLOCK: SKIPN ACTLCK## ;FILE LOCKED?
FATAL (FNL,<File not locked>,ACFNL%,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/>,ACRMS%,ACTVXT)
ACTSCD: SKIPN QUEFLG ;ONLY DEFINED FROM QUEUE. UUO
PJRST IGNORE ;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>,ACSMF%,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 [PUSHJ P,RMGCHK ;CHECK FOR FATAL RMS ERRORS
JUMPT ACTMA4 ;NOT FATAL--NO SUCH USER
PJRST RMGERX] ;FATAL-SEND RESPONSE
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
PUSHJ P,RMGCHK ;CHECK FOR FATAL RMS ERRORS
JUMPF RMGERX ;FATAL ERROR--SEND RESPONSE
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
MOVEI T3,(P1) ;INCASE IPCF 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>,ACPEM%,.RETF)
CAIE T1,.QBAET ;START OF INTERESTING DATA?
JRST MAPLG1 ;NOT YET
MAPLG2: MOVEI P1,UU$MAP(T3) ;POINT TO START OF ACTUAL DATA
MOVEM P1,ACOMAP ;SAVE ADDRESS
SKIPN T1,UU$CNT(T3) ;GET COUNT OF MAPPING BLOCKS
FATAL (MBZ,<Mapping block count is zero>,ACMBZ%,.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/>,ACMBF%,.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/]>,ACILP%,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
TXNE T1,AE.ACT ;IS AN ACCOUNT REQUIRED FOR THIS PPN?
$RETT ;YES--MUST VALIDATE
$RETF ;NO VALIDATION NECESSARY
INVPPN: SKIPA S2,.AEPPN(T1) ;GET PPN FROM PROFILE
INVACC: MOVE S2,PPN ;GET PPN FROM LOW CORE
PUSH P,S2 ;SAVE PPN
PUSH P,T1 ;SAVE CALLER'S AC
MOVEI T1,ACIVA% ;INVALID ACCOUNT STRING ERROR
PUSHJ P,LOGUSR ;LOG THE ERROR
POP P,T1 ;RESTORE AC
$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/>,ACIVA%,.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/>,ACNAP%,.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,1 ;INTERNAL ENTRY POINT
PUSH P,TF ;SAVE FLAG
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: PUSH P,S1 ;SAVE THE PPN
PUSHJ P,RMGCHK ;CHECK FOR FATAL RMS ERRORS
POP P,S1 ;RESTORE THE PPN
POP P,TF ;GET ENTRY POINT FLAG
JUMPN TF,.RETF ;JUMP IF INTERNAL
SKIPE S2,RMGCOD ;FATAL RMS ERROR?
FATAL (RMS,<Unexpected RMS error ^O6R0/S2/>,ACRMS%,.RETF)
FATAL (ILP,<Illegal PPN [^O/S1,LHMASK/,^O/S1,RHMASK/]>,ACILP%,.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
JUMPF [PUSHJ P,RMGCHK ;CHECK FOR FATAL RMS ERRORS
$RETF] ;RETURN FALSE (NO SUCH USER OR FATAL ERROR)
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
STOPCD (WVR,HALT,,<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
PUSHJ P,RMGCHK ;CHECK FOR FATAL RMS ERRORS
; (TELL OPERATOR, BUT KEEP TRYING)
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>,ACJCE%,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