************************************************************************
*M*      LOGON    INITIATES ON-LINE AND TERMINATES ON-LINE AND BATCH SESSIONS
************************************************************************
*P*
*P*      NAME:    LOGON
*P*
*P*      PURPOSE: TO RECEIVE A TERMINAL USER'S REQUEST FOR SERVICE AND TO
*P*               DETERMINE IF HE IS AUTHORIZED TO USE THE CPV SYSTEM AND
*P*               ALSO TO LOG BOTH BATCH AND TERMINAL USERS OFF THE SYSTEM
*P*
*P*      DESCRIPTION: WHEN LOGGING TERMINAL USERS ON, USER AUTHORIZATION
*P*               IS VERIFIED BY COMPARING THE TERMINAL USER'S NAME,
*P*               ACCOUNT, AND PASSWORD WITH THOSE SPECIFIED IN THE
*P*               :USERS FILE. UPON DETERMINING USER VALIDITY,
*P*               INFORMATION FROM THE USER'S LOGON RECORD IS STORED
*P*               IN HIS JIT AND AN ASSIGN-MERGE RECORD CREATED. IF A
*P*               :USERS FILE DOESN'T EXIST AND A USER LOGS ON IN :SYS
*P*               LBE, THE FILE IS CREATED WITH A RECORD FOR THAT ACCOUNT.
*P*               LOGON EXITS TO TEL UNLESS AN AUTO-CALL PROCESSOR IS
*P*               SPECIFIED IN THE USER'S LOGON RECORD. CONTROL IS
*P*               PASSED TO AN INSTALLATION'S JOB INITIATION ROUTINE
*P*               IF ADDITIONAL POLICING OF USERS IS DESIRED.
*P*               IF THE X'2' BIT OF CONTROL CELL S:COUP IS SET, A RECORD
*P*               KEYED BY SYSID IS WRITTEN FOR THE USER IN THE FILE
*P*               :LOGD.:SYS CONTAINING NAME, ACCOUNT, TIME ON, AND EITHER
*P*               THE COC LINE NUMBER OR THE TEXT 'RA' TO DENOTE A REMOTE
*P*               ASSIST USER. THIS FILE IS USED IN CONJUNCTION WITH THE
*P*               TEL 'WHERE' COMMAND.
*P*
*P*               WHEN LOGGING USERS OFF, THE :RATE FILE IS READ AND THE
*P*               ACCTSUM SUBROUTINE CALLED TO COMPUTE AND LOG THE
*P*               ACCOUNTING INFORMATION. COOPERATIVE FILES ARE CLOSED
*P*               THE :LOGD RECORD FOR THE USER IS RE-WRITTEN, IF THE
*P*               FEATURE IS ENABLED, TO INDICATE THE TIME OF LOG OFF.
*P*               AND LOGOFF IS EXITED.
*P*
*P*      REFERENCE: TIME SHARING REFERENCE MANUAL
*P*               DATA BASE TECHNICAL MANUAL
*P*               SYSTEM MANAGEMENT REFERENCE MANUAL
*P*               TIME SHARING USER'S GUIDE
         PSR      0
         TITLE    'CP-V LOGON/LOGOFF'
         SYSTEM   SIG7FDP
         SYSTEM   BPM
         PAGE
*
*        SEND MESSAGE TO OPERATOR (USES R2, SR4)
*
SEND     CNAME
         PROC
LF       RES      0
I        DO       NUM(AF)
         LI,R2    AF(I)
         CAL1,2   SENDOPMS
         FIN
         PEND
*
*        SEND MESSAGE TO TERMINAL USER (USES R2, R3)
*
TYPES    CNAME    0
TYPE     CNAME    1
         PROC
LF       RES      0
I        DO       NUM(AF)
         LI,R2    AF(I)
         DO       NAME
         LB,R3    AF(I)
         CAL1,1   ERIDMSG
         ELSE
         CAL1,1   ERIDMSGS
         FIN
         FIN
         PEND
         PAGE
*
*        PROC TO SET UP ERROR CODE MESSAGE (USES R2, R4)
*
SETERROR CNAME
         PROC
LF       RES      0
         DO1      AF(1)~=R2
         LW,R2    AF(1)
         BAL,SR4  BIN2HEX
         LI,R2    '='
         STB,R2   R4
         STW,R4   ERRCODEM+3
         PEND
*
*        PROC TO GENERATE TEXTC CODE WITHOUT LISTING HEX
*
TXTC     CNAME
         PROC
         DISP     %
         LIST     0
LF       TEXTC    AF
         LIST     1
         PEND
         PAGE
         DEF      SECTION1          START OF CONTROL SECTION CONTAINING
*,*                                 PROCEDURE
         DEF      P:JIT             EQU; EQUATED WITH J:JIT IN LOGON
         REF      SENDOPMS          PLIST TO SEND ERROR MESSAGES TO OC
         REF      TIMEVERT          CONVERT TIME-ON TO MINUTES FROM
*,*                                 MIDNIGHT
         REF      M:EO              DCB FOR READING :RATE AND :USERS FILE
         REF      M:UC              DCB FOR READING TERMINAL INPUT AND
*,*                                 SENDING ERROR MESSAGES TO TERMINAL
         REF      JACCN             OUTPUT; EQU; DISPLACEMENT IN JIT
*,*                                 USED TO SAVE ACCOUNT SPECIFIED AT
*,*                                 LOGON TIME
         REF      JUNAME            OUTPUT; EQU; DISPLACEMENT IN JIT
*,*                                 USED TO SAVE NAME SPECIFIED AT
*,*                                 LOGON TIME
         REF      J:ABUF            OUTPUT; INITIALIZE ASSIGN-MERGE
*,*                                 ADDRESS AT LOGON TIME
         REF      ACCOUNT           OUTPUT; RETAIN USER'S NAME SPECIFIED
*,*                                 AT LOGON TIME
         REF      JTELFLGS          OUTPUT; INITIALIZE TO ZERO AT
*,*                                 AT LOGON TIME
         REF      STDOPT            INPUT; DEFAULT SETTING FOR J:OPT
*,*                                 STORED IN AM:STDOP IN A/M RECORD
         REF      ACCNTSUM          COMPUTE, DISPLAY, LOG ACCOUNTING
*,*                                 INFORMATION
         REF      RATEFLAG          OUTPUT; FLAG SET TO INDICATE TO ACCTSUM
*,*                                 A RATE FILE DOES/DOESN'T EXIST
         REF      J:CCBUF           OUTPUT; NAME OF AUTO-CALL PROCESSOR
*,*                                 SPECIFIED IN :USERS RECORD
         REF      J:JIT             INPUT/OUTPUT; USER INFORMATION
         REF      S:OUIS            OUTPUT; INCREMENT ON-LINE USERS IN
*,*                                 SYSTEM WHEN NON-COC USER LOGGING ON
         REF      S:GUIS            OUTPUT; DECREMENT GHOST USERS IN SYSTEM
*,*                                 WHEN NON-COC USER LOGGING ON
         REF      S:GJOBTBL         OUTPUT; REMOVE LOGON FROM GHOST TABLE
*,*                                 FOR NON-COC USER LOGGING ON
         REF      MAXG              EQU; MAXIMUM LENGTH OG GHOST TABLE
         REF      SB:GJOBUN         OUTPUT; CLEAR GHOST JOB USER
*,*                                 NUMBER FOR NON-COC USER LOGGING ON
         REF      S:GJOBACN         OUTPUT; CLEAR GHOST JOB ACCOUNT NUMBER
*,*                                 FOR NON-COC USER LOGGING ON
         REF      DOUBLEZERO        INPUT; CONTANT
         REF      J:EUP             OUTPUT; SET USER'S TOP ADDRESS BELOW
*,*                                 TEL
         REF      JEUPVP            INPUT; EQU; SET USER'S TOP ADDRESS
*,*                                 BELOW TEL
         REF      JRNST             OUTPUT; EQU; BYTE 0; INITIALIZE TO
*,*                                 0 AT LOGON TIME
         REF      JB:PCW            SET PLATEN WIDTH
         REF      JCPPO             OUTPUT; EQU; BITS 15-31; SET FILE
*,*                                 EXTENSION BITS
         REF      M:X1              DCB USED FOR OPENING MAILBOX FILE
         REF      JABC              OUTPUT; EQU; BYTE 0; INITIALIZE TO
*,*                                 ZERO AT LOGON TIME
         REF      JB:FRS            SET FINAL RUN STATUS FOR TIMEOUT
         REF      SL:OLTO           SET TIMEOUT FOR LOGON'S READ
         REF,1    JB:PRIV           OUTPUT; BYTE 0; SAVE PRIVILEGE FROM
*,*                                 :USERS RECORD
*,*                                 OUTPUT; BIT 6; INDICATE SECURITY
*,*                                 FLAG SET IN :USERS RECORD
         SREF     COCMESS           INPUT; DISPLAY AT LOGON TIME
         REF      SITEID            DISPLAY AT LOGON TIME
         REF      RECORD            BUFFER FOR :USERS RECORD AT LOGON TIME
         REF      OPMES             BUFFER FOR SENDING LINE NUMBER, NAME
*,*                                 AND ACCOUNT TO OPERATOR AT LOGON TIME
         REF      LISTLOC           EQU; BUFFER IN ACCTSUM TO HOLD FPT
*,*                                 USED FOR GENERATING INITIAL :USERS
*,*                                 RECORD (:SYS,LBE)
         REF      RECSIZE           EQU; SIZE OF CONTEXT AREA INITIALIZED
*,*                                 WITH ZEROS AT LOGON TIME
         REF      TIMBUF            OUTPUT; SAVE TIME/DATE OF USERS
*,*                                 LOGON TIME
         REF      UNME              OUTPUT; SAVE USER'S NAME AT LOGON TIME
         REF      UACCOUNT          OUTPUT; SAVE USER'S ACCOUNT AT LOGON
*,*                                 TIME
         REF      UPASSWD           OUTPUT; SAVE USER'S PASSWORD AT LOGON
*,*                                 TIME
         REF      KEYBUFF           OUTPUT; BUILD KEY TO READ RECORD FROM
*,*                                 :USERS FILE
         REF      ERRTRY            INPUT/OUTPUT; COUNT OF USER'S ATTEMPTS
*,*                                 TO LOG ON
         REF      NATRYS            INPUT/OUTPUT; COUNT OF USER'S
*,*                                 ATTEMPTS TO LOG ON USING INCORRECT
*,*                                 NAME/ACCOUNT
         REF      PATRYS            INPUT/OUTPUT; COUNT OF USER'S
*,*                                 ATTEMPTS TO LOG ON USING INCORRECT
*,*                                 PASSWORD
         REF      USERMSG           OUTPUT; USER ID AND LINE # AT LOGON
*,*                                 TIME
         REF      BIN2HEX           CONVERT BINARY VALUE TO HEXADECIMAL
         REF      ERRCODEM          OUTPUT; ERROR CODE INTO ERROR CODE
*,*                                 TEXT MESSAGE
         REF      TIMBUF1           INPUT; LOGON TIME IN MINUTES
         REF      J:XP              OUTPUT; LEFT HALF; STORE FILE
*,*                                 RETENTION PERIOD
         REF      MPPO              OUTPUT; EQU; BITS 0-14; STORE MPPO
*,*                                 SPECIFIED IN :USERS RECORD
         REF      MDPO              OUTPUT; EQU; BITS 0-14; STORE MDPO
*,*                                 SPECIFIED IN :USERS RECORD
         REF      MPO               OUTPUT; EQU; BITS 0-14; STORE MPO
*,*                                 SPECIFIED IN :USERS RECORD
         REF      MUPO              OUTPUT; EQU; BITS 0-14; STORE MUPO
*,*                                 SPECIFIED IN :USERS RECORD
         REF,1    JB:NFPOOL         OUTPUT; STORE FPOOLS SPECIFIED IN
*,*                                 :USERS RECORD
         REF      J:ASSIGN          OUTPUT; BIT 3; SET READ NONE IF
*,*                                 SPECIFIED IN :USERS RECORD
*,*                                 OUTPUT; BIT 6; SET EXECUTE ONLY IF
*,*                                 SPECIFIED IN :USERS RECORD
*,*                                 OUTPUT; BIT 7; SET RESTRICTED
*,*                                 PROCESSOR IF SPECIFIED IN :USERS
*,*                                 RECORD
         REF      PRDCRM            INPUT; MAXIMUM AMOUNT OF PERMANENT
*,*                                 RAD SPACE AVAILABLE
*,*                                 OUTPUT; SAVE PERMANENT RAD SPACE
*,*                                 REMAINING
         REF      PRDPRM            INPUT; MAXIMUM AMOUNT OF PERMANENT
*,*                                 PACK SPACE AVAILABLE
*,*                                 OUTPUT; SAVE PERMANENT PACK SPACE
*,*                                 REMAINING
         REF      TMDPRM            OUTPUT; SAVE TEMPORARY PACK SPACE
*,*                                 REMAINING
         REF      TMDCRM            OUTPUT; SAVE TEMPORARY RAD SPACE
*,*                                 REMAINING
         REF      TMPDCPK           OUTPUT; SAVE PEAK TEMPORARY RAD SPACE
         REF      TMPDPPK           OUTPUT; SAVE PEAK TEMPORARY PACK SPACE
         REF      UEXTACC           OUTPUT; USER'S EXTENDED ACCOUNTING
