*DECK FCSNWFR 
USETEXT TEXTFCS;
      PROC FCSNWFR (ID);
*CALL COPYRITE
# TITLE FCSNWFR - WAIT FOR FTP REPLY.                                  #
  
      BEGIN                            # FCSNWFR                       #
  
# 
**    FCSNWFR - WAIT FOR FTP REPLY. 
* 
*     C. J. RAMSAY                     87/11/03 
* 
*     THIS PROCEDURE WAITS FOR THE NEXT FTP REPLY FROM THE NETWORK. 
* 
*     PROC FCSNWFR (ID) 
* 
*     ENTRY   ID         = CONNECTION IDENTIFIER REPLY EXPECTED FROM. 
*             LRBLEN     = NUMBER OF OCTETS IN LOCAL REPLY. 
*             RRBLEN     = NUMBER OF OCTETS IN REMOTE REPLY.
*             FTPVERBOSE = FTP VERBOSE MODE.
*             MBOX       = MBT INDEX FOR OUTPUT FILE. 
* 
*     EXIT    P<LRB>     = PTR TO BUFFER CONTAINING LOCAL REPLY.
*             P<RRB>     = PTR TO BUFFER CONTAINING REMOTE REPLY. 
*             RPYLEN     = NUMBER OF OCTETS IN REPLY. 
*             FTPID      = CONNECTION IDENTIFIER. 
*             FTPREPLY   = FTP REPLY NUMBER.
*             FTPRPYC1   = FIRST DIGIT OF FTP REPLY NUMBER. 
*             FTPERROR   = TRUE IF FTP PROTOCOL ERROR DETECTED. 
*             FTPSTATE   = FTP USER STATE.
*             FTPCLOSED  = TRUE IF DISCONNECTED DURING FILE TRANSFER. 
* 
*     NOTES   THIS PROCEDURE IS DESIGNED TO HANDLE MULTILINE RESPONSES
*             FROM A LOCAL OR REMOTE HOST WHICH MAY BE INTERSPERSED 
*             WITH MULTILINE RESPONSE FROM THE OTHER HOST.
*             THE CONNECTION IDENTFIER OF THE RECEIVED FTP REPLY IS 
*             PROCESSED ACCORDING TO THE FOLLOWING TABLE. 
* 
*                          ---------------------------------------- 
*                          !  EXPECTED  !  EXPECTED  !  EXPECTED  ! 
*                          ! *LOCALID*  ! *REMOTEID* !  EITHER    ! 
*             -------------!------------!------------!------------! 
*             ! RECEIVED   !            !            !            ! 
*             ! *LOCALID*  !  PROCESS   !   IGNORE   !  PROCESS   ! 
*             ! *AIPISCR*  !            !            !            ! 
*             !------------!------------!------------!------------! 
*             ! RECEIVED   !            !            !            ! 
*             ! *REMOTEID* !   IGNORE   !  PROCESS   !  PROCESS   ! 
*             ! *AIPISCR*  !            !            !            ! 
*             !------------!------------!------------!------------! 
*             ! RECEIVED   !            !            !            ! 
*             ! *AIPIDI*   !  PROCESS   !  PROCESS   !  PROCESS   ! 
*             !            !            !            !            ! 
*             ----------------------------------------------------- 
* 
*     METHOD  WAIT FOR ALL DATA BLOCKS THAT CONSTITUTE THE FTP REPLY. 
*             VALIDATE CONNECTION IDENTIFIER OF FTP REPLY.
*             VALIDATE THE FTP REPLY NUMBER.
*             PROCESS A 221 OR 421 FTP REPLY. 
* 
# 
  
# 
****  PROC FCSNWFR - XREF LIST
# 
      XREF
        BEGIN 
        PROC ABORT;                    # ABORT JOB                     #
        PROC FCSMATS;                  # ALLOCATE TABLE SPACE          #
        PROC FCSNWDB;                  # WAIT FOR DATA BLOCK           #
        PROC FCSOFTO;                  # FLUSH TERMINAL OUTPUT         #
        PROC FCSOWOF;                  # WRITE TO OUTPUT FILE          #
        PROC NETUCAC;                  # COPY ASCII CHARACTER          #
        PROC NETUCAS;                  # COPY ASCII STRING             #
        PROC NETUCDA;                  # CONVERT DISPLAY CODE TO ASCII #
        END 
