FTN4,L
      PROGRAM LOGON(131,50),92067-16260 REV.2026 800414 
C 
C  ***************************************************************
C  * (C) COPYRIGHT HEWLETT-PACKARD COMPANY 1978.  ALL RIGHTS     *
C  * RESERVED.  NO PART OF THIS PROGRAM MAY BE PHOTOCOPIED,      *
C  * REPRODUCED OR TRANSLATED TO ANOTHER PROGRAM LANGUAGE WITHOUT*
C  * THE PRIOR WRITTEN CONSENT OF HEWLETT-PACKARD COMPANY.       *
C  ***************************************************************
C 
C 
C  SOURCE 92067-18260 
C 
C 
      IMPLICIT INTEGER (A-Z)
      REAL REG,CAPCK
C 
C 
      DIMENSION IDCB(144),IDCB2(144),IBUF(192),ISCB(140),IGBUF(53), 
     C          ICON(2),JBUF(15),SMES(5),IPASS(6),CLIST(256), 
     C          REG(2),IREG(2),IWELC(5),TIME(5),USER(11),RUFM(6), 
     C          FMGR(3),FMGXX(3),CUMTM(2),UPDEL(2)
C 
C 
C  ERROR AND LOG-ON MESSAGE BUFFERS 
C  NOTE THAT ONLY THOSE MESSAGES (BUFFERS) WHICH ARE ALTERED ARE
C  DECLARED HERE. ALL OTHERS ARE FORMATED IN THE CALL STATEMENT.
C  EXCEPT THOSE CALLED FROM MORE THAN ONE PLACE.
C 
C 
C 
C 
      DIMENSION LG01(25),LG06(24),LG306(22),ONMS1(23),
     C          ONMS3(29),LG09(10),LG11(23),LG13(20)
C 
C 
C 
      EQUIVALENCE (IDCB(17),IBUF,IDCB2),
     C            (IGBUF(41),JBUF),(JBUF(3),USER),
     C            (REG,IA,IREG),(IREG(2),IB),(RUFM(3),FMGLU), 
     C            (RUFM(4),GX), 
     C            (RUFM(5),XB)
C 
C 
C  THREE WORDS USED IN COMMUNICATION WITH SUBROUTINES 
C 
C  IRTN1
C  IRTN2
C  INTER
C 
C 
C 
C 
C     "LGON 01 FMP ERROR - XXXXX ON ACCOUNT FILE ACCESS"
C 
      DATA LG01/2HLG,2HON,2H 0,2H1 ,2HFM,2HP ,2HER,2HRO,2HR ,2H- ,
     C     2HXX,2HXX,2HXX,2H O,2HN ,2HAC,2HCO,2HUN,2HT ,2HFI,2HLE,
     C     2H A,2HCC,2HES,2HS / 
C 
C    "LGON 11 FMP ERROR XXXXXX ON DISC MOUNT ATTEMPT" 
C 
      DATA LG11/2HLG,2HON,2H 1,2H1 ,2HFM,2HP ,2HER,2HRO,2HR ,2HXX,
     C     2HXX,2HXX,2H O,2HN ,2HDI,2HSC,2H M,2HOU,2HNT,2H A,2HTT,
     C     2HEM,2HPT/ 
C     "LGON 06 CONFLICT IN DEFINITION OF SESSION LU XX" 
C 
      DATA LG06/2HLG,2HON,2H 0,2H6 ,2HCO,2HNF,2HLI,2HCT,2H I,2HN ,
     C     2HDE,2HFI,2HNI,2HTI,2HON,2H O,2HF ,2HSE,2HSS,2HIO,2HN ,
     C     2H L,2HU ,2HXX/
C 
C     "        SESSION LU= XX SYSTEM LU = XXX 
C 
      DATA LG306/2H  ,2H  ,2H  ,2H  ,2H  ,2H  ,2H  ,2HSE,2HSS,2HIO,2HN ,
     C      2HLU,2H= ,2HXX,2H  ,2HSY,2HST,2HEM,2H L,2HU=,2H X,2HXX/ 
C 
C 
C     "LGON 09 SST OVERFLOW"
C 
      DATA LG09/2HLG,2HON,2H 0,2H9 ,2HSS,2HT ,2HOV,2HER,2HFL,2HOW/
C     " ON                                              " 
C 
      DATA ONMS1/2HON,2H  ,2H  ,2H  ,2H  ,2H  ,2H  ,2H  ,2H  ,2H  , 
     C      2H  ,2H  ,2H  ,2H  ,2H  ,2H  ,2H  ,2H  ,2H  ,2H  ,2H  / 
C 
C     "PREVIOUS TOTAL SESSION TIME:  XX HRS.,  YY MIN.,  ZZ SEC." 
C 
      DATA ONMS3/2HPR,2HEV,2HIO,2HUS,2H T,2HOT,2HAL,2H S,2HES,2HSI, 
     C      2HON,2H T,2HIM,2HE:,2H  ,2HXX,2H H,2HRS,2H.,,2H  ,
     C      2HYY,2H M,2HIN,2H.,,2H  ,2HZZ,2H S,2HEC,2H. / 
C 
C     "LGON 13 CONFLICT WITH SYSTEM DISC LU  XX"
C 
      DATA LG13/2HLG,2HON,2H 1,2H3 ,2HCO,2HNF,2HLI,2HCT,2H W,2HIT,
     C     2HH ,2HSY,2HST,2HEM,2H D,2HIS,2HC ,2HLU,2H  ,2HXX/ 
      DATA ICON/0,10000B/ 
      DATA UPDEL/15501B,15515B/ 
      DATA FMGR/2HFM,2HGR,2H  / 
      DATA FMGXX/2HFM,2HGX,2HX /
      DATA RUFM/2HRU,2H, ,2HFM,2HGL,2HU ,2H, /
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C  DETACH FROM SESSION,RETURN POSSIBLE STRING, AND DEFINE SIZE
C  OF SECOND BUFFER FOR PASSWORD RESPONSE.
C 
C 
      CALL DTACH(ITMP1) 
      SBUF=-26
      CALL EXEC(14,1,I,0) 
C 
C 
C  DEFINE ADDRESSES OF COMMUNICATION WORDS
C 
      CALL SETAA(IRTN1,IRTN2,INTER) 