*,*                                 SPECIFIED AT LOGON TIME
*,*                                 INPUT; STORE EXTENDED ACCOUNTING
*,*                                 INFORMATION IN ASSIGN-MERGE RECORD
*,*                                 AT LOGON TIME
         REF      M:LL              CLOSED AT LOGOFF TIME
         REF      SV:RSIZ           EQU; SIZE OF RESOURCE NAME TABLE
         REF      SH:RNM            INPUT; DETERMINE EXISTENCE OF
*,*                                 RESOURCES IN :USERS RECORD
         REF      JB:MAX            INPUT; SYSTEM DEFAULTS FOR RESOURCES
         REF      SV:LIM            EQU; SERVICE LIMIT TABLE SIZE
         REF      SL:NAME           INPUT; DETERMINE EXISTENCE OF SERVICE
*,*                                 LIMITS IN :USERS RECORD
         REF      SV:FTYM           EQU; LOGICAL DEVICE LIMIT TABLE SIZE
         REF      SH:SYMT           INPUT; DETERMINE AUTHORIZATION FOR
*,*                                 LOGICAL DEVICES SPECIFIED IN :USERS
*,*                                 RECORD
         REF,2    JH:LDCF           OUTPUT; LOGICAL DEVICE CONTROL FLAGS
*,*                                 SET FOR LOGICAL DEVICES SPECIFIED
*,*                                 IN :USERS RECORD
         REF      TSTACK            INPUT/OUTPUT; PRESERVE REGISTERS
         REF      SCRAM             SCRAMBLE PASSWORD
         REF      COCLN             EQU; OFFSET INTO M:UC FOR LINE NUMBER
         REF      AM:HED            EQU; ASSIGN-MERGE HEAD (INDEX TO
*,*                                 AVAILABLE AREA)
         REF      AM:ORG            EQU; POINTER TO AVAILABLE SPACE IN
*,*                                 A-M RECORD
         REF      AM:LOG            EQU; LOGON TIME IN MINUTES FROM
*,*                                 MIDNIGHT IN A-M RECORD
         REF      AM:STDOP          EQU; A/M RECORD COPY OF STANDARD
*,*                                 SETTINGS FOR J:OPT
         REF      AMH:BILL          EQU; BILLING RATE IN A-M RECORD
         REF      AM:DATE           EQU; CREATION YEAR AND DAY IN A-M
*,*                                 RECORD
         REF      AM:XACC           EQU; ACCOUNTING INFO. IN A-M RECORD
         REF      AM:PRMAX          EQU;
         REF      AM:PRCUR          EQU;
         REF      AM:LNK            OUTPUT; EQU; ZERO OUT LINK TO FIRST
*,*                                 ENTRY
         SREF     M:ACINIT          INPUT; ADDRESS OF INSTALLATIONS
*,*                                 JOB INITIATION ACCOUNTING ROUTINE
         REF      S:COUP            COUPLING/LOGD CONTROL CELL
*,*                                 ALSO CONTROLS LOGGING OF UNSUCESSFUL
*,*                                 LOGON ATTEMPTS
         REF      M:OC              FOR TELLING OC OF UNSUCESSFUL ATTEMPT
         DEF      DISPLINE          WHY DID JOHN DO THIS ONE??????
LIST     EQU      LISTLOC
UC       EQU      M:UC
M:LOG    EQU      M:EO                                                  U:LO0014
M:RATE   EQU      M:EO                                                  U:LO0015
SYSACCNT EQU      ':SYS    '
SYSUNAME EQU      'LBE         '
         PAGE
* SYMBOLIC REGISTER DEFINITIONS
R0       EQU      0
R1       EQU      1
R2       EQU      2
R3       EQU      3
R4       EQU      4
R5       EQU      5
R6       EQU      6
R7       EQU      7
SR1      EQU      8
SR2      EQU      9
SR3      EQU      10
SR4      EQU      11
D1       EQU      12
D2       EQU      13
D3       EQU      14
D4       EQU      15
* DISPLACEMENT VALUES FOR LOGIN RECORD
LR:ACC   EQU      0                 ACCOUNT
LR:USR   EQU      2                 USER NAME
LR:FG    EQU      5                 READ
LR:PW    EQU      6                 PASSWORD
LR:CPP   EQU      8                 AUTO-CALL PASSWORD
LR:CPA   EQU      10                AUTO-CALL ACCOUNT
LR:CPN   EQU      12                AUTO-CALL PROCESSOR LMN NAME
LR:BIL   EQU      15                BATCH,ON-LINE,GHOST BILLING
LR:PRIV  EQU      16                BATCH,ON-LINE,GHOST PRIVILEGE
LR:ARAD  EQU      18                ACCU. PERM RAD SPACE
LR:DMR   EQU      20                DEF AND MAX FILE RETENTION PERIODS
LR:ADIS  EQU      22                ACCU PERM DISK SPACE
LR:EACCT EQU      24                EXTENDED ACCOUNTING INFORMATION
LR:UNML  EQU      30                USER LIMIT SPECIFICATION TABLE (HALFWORD)
LR:UOML  EQU      62                ON-LINE LIMIT
LR:UGML  EQU      78                GHOST LIMIT
LR:UNMR  EQU      94                RESOURCE NAME TABLE(HALFWORD)
LR:UOMR  EQU      106               ON-LINE RESOURCE VALUE(BYTE)
LR:UGMR  EQU      110               GHOST RESOURCE VALUE(BYTE)
LR:UNMP  EQU      114               PERIPHERAL NAME TABLE(HALFWORD)
LR:UPFLG EQU      122               ON-LINE PERIPHERAL AUTHORIZATION(BYTE)
LMTSZE   EQU      15                SIZE OF LIMIT TABLES IN :USERS RECORD
ARS      EQU      UC+4              ACTUAL RECORD SIZE OF LAST RECORD READ
LOGRECSZ EQU      126               LOGON RECORD SIZE(NOW EXPANDED)
TRYERR   EQU      5                 ERROR RETRY COUNT
DCBER    EQU      3                 ERROR RETURN POINTER IN DCB
DCBAR    EQU      4                 ABNORMAL RETURN POINTER IN DCB
P:JIT    EQU      J:JIT             FOR DISPLAY
         PAGE
THISISIT CSECT    1
SECTION1 RES      0
         BOUND    8
TXLOGON  TEXTC    'LOGON'
SLAVE    GEN,8,4,20   0,12,LOGON:COC
         DATA         0             ****LOGON'S RETURN TO SLAVE MODE**
MASTER   GEN,8,24    8,0
NEWLINE  DATA     X'01150000'       NEW LINE MESSAGE
YFFFE    DATA     X'FFFE0000'
Y03      DATA     X'03000000'
Y008     DATA     X'00800000'
XFFFF    DATA     X'FFFF'
X1FFFF   DATA     X'1FFFF'
Y40FF    DATA     X'40FFFFFF'
TEL      TXTC     'TEL'
SYS      TEXT     SYSACCNT
SYSUSR   TEXT     SYSUNAME
BLANKS   TEXT     '    '
TIMKWD   TEXT     'TIME'
ERID     TXTC     'ID?'
ERAC     TXTC     'ACCOUNT?'
EREXT    TXTC     'EXT. ACNT. LEFT OR RIGHT PAREN. MISSING'
PASSWORD TXTC     'PASSWORD '
NAMACT   TXTC     'ACCOUNT/ID '                                         U:LO0017
IDMSG    TXTC     'LOGON PLEASE: '
KBELL    EQU      ' '               BELL CHARACTER
KNEWLINE EQU      '
'               NEW-LINE (.15) CHARACTER
SORRY    TXTC     KNEWLINE,'SORRY, UNABLE TO LOG YOU ON'
ONATM    TXTC     'ON AT '
DOWN     TXTC     'UNRECOVERABLE I/O ON RAD'
NOTHERE  TXTC     'ABNORMAL ERROR ON LOGON FILE'
SLASH    TXTC     '/'
QUEST    TXTC     '?'
MAILMSG  TXTC     'CHECK DC/MAILBOX'
RDLOGONM TXTC     'UNRECOVERABLE ERROR READING USERS FILE'
ARFMSG   TXTC     'UNABLE TO ACCESS RATE FILE'
RRFMSG   TXTC     'UNABLE TO READ RATE FILE'
OPNRFMSG TXTC     'UNABLE TO OPEN RATE FILE'
FILEXMSG TXTC     'FILE STORAGE LIMIT EXCEEDED(RAD)'
PACKXMSG TXTC     'FILE STORAGE LIMIT EXCEEDED(PACK)'
LOFFMSG  TXTC     'INSTALLATION PROHIBITS YOUR LOGGING ON'
AMERRMSG TXTC     'UNABLE TO WRITE ASSIGN-MERGE RECORD'
HELDMSG  TXTC     'PROGRAM HELD. RECONNECT? '
NOIMGMSG TXTC     'HELD PROGRAM TIMED OUT.'
OFFMSG   TXTC     'OFF'
*     ASSIGN/MERGE TABLE IMAGE
DATA     CSECT    0                 DATA AREA
MERTAB   EQU      %
         DO1      9
         DATA     0
         DO1      3                 USER NAME (3 WDS)
         DATA     X'40404040'
         DATA     0                 LOGON TIME
         DATA     0                 BILLING TIME
         DO1      6                 EXT. ACCNT. FIELD (6 WDS)
         DATA     X'40404040'
         LIST     0
         DO1      492
         DATA     0
         LIST     1
DISPLINE DATA     0                 SET TO 0 TO INHIBIT BAD LOGON MSGE
*                                   BEING SENT TO OC.
BADLOGON TXTC     'UNSUCCESSFUL LOGON ATTEMPT ON LINE ##, ID: ##'
INSIZE   DATA                       SIZE OF USER NAME/ACCOUNT/PASS INPUT
CVMP1    DATA                       ADR OF 1ST PAGE TO CVM
CVMP2    DATA     512               ADR OF NEXT VIRTUAL PAGE
SALUT    TEXTC    KBELL,KNEWLINE,KNEWLINE,KNEWLINE,;
                  KBELL,'HONEYWELL CP-V AT YOUR SERVICE',KBELL,;
                  ' -         ',KNEWLINE
SALUTEND EQU      %                 END OF SALUT MESSAGE
COCRDOPT DATA     X'40000000'       READ TIMEOUT OPTION FOR M:UC READ
         PAGE
*  THIS PROCESSOR CONTAINS THE TWO ROUTINES: LOG-ON AND LOG-OFF.
*  LOG-ON INITIALLY RECEIVES A USER REQUEST FOR SERVICE, ACCEPTS HIS
*  IDENTIFYING DATA, TESTS FOR A LEGAL ACCOUNT AND REJECTS HIS REQUEST
*  IF HE IS NOT AN AUTHORIZED USER. IF HE IS A VALID USER, HE IS
*  SERVICED BY CALLING TEL, OR, IF PREVIOUSLY SPECIFIED, ANOTHER USER
*  ASSOCIATED PROCESSOR.
*  THE LOG-OFF ROUTINE IS CHARGED WITH THE CLEAN-UP WHEN A USER HAS
*  COMPLETED A SESSION. IT WILL RELEASE TEMPORARY FILES, INITIATE THE
*  I/O RUNDOWN PROCESS AND PERFORM THE USER ACCOUNTING FUNCTION.
*
*  FOR THE LOG-ON PROCESS, ENTRY IS FROM THE MONITOR AS A RESULT OF A
*  TERMINAL ACTION. A SKELETAL JIT IS PROVIDED WITH THE USER NUMBER AS
*  SYSID.
         USECT    THISISIT          RESUME PT 1
LOGON    RES      0
         LC       J:JIT             CHECK FOR GHOST MODE
         BCS,4    GHST              B/YES , SEE IF NON-COC USER
         LW,R4    J:JIT+JACCN       NO, GET ACCOUNT FIELD
         BNEZ     LOGOFF            REGULAR USER LOGGING OFF
         B        LOGON:COC         REGULAR USER LOGGING ON
*   MUST BE GHOST- SEE IF NON-COC USER LOGGING ON, OR GHOST LOGOFF
GHST     EQU      %
         LH,R1    M:UC              IF UC IS OPEN/HAS BEEN OPEN , HE IS
         CI,R1    X'60'             ....LOGGING OFF
         BANZ     LOGOFF            B/ M:UC IS OPEN
         LI,R1    X'FFFF'           MASK TO PICK UP DEVICE NAME
         AND,R1   M:UC+1            DEVICE NAME (UC,MC,ETC...)
         CI,R1    'UC'              IF UC, THIS IS NOT A NON-COC USER
         BE       LOGOFF            LOG OFF REGULAR GHOST
         LCFI     10                MAKE THIS FLAG
         STCF     J:JIT             FOR THE 'NON COC' USER
         CAL1,1   SETRES            SET ERR/ABN FOR IMPLICIT OPEN
         CAL1,6   MASTER            GO MASTER MODE TO CHANGE LOW CORE
         MTW,1    S:OUIS            BUMP ONLINE USERS IN SYSTEM
         MTW,-1   S:GUIS            DECREMENT GHOSTS IN SYSTEM
         LI,R1    MAXG              MAX LENGTH OF GHOST TABLES
         LD,R2    TXLOGON           OUR NAME IN TEXTC
         CD,R2    S:GJOBTBL,R1      FIND LOGON'S POSITION IN TABLES
         BE       RGHST             GOTCHA
         BDR,R1   %-2
         LPSD,0   SLAVE             GO SLAVE AGAIN
         B        LOGON:COC         ******WEIRD*******