# 
****
# 
      ITEM ID            I;            # EXPECTED CONNECTION IDENTIFIER#
  
      ITEM COMPLETE      B;            # FTP REPLY COMPLETE FLAG       #
      ITEM CURLEN        I;            # LENGTH OF CURRENT INPUT       #
      ITEM DIND          I;            # DESTINATION INDEX             #
      ITEM I             I;            # INDUCTION VARIABLE            #
      ITEM SIND          I;            # SOURCE INDEX                  #
  
      ARRAY LASTLINE [00:00] S(1);
        BEGIN 
        ITEM LAST$4B     U(00,00,32);  # FIRST 4 BYTES OF LAST LINE    #
        END 
  
      ARRAY LASTCHAR [00:00] S(1);     # LAST CHARACTERS               #
        BEGIN 
        ITEM LAST$B1     U(00,00,08);  # FIRST BYTE                    #
        ITEM LAST$B2     U(00,08,08);  # SECOND BYTE                   #
        ITEM LAST$2B     U(00,00,16);  # FIRST TWO BYTES               #
        END 
  
      ARRAY THISCHAR [00:00] S(1);     # CURRENT CHARACTER             #
        BEGIN 
        ITEM THISCHR     U(00,00,08); 
        END 
  
      BASED ARRAY RPY[00:00] S(1);
        BEGIN 
        ITEM RPY$B1      U(00,00,08);  # FIRST BYTE                    #
        ITEM RPY$B2      U(00,08,08);  # SECOND BYTE                   #
        ITEM RPY$B3      U(00,16,08);  # THIRD BYTE                    #
        ITEM RPY$B4      U(00,24,08);  # FOURTH BYTE                   #
        ITEM RPY$4B      U(00,00,32);  # FIRST FOUR BYTES OF REPLY     #
        END 
  
      ARRAY VERBHDR [LOCALID:REMOTEID] S(2);
        BEGIN 
        ITEM VERB$TEXT   C(00,00,AIPIHDR$) =
       ["--REPLY--  (L) ",
        "--REPLY--  (R) "]; 
        END 
      CONTROL EJECT;
      PROC FCS2INV; 
      BEGIN                            # FCS2INV                       #
# 
**    THIS EMBEDDED PROCEDURE PROCESSES AN INVALID FTP REPLY. 
*     IF THE REPLY IS FROM THE LOCAL HOST THEN ABORT THE PROGRAM. 
*     IF THE REPLY IS FROM THE REMOTE HOST THEN PROCESS AS AN FTP 
*     PROTOCOL ERROR. 
# 
      IF FTPID EQ LOCALID 
      THEN
        BEGIN                          # INVALID REPLY FROM *FTPI*     #
        FTPABORT = EINVRPY;            # SET UP ABORT CODE             #
        ABORT;                         # ABORT JOB                     #
        END 
      ELSE
        BEGIN                          # INVALID REPLY FROM REMOTE     #
        FTPERROR = TRUE;               # SET FTP PROTOCOL ERROR FLAG   #
        FTPREPLY = 0;                  # SET INVALID FTP REPLY NUMBER  #
        FTPRPYC1 = 0;                  # SET INVALID FTP REPLY NUMBER  #
        RRBLEN = 0;                    # RESET REMOTE REPLY LENGTH     #
        END 
  
      RETURN;                          # RETURN TO CALLER              #
  
      END                              # FCS2INV                       #
      CONTROL EJECT;
# 
*     START MAIN PROCEDURE
# 
      COMPLETE = FALSE;                # INITIALIZE COMPLETION FLAG    #
      FOR I = 0 
        WHILE NOT COMPLETE DO 
        BEGIN 
        FCSNWDB (AIPISCR, ID);         # WAIT FOR *AIPISCR* BLOCK      #