C 
C 
C 
C  MAKE INITIALIZATION CALL 
C 
C   IF DSCS2 RETURNS NEGATIVE, THEN THE ACCOUNT PROGRAM (ACCTS) 
C   IS BUSY WORKING ON THE ACCOUNT FILE SO WE JUST TERMINATE. 
C   ACCTS WILL RESTART US WHEN IT HAS COMPLETED.
C 
C 
C  THE FOLLOWING VALUES ARE DEFINED BY THE INIT CALL: 
C 
C   -LOG-ON ($LGON) CLASS NUMBER (WITH DON'T DEALLOCATE BIT SET)=LGC
C 
C   -THE FOLLOWING OFFSETS FROM THE FIRST WORD OF THE SCB BUFFER: 
C 
C    IDENTIFIER(IDENT),DIRECTORY ENT#(DIRN), CAPABILITY(ICAP) 
C    USER ID(IUID),GROUP ID (IGID), DISC LIMIT(IDLMT), SST LENGTH WORD(LSST)
C 
C 
1     CALL=INIT(LGC,IDENT,DIRN,ICAP,EROF,IUID,IGID,IDLMT,LSST,DSCS2)
C 
C 
      IF(DSCS2.LT.0) GOTO 158 
C 
C  MAKE A GET SO WE HAVE SOMEONE TO TALK TO IF WE HAVE PROBLEMS.
C 
      CALL EXEC(100025B,LGC+40000B,IGBUF,-106,IRTN1,IRTN2,ITMP1)
      GOTO 160
C 
C  MAKE SURE IT WAS A READ OR WRITE/READ
C 
109   IF(ITMP1.NE.1) GOTO 156 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                    C
C OK, BEFORE CHECKING THE ACCOUNT FILE, DETERMINE WHO WE ARE TALKING C
C TO. THIS IS DONE TO PERMIT LOGON TO REPORT AN ERROR TO THE CALLER  C
C AND THEN RE-ENABLE THE REQUESTING TERMINAL. THIS CODE IS EXECUTED  C
C ONLY ON THE FIRST ENTRY TO LOGON. AFTER THE ACCOUNT FILE IS FOUND  C
C AND OPENED, LOGON NEVER TERMINATES BUT HANGS ON A CLASS GET REQ.   C
C THIS CODE SHOULD BE IN A SUBROUTINE SO ALL REQUESTS TO LOGON (NOT  C
C JUST THE FIRST ONE) COULD USE IT.                                  C 
C                                                                    C
C  NOTE: THE REQUEST BUFFER WAS NOT RELEASED. THIS IS SETUP WORK     C
C        ONLY. THE NORMAL PROCESSING WILL MAKE ANOTHER GET AND       C
C        THEN DO THE REAL WORK ON THIS REQUEST.                      C
C                                                                    C
C                                                                    C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
      INTER=0 
      IF(IRTN2) 10,157,20 
C 
C 
C  THE REQUEST CODE WAS NEGATIVE. IF IT'S NOT (SBUF) THEN THIS
C  IS A SPECIAL BATCH REQUEST AND THE COMMUNICATION IS VIA CLASS
C  CLASS I/O. THE CLASS NUMBER IS IN IRTN1. THE ONLY OTHER NEGATIVE 
C  REQUEST IS TO SHUTDOWN (IRTN2=-1). 
C 
C 
10    IF(IRTN2.EQ.-1) GOTO 156
C 
C  CHECK FOR PASSWORD RESPONSE. 
C 
      IF(IRTN2.NE.SBUF) GOTO 150
C 
C 
C  THE REQUEST WAS = SBUF SO THIS IS A PASSWORD RESPONSE. MODIFY
C  CONTROL PARMS FROM 2ND BUFFER RETURNED IN THE "GET" REQUEST. 
C 
C 
      IRTN1=JBUF
      IRTN2=JBUF(2) 
C 
C 
C 
C  SEE IF THE REQUEST IS INTERACTIVE. 
C 
C 
20    IF(IRTN2.GT.99) GOTO 150
      INTER=XFTTY(IRTN2)
C 
C 
C  SESSION ENVIRONMENT HAS BEEN INITIALIZED--(OR THE CLASS "GET"
C  WOULD HAVE FAILED).
C 
C  OPEN ACCOUNT FILE AND DEFINE RECORD NUMBERS OF THE FOLLOWING 
C  INFORMATION: ACTIVE SESSION TABLE(IACTV),CONFIGURATION TABLE(ICONF), 
C  ACCOUNT DIRECTORY(IDIRC) AND DISC POOL(DSKPL). ALSO, FETCH THE 
C  RESOURCE NUMBER FOR ACCOUNT FILE CONTROL(IRN) AND SAVE SYSTEM MESSAGE
C  NAMR.
C 
C 
150   CALL OPEN(IDCB,IERR,6H+@CCT!,1,-31178)
      IF(IERR.EQ.1) GOTO 175
C 
C 
C  PROBLEM WITH ACCOUNT FILE -- ISSUE ERROR AND TERMINATE.
C 
C  IF IERR POSITIVE, BUT NOT = 1 GIVE FILE NOT FOUND ERROR. 
C 
C  FILE TYPE MUST BE 1
C 
C 
153   IF(IERR.GE.0) IERR=-6 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                    C
C    FMP ERROR AND SHUT DOWN WORK    C
C                                    C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
155   CALL CNUMD(-IERR,LG01(11))
      CALL MESSP(100103B,LG01,-50)
C 
C  RELEASE POSSIBLE CLASS BUFFER
C 
156   CALL EXEC(21+100000B,LGC,IGBUF,0) 
      GOTO 157
C 
C  FAKE OUT THE COMPLIER
C 
98765 CONTINUE
157   CALL CLOSE(IDCB)
C 
C  IF NOT  SHUTDOWN GO WAIT FOR BETTER NEWS 
C 
      IF(IRTN2.NE.-1) GOTO 1
C 
C 
C 
158   CALL EXEC(6)
C 
C 
C 
160   CALL MESSP(100003B, 
     C           44HLGON 00 SESSION ENVIRONMENT NOT INITIALIZED ,-44) 
C 
C  FORCE A TERMINATION
C 
      IRTN2=-1
      GOTO 156
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                  C
C  ACCOUNT FILE OPEN - REQUEST LOCAL LOCK ON RN TO VERIFY VALIDITY C
C                                                                  C
C  READ HEADER                                                     C
C                                                                  C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
175   CALL READF(IDCB,IERR,IBUF,128,ITMP1,1)
      IF(IERR.LT.0) GOTO 155
C     IRN=IAND(IBUF(25),377B) 
      IRN=IBUF(25)
C 
C  IF REJECT ON LOCK OF RN, BAD ENVITONMENT ERROR 
C 
      CALL RNRQ(40001B,IRN,ITMP1) 
      GOTO 160
C 
C 
C  NORMAL RETURN-- ACCOUNT FOUND AND SET-UP.
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C                                                                 C 
C  NORMAL FLOW OF CONTROL RETURNS HERE TO MAKE NEXT "GET" REQUEST.C 
C  WE ALWAYS RELEASE THE RN BEFORE THE "GET" SO SOMEONE ELSE CAN  C 
C  GAIN ACCESS TO THE ACCOUNT FILE.                               C 
C                                                                 C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C 
C 
C 
C 
500   CALL RNRQ(40004B,IRN,ITMP1) 
C 
C  IGNORE NOT SET ABORT RETURN
C 
      GOTO 505
C 
C  FAKE OUT THE COMPLIER
C 
87654 CONTINUE
C 
C 
C  CLEAR NO-PARSE, NO PASSWORD AND BATCH FLAGS
C 
505   NOPAR=0 
      NOPAS=0 
      BFLG=0
      IGBUF=0 
      SCBAD=0 
C 
C 
C  MAKE A "GET" REQUEST BUT DON'T RELEASE THE BUFFER. 
C 
C 
      REG=EXEC(21,LGC+40000B,IGBUF,-106,IRTN1,IRTN2,ITMP1)
C 
C 
C  ONLY ACCEPT READ OR WRITE\READ REQUESTS
C 
C 
      IF(ITMP1.EQ.1) 550,525
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                      C
C  THIS SECTION RELEASES THE CURRENT REQUEST BUFFER,SIGNALS COMPLETION C
C  FOR PROGRAMATIC CALLS, AND CONTINUES WITH THE NEXT "GET" REQUEST.   C
C                                                                      C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
C 
C  RETURN POSSIBLE SCB ADDRESS AND COMPLETION STATUS
C 
515   CALL MESSP(0,SCBAD,-2)
C 
525   CALL EXEC(21,LGC,IGBUF,0) 
      GOTO 500
C 
C 
C 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C                                                                       C 
C  WE HAVE A REAL REQUEST, LOCK TH RN, UPDATE MESSAGE FILE NAMR AND     C 
C  ACCOUNT FILE POINTERS. THEN DETERMINE TYPE OF CALL.                  C 
C                                                                       C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C 
C  IF SHUTDOWN, GO DO IT
C 
550   IF(IRTN2.EQ.-1) GOTO 156
C 
C 
      CALL RNRQ(1,IRN,ITMP1)
C 
C 
C  GET ACCOUNT FILE HEADER INTO MEMORY
C 
      CALL READF(IDCB,IERR,IBUF,128,ITMP1,1)
C 
      IF (IERR.NE.0) GOTO 155 
C 
C 
C  DEFINE ACCOUNT FILE POINTERS 
C 
C 
      IACTV=IBUF
      ICONF=IBUF(2) 
      DSKPL=IBUF(3) 
      IDIRC=IBUF(5) 
      ACENT=IBUF(6) 
      DO 552 I=1,5
      SMES(I)=IBUF(I+6) 
552   CONTINUE
C 
C 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                    C
C  CHECK THE SECOND OPTIONAL PARAMETER FROM THE "GET" REQUEST TO     C
C  DETERMINE TYPE OF CALL.                                           C
C                                                                    C
C                                                                    C
C  IF IRTN2 IS NEGATIVE, THIS IS A PASSWORD,SHUTDOWN OR BATCH LOG-ON C
C  PROCESS. A ZERO WILL CAUSE THE REQUEST TO BE IGNORED. IF POSITIVE,C
C  THEN WE HAVE A LOG-ON REQUEST.                                    C
C                                                                    C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
      IF(IRTN2) 5000,525,555
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C  THIS IS A LOG-ON REQUEST. SET INTERACTIVE / NON-INTERACTIVE FLAG. C
C 
C  CHECK FOR A NUMBER GREATER THAN THE MAX SESSION TERMINAL LU.      C
C                                                                    C
C  NOTE: THE RESPONSE TO THE PASSWORD PROCESSING CONTINUES HERE (555)C
C                                                                    C
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
555   INTER=0 
      IF(IRTN2.GT.99) GOTO 560
      INTER=XFTTY(IRTN2)
C 
C  NOTE: IF SOMEONE ATTEMPTS TO FAKE A BATCH LOG-ON, THEY WILL
C        NEVER SEE A COMPLETION STATUS RETURNED (525 JUST RELEASES
C        THE CLASS BUFFER THEN GETS ON WITH THE NEXT REQUEST).
C 
560   IF(IRTN2.GT.376B) GOTO 525
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                    C
C  TRANSFER LOG MUST BE GREATER THAN ZERO. IF ZERO LENGTH TRANSFER,  C
C  ENABLE THE TERMINAL FOR ANOTHER TRY AND RETURN AN SCB ADDRESS     C
C  OF ZERO IN CASE THIS WAS A PROGRAMMATIC LOG-ON REQUEST.           C
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
      IF(IB.EQ.0) GOTO 515
C 
C 
C 
C 
C 
C 
C 
C  CHECK THE SESSION LIMIT
C 
C 
      IF(IBUF(28)+IBUF(29).LT.0) GOTO 575 
C 
C 
C  SESSION LIMIT EXCEEDED 
C  ISSUE ERROR MESSAGES AND CONTINUE WITH NEXT "GET"
C 
C 
      CALL MESSP(100303B,30HLGON 03 SESSION LIMIT EXCEEDED,-30) 
      GOTO 525
C 
C 
C 
C 
C 
C 
C  THE NUMBER OF ACTIVE SESSIONS IS OK
C  PARSE THE INPUT BUFFER FOR USER,GROUP AND PASSWORD (UNLESS 
C  THE NO-PARSE FLAG IS SET)
C 
575   IF(NOPAR.NE.0) GOTO 579 
C 
C 
C 
C 
C 
576   CALL LPARS(IGBUF,IB,USER,IPASS) 
C 
C 
C  WAS A USER NAME SPECIFIED? 
C 
      IF(USER.EQ.0) GOTO 592
C 
C 
C  USER SPECIFIED. SCAN THE ACCOUNT FILE DIRECTORY FOR SPECIFIED
C  ENTRY. 
C 
C 
C  PRESET DIRECTORY ENTRY NUMBER
C 
579   DENT=0
C 
C 
C  SCAN ALL RECORDS CONTAINING DIRECTORY ENTRIES
C 
      DO 590 I=IDIRC,ACENT-1
      CALL READF(IDCB,IERR,IBUF,128,ITMP1,I)
C 
         DO 585 J=0,112,16
C 
C 
C  IF WE COMPLETE THIS LEVEL WE HAVE FOUND THE USER 
C 
C  2026 PCO CHANGE TO SCAN FULL GROUP NAME C
C 
            DO 580 K=1,11 
            IF(IBUF(J+K).NE.USER(K)) GOTO 585 
580         CONTINUE
C 
          GOTO 595
C 
585       DENT=DENT+1 
          CONTINUE
C 
590   CONTINUE
C 
C 
C  TO GET HERE MEANS THAT THE USER WAS NOT FOUND. 
C 
C  GO ISSUE ERROR AND CONTINUE WITH THE NEXT REQUEST. 
C 
C 
592   CALL MESSP(100403B,20HLGON 04 NO SUCH USER,-20) 
      GOTO 515
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                  C
C  THE USER HAS BEEN IDENTIFIED.                                   C
C                                                                  C
C  IF SIGN SET ON WORD 14 OF THE DIRECTORY ENTRY, THE USER ACCOUNT C
C  BEGINS WITH THE 64TH WORD OF THE SPECIFIED ENTRY.               C
C                                                                  C
C                                                                  C
C NOTE: BATCH LOG-ON REQUESTS CONTINUE AT 595                      C
C                                                                  C
C                                                                  C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
C 
C 
C 
595   IOFF=0
      AREC=IBUF(J+15) 
      IF(AREC) 600,610
C 
C 
C 
C 
C 
C  USER ENTRY FOUND. IT BEGINS AT WORD 64 OF THE SECTOR.
C 
C 
600   IOFF=64 
      AREC=IAND(AREC,77777B)
C 
C 
C 
C 
C 
C  READ THE SECTOR FOR THE SPECIFIED USER ENTRY.
C 
C 
610   CALL READF(IDCB,IERR,IBUF,128,ITMP1,AREC) 
      IF(IERR.NE.0) GOTO 155
C 
C  IF THIS IS A BATCH LOG-ON REQUEST, SKIP THE PASSWORD 
C  CHECK AS THAT WAS PERFORMED BY AN INDEPENDENT PROCESSOR (BATCH 
C  ROUTINES). 
C 
      IF(NOPAS.NE.0) GOTO 735 
C 
C  CHECK THE CHARACTER COUNT OF THE PASSWORD FIELD. IF ZERO, NO PASS- 
C  WORD IS REQUIRED.
C 
C 
      ITMP1=IAND(IBUF(IOFF+1),377B) 
      IF(ITMP1.EQ.0) GOTO 735 
C 
C 
C  PASSWWORD REQUIRED. SEE IF ONE WAS PASSED. 
C 
C 
      IF(IPASS.EQ.0) GOTO 635 
C 
C 
C  PASSWORD PROVIDED. IF SAME LENGTH, COMPARE PASSWORDS.
C 
C 
      IF(IPASS.NE.ITMP1) GOTO 645 
C 
      DO 615 I=2,6
      IF(IBUF(I+IOFF).NE.IPASS(I)) GOTO 645 
615   CONTINUE
C 
C  PASSWORD MATCHES. CONTINUE LOG-ON
C 
C 
C 
C 
C  USER HAS BEEN IDENTIDIED -- ACCOUNT ENTRY IS IN IBUF 
C 
C 
C  CHECK FOR SPECIAL BATCH/SPOOL REQUEST 
C 
735   IF(BFLG.NE.-4) GOTO 740 
C 
C  WE HAVE A REQUEST FOR A DIRECTORY ENTRY NUMBER 
C 
      CALL MESSP(110011B,DENT,-2) 
      GOTO 525
C 
C  SEE IF WE NEED ANOTHER 64 WORD BLOCK 
C 
C  2026 PCO TO CORRECTLY READ EXTENSION INTO BUFFER 
C 
C 
C 
740   ITMP1=IBUF(IOFF+64) 
      IF(IAND(IBUF(IOFF+1),100000B).NE.0) 
     C   CALL READF(IDCB,IERR,IBUF(IOFF+64),64,I,ITMP1) 
C 
C 
C  CLEAR THE SCB BUFFER 
C 
C 
      DO 750 I=1,140
      ISCB(I)=0 
750   CONTINUE
C 
C 
C  SET SESSION IDENTIFIER, DIRECTORY ENT#, USER CAPABILITY, USER \GROUP 
C  DISC ID'S AND DISC LIMIT.
C 
C 
      ISCB(IDENT)=IRTN2 
      ISCB(DIRN) =DENT
      ISCB(ICAP) =IBUF(IOFF+22) 
      ISCB(IUID) =IBUF(IOFF+29) 
      ISCB(IGID) =IBUF(IOFF+30) 
      ISCB(IDLMT)=IBUF(IOFF+31) 
      UID=ISCB(IUID)
      GID=ISCB(IGID)
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                    C
C  BUILD SST -- START LENGTH AT 2+# SPARES                           C
C                                                                    C
C  THE SST SPARES (-1'S) ARE PLACED IN THE SST FIRST. THESE          C
C  ARE THE ONLY ENTRIES WHICH MAY BE MODIFIED ON-LINE. ALL ENTRIES   C
C  FROM THE CONSOLE DEFINITION (LU 1) TO THE END OF THE TABLE ARE    C
C  DEFINED HERE AND ARE NOT ALTERED THEREAFTER.                      C
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
      SPARE=IAND(IBUF(IOFF+32),377B)+IBUF(IOFF+31)
C 
      ITMP1=SPARE+LSST+1
C 
      DO 760 I=1,SPARE
      ISCB(LSST+I)=-1 
760   CONTINUE
C 
C 
      ISCB(LSST)=2+SPARE
C 
C 
C  NOTE: LU'S IN THE SST ARE STORED AS LU-1.
C 
C 
C  SET SESSION LU 1 = TERMINAL LU 
C 
C 
      ISCB(ITMP1)=(IRTN2-1)*256 
C 
C 
C  IF NON-INTERACTIVE CALL, SET LU 1= LU 1
C 
C 
      IF(INTER.EQ.0) ISCB(ITMP1)=0
C 
C 
C  DEFINE STATION NUMBER (USED IN CONFIG TABLE SEARCH)
C 
      STON=ISCB(ITMP1)
C 
C  SAVE START LOCATION FOR MKSST
C 
      SOFF=ITMP1-LSST+1 
C 
C  DEFINE LU 2=LU 2 AND LU 3=LU 3 (IF LU 3 DEFINED IN SYSTEM) 
C 
C 
      ISCB(ITMP1+1)=401B
C 
      LU3=IXGET(1760B)
      IF(LU3.EQ.0) GOTO 762 
C 
C 
C  LU 3 DEFINED IN SYSTEM-- SET UP SST ENTRY AND UPDATE LENGTH. 
C 
C 
      ISCB(ITMP1+2)=1002B 
      ISCB(LSST)=3+SPARE
C 
C 
C 
C  POST ALL SYSTEM DISCS TO SST 
C    (DISCS WITH AN ID=7777)
C 
C 
C  NOTE: THE 256 WORD BUFFER "CLIST" IS USED ONLY TO
C        HOLD THE CARTRIDGE LIST. THE DECISION TO USE 
C        A SECOND BUFFER (RATHER THAN SHARE "IBUF") WAS MADE BECAUSE
C        OF SPEED CONSIDERATIONS. THE SYSTEM DISCS MUST BE DEFINED
C        BEFORE THE USER SST AND WE DON'T WANT TO MAKE THE DISC ACCESS
C        UNLESS WE REALLY HAVE A USER TO LOG-ON. IF PROGRAM SIZE SHOULD 
C        OVERRIDE SPEED REQUIRMENTS, "IBUF" COULD BE USED EITHER
C        BEFORE WE FIND THE USER, OR, ONCE THE USER IS FOUND, SAVE THE
C        POINTERS - READ THE CARTRIDGE LIST - THEN BRING THE USER 
C        RECORD BACK INTO MEMORY. 
C 
762   CALL FSTAA(CLIST) 
C 
C 
C  SCAN LIST OF MOUNTED DISCS 
C 
C 
      DO 765 I=1,252,4
C 
C 
C  END OF LIST ?
C 
C 
      IF(CLIST(I).EQ.0) GOTO 770
C 
C 
C  CHECK FOR ID=SYSTEM (7777B)
C 
C 
      IF(IAND(CLIST(I+3),7777B).NE.7777B) GOTO 765
C 
C 
C  WE HAVE A MATCH. SEE IF IT IS LU 2 OR 3
C 
C 
      DLU=IAND(CLIST(I),77B)-1
      IF(DLU.EQ.1) GOTO 765 
      IF(DLU.EQ.2) GOTO 765 
C 
C 
C  NOT LU 2 OR 3. BUILD SST ENTRY.
C 
      DLU=DLU*256+DLU 
C 
C 
C  MOVE THE ENTRY INTO THE SCB/ NOT POSSIBLE TO OVERFLOW OR COLLIDE 
C  SO NO ERROR CONDITIONS NEED BE CHECKED.
C 
C 
C 
      CALL MKSST(ISCB,DLU,SOFF,ISTAT) 
C 
C 
765   CONTINUE
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                    C
C  PREPARE TO SCAN THE CONFIGURATION TBL. SAVE THE FOLLOWING INFOR-  C
C  MATION BEFORE IBUF (THE USER ACCOUNT ENTRY) IS ALTERED: #SST      C
C  SPARES, USER WELCOME FILE NAMR AND PREVIOUS TOTAL SESSION TIME.   C
C                                                                    C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
770   CUMTM=IBUF(IOFF+25) 
      CUMTM(2)=IBUF(IOFF+26)
C 
      DO 775 I=1,5
      IWELC(I)=IBUF(IOFF+I+6) 
775   CONTINUE
C 
C 
C 
C 
C  CHECK FOR PENDING MAIL BY SAVING BIT 15 OF WORD 21 OF USER ENTRY.
C  BIT IS SET IF MAIL IS PENDING. 
C 
C 
      MAIL=IBUF(IOFF+21)
C 
C  PREPARE TO BRING ACCOUNT SST ENTRIES INTO SCB. 
C 
C 
      LEN=IAND(IBUF(IOFF+33),77777B)
      IF(LEN.EQ.0) GOTO 880 
      ISST=IOFF+33
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                    C
C  THE MKSST ROUTINE MOVES SST DEFINITIONS FROM ONE LOCATION         C
C  (ACCOUNT FILE BUFFER) TO THE SCB BEING BUILT. THIS ROUTINE        C
C  CHECKS FOR DUPLICATE ENTRIES AND FOR ROOM IN THE SST. THE         C
C  SST LENGTH WORD IS INCREMENTED EACH TIME AN ENTRY IS ADDED        C
C  TO THE SST.                                                       C
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
C  BRING IN THE ACCOUNT FILE SST'S. 
C 
C 
      DO 875 I=1,LEN
      IF(MKSST(ISCB,IBUF(ISST+I),SOFF,ISTAT)) 800,875,790 
C 
C  SST OVERFLOW - REPORT ERROR - SKIP ANY ADDITIONAL SST ADDITIONS
C 
790   CALL MESSP(1101B,LG09,-20)
      CALL PERR(LG09,ISCB(EROF))
      GOTO 1000 
C 
C  USER SST CONFLICT WITH SYSTEM DISC DEFINITION - REPORT ERROR 
C  THEN TRY NEXT ONE. 
C 
800   LG13(20)=KCVT(IAND(ISTAT,377B)+1) 
      CALL MESSP(1101B,LG13,-40)
      CALL PERR(LG13,ISCB(EROF))
C 
875   CONTINUE
C 
C 
C 
C 
C 
C  CHECK FOR A CONFIGURATION TABLE ENTRY (IF INTERACTIVE OR BATCH)
C 
880   IF(BFLG.EQ.-2) GOTO 900 
C 
      IF(INTER.EQ.0) GOTO 1000
C 
C 
C  SCAN FOR CONFIGURATION TABLE ENTRY - FAILURE EXIT IS TO 1000 
C                                     - FOUND IS TO 935 
C 
900   ISEC=ICONF
      LEN=0 
      IOFF=1
C 
C  CHECK FOR END OF CONFIGURATION TABLE SECTORS 
C 
910   IF(ISEC.EQ.DSKPL) GOTO 1000 
      CALL READF(IDCB,IERR,IBUF,128,ITMP1,ISEC) 
      IF(IERR.NE.0) GOTO 155
      ISEC=ISEC+1 
C 
C 
C  IF THE OFFSET IS ZERO THEN THIS ENTRY BEGAN ON THE LAST
C  WORD OF THE PREVIOUS SECTOR. WE ALREADY HAVE THE LENGTH
C  WORD SO CONTINUE WITH STATION CHECK. 
C 
      IF(IOFF.EQ.0) GOTO 925
C 
915   LEN=IBUF(IOFF)
920   IF(LEN.EQ.0) GOTO 1000
C 
C  IF THE NEXT ENTRY BEGINS ON THE LAST WORD OF THE SECTOR, 
C  GO BRING IN THE NEXT 64 WORDS OF THE NEXT SECTOR (LENGTH WORD SAVED).
C 
      IF(IOFF.EQ.128) GOTO 930
C 
925   IF(IBUF(IOFF+1).EQ.STON) GOTO 935 
      IOFF=IOFF+LEN+1 
      IF(IOFF.LT.129) GOTO 915
C 
C SET UP OFFSET FOR NEXT SECTOR AND GO GET IT 
C 
930   IOFF=IOFF-128 
      GOTO 910
C 
C 
C  FOUND THE ENTRY FOR THIS STATION 
C 
C  IF CONFIGURATION TABLE ENTRY OVERFLOWS TO NEXT SECTOR
C     THEN READ NEXT SECTOR ( FIRST 64 WORDS )
C 
935   IF(LEN+IOFF.GT.128) CALL READF(IDCB,IERR,IBUF(129),64)
C 
C 
C 
C 
C  CONFIGURATION TABLE ENTRY FOUND FOR THIS STATION.
C 
C 
C  SET LENGTH AND POINTERS
C 
      LEN=LEN-1 
      IF(LEN.EQ.0) GOTO 1000
      IOFF=IOFF+1 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                    C
C  NOTE: IOFF IS INCREMENTED BY 1, NOT 2 BECAUSE THE MKSST           C
C        CALLS START FROM IOFF+1.                                    C
C                                                                    C
C 
C  MOVE CONFIGURATION TABLE ENTRIES TO SST VIA MKSST.                C
C  NOTE: IF DUPLICATE ENTRY IS DETECTED, THE ERROR DIAGNOSTIC        C
C        PRINTED IS DEPENDENT UPON THE USER'S ABILITY TO             C
C        PERFORM THE "SL" COMMAND.                                   C
C                                                                    C
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
      DO 980 I=1,LEN
C 
      IF(MKSST(ISCB,IBUF(IOFF+I),SOFF,ISTAT)) 960,980,950 
C 
C 
C  SST OVERFLOW (MORE THAN 70 ENTRIES)
C 
950   CALL MESSP(1101B,LG09,-20)
      CALL PERR(LG09,ISCB(EROF))
      GOTO 1000 
C 
C 
C 
C 
C 
C  DUPLICATE ENTRY FOUND
C  IF USER CAN'T PERFORM THE "SL" COMMAND, ISSUE THE SHORT DIAGNOSTIC.
C   OTHERWISE, REPORT ALL LU'S IN QUESTION. 
C 
C 
C 
960   CALL CONV(ISTAT,LG306(21),LG306(14))
      LG06(24)=LG306(14)
      CALL MESSP(601B,LG06,-48) 
      CALL PERR(LG06,ISCB(EROF))
      CALL MESSP(10601B,
     C     43H              USER ACCOUNT DEFFINITION USED,-43)
C 
C 
C  CHECK ABILITY TO DO "SL" 
C 
      REG=CAPCK(2HL3,-2,0,ISCB(ICAP)) 
C 
      IF(IB.LT.0) GOTO 980
C 
C 
C  REPORT ALL LU'S INVOLVED AS USER MIGHT WISH TO USE "SL" TO 
C  CHANGE SOMETHING.
C 
      CALL MESSP(10601B,LG306,-44)
      CALL MESSP(10601B,2H  ,-2)
      CALL MESSP(10601B,
     C     42H              CONFIGURATION TABLE IGNORED ,-42) 
      CALL CONV(IBUF(IOFF+I),LG306(21),LG306(14)) 
      CALL MESSP(10601B,LG306,-44)
C 
C 
C  CONTINUE WITH NEXT ENTRY 
C 
980   CONTINUE
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C  CALCULATE THE OFFSET TO THE FIRST LOCATION PAST LAST SST ENTRY 
C 
1000  ITMP1=LSST+ISCB(LSST)+1 
C 
C 
C  UPDATE THE SST LENGTH WORD. NOTE THAT THIS VALUE IS SAVED IN IT'S
C  TWO'S COMPLEMENT FORM. 
C 
      ISCB(LSST)=-ISCB(LSST)
C 
C 
C 
C  SET THE NEGATIVE DISC LIMIT BEHIND THE LAST SST ENTRY. 
C 
C 
      ISCB(ITMP1)=-ISCB(IDLMT)
C 
C 
C  CALCULATE SIZE REQUIRED FOR SCB. 
C 
C 
      IREQ=ITMP1+ISCB(IDLMT)
C 
C 
C 
C 
C 
C 
C  BEFORE BUILDING THE SCB-- BUILD THE SESSION PROGENITOR SO WE 
C  DON'T GRAB MEMORY UNTIL IT IS NEEDED.
C 
C 
C  DUPLICATE A FMGR FOR THIS SESSION. LOOK FOR FMGXX FIRST AS IT
C  MIGHT BE SMALLER. IF NOT FOUND, DUPLICATE FMGR.
C 
C 
C  IF NON-INTERACTIVE, SKIP THE PROGENITOR BUILD
C 
C 
      IF(INTER.EQ.0) GOTO 1280
C 
      ITMP1=IOR(KCVT(IRTN2),30000B) 
C 
      GX=43400B+(ITMP1/256) 
      XB=IAND(ITMP1,377B)*256+40B 
C 
C 
C  IS OUR COPY ALREADY THERE ?
C 
C 
C 
C 
C 
      IF(IDGET(FMGLU).NE.0) GOTO 1280 
C 
C 
C  DUPLICATE THE REAL FMGR
C 
C 
       IF(IDDUP(FMGR,FMGLU,I).EQ.0) GOTO 1276 
C 
C  SEE WHAT ERROR WAS RETURNED
C 
C 
C  14=NO FREE ID'S
C  17=PROGRAM TO BE COPPIED IS MEM RES (CAN'T DO THAT)
C  23=NEW PROG ALREADY EXISTS (SOMEONE BEAT US TO IT) 
C 
C 
      IF(I.EQ.23) GOTO 1280 
C 
C 
C  NO FREE ID SEGMENTS ERROR
C 
1110  CALL MESSP(101203B, 
     C           46HLGON 10 NO FREE ID SEGMENTS OR FMGR NOT FOUND ,-46) 
C 
C 
C  GO TERMINATE THE REQUEST AND START NEXT ONE. 
C 
      GOTO 515
C 
C 
C  SET OWNER ID IN ID SEGMENT (PRESERVE ALL OTHER INFO) 
C 
1276  ITMP1=IDGET(FMGLU)+31 
      IF(ITMP1.EQ.31) GOTO 1110 
      I=IAND(IXGET(ITMP1),177400B)+IRTN2
      CALL IXPUT(ITMP1,I) 
C 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C 
C  BUILD THE SCB
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C 
C 
C 
C 
C 
1280  CALL MKSCB(ISCB,IREQ,SCBAD,IERR)
C 
C 
      IF(IERR.EQ.0) GOTO 1300 
C 
      IF(IERR.EQ.-3) GOTO 1250
C 
C 
C  NO MEMORY ERROR - ISSUE ERROR, KILL FMGLU & GO MAKE NEXT "GET" 
C 
C 
      CALL MESSP(100703B, 
     C           42HLGON 07 NO ROOM FOR SESSION CONTROL BLOCK ,-42) 
1225  CALL IDRPD(FMGLU) 
      GOTO 515
C 
C 
C 
C  DUPLICATE SESSION IDENTIFIER 
C 
C 
C 
1250  CALL MESSP(101003B,36HLGON 08 DUPLICATE SESSION IDENTIFIER,-36) 
      GOTO 1225 
C 
C 
C 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                    C
C                                                                    C
C 
C  AT THIS POINT WE HAVE ACCOMPLISHED THE FOLLOWING:                 C
C                                                                    C
C  -IDENTIFIED AND VERIFIED THE USER                                 C
C  -BUILT A PROGENITOR (FMGLU) FOR THE SESSION                       C
C  -BUILT A SESSION CONTROL BLOCK                                    C
C                                                                    C
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C  GET LOG-ON TIME
C 
C 
1300  CALL EXEC(11,TIME,YEAR) 
      CALL FTIME(ONMS1(3))
C 
C 
C  FORMAT THE TIME AS FOLLOWS FOR ACCOUNT FILE: 
C 
C  WD1= YEAR OFFSET (BITS 15-13 ) MIN(BITS 12-7 ) SEC(BITS 6-0 )
C  WD2= DAY(BITS 13-5) HR(BITS 4-0) 
C 
C 
      LOT1=TIME(2)+(TIME(3)*64)+((YEAR-1978)*4096)
      LOT2=TIME(4)+(TIME(5)*32) 
C 
C 
C 
C  POST LOG-ON INFORMATION TO ACCT FILE 
C 
C  FIRST GET HEADER INTO MEMORY 
C 
C 
      CALL READF(IDCB,IERR,IBUF,128,ITMP1,1)
      IF(IERR.NE.0) GOTO 1265 
C 
C 
C  UPDATE ACTIVE SESSION COUNTER
C 
C 
      IBUF(29)=IBUF(29)+1 
      CALL WRITF(IDCB,IERR,IBUF,128,1)
      IF(IERR.NE.0) GOTO 1265 
C 
C 
C  UPDATE ACTIVE SESSION TABLE
C  -MUST FIRST FIND A FREE SPACE
C 
C 
C 
      DO 1350 I=IACTV,ICONF-1 
C 
      CALL READF(IDCB,IERR,IBUF,128,ITMP1,I)
      IF(IERR.NE.0) GOTO 1265 
C 
         DO 1325 J=1,124,4
         IF(IBUF(J).EQ.0) GOTO 1375 
C 
C 
1325     CONTINUE 
1350  CONTINUE
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                    C
C 
C      SOMETHING IS WRONG HERE. THE SESSION LIMIT INDICATED          C
C      THAT THERE WAS ROOM FOR THIS SESSION. HOWEVER, A SCAN         C
C      OF THE ACTIVE SESSION TABLE INDICATES THAT A) THE ACCOUNT     C
C      FILE HAS BEEN ALTERED, OR B) THE SESSION LIMIT LIES!          C
C                                                                    C
C                                                                    C
C  SO DO THE FOLLOWING:                                              C
C                                                                    C
C  -----IDRPD CALL                                                   C
C  -----ISSUE ERROR MESSAGE                                          C
C  -----CLOSE ACCOUNT FILE                                           C
C  -----TERMINATE                                                    C
C                                                                    C
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
      CALL MESSP(101403B,28HLGON 12 ACCOUNT FILE CORRUPT,-28) 
C 
C 
1265  CALL IDRPD(FMGLU) 
      CALL RLSCB(IRTN2,ITMP1) 
      IF(IERR.EQ.0) GOTO 156
      GOTO 155
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C 
C  FOUND A FREE SPOT IN ACTIVE LIST 
C 
1375  IBUF(J)=IRTN2 
      IBUF(J+1)=LOT1
      IBUF(J+2)=LOT2
      IBUF(J+3)=DENT
C 
C  WRITE IT BACK OUT
C 
C 
      CALL WRITF(IDCB,IERR,IBUF,128,I)
      IF(IERR.NE.0) GOTO 1265 
C 
C 
C 
C 
C 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                    C
C  USER SCB &FMGR ARE BUILT                                          C
C  ACCOUNT FILE HAS BEEN UPDATED                                     C
C  - MOVE AND LINK SCB WITH EXISTING SCB'S                           C
C  -RELEASE RN TO ALLOW POSSIBLE LOG-OFFS                            C
C  -MOUNT ALL DISCS LEFT MOUNTED                                     C
C                                                                    C
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
C 
C 
C 
C  RELEASE LOCK 
C 
      CALL RNRQ(4,IRN,ITMP1)
C 
C  ATTEMPT TO MOUNT DISCS AVAILABLE TO THIS SESSION 
C  THE BUFFER "CLIST" CONTAINS A COPY OF THE CARTRIDGE DIRECTORY
C 
C 
      ID=UID
C 
C 
C  SCAN LIST OF MOUNTED DISCS FOR PRIVATE OR GROUP DISCS
C 
C 
      DO 1500 J=1,2 
      IF(J.EQ.2) ID=GID 
C 
         DO 1400 I=1,252,4
C 
         IF(CLIST(I).EQ.0) GOTO 1500
C 
         IF(IAND(CLIST(I+3),7777B).NE.ID) GOTO 1400 
C 
C 
C  MATCH FOUND. CALL DCMC PROCESSOR.
C 
         CALL DCMC(ITMP1,1,-(IAND(CLIST(I),77B)),J-1,CLIST(I+1),0,0,0,
     C              SCBAD)
      IF(ITMP1.EQ.0) GOTO 1400
      CALL CNUMD(ITMP1,LG11(10))
      CALL MESSP(1301B,LG11,-46)
      CALL PERR(LG11,ISCB(EROF))
C 
C 
1400     CONTINUE 
1500  CONTINUE
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC 
C 
C 
C  BUILD, THEN ISSUE LOG-ON MESSAGES
C 
C  FIRST ISSUE SESSION # AND LOG-ON TIME TO SESSION TERMINAL
C 
      CALL MESSP(10001B,2H  ,-2)
      CALL MESSP(1,ONMS1,-34) 
C 
C 
C 
C 
C  MOVE USER AND GROUP NAMES INTO BUFFER (SYS CON ONLY) 
C  (RETURNS NEGATIVE BYTE COUNT)
C 
C 
      ITMP1= MBT(USER,ONMS1(13))
      CALL MESSP(2,ONMS1,-24+ITMP1) 
C 
      CALL FCNCT(CUMTM,ISCB)
C 
C  CNV2 RETURNS 2 WORDS OF ASCII HOURS
C 
      CALL CNV2(ONMS3(15),ISCB) 
C 
      ONMS3(21)=IOR(KCVT(ISCB(2)),30060B) 
      ONMS3(26)=IOR(KCVT(ISCB(3)),30060B) 
      CALL MESSP(10001B,ONMS3,-58)
C 
C 
C 
C 
C  LIST SYSTEM MESSAGE FILE 
C 
C 
      CALL OPEN(IDCB2,IERR,SMES,1,SMES(4),SMES(5))
C 
C  IF SYSTEM MESSAGE FILE NOT FOUND-- GO CHECK FOR MAIL.
C 
      IF(IERR.LE.0)  GOTO 1600
C 
1550  CALL READF(IDCB2,IERR,ISCB,128,LEN) 
C 
      IF(IERR.NE.0) GOTO 1600 
C 
      IF(LEN.EQ.-1) GOTO 1600 
      CALL MESSP(10001B,ISCB,-(LEN*2))
C 
      GOTO 1550 
C 
C  SPACE A LINE AND CHECK FOR MAIL
C 
C 
1600  CALL CLOSE(IDCB2) 
      IF(MAIL.LT.0) CALL MESSP(10001B,16HMESSAGES WAITING,-16)
      CALL MESSP(10001B,2H  ,-2)
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C  IF NON-INTERACTIVE LOG-ON, WERE ALL DONE 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C 
      IF (INTER.EQ.0) GOTO 515
C 
C 
C 
C 
C  MUST MAKE MESSS CALL WITH -SCB ADDR TO GET FMGR GOING
C 
C  FIRST, BUILD "RU, FMGLU ,NAME:SC:CRN 
C 
      DO 1650 I=1,6 
      ISCB(I)=RUFM(I) 
1650  CONTINUE
C 
C 
      ISCB(7)=IWELC(1)
      ISCB(8)=IWELC(2)
      ISCB(9)=IWELC(3)
      ISCB(10)=2H:
      CALL CNUMD(IWELC(4),ISCB(11)) 
      ISCB(14)=2H:
      CALL CNUMD(IWELC(5),ISCB(15)) 
C 
C 
C 
C 
      CALL MESSS(ISCB,34,1,-SCBAD)
C 
C 
      GOTO 515
C 
C 
C 
C 
C 
C  PASSWORD REQUIRED, BUT NOT PASSED. 
C  PROMPT THE USER FOR A PASSWORD, START A CLASS READ OF THE
C  THE RESPONSE. NOTE THAT THIS IS A DOUBLE BUFFERED READ.
C 
C  NOTE! STATUS CODE=77B FOR PASSWORD REQUIRED. 
C 
635   CALL MESSP(17701B,11HPASSWORD ?_,-11) 
C 
C 
C  SEE IF THIS IS AN INTERACTIVE CALL 
C 
C  AT THIS POINT, D.S. AND BATCH REQUIRE THE PASSWORD TO BE SPECIFIED 
C  IN THE LOG-ON REQUEST. THEREFORE, IF WE NEED A PASSWORD AND THE
C  REQUEST IS NOT INTERACTIVE, ABORT THE PROCESS WITH A LGON 05 ERROR.
C 
C 
      IF(INTER.NE.0) GOTO 680 
645   CALL MESSP(100503B,22HLGON 05 ILLEGAL ACCESS,-22) 
      GOTO 515
C 
C 
C 
C 
C 
C  SET UP FOR INTERACTIVE RESPONSE
C 
C 
C 
680   JBUF=0
      ICON(1)=IRTN2 
      ITMP1=-80 
      ICLAS=LGC 
      IREQ=100021B
C 
685   JBUF(2)=IRTN2 
C 
C 
C 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                                                                    C
C                                                                    C
C  NOTE: JBUF IS THE FINAL 13 WORDS OF IGBUF. THE FIRST 40 WORDS OF  C
C        IGBUF ARE USED FOR THE USER INPUT. THE LAST 13 WORDS (THE   C
C        SECOND BUFFER ON THE PASSWORD CALL) CONTAIN INFORMATION     C
C        DESCRIBING THE USER.                                        C
C                                                                    C
C        WD1= 0 IF INTERACTIVE                                       C
C             CLASS # FOR COMMUNICATION OTHERWISE                    C
C                                                                    C
C        WD2= SESSION ID                                             C
C                                                                    C
C        WD3= BYTE COUNTS OF USER & GROUP NAMES (USER IN HIGH BYTE)  C
C             NOTE: THIS 11 WORD FIELD IS EQUATED TO "USER".         C
C                                                                    C
C        WDS 4-8= USER NAME (BLANK FILL)                             C
C                                                                    C
C        WDS 9-13= GROUP NAME (BLANK FILL)                           C
C                                                                    C
C                                                                    C
C 
C  NOTE: WORD 1 CURRENTLY HAS NO USE. IT IS USED HERE ON THE CHANCE  C
C        THAT NON-INTERACTIVE LOG-ON REQUESTS MAY WANT TO BE ABLE    C
C        TO PROMPT FOR AND THEN RETURN A PASSWORD IF IT WAS NOT      C
C        PROVIDED IN THE ORIGIONAL REQUEST. BY CHANGING THE ABOVE    C
C        SET UP FOR THE CLASS WRITE-READ, THE DOUBLE BUFFERED        C
C        REQUEST COULD BE SENT BACK TO THE REQUESTOR.                C
C                                                                    C
C 
C                                                                    C
C  MAKE THE CLASS REQUEST. IF ERROR, ASSUME BAD CLASS # PASSED       C
C  IN PROGRAMATIC REQUEST.                                           C
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
      CALL XLUEX(IREQ,ICON,IGBUF,ITMP1,JBUF,SBUF,ICLAS) 
      GOTO 645
C 
C  GO MAKE NEXT "GET" REQUEST.
C 
C 
690   GOTO 525
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C  CHECK TYPE OF CALL 
C 
C 
C  -1=SHUTDOWN
C  -2=BATCH (JOB) LOG-ON
C  -3=ACCOUNT NAME REQUEST
C  -4=ACCOUNT DIRECTORY ENTRY REQUEST 
C  -SBUF=PASSWORD RESPONSE
C 
C 
C 
C  CHECK FOR BATCH LOG-ON OR ACCOUNT NAME REQUEST 
C 
5000  BFLG=IRTN2
      IF(IRTN2.EQ.-2.OR.IRTN2.EQ.-3) GOTO 7000
C 
C  CHECK FOR ACCOUNT DIRECTORY ENTRY NUMBER REQUEST 
C 
      IF(IRTN2.EQ.-4) GOTO 8000 
C 
C 
C 
C 
C  IF IRTN2 IS NOT EQUAL TO THE NEG BYTE SIZE OF THE SECOND 
C  BUFFER, IGNORE THIS CALL.
C 
C 
      IF(IRTN2.NE.SBUF) GOTO 525
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C  THIS IS A PASSWORD RESPONSE. 
C 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C 
C  SET SOME FLAGS, PARSE THE PASSWORD (JUST FOR BYTE COUNT AND REMOVAL
C  OF BLANKS).
C 
C 
C 
C 
      IRTN1=JBUF
      IRTN2=JBUF(2) 
C 
C  GET A CR/LF AFTER INTERACTIVE FLAG IS SET UP 
C  IF TERMINAL IS A MULTIPOINT NODE, ISSUE UPLINE,DELETE REQUEST
C 
C 
      CALL XFTTY(IRTN2) 
      CALL ABREG(INTER,ITMP1) 
      IF(IRTN2.GT.99) INTER=0 
      IF(IAND(ITMP1,37400B).EQ.3400B) CALL MESSP(10001B,UPDEL,-4) 
      CALL MESSP(10001B,2H  ,-2)
C 
      CALL LPARS(IGBUF,-IB,ISCB,IPASS)
C 
C  IF PASSWORD NOT GIVEN, ISSUE "ILLEGAL ACCESS"
C 
      IF(IPASS.EQ.0) GOTO 645 
C 
C 
C 
C  CONTINUE WITH PASSWORD CHECK 
      NOPAR=1 
      GOTO 555
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
C 
CCCCCCCCCCCCCCCCCCCCCCCCC 
C  BATCH LOG-ON REQUEST C 
CCCCCCCCCCCCCCCCCCCCCCCCC 
C 
C 
C  DIRECTORY SECTOR IS IN IBUF AND RN IS LOCKED 
C 
C 
C 
7000  DENT=IGBUF
      INTER=0 
      NOPAS=1 
      IRTN2=377B
C 
C  NOTE: ID 377B IS RESERVED FOR BATCH
C 
C 
C  DEFINE RECORD NUMBER 
C 
      ITMP1=DENT/8+IDIRC
C 
C  VERIFY PASSED PARAMETER
C 
      IF(ITMP1.LT.IDIRC.OR.ITMP1.GE.ACENT) GOTO 7900
C 
C  GET DIRECTORY SECTOR INTO MEMORY 
C 
      CALL READF(IDCB,IERR,IBUF,128,I,ITMP1)
      IF(IERR.NE.0) GOTO 155
C  DEFINE THE VARIABLE "J" TO BE THE OFFSET INTO THE SECTOR.
C  NOTE: "J" MUST BE DEFINED AS NOTED.
C 
      J=MOD(DENT,8)*16
C 
C  PERFORM FUTHER VALIDITY CHECKS 
C 
      IF(IBUF(J+15).EQ.0) GOTO 7900 
      IF(IBUF(J+1).EQ.0.OR.IBUF(J+1).EQ.-1) GOTO 7900 
C 
C 
C  CHECK FOR USER.GROUP NAME REQUEST (SPECIAL BATCH\SPOOL ENTRY)
C 
      IF(BFLG.NE.-3) GOTO 7100
C 
C  NOTE: FORMAT = DIRECTORY FORMAT
C  RETURN NAME TO CALLER AND MAKE NEXT GET REQUEST
C 
      CALL MESSP(110011B,IBUF(J+1),-22) 
      GOTO 525
C 
C 
C 
C 
C  CONTINUE BATCH LOG-ON
C  LOOKS OK- MOVE USER.GROUP NAME INTO "USER" 
C 
7100  DO 7200 I=1,11
      USER(I)=IBUF(J+I) 
7200  CONTINUE
C 
C 
C  CONTINUE LOG-ON WITH STANDARD PROCESSING 
C 
      GOTO 595
C 
C 
7900  CALL MESSP(101603B,30HLGON 14 BAD JOB LOG-ON REQUEST,-30) 
      GOTO 525
C 
C 
C 
C 
C 
C 
C  THIS IS A REQUEST FOR THE ACCOUNT DIRECTORY ENTRY NUMBER 
C  CORRESPONDING TO THE LOGON STRING PASSED.
C 
8000  IRTN2=377B
      INTER=0 
      CALL RNRQ(1,IRN,ITMP1)
      GOTO 576
C 
C 
      END 
      END$