RGHST    EQU      %
         LD,R2    DOUBLEZERO
         STD,R2   S:GJOBTBL,R1      BLAST LOGON OUT OF THE GHOST TABLES
         STB,R2   SB:GJOBUN,R1      CLEAR USER NUMBER
         STD,R2   S:GJOBACN,R1      CLEAR LOGON'S ACCOUNT NUMBER
         LI,R1    JEUPVP            LOWER USER'S VIRTUAL
         STW,R1   J:EUP             TOP ADDRESS BELOW TEL.....
         SREF     RAS:CBP           EXISTS ONLY IN 560 SYSTEMS
         LI,R1    RAS:CBP           IS 560 SYSTEM
         BEZ      NO:RES            SHOULD HAVE NEVER HAVE GOTTEN HERE
         LI,R1    X'FFFF'           OKAY - MASK TO PICK
         AND,R1   J:JIT             UP USER NUMBER
         STB,R1   RAS:CBP           SAVE IT FOR RAS HANDLER
         LI,R1    2                 INDEX TO SET UP
         LI,R0    0                 BREAK SENT TO
         STB,R0   RAS:CBP,R1        THE RAS STATION
         LPSD,0   SLAVE             GOSLAVE AGAIN...
LOGON:COC EQU     %
         CAL1,8   =X'06600000'      M:TS, EXTENDED FORMAT
         LI,R2    BA(JB:PCW)        L/BA OF PLATEN WIDTH IN JIT
         LI,R3    72                L/72; ASSUME TTY, WIDTH = 72
         CI,8     X'10'**8          C/MODE2 IN STATUS W/.10
         BAZ      %+2               BAZ; NOT 2741
         LI,R3    132               L/132; WIDTH FOR 2741
         STB,R3   0,R2              S/PLATEN WIDTH
         CI,11    1**16             C/MODE6 IN STATUS W/1
         BAZ      %+3               BAZ; NOT HARDWIRED LINE
         LI,R3    0                 L/0
         STB,R3   COCRDOPT          0/FLAG BITS IN COC READ OPTION
*                                   .. WORD; RESET TIMEOUT OPTION
         M:GDDL                     G/DYNAMIC DATA LIMITS
         STW,8    CVMP1             S/ADR OF 1ST AVAIL PAGE
         AWM,8    CVMP2             G/ADR OF 2ND AVAIL PAGE
         M:CVM    SITEID,*CVMP1     MAP PAGE INTO SITEID PAGE
         M:CVM    SITEID+512,*CVMP2 MAP 2ND PAGE IN CASE OF PAGE BOUND
         LI,R2    SITEID            L/ADR OF SITEID
         AND,R2   =X'1FF'           &/SITEID ADR W/.1FF; G/PAGE DISPL
         LCI      2
         LM,R3    *CVMP1,R2         L/SITEID
         STM,R3   SALUTEND-3        S/SITEID IN SALUTATION MESSAGE
         TYPE     SALUT             TYPE 'XEROX CP-V AT YOUR ... SITEID'
         CAL1,8   TIMER
         LI,R3    16                PRINT TIME
         TYPES    TIMBUF
         LW,R2    J:JIT             GET USER ID
         AND,R2   XFFFF
         BAL,SR4  BIN2HEX           CONVERT
         BAL,SR4  SHIFT             SHIFT VALUE
         STW,R4   USERMSG+2         STORE INTO MESSAGE
         LI,R2    X'FF'             GET LINE NUMBER
         AND,R2   M:UC+COCLN
         BAL,SR4  BIN2HEX           CONVERT
         BAL,SR4  SHIFT             SHIFT VALUE
         STW,R4   USERMSG+5         STORE INTO MESSAGE
         LI,R3    25
         TYPES    USERMSG           PRINT USER ID AND LINE NUMBER
         CAL1,8   NOECHO            SUPPRESS ECHOING
         M:CVM    COCMESS,*CVMP1    MAP PAGE INTO COC SEND,ALL/HEADER MESSAGE
         M:CVM    COCMESS+512,*CVMP2 MAP NEXT PAGE IN CASE OF PAGE BOUNDARY
         LI,R2    COCMESS           L/ADR OF COC MESSAGE
         AND,R2   =X'1FF'           &/ADR W/.1FF; G/DISPLACEMENT WITHIN PAGE
         AW,R2    CVMP1             G/MAPPED ADR OF COCMESS
         LB,R3    *R2               L/BC OF COC MESSAGE; IT'S TEXTC
         BEZ      MAPOLTO           BEZ; NO MESSAGE
         CAL1,1   ERIDMSG           PRINT COC MESSAGE
         TYPE     NEWLINE
MAPOLTO  M:CVM    SL:OLTO,*CVMP1    MAP CVMP1 INTO SL:OLTO
         LI,R2    SL:OLTO           L/ADR OF LOGON'S READ TIMEOUT VALUE
         AND,R2   =X'1FF'           &/ADR W/.1FF; G/PAGE DISPLACEMENT
         INT,R3   *CVMP1,R2         L/RH OF SL:OLTO
         STS,R3   COCRDOPT          S/TIMEOUT VALUE IN READ OPTIONS WORD
INQUIRE  RES      0
         LI,R2    0                 CLEAR TO ZERO WORKING STORAGE
         LI,R3    RECSIZE
         STW,R2     RECORD,R3
         BDR,R3   %-1
         LW,R2    BLANKS
         LW,R4    BLANKS
         LW,R3    BLANKS
         LCI      3
         STM,R2   JUNAME+J:JIT
         STM,R2   ACCOUNT           SAVE USER NAME
         LCI      2
         STM,R2   J:JIT+JACCN
         TYPE     IDMSG
         M:READ   M:UC,(BUF,RECORD),(SIZE,72),(BTD,0),(ABN,ABRDUC),;
                  (COC,*COCRDOPT)   READ WITH TIMEOUT OF SL:OLTO
         LW,R3    ARS               PICK-UP INPUT BYTE COUNT
         SLS,R3   -17               AND FIX IT AS COUNT IN R3
         STW,R3   INSIZE            S/BC OF USER RESPONSE
         BAL,SR4  PARSE             PARSE THE INPUT USER ID
*
* CONCATINATE ACCOUNT AND NAME FOR KEYED READ OF LOGIN FILE
*
         LI,R2    UACCOUNT
         LI,R3    KEYBUFF
         LI,R4    0                 MAINTAINS BYTE COUNT
         LI,R7    8                 PUT IN LIMIT FOR ACCOUNT
         BAL,SR4  CONCAT            DO ACCOUNT
         LI,R2    UNME
         LI,R7    12                PUT IN LIMIT FOR NAME
         LI,R5    X'40'
         AI,R4    1
         STB,R5   *R3,R4            INSERT BLANK AFTER ACCT
         BAL,SR4  CONCAT            ADD NAME
         STB,R4   *R3               ADD BYTE COUNT TO KEY
         LCI      2
         LM,D3    SECAT             PROVIDE SPECIAL ACCOUNT
         XW,D3    J:JIT+JACCN
         XW,D4    J:JIT+JACCN+1
OPENIT   CAL1,1   OPNLOGON          ATTEMPT TO OPEN LOGIN FILE
         CAL1,1   LOGFILE           KEYREAD THE LOGIN FILE
         CAL1,1   CLOSE             CLOSE FILE
         LCI      2
         STM,D3   J:JIT+JACCN       RESTORE USERS ACCOUNT
*
*  CHECK IF ACCOUNT IS VALID
*
         CW,D3    RECORD
         BNE      BUMMER1
         CW,D4    RECORD+1
         BNE      BUMMER1
*
* PERFORM VALIDITY TEST ON SUPPLIED PASSWORD
*
         MTW,0    LR:PW+RECORD      WAS A PASSWORD SPEC'D
         BEZ      LOGIT             NO
         LCI      2
         LM,R2    LR:PW+RECORD      DOES PASSWORD MATCH
         CD,R2    UPASSWD
         BNE      NOACCESS          NO, ERROR
LOGIT    RES      0
         CAL1,8   ECHO              TURN ECHOING BACK ON
         CAL1,8   TIMER
         LI,R2    AM:DATE           SAVE DATE FOR A-M RECORD
         STW,SR1  MERTAB,R2
         BAL,SR4  TIMEVERT          TIME ON TO TIMBUF1(SECNDS FROM MID.)
         TYPE     NEWLINE,ONATM
         LI,R3    16
         TYPES    TIMBUF
         LW,R2    UEXTACC           USE EXT. ACCTG. SPEC. AT LOGON TIME
         CW,R2    BLANKS            ANY SPECIFIED?
         BNE      LOGIT10           YES
         LI,R3    -6                NO, USE EXT. ACCTG. FROM :USERS RECORD
LOGIT5   RES      0
         LW,R2    RECORD+LR:EACCT+6,R3
         BEZ      LOGIT10
         STW,R2   UEXTACC+6,R3
         BIR,R3   LOGIT5
LOGIT10  RES      0
         LI,R2    X'FF'
         AND,R2   M:UC+COCLN        LOAD LINE NUMBER
         BAL,SR4  BIN2HEX           CONVERT TO HEX.
         LI,R3    1
         STH,R4   OPMES+1,R3        PUT LINE # INTO MESSAGE
         LI,R1    0
COMPRS   LB,R2    J:JIT+JACCN,R1    GET ACCOUNT FROM JIT                U:LO0019
         CI,R2    ' '               WAS END OF NAME REACHED
         BE       NEXT              YES; GO GET ACCOUNT,OTHERWISE
         STB,R2   OPMES+2,R3        PUT NAME INTO OPMES
         AI,R3    1                 INCREMENT MESSAGE POINTE
         AI,R1    1                 INCREMENT JIT POINTER
         CI,R1    8                 HAS END OF ACCOUNT BEEN REACHED     U:LO0021
         BL       COMPRS            NO;
NEXT     LI,R2    ','
         STB,R2   OPMES+2,R3        PUT A COMMA INTO MESSAGE AFTER NAME
         AI,R3    1                 INCREMENT MESSAGE POINTER
         LI,R1    0                 LOAD JIT POINTER
NEXLOOP  LB,R2    ACCOUNT,R1        GET USER NAME                       U:LO0023
         CI,R2    ' '               HAS END OF ACCOUNT BEEN REACHED
         BE       OUT1              YES;
         STB,R2   OPMES+2,R3        PUT ACCOUNT INTO MESSAGE
         AI,R3    1                 INCREMENT MESSAGE POINTER
         AI,R1    1                 INCREMENT JIT POINTER
         CI,R1    12                HAS END OF NAME BEEN REACHED        U:LO0025
         BL       NEXLOOP           NO;
OUT1     AI,R3    7                 YES;
         STB,R3   OPMES             STORE BYTE COUNT INTO MESSAGE
         SEND     OPMES             SEND MESSAGE TO OPERATOR
**CLEAR J:ABUF AND J:TELFLGS IN JIT
         LI,R2    0                 CLEAR J:ABUF AND JTELFLGS IN JIT    U:LO0029
         STW,R2   J:ABUF
         STW,R2   J:JIT+JTELFLGS
**PRIVILEGE
         LI,R3    BA(RECORD+LR:PRIV)+1
         LB,R2    0,R3
         CI,R2    0                 DOES THE BYTE HAVE SOMETHING IN IT
         BE       OUT3              NO.
         LI,R3    JB:PRIV
         STB,R2   0,R3              STORE PRIVELEGE INTO JIT
**FILE READ ('ALL'=0 , 'NONE'=1)
OUT3     LW,R2    RECORD+LR:FG      GET THE DESIRED RECORD
         CW,R2    =X'80000000'
         BAZ      %+3               OPTION BIT NOT SET(IE READ ALL)
         LW,R3    =X'10000000'
         STS,R3   J:ASSIGN          SET BIT 3 IN J:ASSIGN(READ NONE)
**EXEC. ONLY(XOS),RESTR. PROCESSOR(RP),SECURITY(SE)
         LI,R3    2                 IF SECURITY BIT SET
         AND,R3   R2
         BEZ      OUT3A
         LI,R1    JB:PRIV           SET BIT 2 IN JB:PRIV
         LB,R6    0,R1
         OR,R6    R3
         STB,R6   0,R1
OUT3A    EQU      %
         SLS,R2   22                STORE X0S AND RP BITS INTO JIT
         LW,R3    Y03
         STS,R2   J:ASSIGN
**FILE RETENTION PERIODS
**** NONE--0(DEFAULT), NEVER--FFFF
         LH,R2    RECORD+LR:DMR     GET DEF. RETN. PERIOD
         BEZ      %+2               IF ZERO,USE DEFAULT IN JIT
         STH,R2   J:XP              STORE INTO JIT
         LI,R3    1
         LH,R2    RECORD+LR:DMR,R3  GET MAX. RETN. PERIOD
         BEZ      OUT4              USE DEFAULT
         STH,R2   J:XP,R3           STORE INTO JIT
**FILE EXTENSION BITS
OUT4     LI,R2    X'1FFFF'
         STW,R2   J:JIT+JCPPO       STORE FILE EXT