# 
*     IF VERBOSE MODE IS ON THEN WRITE FTP REPLY TO OUTPUT FILE.
# 
        IF FTPVERBM EQ OPTON$ 
        THEN
          BEGIN                        # VERBOSE MODE IS ON            #
          DIND = 0;                    # INITIALIZE DESTINATION INDEX  #
          NETUCDA (VERBHDR[FTPID], 0, 
                   AIPIHDR$, INPBUF,
                   DIND, FALSE);       # INSERT --REPLY--  (X) HEADER  #
          FCSOWOF (INPBUF, INPLEN);    # WRITE TO OUTPUT FILE          #
          FCSOFTO;                     # FLUSH TERMINAL OUTPUT         #
          END 
# 
*     COPY DATA FROM INPUT BLOCK TO LOCAL OR REMOTE REPLY BUFFER. 
# 
        CURLEN = INPLEN - AIPIHDR$;    # LENGTH OF DATA IN BLOCK       #
        IF FTPID EQ LOCALID 
        THEN
          BEGIN                        # REPLY FROM LOCAL HOST         #
          RPYLEN = LRBLEN;             # EXISTING DATA IN BUFFER       #
          FOR LRBLEN = LRBLEN + CURLEN
            WHILE ((LRBLEN*10)+70)/75 GR LRBL DO
            BEGIN                      # DATA WILL OVERFLOW BUFFER     #
            FCSMATS (P<LRB>, LRBL,
                     RPYSIZ$);         # ALLOCATE MORE SPACE           #
            END 
          P<RPY> = P<LRB>;             # BASE REPLY BUFFER POINTER     #
          END 
        ELSE
          BEGIN                        # REPLY FROM REMOTE HOST        #
          RPYLEN = RRBLEN;             # EXISTING DATA IN BUFFER       #
          FOR RRBLEN = RRBLEN + CURLEN
            WHILE ((RRBLEN*10)+70)/75 GR RRBL DO
            BEGIN                      # DATA WILL OVERFLOW BUFFER     #
            FCSMATS (P<RRB>, RRBL,
                     RPYSIZ$);         # ALLOCATE MORE SPACE           #
            END 
          P<RPY> = P<RRB>;             # BASE REPLY BUFFER POINTER     #
          END 
        NETUCAS (INPBUF, AIPIHDR$, CURLEN,
                 RPY, RPYLEN);         # COPY TO REPLY BUFFER          #
# 
*     VALIDATE LENGTH OF FTP REPLY. 
# 
        IF RPYLEN LS 4
        THEN
          BEGIN                        # NOT NNN + SPACE               #
          FCS2INV;                     # PROCESS INVALID REPLY         #
          RETURN;                      # GET OUT OF HERE QUICKLY       #
          END 
# 
*     CHECK FOR END OF FTP REPLY. 
# 
        DIND = 0; 
        NETUCAS (RPY, RPYLEN - 2, 
                 2, LASTCHAR, DIND);   # COPY LAST 2 CHARACTERS        #
  
        IF   (LAST$B1 NQ ASCICR)       # LOOK FOR CR LF (TELNET EOL)   #
          OR (LAST$B2 NQ ASCILF)
        THEN
          BEGIN 
          TEST I;                      # RESPONSE NOT COMPLETE         #
          END 
  
        IF RPY$B4 EQ ASCISPACE
        THEN
          BEGIN                        # NOT A MULTILINE REPLY         #
          COMPLETE = TRUE;             # FTP REPLY COMPLETE            #
          END 
        ELSE IF RPY$B4 NQ ASCIMINUS 
        THEN
          BEGIN                        # NOT COMPLETE OR MULTILINE     #
          FCS2INV;                     # PROCESS INVALID REPLY         #
          RETURN;                      # GET OUT OF HERE QUICKLY       #
          END 