**RESOURCE
         LI,R1    SV:RSIZ           GET RESOURCE LIMIT TABLE SIZE
OUT5A    LH,R2    SH:RNM,R1         GET RESOURCE NAME
         BEZ      OUT5F             IF ZERO GET NEXT
         LI,R3    LMTSZE
OUT5B    CH,R2    RECORD+LR:UNMR,R3 WAS RESOURCE FOUND IN :USERS RECORD
         BNE      OUT5C             NO
         LB,R6    RECORD+LR:UOMR,R3  GET :USERS VALUE
         LI,R5    255               FLAG FROM USER'S RECORD
         B        OUT5E
OUT5C    BDR,R3   OUT5B
         LB,R6    JB:MAX,R1         NO, USE SYSTEM DEFAULT
         LI,R5    -255              FLAG FROM SYSTEM DEFAULT TABLE
OUT5D    AND,R2   XFFFF             IF RESOURCE='CO', CHANGE TO PAGES
         CI,R2    'CO'
         BNE      OUT5E
         AW,R6    R6
OUT5E    EQU      %
         AND,R2   XFFFF             MASK NAME
         CI,R2    'MC'              SPECIAL CASE NAME
         BNE      OUT5EA            NOPE
         CI,R5    0                 DID R6 COME FROM USER'S RECORD
         BLZ      JCUSRERR          CANNOT ACCEPT USER
         CI,R6    0                 IF FROM :USERS RECORD IS NON ZERO
         BEZ      JCUSRERR          NOPE - CANNOT ALLOW USER ON
*
*        USER DID NOT HAVE AN MC RESOURCE ASSIGNMENT IN HIS
*        :USERS RECORD - AND WE NOW OWN THE DARN THING - SO
*        WE'RE GONNA EXIT THE SYSTEM AFTER TELLING THE USER
*        AND OPERATOR WHY.
*
OUT5EA   EQU      %
         STB,R6   JB:MAX,R1         STORE MAX VALUE FOR RESOURCE
OUT5F    BDR,R1   OUT5A
**SERVICE
         LI,R1    SV:LIM            GET SERVICE LIMIT TABLE SIZE
OUT6A    LW,R2    SL:NAME,R1        GET SERVICE LIMIT NAME
         LI,R3    LMTSZE
OUT6B    CW,R2    RECORD+LR:UNML,R3 WAS LIMIT FOUND IN :USERS RECORD
         BE       OUT6C             YES
         BDR,R3   OUT6B
         B        OUT6F             NOT FOUND
OUT6C    LW,R6    RECORD+LR:UOML,R3 GET :USERS VALUE
OUT6E    CW,R2    TIMKWD            IGNORE 'TIME' AS N/A TO ON-LINE USER
         BE       OUT6F
         LI,R5    J:JIT
         LW,R2    LIMINFO,R1        GET STORAGE INFO.
         LB,R4    R2                SHIFT VALUE AND RESOLUTION
         SCS,R6   0,R4              VALUE TO PROPER FIELD WITHIN JIT WORD
         SLS,R4   -6                RESOLUTION
         LI,R7    -1                LOAD PROPER MASK
         CI,R1    LIMINFOA
         BGE      %+2
         LW,R7    YFFFE
         EXU      LIMSTORE,R4       STORE IT
OUT6F    BDR,R1   OUT6A             GO GET NEXT LIMIT NAME
**PERM RAD SPACE RMNG = PERM RAD SPACE LIMIT - ACCU PERM RAD SPACE
         LW,R2    J:JIT+PRDCRM      GET LIMIT FROM JIT
         SW,R2    RECORD+LR:ARAD    GET ACCU. RAD SPACE FROM :USERS
         BGEZ     OUT8
         TYPE     NEWLINE,FILEXMSG,NEWLINE
*E*      MESSAGE: FILE STORAGE LIMIT EXCEEDED (RAD)
         LI,R2    0                 MINUS ACCU. SET=0
OUT8     STW,R2   J:JIT+PRDCRM
**PERM PACK SPACE RMNG = PERM PACK LIMIT - ACCU. PERM PACK SPACE
         LW,R2    J:JIT+PRDPRM      GET LIMIT FROM JIT
         SW,R2    RECORD+LR:ADIS    GET ACCU. PACK SPACE FROM :USERS
         BGEZ     OUT9
         TYPE     NEWLINE,PACKXMSG,NEWLINE
*E*      MESSAGE: FILE STORAGE LIMIT EXCEEDED (PACK)
         LI,R2    0                 MINUS ACCU. SET=0
OUT9     STW,R2   J:JIT+PRDPRM
**LOGICAL DEVICE CONTROL FLAGS
         LI,R7    1                 SET LOGICAL DEVICE CONTROL FLAGS
         LI,R4    RECORD+LR:UNMP
         LI,R5    RECORD+LR:UPFLG
         BAL,SR4  SETLDCF
*
* RELEASE THE LOGIN DCB AND EXIT.
*
CLEANUP  RES      0
         CAL1,1   OPNMAIL           OPEN 'MAILBOX' TO SEE IF THERES MAIL
         CAL1,1   CLSMAIL           IT'S THERE. CLOSE 'MAILBOX'
RETREQ   TYPE     NEWLINE,MAILMSG,NEWLINE   NOTIFY USER
*E*      MESSAGE: CHECK D/C MAILBOX
*
* PERFORM AUTO-CALL LOGIC
*
AUTOCALL LW,R6    LR:CPN+RECORD     AUTO-CALL PROCESSOR
         BNEZ     AUTOEXIT          YES
         LW,R6    TEL               CALL TEL PROCESSOR
         LW,R7    BLANKS
         LW,SR1   BLANKS
         LI,SR2   0                 INDICATE 'NOT COMMAND FILE' TO STEP
         LCI      2                 SYSTEM
         LM,D2    SYS               ACCOUNT
         LI,R5    J:JIT
         B        WRITEAMR
AUTOEXIT LW,R7    LR:CPN+1+RECORD   PICK UP 2ND WD PROC NAME
         LW,SR1   LR:CPN+2+RECORD   PICK UP 3RD WD PROC NAME
         LI,SR2   1                 INDICATE 'POSSIBLE COMMAND FILE TO STEP
         LCI      2
         LM,D2    LR:CPA+RECORD     PICK UP ACCT OF PROC
         LM,SR3   LR:CPP+RECORD     PICK UP PROC PASSWD
         LCI      3
         STM,R6   J:CCBUF
         LI,R0    ' '
         STB,R0   J:CCBUF
*NOW THAT ALL NEC. INFO. IN LOG REC PROCESSED,
*PREPARE AND WRITE THE ASSIGN-MERGE RECORD
*LOGON DATE ALREADY STORE INTO A-M IMAGE AFTER THE TIME CALL
*
WRITEAMR EQU      %
         LI,R1    MERTAB
*
         LI,R3    AM:HED            STORE POINTER TO AVAILABLE
         STW,R3   AM:ORG,R1
*
         LW,R3    TIMBUF1           STORE LOGON TIME
         STW,R3   AM:LOG,R1
*
         LI,R3    BA(RECORD+LR:BIL)+1  GET RATE STRUCTURE FROM LOG REC
         LB,R2    0,R3
         BEZ      WRAM1
         LI,R3    HA(AMH:BILL)
         STH,R2   *R1,R3            STORE RATE STRUCTURE IN LEFT HALFWD
*
WRAM1    EQU      %
         LW,R2    J:JIT+PRDCRM      PERM RAD SPACE RMNG AT LOGON
         STW,R2   AM:ORG+20,R1
*
         LW,R2    J:JIT+PRDPRM      PERM PACK SPACE RMNG AT LOGON
         STW,R2   AM:ORG+21,R1
*
         LW,R2    STDOPT            MOVE DEFAULT FOR
         STW,R2   AM:STDOP,R1       J:OPT TO A/M RECORD
*
         LI,R2    0                 INITIALIZE TO ZERO
         STW,R2   AM:PRMAX,R1
         STW,R2   AM:PRCUR,R1
         STW,R2   AM:LNK,R1         SET LINK = 0
*
         LI,R3    -6
WRAM2    LW,R2    UEXTACC+6,R3      STORE EXT. ACCT. INFO.
         STW,R2   AM:XACC,R1
         AI,R1    1
         BIR,R3   WRAM2
*
         LI,R1    M:EO
         LI,D4    AMWERR
         CAL1,1   SETEABN           SET ERR/ABN ADDRESSES
         CAL1,1   AMR               WRITE A-M RECORD
*  NOW THAT AUTHOZN. CHECKS ARE MADE,EXIT TO THE INSTALLATION JOB
*   INITIATION ROUTINE VIA REG. 15
*  REG.3 CONTAINS THE ADDRESS OF IMAGE OF LOGON REC. AND REG.5 THAT
*   OF JIT.   THE INSTALLATION CAN THEN POLICE THE JOB AND /OR
*   MODIFY THE JIT
* UPON RETURN, IF REG.3 SET TO 0, THE JOB WILL BE AUTO. LOGGED OFF
*  REG.S EXCEPT 3 ARE EXPECTED TO BE INTACT
*
         LI,D4    M:ACINIT
         BEZ      EVTHNOK
         LI,R3    RECORD
         LI,R5    J:JIT
         BAL,D4   *D4
         CI,R3    0
         BNE      EVTHNOK
         TYPE     NEWLINE,LOFFMSG,NEWLINE
*E*      MESSAGE: INSTALLATION PROHIBITS YOUR LOGGING ON
*E*      DESCRIPTION: THE USER IS PROHIBITED BY THE INSTALLATION
*E*               TO HAVE ANY FURTHER ACCESS TO THE SYSTEM.
         SEND     OFFMSG            NOTIFY OPERATOR USER IS LOGGED OFF
         B        LOGOFFX1          AVOID WRITING ACCOUNTING RECORD
EVTHNOK  EQU      %
         LCI      3
         LM,R0    ACCOUNT           PUT USER NAME INTO JIT
         STM,R0   J:JIT+JUNAME
         CAL1,8   FSI
         BCR,8    RECONNECT         WE'VE GOT A HELD PROGRAM
NOCONNECT EQU     %
         LI,R0    0
         STB,R0   J:JIT+JRNST       INSURE ERROR CELLS ARE NULL
         STB,R0   J:JIT+JABC
         STW,R0   LR:PW+RECORD      CLOBBER THE PASSWORD TO PREVENT
         STW,R0   LR:PW+RECORD+1    FUTURE PAGE USERS FROM STEALING IT.
         LI,0     '*'
         BAL,15   WRLOGD            GO WRITE :LOGD RECORD.
         LI,R0    0                 INDICATE NO DEBUGGER TO STEP
         CAL1,9   1                 INTERPRETIVE EXIT
         PAGE
*
* A SYNTAX ERROR HAS BEEN FOUND IN USER INPUT.
*
SYNTAXA  BAL,SR4  TRIES             NO USER NAME PROVIDED-CHECK TRIES
         TYPE     ERAC              SEND 'ACCOUNT?' MESSAGE             U:LO0033
*E*      MESSAGE: ACCOUNT?
*E*      DESCRIPTION: THE ACCOUNT FIELD CONTAINED TOO MANY CHARACTERS.
         B        SYNPRINT
ABRDUC   LB,SR4   SR3               L/ABN CODE
         CI,SR4   X'23'             C/CODE W/.23; READ TIMEOUT
         BNE      SYNTAX            B/NOT READ TIMEOUT
         LI,R1    X'10'             L/.10; RUN STATUS FOR TIMEOUT/HANGUP
         LI,R2    BA(JB:FRS)        L/BA OF FINAL RUN STATUS
         STB,R1   0,R2              S/FINAL RUN STATUS
         B        LOGON             B; START OVER AGAIN, DO LOGOFF
SYNTAX   RES      0                 GARBLED MSG-TOO MANY CHARACTERS
         BAL,SR4  TRIES             SEE IF TOO MANY TRIES
         LW,R2    ARS
         SLS,R2   -17               GET THE ACTUAL RECORD SIZE
         CAL1,1   ECHOWTE           SEND MESSAGE BACK TO USER
         B        ACT1
SYNTAXB  BAL,SR4  TRIES             NO USER ACCOUNT PROVIDED
         TYPE     ERID              SEND 'ID?' MESSAGE                  U:LO0035
*E*      MESSAGE: ID?
*E*      DESCRIPTION: EITHER A USER NAME WAS NOT SPECIFIED OR CONTAINED
*E*               TOO MANY CHARACTERS.
         B        SYNPRINT
SYNTAXC  BAL,SR4  TRIES             EXTENDED ACC. INFO. ERROR
         TYPE     EREXT             SEND 'EXTENDED ACCOUNTING?'
*E*      MESSAGE: EXT. ACNT. LEFT OR RIGHT PAREN. MISSING
SYNPRINT RES      0
         LI,R1    M:EO
         LI,D4    0                 RESET ERR/ABN ADDRESS
         CAL1,1   SETEABN
*  CHECK TO SEE IF THE CHARACTER STRING 'LOGON PLEASE:' APPEARS
*  IN THE 'USER' RESPONSE.  IF THE LINE IS IN TEST-BACK-TO-BACK
*  (TURNAROUND) MODE, LOGON'S OUTPUT WILL GET FED BACK IN (AT THE
*  COC HARDWARE LEVEL) AS INPUT FOR THE LINE.  IF WE SPOT THAT
*  WE WILL ISSUE A 'SET TERMINAL ATTRIBUTES' CALL TO SET THE LINE
*  HANG-UP BIT, ISSUE A WRITE THAT WILL DELETE ALL BUFFERED INPUT,
*  AND GET RID OF THIS USER SESSION.
         LW,R4    INSIZE            L/SIZE OF USER RESPONSE
         AI,R4    -13               -13; SIZE OF 'LOGON PLEASE:'