# 
*     A MULTILINE REPLY IS OF THE FORM "NNN-" FOR THE FIRST LINE
*     AND "NNN " FOR THE LAST LINE OF THE REPLY.
# 
        ELSE
          BEGIN                        # MULTILINE REPLY               #
          THISCHR = ASCICR;            # SKIP PAST LAST CR + LF        #
          FOR SIND = RPYLEN - 2 
            WHILE (THISCHR NQ ASCILF) AND 
                  (SIND GQ 0) DO
            BEGIN                      # LOOP TILL START OF LAST LINE  #
            SIND = SIND - 1;           # DECREMENT SOURCE INDEX        #
            DIND = 0; 
            NETUCAC (RPY, SIND, 
                     THISCHAR, DIND);  # GET PREVIOUS CHARACTER        #
            END 
          DIND = 0; 
          NETUCAS (RPY, SIND + 1, 4,
                   LASTLINE, DIND);    # FIRST 4 CHARS OF LAST LINE    #
          COMPLETE =
           (RPY$4B - LAST$4B) EQ       # COMPLETE IF REPLY IS SAME FTP #
           (ASCIMINUS - ASCISPACE);    # REPLY NUMBER + ASCII SPACE    #
          END 
# 
*     IF FTP REPLY COMPLETE THEN RESET LOCAL OR REMOTE BUFFER LENGTH
*     AND VALIDATE CONNECTION IDENTIFIER OF FTP REPLY.
# 
        IF COMPLETE 
        THEN
          BEGIN                        # COMPLETE FTP REPLY ASSEMBLED  #
          IF FTPID EQ LOCALID 
          THEN
            BEGIN                      # FTP REPLY FROM LOCAL HOST     #
            LRBLEN = 0;                # RESET LOCAL REPLY LENGTH      #
            COMPLETE = (ID EQ LOCALID) OR 
                       (ID EQ EITHERID) OR
                       (FTPFC EQ AIPIDI); 
            END 
          ELSE
            BEGIN                      # FTP REPLY FROM REMOTE HOST    #
            RRBLEN = 0;                # RESET REMOTE REPLY LENGTH     #
            COMPLETE = (ID EQ REMOTEID) OR
                       (ID EQ EITHERID) OR
                       (FTPFC EQ AIPIDI); 
            END 
          END 
        END 
# 
*     PICK UP AND VALIDATE FTP REPLY CODE.
# 
      FTPRPYC1 = RPY$B1 - ASCIZERO;    # FIRST DIGIT OF REPLY CODE     #
      FTPREPLY = ((RPY$B1 - ASCIZERO) * 100) +
                 ((RPY$B2 - ASCIZERO) * 10) + 
                  (RPY$B3 - ASCIZERO);
      IF (RPY$B1 LS ASCIONE) OR 
         (RPY$B1 GR ASCIFIVE) OR
         (RPY$B2 LS ASCIZERO) OR
         (RPY$B2 GR ASCININE) OR
         (RPY$B3 LS ASCIZERO) OR
         (RPY$B3 GR ASCININE) 
      THEN
        BEGIN                          # REPLY CODE OUT OF RANGE       #
        FCS2INV;                       # PROCESS INVALID REPLY         #
        RETURN;                        # GET OUT OF HERE QUICKLY       #
        END 
# 
*     IF A 221 OR 421 REPLY IS RECEIVED DURING A FILE TRANSFER THEN 
*     SET THE CLOSED FLAG ELSE UPDATE THE FTP STATE.
# 
      IF (FTPREPLY EQ 221) OR 
         (FTPREPLY EQ 421)
      THEN
        BEGIN                          # CONTROL CONNECTION CLOSED     #
        IF FTPSTATE LAN (FTPUFILE + FTPULENT) NQ 0
        THEN
          BEGIN                        # DURING FILE TRANSFER          #
          FTPCLOSED = TRUE;            # SET REMOTE CONNECTION CLOSED  #
          END 
        ELSE
          BEGIN                        # NOT DURING FILE TRANSFER      #
          FTPSTATE = FTPUIDLE;         # FTP STATE IS IDLE             #
          END 
        END 
  
      RETURN;                          # RETURN TO CALLER              #
  
      END                              # FCSNWFR                       #
  
      TERM