LOGPL3   LW,R2    R4                L/CURRENT BTD INTO RESPONSE
         LW,R3    =13**24+BA(IDMSG)+1 L/BC, DESTINATION FOR CBS
         CBS,R2   BA(RECORD)-1      C/'LOGON PLEASE:' W/RESPONSE
         BE       LOGPL6            BE; HANG UP THE LINE
         BDR,R4   LOGPL3            BDR/CHECK NEXT 13-CHAR FIELD
         TYPE     NEWLINE
         B        INQUIRE           BNE; RE-PROMPT THE USER
LOGPL6   CAL1,8   FPHU              HANG UP COC LINE
         B        TRIES1            GET RID OF THE USER
*
* MAINTAIN AND TEST THE RETRY COUNT.
*
TRIES    LW,R2    ERRTRY            PICK-UP ACCUMULATED RETRY COUNT
         AI,R2    1                 KICK IT UP
         STW,R2   ERRTRY            SAVE IT
         CI,R2    TRYERR            AND TEST FOR LIMIT
         BL       *SR4              NOT REACHED
TRIES1   RES      0
*E*      MESSAGE: SORRY, UNABLE TO LOG YOU ON
         LB,R2    SORRY             L/BC OF 'SORRY, UNABLE TO LOG..'
         M:WRITE  M:UC,(BUF,SORRY),(BTD,1),(SIZE,*R2),;
                  (COC,DELETEIN)
         MTW,0    DISPLINE          ARE WE TO DISPLAY BAD LOGON TO OC
         BEZ      NOOCMSG           NOPE
         LI,R2    X'FF'
         AND,R2   M:UC+COCLN        GET LINE #
         BAL,SR4  BIN2HEX
         STH,R4   BADLOGON+9        MOVE LINE # TO MESSAGE BUFFER
         LW,R2    J:JIT             GET USER #
         AND,R2   XFFFF
         BAL,SR4  BIN2HEX
         STH,R4   BADLOGON+11       MOVE USER # TO MESSAGE BUFFER
         LI,R2    BADLOGON
         CAL1,2   BADLGMSG          WRITE MESSAGE TO OC
         LI,R2    NAMACT            NAME/ACCT TO OC
         LW,R6    NATRYS            IS NAME/ACCOUNT TRIES>PASSWORD TRIES
         CW,R6    PATRYS
         BGE      %+2
         LI,R2    PASSWORD          NO, PASSWORD TO OC
         CAL1,2   BADLGMSG
         LI,R2    QUEST             QUESTION MARK TO OC
         CAL1,2   BADLGMSG
NOOCMSG  EQU      %
         LI,R6    0                 CLEAR FOR EXIT CAL
         CAL1,9   1                 DITCH USER - HE BLEW IT
*
* CLOBBER THE PASSWORD TO PREVENT FUTURE USERS OF THIS PAGE FROM
* STEALING IT.
*
NOACCESS EQU      %
         LW,R2    BLANKS
         STW,R2   LR:PW+RECORD
         STW,R2   LR:PW+RECORD+1
*
* PUT OUT INVALID PASSWORD MESSAGE
*
         MTW,1    PATRYS            INCREMENT # PASSWORD TRIES
         BAL,SR4  TRIES
         TYPE     PASSWORD
ACT1     RES      0
         TYPE     QUEST
*
* REINITIALIZE UPASSWD TO REMOVE RESIDUE FROM PREVIOUS LOG-ON ATTEMPT
* BEFORE RETURNING.
*
         LW,R2    BLANKS
         LW,R3    BLANKS
         STD,R2   UPASSWD
*
* REINITIALIZE UEXTACC TO REMOVE RESIDUE FROM PREVIOUS LOG-ON ATTEMPT
*BEFORE RETURNING.
         LI,R2    6
         STW,R3   UEXTACC-1,R2
         BDR,R2   %-1
         B        SYNPRINT
         PAGE
************************************************************************
* THE FOLLOWING IS ENTERED AS A RESULT OF AN I/O ERROR DURING THE READ
* OF THE LOGIN FILE. THE CURRENT IMPLEMENTATION NOTIFIES THE USER THAT
* AN UNRECOVERABLE I/O ERROR HAS OCCURED DURING THE LOG-ON PROCESS AND
* HE CANNOT CONTINUE. A LATER IMPLEMENTATION WOULD BE TO INITIATE
* MONITOR RECOVERY PROCEEDURES, IF AND WHEN AVAILABLE.
*
*
IOERROR  RES      0
         CAL1,1   NORETURN          IGNORE ERROR RETURNS
         CAL1,1   CLOSE             CLOSE LOGON FILE
         LB,R2    SR3               RIGHT JUSTIFY ERROR CODE IN R2
         SETERROR R2                BUILD ERROR CODE MESSAGE
         TYPE     NEWLINE,DOWN      TELL USER
*E*      MESSAGE: UNRECOVERABLE I/O ON RAD
*E*      DESCRIPTION: AN UNRECOVERABLE I/O ERROR WAS ENCOUNTERED
*E*               WHILE READING THE :USERS FILE.
         SEND     RDLOGONM,ERRCODEM   TELL OPERATOR
*O*      MESSAGE: IDUNRECOVERABLE ERROR READING USERS FILE
*O*               ERROR CODE=XX
*O*      ACTION:  RECREATE INDICATED USER'S RECORD WITH SUPER.
*O*      MEANING: ERROR IN :USERS FILE RECORD FOR INDICATED USER.
         B        TRIES1            AND CLEAN-UP LOG-ON FOR EXIT.
         PAGE
************************************************************************
* THE FOLLOWING CODE IS ENTERED AS A RESULT OF AN ABNORMAL CONDITION ON
* THE READ OF THE LOGIN FILE-PROBABLY FILE NOT PRESENT. THE USER IS
* NOTIFIED AND THE LOG-ON PROCESS IS TERMINATED.
* IF THE USER IS THE MANAGMENT ACCOUNT AND THE ERROR IS 'FILE NOT
* PRESENT', LOGON WILL AUTOMATICALLY CREATE THE FILE WITH THE SPECIAL
* KEY AND ANY PASSWORD GIVEN. THIS DONE, SUPER MAY THEN BE INVOKED
* TO CREATE THE OTHER ACCOUNT ENTRIES.
*
*
OOPS     RES      0
         LB,R2    SR3               PUT ERROR CODE IN R2
         CAL1,1   NORETURN          IGNORE ERROR RETURNS
         CAL1,1   CLOSE             CLOSE LOGON FILE
         CI,R2    3
         BNE      OOPS1             MUST BE ANOTHER ABNORMAL
         CW,D3    SYS               TEST ACCOUNT (IN D3,D4) TO SEE IF
         BNE      BUMMER1              IT'S THE MANAGEMENT ACCOUNT      U:LO0045
         CW,D4    SYS+1
         BNE      BUMMER1                                               U:LO0047
         LW,R2    ACCOUNT           ACCOUNT'S OK, TEST NAME
         CW,R2    SYSUSR
         BNE      BUMMER1                                               U:LO0049
         LW,R2    ACCOUNT+1
         CW,R2    SYSUSR+1
         BNE      BUMMER1                                               U:LO0051
         LW,R2    ACCOUNT+2
         CW,R2    SYSUSR+2
         BNE      BUMMER1                                               U:LO0053
         LCI      2                 ITS THE BOSS-CREATE A LOGIN RECORD
         LM,R2    UPASSWD           FOR HIM WITH PASSWORD, IF ANY
         CW,R2    BLANKS            WAS A PASSWORD SPEC'D
         BE       OOPS5             NO, LEAVE ZEROS IN RECORD
         LCI      2
         STM,R2   LR:PW+RECORD
OOPS5    EQU      %
         LCI      2                 STORE ACCOUNT INTO LOGON RECORD AND
         STM,D3   J:JIT+JACCN          JIT
         STM,D3   LR:ACC+RECORD
         STM,D3   UACCOUNT
         LCI      3                 STORE USER NAME INTO LOGON RECORD
         LM,R0    ACCOUNT
         STM,R0   LR:USR+RECORD
         LI,R0    X'C0C0'           SET PRIV. LEVEL TO 'C0' FOR BATCH AND ON-LIN
         STH,R0   LR:PRIV+RECORD
         LCI      7                 SET UP FPT FOR OPENING LOGON FILE IN
         LM,R0    OPNLOGON             OUTIN MODE
         STM,R0   LIST
         LI,R0    8                 CREATE AS OUTIN
         LCI       13
         LM,R1    OPNLOGON+8
         LCI      14
         STM,R0   LIST+7
         CAL1,1   LIST              DO THE OPEN
         LCI      6                 AND SET UP A WRITE
         LM,R0    LOGFILE
         OR,R0    L(X'1000000')     CHANGE TO A WRITE
         AI,R1    X'20'             PUT IN NEW KEY OPTION
         LCI      6
         STM,R0   LIST
         LI,R3    KEYBUFF
         CAL1,1   LIST              AND WRITE SUPERVISORY RECORD
         CAL1,1   CLOSE             CLOSE LOGON FILE
         B        LOGIT             FINISH LOGGING ON
OOPS1    RES      0
         CI,R2    X'14'             CHECK FOR FILE BUSY
         BE       BUSY
         CI,R2    X'2E'
         BE       BUSY
         CI,R2    X'4C'
         BE       BUSY
         SETERROR R2                BUILD ERROR CODE MESSAGE
         TYPE     NOTHERE,NEWLINE   TELL USER
*E*      MESSAGE: ABNORMAL ERROR ON LOGON FILE
*E*      DESCRIPTION: TROUBLE WITH :USERS FILE DETECTED WHILE LOGGING
*E*               A USER ON.
         SEND     NOTHERE,ERRCODEM     TELL OPERATOR
*O*      MESSAGE: IDABNORMAL ERROR ON LOGON FILE
*O*               ERROR CODE=XX
*O*      ACTION:  RECREATE ACCOUNT WITH SUPER. IF UNSUCCESSFUL, DELETE
*O*               :USERS FILE AND RECREATE FILE WITH SUPER.
*O*      MEANING: TROUBLE WITH :USERS FILE DETECTED WHILE LOGGING A
*O*               USER ON.
         B        TRIES1            DITCH USER
         PAGE
*
*        GOT AN ABNORMAL FROM THE M:UC DCB
*
RES:ERR  EQU      %
RES:ABN  EQU      %
         LB,R1    10                GET I.O ERROR CODE
         CI,R1    X'49'             IS RESOURCE ERROR
         BE       NO:RES            CANT GET THHE RESOURCE
         SEND     RAS:USR           TELL OPERATOR COUNDNT GET RESOURCE
*O*      MESSAGE: ID**LOGON:  CANNOT LOGON RESOURCE REQUESTED
*O*      ACTION:  CONTACT SYSTEMS ANALYST OR MANAGER.
*O*      MEANING: CANNOT ACQUIRE SPECIFIED RESOURCE.
         CAL1,9   1                 AND EXIT
NO:RES   EQU      %
         SEND     RAS:RES           TELL OPERATOR COUNDT DO IT
*O*      MESSAGE: ID**LOGON:  CANNOT LOGON RESOURCE REQUESTED
*O*      ACTION:  CONTACT SYSTEMS ANALYST OR MANAGER.
*O*      MEANING: ILLEGAL RESOURCE SPECIFIED.
         CAL1,9   1                 AND EXIT
*
*
JCUSRERR EQU      %
         LC       J:JIT             BUT IS USER REALLY CONNECTED
         BCR,2    OUT5EA            NO - MY FAULT....
         SEND     USR:ERR           DEFINITELY WRONG
*O*      MESSAGE: ID**LOGON:  USER NOT AUTHORIZED TO USE MC
*O*      ACTION:  NONE
*O*      MEANING: USER WASN'T AUTHORIZED VIA SUPER TO USE MC RESOURCE
         TYPE     NEWLINE,USR:ERR1  TELL USER AT STATION
*E*      MESSAGE: **  YOU ARE NOT AUTHORIZED TO USE THE REMOTE ASSIST
*E*               STATION
         B        LOGOFFX2          AND EXIT SYSTEM...
USR:ERR  TEXTC    '**LOGON:  USER NOT AUTHORIZED TO USE MC'
USR:ERR1 TEXTC    '**  YOU ARE NOT AUTHORIZED TO USE THE REMOTE',;
                  ' ASSIST STATION'
RAS:RES  TEXTC    '**LOGON:  CANNOT ACQUIRE RESOURCE'
RAS:USR  TEXTC    '**LOGON:  CANNOT LOGON RESOURCE REQUESTED'
         PAGE
* THE FOLLOWING CODE IS ENTERED AS THE RESULT OF AN ERROR DURING THE
* KEYED READ OF THE LOGIN FILE. THIS HAS THE IMPLICATION OF THE USER
* SUBMITTING AN INVALID OR GARBLED ID AND/OR ACCOUNT. IT IS NOT POSSIBLE
* TO DETERMINE WHICH PART IS BAD SO A MESSAGE REPEATING BOTH INPUT
* FIELDS IS RETURNED TO THE USER.
*
*
*
BUMMER   RES      0
         CAL1,1   NORETURN          IGNORE ERROR RETURNS
         CAL1,1   CLOSE             CLOSE LOGON FILE
BUMMER1  RES      0
         MTW,1    NATRYS            INCREMENT # NAME/ACCOUNT TRIES
         BAL,SR4  TRIES             PERFORM ERROR LIMIT CHECK
         TYPE     NAMACT            TYPE 'ACCOUNT/ID'
         CAL1,8   COCSTAT
         CW,SR1   Y008              IF N0-ECHO MODE SET,
         BAZ      ACT1              PREVENT ECHOING
         LI,R3    8                    OF USER ACCOUNT AND NAME         U:LO0059
         TYPES    UACCOUNT                                              U:LO0061
         TYPE     SLASH
         LI,R3    12                                                    U:LO0063
         TYPES    UNME
         B        ACT1
*
* COME HERE IF LOGON FILE IS BUSY
*
BUSY     RES      0
         CAL1,8   WAIT1             WAIT FOR ONE SECOND AND TRY AGAIN
         B        OPENIT
         PAGE
* THE FOLLOWING CODE IS ENTERED AS THE RESULT OF ERRORS DURING THE WRITE
* OF THE ASSIGN-MERGE RECORD. USER IS NOTIFIED THAT THE SYSTEM IS UNABLE
* TO WRITE AN A/M RECORD AND IS UNABLE TO LOG HIM ON.
*
*
AMWERR   RES      0
         TYPE     NEWLINE,AMERRMSG  NOTIFY USER
*E*      MESSAGE: UNABLE TO WRITE ASSIGN-MERGE RECORD
*E*      DESCRIPTION: SYSTEM WAS UNABLE TO WRITE AN ASSIGN-MERGE
*E*               RECORD FOR THIS USER.
         LI,R2    0                 INDICATE TO LOGOFF THAT IT'S AN A/M
         STB,R2   J:JIT+JUNAME      ERROR.
         B        TRIES1            TELL USER YOU CAN'T LOG HIM ON, EXIT.
         PAGE
*
*        PARAMETER LISTS
*
WAIT1    RES      0
         GEN,8,24 X'F',1            WAIT CAL PLIST - TIME = 1 SEC
*
* PLIST FOR OUTPUT MESSAGES TO USER CONSOLE.
*
ERIDMSG  GEN,8,24 X'11',UC          WRITE TO USER TERMINAL
         DATA     X'34000000'       P3,P4,P6
         GEN,1,31 1,R2              BUFFER POINTER IN R2
         GEN,1,31 1,R3              SIZE IN R3
         DATA     1                 BYTE DISPLACEMENT
MCLL     GEN,8,24  1,0
         PZE      *0
         DATA     %+1
MCLLMSG  DATA,1   MCLLCNT,21,21,64
         TEXT     '** STATION RELEASED **'
         DATA,1   21,21,21,21
MCLLCNT  EQU      BA(%)-BA(MCLLMSG)-1
*
*
* PLIST FOR OUTPUTTING TEXT MESSAGES TO USER CONSOLE
*
ERIDMSGS GEN,8,24 X'11',UC          WRITE TO USER CONSOLE
         DATA     X'34000000'       P3,P4,P6
         GEN,1,31 1,R2              BUFFER ADDRESS IN R2
         GEN,1,31 1,R3              BUFFER SIZE IN R3
         DATA     0                 BYTE DISPLACEMENT
*
* PLIST TO OBTAIN DATE/TIME
*     TIME RETURNED BOTH IN EBCDIC AND BINARY FORM
*
TIMER    GEN,8,1,23   X'10',1,TIMBUF
*
* PLIST FOR OPENING LOGON FILE
*
OPNLOGON GEN,8,24 X'14',M:LOG       OPEN 'USERS' LOGON FILE             U:LO0067
         DATA     X'CF480219'       P1,2,5,6,7,8,10,13  F3,8,9,12
         DATA     BUMMER            ERROR RETURN ADDRESS
         DATA     OOPS              ABNORMAL RETURN ADDRESS
         DATA     10                MAX RECOVERY TRIES
         DATA     2                 ORGANIZATION KEYED
         DATA     2                 DIRECT ACCESS
         DATA     1                 IN MODE
         DATA     2                 SAVE
         DATA     21                MAX KEY LENGTH = 21
         GEN,8,8,8,8  1,0,2,2       FILE NAME
         TEXTC    ':USERS'
         GEN,8,8,8,8  2,0,2,2       ACCOUNT NUMBER
SECAT    RES      0
         TEXT     SYSACCNT
         DATA     X'03000202'       PASSWORD
         DATA     X'DFEF803F',X'AFC0BF9F'
         DATA     X'05010101'       READ ACCOUNT NUMBERS
         TEXT     'NONE'
*
* PLIST TO ECHO AN UNCLEAR MESSAGE BACK TO THE SENDER
*
ECHOWTE  GEN,8,24 X'11',UC          WRITE TO USER TERMINAL
         DATA     X'30000000'       P3,P4
         DATA     RECORD            BUFFER ADDRESS
         GEN,1,31 1,R2              SIZE IN R2
*
*  PLIST FOR CLOSING THE LOGIN FILE.
*
CLOSE    GEN,8,24 X'15',M:LOG       CLOSE 'USERS' LOGON FILE
         GEN,1,31  1,0              P1
         DATA    2                  SAVE
*
* PLIST FOR IGNORING ERROR RETURNS
*
NORETURN GEN,8,24 X'06',M:LOG       SETDCB FOR LOGON, RATE FILES        U:LO0069
         DATA     X'C0000000'       P1,P2
         DATA     RETURN            ERROR RETURN
         DATA     RETURN            ABNORMAL RETURN
*
* PLIST FOR WRITING ASSIGN/MERGE TABLE.
*
AMR      GEN,8,24 X'2E',M:EO        WRITE ASSIGN-MERGE TABLE            U:LO0071
         GEN,8,24 X'30',0           P3,P4
         DATA     MERTAB            BUFFER ADDRESS
         DATA     4*512             BUFFER SIZE
*
*  PLIST FOR READING THE LOGIN FILE.
*
LOGFILE  GEN,8,24 X'10',M:LOG       READ LOGON FILE RECORD
         DATA     X'B8000010'       P1,P3,P4,P5,F8
         DATA     IOERROR           ERROR RETURN ADDRESS
         DATA     RECORD            BUFFER ADDRESS
         DATA     4*LOGRECSZ        RECORD SIZE
         GEN,1,31 1,R3              KEY ADDRESS IN R3
*
* PLIST FOR OPENING 'MAILBOX'
*
OPNMAIL  GEN,8,24 X'14',M:X1        OPEN MAILBOX FILE
         DATA     X'C5400001'       P1,P2,P6,P8,P10,F12
         DATA     NOMAIL            ERROR RETURN ADDRESS
         DATA     NOMAIL            ABNORMAL RETURN ADDRESS
         DATA     2                 KEYED
         DATA     1                 IN MODE
         DATA     2                 SAVE
         DATA     X'01000202'       FILE NAME
         TEXTC    'MAILBOX'
         DATA     X'02010002'       ACCOUNT
         DATA     0
         DATA     0
*
* PLIST FOR CLOSING 'MAILBOX'
*
CLSMAIL  GEN,8,24 X'15',M:X1        CLOSE MAILBOX FILE
         GEN,1,31 1,0               P1
         DATA     2                 SAVE
*
* PLIST FOR SETTING ERR/ABN ADDRESSES
*
SETEABN  GEN,8,24 X'86',1
         GEN,2,30 3,0
         GEN,1,31 1,D4              ERROR
         GEN,1,31 1,D4              ABNORMAL
*
* PLIST FOR FINDING HELD PROGRAM
*
FSI      GEN,8,24 X'1C',0
*
* PLIST FOR ASSOCIATING HELD PROGRAM
*
ASI      GEN,8,24 X'1C',1
*
*        PLIST FOR DECOUPLING TERMINAL
*
MDCPL    DATA     X'1D800000'       M:DECOUPLE
*
*        PLIST FOR REJECTING COUPLE ATTEMPTS
*
MRCPL    GEN,8,4,20 6,2,0           M:RCPL CAL FPT
         DATA     X'04000000',X'80'
*
*  FPT FOR SETTING THE .80 BIT IN MODE2 (LINE HANG-UP BIT)
*
FPHU     DATA     X'06200000'       SET ATTRIBUTES
         DATA     X'40000000'       SELECT MODE2
         DATA,2   X'80',X'80'       SET .80 BIT
*
*  FPT FOR OBTAINING TERMINAL STATUS
*
COCSTAT  GEN,8,4,20 6,4,0
*
*        PLIST TO WRITE UNSUCCESSFUL LOGON MSG TO OC
*
BADLGMSG DATA     0
         PZE      *0
         PZE      *R2               MESSAGE ADDRESS
*
*        PLIST TO TURN OFF ECHOING
*
NOECHO   GEN,8,4,20 X'06',2,0
         DATA     X'80000000'
         DATA     X'00000080'
*
*        PLIST TO TURN ON ECHOING
*
ECHO     GEN,8,4,20 X'06',2,0
         DATA     X'80000000'
         DATA     X'00800080'
         PAGE
*
*        COME HERE IF ABNORMAL OR ERROR WHILE OPENING 'MAILBOX'
*
NOMAIL   RES      0
         LB,SR3   SR3               RIGHT JUSTIFY ERROR CODE
         CI,SR3   X'2E'             IF FILE IS BUSY, GO AHEAD AND TELL
         BE       RETREQ               USER THAT MAIL HAS BEEN DELIVERED
         CI,SR3   X'14'
         BE       RETREQ
         CI,SR3   X'4C'
         BE       RETREQ
         B        AUTOCALL
*
*        COME HERE IF ERRORS ARE TO BE IGNORED
*
RETURN   RES      0
         B        *SR1              RETURN TO CAL + 1
         PAGE
* THE PARSE SUB-ROUTINE WILL PLACE THE USER ID INTO TEMP STORAGE/JIT
* HAVING THE THREE PARTS AS SEPERATE ENTITIES. SYNTAX CHECKING IS
* PERFORMED AND ERROR ACTIONS ARE TAKEN IN THE EVENT OF SYNTACTICAL
* ERRORS ARE PRESENT.
*   ON ENTRY, R3 = SIZE OF INPUT MESSAGE IN BYTES
*   MESSAGE BEGINS IN LOCATION RECORD
*
*
PARSE    RES      0
         LI,D1    0                 LEFT PAREN FLAG
         LI,D2    0                 RIGHT PAREN. FLAG
         LI,R2    0                 R2 MAINTAINS FIELD POSITION
         LI,R5    J:JIT+JACCN                                           U:LO0077
         LI,R4    UACCOUNT                                              U:LO0079
         BAL,SR3  SCAN              GET ACCOUNT                         U:LO0081
         CI,R7    8                                                     U:LO0083
         BG       SYNTAXA
         LI,R5    ACCOUNT                                               U:LO0085
         LI,R4    UNME
         BAL,SR3  SCAN              GET NAME                            U:LO0089
         CI,R7     0                TEST TO INSURE DATA SUPPLIED
         BE       SYNTAXB
         CI,R7    12                                                    U:LO0091
         BG       SYNTAXB
         CI,D1    0
         BE       %+4               NO EXT. ACC. FIELD PRESENT
         LI,R5    0                 DISABLE STORING IN SCAN
         LI,R4    UEXTACC           FOR STORING ,DATA DEFED IN ACCTSUM
         BAL,SR3  SCAN              GET EXT. ACC. FIELD
         LI,R5    0                 DISABLE UNNEC. STORING IN SCAN
         LI,R4    UPASSWD
         CW,D2    D1
         BE       %+2
         B        SYNTAXC           LEFT OR RIGHT PAREN. MISSING
         LI,D1    0                 RESET
         LI,D2    0                 RESET
         BAL,SR3  SCAN              GET PASSWORD
         CI,R7    8
         BG       SYNTAX
         CI,R7    0                 CHECK IF PASSWORD PRESENT
         BE       PARSE10           NOPE
         PSW,SR4  TSTACK
         LD,D1    UPASSWD
         BAL,SR4  SCRAM             SCRAMBLE THE PASSWORD
         STD,R6   UPASSWD
         PLW,SR4  TSTACK
PARSE10  RES      0
         B        *SR4
         PAGE
* THE SUB-ROUTINE SCAN FORMS A TWO WORD DATA ELEMENT IN *R4 AND *R5
* IT PROVIDES THE NECESSARY BOOKKEEPING TO MAINTAIN THE PLACE WITHIN
* THE INPUT BUFFER.
*
*
SCAN     RES      0
         LI,SR1   0
         LI,R7    0                 R7 IS THE REGISTER BYTE DISPLACEMENT
LOOP     BDR,R3   %+2               THIS TEST MAY BE DONE
         B        *SR3              FIRST BECAUSE
         LB,R6    RECORD,R2         THIS EOM IS COUNTED AS A CHARACTER
         AI,R2    1                 BUMP TO NEXT POSITION
         CI,R6    ' '               IS THIS A BLANK
         BE       YBLK
         CI,R6    X'05'             OR A TAB-TREATED AS BLANK
         BNE      COMMA
YBLK     CI,D1    0                 ALLOW BLANKS IN EXPRESSION
         BNE      COMMA             FOR EXT. ACCT.
         CI,R7    0
         BEZ      LOOP              IGNORE LEADING BLANKS
         AI,SR1   1                 YES-SET BLANK FLAG
         B        LOOP              SUPPRESS TRAILING BLANKS
COMMA    CI,R6    ','               HOW ABOUT A COMMA
         BE       *SR3              FIELD COMPLETE-RETURN
         CI,R6    '('               LEFT PAREN IS A FIELD TERMINATOR
         BNE      PCA
         AI,D1    1                 ALSO INDICATES THE PRESENCE OF EXTACC FIELD

         B        *SR3
PCA      CI,R6    ')'               IN EXTACC,PARENS AND TRAILING BLNKS NOT ALLO
         BNE      BKCHCK
         AI,D2    1                 RIGHT PARENTHESIS PRESENT
         B        LOOP              RIGHT PAREN DOES NOT NEC. TERM. FIELD
BKCHCK   CI,SR1   0                 TEST BLANK FLAG
         BE       CHAROK            JUMP IF OK
         AI,R3    1                 RESET POSITION TO START OF FIELD
         AI,R2    -1
         B        *SR3
CHAROK   CI,R7    24                MAX LENGH OF ANY FIELD
         BGE      SYNTAX            TOO MANY CHARACTERS IN FIELD.
         CI,R4    0                 AVOID UNNEC. STORING
         BE       %+2
         STB,R6   *R4,R7            STORE
         CI,R5    0                 AVOID UNNEC. STORING
         BE       %+2
         STB,R6   *R5,R7            STORE
         AI,R7    1
         B        LOOP
         PAGE
* THE ROUTINE CONCAT IS USED TO CONCATINATE NAME TO ACCOUNT AND PROVIDE
* A BYTE COUNT. THIS CODE IS USED TO GENERATE A KEYWORD TO READ THE
* LOGIN FILE.
*   FOR ENTRY, R2=INPUT FIELD ADDRESS(EIGHT BYTE MAX)
*              R3=KEY BUFFER ADDRESS
*   FOR EXIT,  R4=ACCUMULATED BYTE COUNT - SHOULD BE ZERO ON ENTRY
*              R5=USED FOR BYTE POSITIONING - R6 CONTAINS LAST CHAR.
*   ENTRY AND RETURN ARE MADE ON SR4.
*
*
CONCAT   LI,R5    0
DOIT     LB,R6    *R2,R5            PICK UP CHARACTER.
         AI,R5    1                 BUMP POSITION.
         CI,R6    0
         BE       *SR4              DONE
         AI,R4    1                 COUNT CHARACTER
         STB,R6   *R3,R4            STORE IN KEYBUFFER
         CW,R5    R7                THIS FIELD AT MAXIMUM
         BE       *SR4              DONE
         B        DOIT              NO.
         PAGE
*DRIVE TABLES FOR LIMIT DEFAULT STORING
*THE POSITION OF ENTRY WITHIN THE TABLE IS KEYED DIRECTLY TO TABLE SL:NAME
LIM      COM,2,6,24 CF(2),AF(1),AF(2)
LIMSTORE RES      0
         STS,R6   *R5,R2
         STB,R6   *R5,R2
         STH,R6   *R5,R2
         BAL,SR1  0,R2
LIMINFO  RES      1
         RES      1                 TIME
         LIM,WORD 17,MPPO           LO
         LIM,WORD 17,MPO            PO
         LIM,WORD 17,MDPO           DO
         LIM,WORD 17,MUPO           UO
LIMINFOA EQU      %-LIMINFO
         LIM,WORD 0,PRDCRM          PSTORE
         LIM,SPEC 0,TSTST           TSTORE
         LIM,BYTE 0,JB:NFPOOL-BA(J:JIT) FPOOL
         LIM,SPEC 0,TSTDI           TDISK
         LIM,WORD 0,PRDPRM          PDISK
WORD     EQU      0
HALF     EQU      2
BYTE     EQU      1
SPEC     EQU      3
TSTST    STW,R6   TMDCRM,R5         TEMP DISC SPACE
         STW,R6   TMPDCPK,R5        PEAK TEMP RAD SPACE USED
         B        *SR1
TSTDI    STW,R6   TMDPRM,R5         TEMP DISC PACK SPACE
         STW,R6   TMPDPPK,R5        PEAK TEMP PACK SPACE USED
         B        *SR1
         PAGE
* THE SETLDCF ROUTINE AUTHORIZES ACCESS TO LOGICAL DEVICE PERIPHERALS
* BY SETTING PERTINENT BITS IN JIT (JH:LDCF) FOR THOSE PERIPHERALS
* SPECIFIED IN THE :USERS FILE.
*        ENTER    BAL,SR4  SETLDCF
*        INPUT    R7=0 - AUTHORIZE DEVICES FOR BATCH.
*                 R7=1 - AUTHORIZE DEVICES FOR ON-LINE.
*                 R7=2 - AUTHORIZE DEVICES FOR GHOST.
*                 R4= - ADDRESS OF :UNMP TABLE IN :USERS FILE.
*                 R5= - ADDRESS OF :UPFLGS TABLE IN :USERS FILE.
*        ENTER    BAL,SR4  SETLDCF
*                 REG.USED R1,R2,R3,R6
*
SETLDCF  RES      0
         LI,R1    SV:FTYM           GET LOGICAL DEVICE LIMIT TABLE SIZE.
         STB,R7   SR4               SAVE FLAG TEMPORARILY
SETLDCF2 LH,R2    SH:SYMT,R1        GET PERIPHERAL DEVICE NAME
         LI,R3    LMTSZE
SETLDCF4 CH,R2    *R4,R3            WAS DEVICE NAME IN :USERS FILE
         BE       SETLDCF6          YES, SET FLAG
         BDR,R3   SETLDCF4
         B        SETLDCF8          NO, GET NEXT DEVICE NAME
*
SETLDCF6 LB,R6    *R5,R3            GET PERIPHERAL FLAF FROM :USERS
         AI,R7    8
         SLS,R6   0,R7              SHIFT SPEC. FLAG(BATCH,O/L,GHOST) TO
*                                   BIT 16
         LCW,R3   R1                SHIFT MASK FOR PERIPHERAL FLAG
         LI,R7    X'8000'
         SLS,R7   0,R3
         SLS,R6   0,R3              SHIFT PERIPHERAL FLAG
*
         LI,R2    JH:LDCF           GET LOGICAL DEVICE CONTROL FLAGS
         LH,R3    0,R2
         STS,R6   R3
         STH,R3   0,R2
         LB,R7    SR4               RESTORE FLAG
SETLDCF8 BDR,R1   SETLDCF2          GET NEXT DEVICE NAME
         B        *SR4
         PAGE
* THE ROUTINE SHIFT IS USED TO LEFT SHIFT THE VALUE SPECIFIED IN R4 AND
* TO PRECEDE THE VALUE WITH A BLANK.
*        ENTER    BAL,SR4  SHIFT
*        INPUT    R4=VALUE TO BE SHIFTED
*        OUTPUT   R4=SHIFTED VALUE
*        REGS. USED  R3,R5
SHIFT    EQU      %
         LI,R3    3
SHIFT5   EQU      %
         LB,R5    R4                IF ZERO
         CI,R5    '0'
         BNE      SHIFT8
         AND,R4   Y40FF             REPLACE WITH BLANK
         SCS,R4   8
         BDR,R3   SHIFT5
SHIFT8   EQU      %
         SCS,R4   -8                PRECEDE VALUE WITH BLANK
         B        *SR4
         PAGE
************************************************************************
*                                                                      *
*        ENDJOB/LOGOFF PROCESSOR                                       *
*                                                                      *
************************************************************************
*
LTO      TEXTC    KNEWLINE,'LINE TIMED OUT'
*
LOGOFF   RES      0
         LB,SR3   J:JIT+JUNAME      IF AREA IN JIT RESERVED FOR THE
         CI,SR3   0                    USER NAME HAS BLANKS OR ZEROS
         BE       LOGOFFX              IN IT, THE USER WAS IN THE
         CI,SR3   X'40'
         BE       LOGOFFX
         STW,SR1  TIMBUF+4          (SR1)=YY,DD FROM TIME CALL
         LI,SR3   0
         STB,SR3  J:JIT+JRNST       ERR/ABN RETURNED IN SR3 IF J:RNST=0
         STW,SR3  RATEFLAG          SET RATE FILE INDICATOR TO 'IN'
         CAL1,1   ORATE             OPEN RATE FILE
         CAL1,1   RRATE             READ RECORD INTO 'RECORD'
         CAL1,1   CRATE             CLOSE RATE FILE
RATEIN   BAL,SR4  ACCNTSUM          COMPUTE, DISPLAY, LOG ACCOUNTING INFO
         B        LOGOFFX1
LOGOFFX  EQU      %
         LC       J:JIT             HERE WITH NO UNAME
         BCR,8    LOGOFFX1          AVOID IF NOT ON-LINE
         CI,SR3   0
         BE       LOGOFFX1          A/M WRITE ERROR
         CAL1,8   FPHU              SET HANGUP BIT
         LB,R3    LTO               L/BC OF LINE-TIMED-OUT MESSAGE
         M:WRITE  M:UC,(BUF,LTO),(SIZE,*R3),(BTD,1),;
                  (COC,DELETEIN,DELETEOUT)
LOGOFFX1 EQU      %
         CAL1,8   MDCPL             DECOUPLE CAL AND REJECT CAL
         CAL1,8   MRCPL             TO MAKE SURE THINGS ARE CLEANED UP
         LI,0     ' '               GO WRITE :LOGD RECORD
         BAL,15   WRLOGD            FOR THIS USER.
         LC       J:JIT             JUST LOG OFF MC USER
         BCR,2    LOGOFFX3          NOPE
LOGOFFX2 EQU      %
         LI,R6    RAS:CBP           IT REALLY IS A 560 SYSTEM ISNT IT
         BEZ      LOGOFFX3          NOPE - JUMP OVER THERE...
         LI,R6    X'C0'             JUMP UP
         STB,R6   JB:PRIV           PRIVILEGE LEVEL
         CAL1,2   MCLL              INFORM USER STATION IS RELEASED
*O*      MESSAGE: ** STATION RELEASED **
*O*      ACTION:  NONE
*O*      MEANING: INFORMATION
         CAL1,6   MASTER            GO BRIEFLY MASTER MODE
         LI,R6    0
         STB,R6   RAS:CBP           ZAP RAS USER NUMBER
         LI,R1    1
         STH,R6   RAS:CBP,R1        ZAP BREAK SENT
LOGOFFX3 EQU      %
         LW,R6    =X'00200000'
         CW,R6    M:LL              IS M:LL OPEN
         BAZ      LOGOFFX6          NO
         LI,R1    M:LL
         LI,D4    LOGOFFX6
         CAL1,1   SETEABN           SET ERROR/ABNORMAL ADDRESSES
         CAL1,1   FPTCLSLL          CLOSE M:LL
LOGOFFX6 EQU      %
         CAL1,9   6                 CLOSE COOPERATIVE FILES
         LI,R6    0                 COMMAND PROCESSOR FLAG RETURNED
         CAL1,9   1                 EXIT
*
FPTCLSLL GEN,8,7,17  X'15',0,M:LL
         DATA     X'80000000'
         DATA     2                 SAVE
*
*        COME HERE ON OPEN OR READ ERROR OF RATE FILE
*
RATEERR  RES      0
         LB,SR3   SR3               RIGHT JUSTIFY ERROR CODE
         CI,SR3   3                 BRANCH TO 'NORATE' IF FILE DOESN'T
         BE       NORATE               EXIST
         CI,SR3   X'14'             BRANCH TO 'RATEBUSY' IF THE FILE
         BE       RATEBUSY             IS BUSY
         CI,SR3   X'2E'
         BE       RATEBUSY
         CI,SR3   X'4C'
         BE       RATEBUSY
         CI,SR3   X'75'             THIS IS TO SEE IF THE ERROR WAS DUE
         BE       FDERROR1             TO A BAD FILE DIRECTORY
         SETERROR SR3               BUILD ERROR CODE MESSAGE
         SEND     OPNRFMSG,ERRCODEM
*O*      MESSAGE: IDUNABLE TO OPEN RATE FILE
*O*               ERROR CODE=XX
*O*      ACTION:  DELETE :RATE FILE AND RECREATE WITH RATES PROCESSOR.
*O*      MEANING: THE :RATE FILE HAS AN ERROR.
*
*        COME HERE IF COULDN'T GET A RATE FILE
*
NORATE   RES      0
         CAL1,1   NORETURN          IGNORE ERROR RETURNS FOR CLOSE
         CAL1,1   CRATE             CLOSE RATE FILE
         LI,SR3   -1                INDICATE TO DISPLAY NO RATE FILE
         STW,SR3  RATEFLAG          WAS READ
         B        RATEIN            CONTINUE PROCESSING
*
*        COME HERE IF THE FILE WAS BUSY
*
RATEBUSY RES      0
         CAL1,8   WAIT1             WAIT FOR 1 SECOND AND THEN TRY
         B        LOGOFF               AGAIN
*
*        COME HERE IF THERE IS AN ERROR IN THE :SYS ACCOUNT DIRECTORY
*
FDERROR1 RES      0
         SETERROR SR3
         SEND     ARFMSG,ERRCODEM   TELL OPERATOR
*O*      MESSAGE: IDUNABLE TO ACCESS RATE FILE
*O*               ERROR CODE=XX
*O*      ACTION:  ACTION VARIES WITH ERROR TYPE (SEE BATCH PROCESSING
*O*               REFERENCE MANUAL FOR ERROR CODES.)
*O*      MEANING: LOGON IS UNABLE TO ACCESS THE RATE FILE DUE TO A BAD
*O*               ACCOUNT DIRECTORY.
         B        NORATE            PROCEED AS IF NO RATE FILE
*
*        COME HERE IF THERE IS AN ERROR READING RATE FILE
*
RDRATERR RES      0
         LB,R2    SR3               BUILD ERROR CODE MESSAGE
         SETERROR R2
         SEND     RRFMSG,ERRCODEM
*O*      MESSAGE: IDUNABLE TO READ FILE
*O*               ERROR CODE=XX
*O*      ACTION:  DELETE :RATE FILE AND RECREATE WITH RATES PROCESSOR.
*O*      MEANING: ERROR IN READING :RATE FILE.
         B        NORATE            PROCEED AS IF NO RATE FILE
         PAGE
*
*        RATE FILE PARAMETER LISTS
*
ORATE    RES      0
         GEN,8,24 X'14',M:RATE      OPEN RATE FILE                      U:LO0097
         DATA     X'FF400009'       P1,P2,P3,P4,P5,P6,P7,P8,P10,F9,F12
         DATA     RATEERR           ERROR RETURN ADDRESS
         DATA     RATEERR           ABNORMAL RETURN ADDRESS
         DATA     RECORD            BUFFER AREA
         DATA     288               MAX SIZE EQUALS 72 WORDS
         DATA     10                RECOVERY TRIES
         DATA     1                 CONSECUTIVE
         DATA     1                 SEQUENTIAL ACCESS
         DATA     1                 INPUT MODE
         DATA     2                 SAVE
         DATA     X'07000000'       NULLIFY SN THAT MIGHT BE CARRIED
         DATA     X'08000000'       OVER FROM PREV. ACT. THGH M:EO DCB
         DATA     X'01000202'       FILE NAME
         TEXTC    ':RATE'
         DATA     X'02010202'       ACCOUNT
         TEXT     SYSACCNT
*
*        READ RATE FILE
*
RRATE    RES      0
         GEN,8,24 X'10',M:RATE      READ RATE FILE                      U:LO0099
         DATA     X'C0000000'       P1,P2
         DATA     RDRATERR          ERROR RETURN ADDRESS
         DATA     RDRATERR          ABNORMAL RETURN ADDRESS
*
*        FPT TO SET ERR/ABN FOR IMPLICIT OPEN OF M:UC
*
SETRES   GEN,8,24 6,M:UC
         GEN,8,24   X'C0',0
         DATA     RES:ERR,RES:ABN
*
*        CLOSE RATE FILE
*
CRATE    RES      0
         GEN,8,24 X'15',M:RATE      CLOSE RATE FILE                     U:LO0101
         DATA     0
         PAGE
*************************************************
*  RECONNECT TO SAVED PROGRAM IF USER SO WILLS  *
*************************************************
RECONNECT EQU     %
         TYPE     NEWLINE,HELDMSG
         M:READ   M:UC,(BUF,RECORD),(SIZE,72),(BTD,0)
         LB,R0    RECORD            SEE WHAT HE TYPED
         CI,R0    C'Y'              DID IT START WITH 'Y'
         BE       MASI              YES
         CI,R0    C'N'              DID IT START WITH 'N'?
         BE       NOCONNECT         SURE DID
         B        RECONNECT         LET HIM TRY ONCE MORE
MASI     CAL1,8   ASI               ASSOCIATE HELD PROGRAM
         BCR,8    RECONNOUT         AND LEAVE
         TYPE     NEWLINE,NOIMGMSG  SOMETHING WENT WRONG
         B        NOCONNECT         RESUME NORMAL LOGON
RECONNOUT EQU     %
         OR,8     =X'03000000'      OR IN BC FOR KEY (R8 HAS USER#)
         STW,8    KEYBUFF           S/KEY FOR READ
         LI,R1    X'C0'             L/.C0
         STB,R1   JB:PRIV           S/.C0 AS PRIVILEGE
         M:OPEN   M:EO,(FILE,':LOGD',':SYS'),(INOUT,SHARE),;
                  (ABN,EROPLX),(ERR,EROPLX)
         M:READ   M:EO,(BUF,RECORD),(SIZE,44),(KEY,KEYBUFF),;
                  (BTD,0),(ABN,ERRDWRX),(ERR,ERRDWRX)
         LI,R2    X'FF'             L/.FF; MASK FOR COC LINE #
         AND,R2   M:UC+COCLN        &/MASK W/LINE #
         BAL,11   BIN2HEX           CONVERT LN # TO EBCDIC HEX
         STH,R0   RECORD            S/EBCDIC HEX INTO REC
         M:WRITE  M:EO,(BUF,RECORD),(SIZE,44),(ONEWKEY),;
                  (ABN,ERRDWRX),(ERR,ERRDWRX)
ERRDWRX ;
         M:CLOSE  M:EO              CLOSE :LOGD FILE
EROPLX   ;
         LI,6     0                 FOR INTERP. EXIT - DELUSER
         CAL1,9   1                 EXIT
         PAGE
*
*        THE WRLOGD ROUTINE WRITES A RECORD INTO THE FILE
*        :LOGD.:SYS IF THE SYSTEM CELL S:COUP EXISTS AND CONTAINS
*        THE VALUE TWO. AN 11 WORD RECORD IS WRITTEN CONTAINING
*        THE TIME AND DATE, USER NAME AND ACCOUNT, AN INDICATOR
*        AS TO LOGGING ON OR OFF, AND THE COC LINE NUMBER FROM THE
*        M:UC DCB. THE RECORD IS WRITTEN USING THE SYSID AS A KEY.
*        THE FILE IS IN :SYS, AND IS READ NONE, WRITE NONE, SO WE
*        MUST GO TO X'C0' PRIVELIGE LEVEL TO WRITE IN IT.
*
WRLOGD   LC       J:JIT             IS THIS ONLINE???
         BCR,8    *15               IF NOT, NOTHING TO DO.
         LCI      0
         STM,0    RECORD+20         STUFF THE REGS
         LW,1     S:COUP
         CI,1     2                 IS THE TWO BIT SET??
         BAZ      WRX               NO. HOW DULL....
         LI,4     X'FF'
         AND,4    J:JIT             PICK UP THE SYSID
         OR,4     =X'03000000'      MAKE IT A KEY FOR THE WRITE.
         STW,4    KEYBUFF           AND POKE AWAY.
         LI,2     X'FF'
         AND,2    M:UC+COCLN        GET THE LINE # FROM M:UC
         BAL,SR4  BIN2HEX
         LC       J:JIT             IS THIS A RA USER????
         BCR,2    %+2
         LI,4     'RA'              IF SO, PUT THAT IN RECORD; NO LINE NUMBER.
         SLS,4    16                MOVE OVER TO LOOK PRETTY
         OR,4     0                 PUT IN THE STAR OR BLANK
         AI,4     X'4000'           MIDDLE CHR A BLANK
         LCI      5
         LM,5     J:JIT+JACCN       GET NAME AND ACCOUNT
         LW,10    ='    '           PUT IN BLANKS
         CW,5     10                IS THE ACCOUNT BLANKS??
         BE       WRX               B/YES-TIMED OUT LINE, DONT WRITE...
         LCI      7
         STM,4    RECORD            SHOVE INTO BUFFER AREA
WRLOGG   CAL1,8   WRTIME            REMEMBER WHEN IT HAPPENED.
         LB,1     JB:PRIV           WHATS THIS GUY'S PRIV LEVEL
         STW,1    RECORD+19         REMEMBER THAT.
         LI,1     X'C0'             I THINK THAT ITS X'C0'
         STB,1    JB:PRIV           AND I MEAN WHAT I SAY...
WRLOGO   CAL1,1   WROPEN            OPEN SESAME!!!!
         CAL1,1   WRWRITE           POKE IN THE RECORD
WRLOGC   CAL1,1   WRCLS             SLAM!
WRLOGR   LW,1     RECORD+19         RESTORE THE PRIV LEVEL
         STB,1    JB:PRIV           TO KEEP PEOPLE HAPPY...
WRX      LCI      0
         LM,0     RECORD+20         RESTORE THE REGS
         B        *15               AND SPLIT......
         PAGE
*
*        FPT TO CRAM TIME AND DATE INTO RECORD
*
WRTIME   GEN,8,24 X'10',RECORD+7
*
*        CLOSE :LOGD FILE ON M:EO, SAVE
*
WRCLS    GEN,8,24 X'15',M:EO
         GEN,1,31 1,0               P1
         DATA     2                 SAVE
*
*        WRITE THE RECORD INTO THE FILE
*
WRWRITE  GEN,8,24 X'11',M:EO
         DATA     X'FC000040'       P1-P6, ONEWKEY
         DATA     WOPNE,WOPNE       ERROR AND ABNORMAL
         DATA     RECORD,44,KEYBUFF,0
*
*        OPEN THE :LOGD FILE IN :SYS
*        IN CSECT 0 BECAUSE WE MAY CHANGE MODE FROM INOUT TO OUT
*        TO CREATE THE FILE.
*
         CSECT    0
WROPEN   GEN,8,24 X'14',M:EO
         DATA     X'CF480009'       LOTS OF PARAMETERS....
         DATA     WOPNE             P1- ERR ADDR
         DATA     WOPNE             P2- ABN ADDR
         DATA     10                P5- TRIES=10
         DATA     2                 P6- KEYED
         DATA     2                 P7- DIRECT
WOPNMODE DATA     X'304'            P8- INOUT SHARE, MAY BE OUT
         DATA     2                 P10- SAVE
         DATA     4                 P13- KEYM=4
         GEN,8,8,8,8 1,0,2,2
         TEXTC    ':LOGD'           NAME=:LOGD
         GEN,8,8,8,8 2,0,2,2
         TEXT     ':SYS '           ACCT=:SYS
         GEN,8,8,8,8 3,0,2,2
         RES      2                 PASSWORD=HASH FROM LOADER.
         GEN,8,8,8,8 5,0,2,2
         TEXT     'NONE','    '     READ=NONE
         GEN,8,8,8,8 6,1,2,2
         TEXT     'NONE    '        WRITE=NONE
         USECT    WRLOGD            BACK TO PROCEDURE
         PAGE
*
*        THESE ROUTINES HANDLE ERROR AND ABNORMAL CONDITIONS ON THE
*        :LOGD FILE PROCESSING.
*
WOPNE    LB,2     10                LOOK AT THE ERROR CODE
         CI,2     X'14'             FILE BUSY???
         BE       WRBUSY            IF SO, THAT'S EASY.
         CI,2     3                 MAYBE THE FILE DOESNT EXIST..
         BE       WROPNO            GO CREATE IT.
WROOPS   STW,10   RECORD+18         SAVE ERROR CODE
         BAL,SR4  BIN2HEX
         STH,4    WRMSG+3           CRAM IN ERROR CODE
         LW,SR3   RECORD+18
         SLS,SR3  -17
         LI,2     X'7F'
         AND,2    SR3               GET SUBCODE
         BAL,SR4  BIN2HEX
         STH,4    WRMSG+4           STUFF SUBCODE
         CAL1,2   WMSGF             HOLLER TO OPERATOR
         LH,4     M:EO
         CI,4     X'0020'           IS THE FILE OPEN??
         BANZ     WRLOGC            B/YUP, CLOSE IT
         B        WRLOGR            ELSE JUST SPLIT.
*
*        IF THE FILE WAS BUSY, WE RESTORE USER PRIV LEVEL
*        AND SLEEP FOR A SECOND, THEN TRY AGAIN.
*
WRBUSY   LW,1     RECORD+19
         STB,1    JB:PRIV           ITS NOT THAT I DONT TRUST YOU...
         CAL1,8   WRZZZZ            SNOOZE....
         B        WRLOGG            AND TRY AGAIN.
*
*        IF THE FILE WASN'T THERE, OPEN IT OUT, AND GO TRY THE WRITE.
*        ANY ERRORS ARE PASSED THROUGH THE SAME ERROR HANDLING CODE
*
WROPNO   LW,1     WOPNMODE          GET THE MODE
         CI,1     2                 IF ITS 2=OUT, WE'VE TRIED THIS ALREADY
         BE       WROOPS            AND SHOULDNT TRY IT AGAIN.
         LI,1     2                 SET THE MODE TO OUT
         STW,1    WOPNMODE
         B        WRLOGO            AND GO TRY AGAIN.
*
*        FPT FOR OP MESSAGE
*
WMSGF    DATA     0,X'80000000',WRMSG
*        SNOOZE FPT
*
WRZZZZ   GEN,8,24 X'F',1            SNOOZE FOR ONE 1.2 SEC TICK.
         USECT    DATA
WRMSG    TEXTC    ' LOGON-ERR XX--XX ON :LOGD FILE'
         USECT    WROPNO
         END      LOGON

