*DECK FFSRCDT 
USETEXT TEXTFFS                        # FS SYSTEM TEXT                #
PROC FFSRCDT(TRFRTYPE, RETSTAT, RSPCN); 
*CALL COPYRITE
# TITLE FFSRCDT - COMPLETE DATA TRANSFER.                              #
  
      BEGIN                            # FFSRCDT                       #
  
# 
**    FFSRCDT - COMPLETE DATA TRANSFER. 
* 
*     CMP                              02/02/88 
* 
*     PROC FFSRCDT(TRFRTYPE, RETSTAT, RSPCN)
* 
*     ENTRY     (TRFRTYPE) = TRTYPE 
*                              RETR,
*                              STOR,
*                              APPE,
*                              LIST.
*               (RSPCN)    = CONNECTION FOR RESPONSES.
* 
*     EXIT      (RETSTAT) = 0 IF NO ERRORS. 
* 
* 
# 
  
      ITEM TRFRTYPE    S:TRTYPE;       # TRANSFER TYPE SET BY CALLER   #
      ITEM RETSTAT     U;              # STATUS RETURNED               #
      ITEM RSPCN       U;              # RESPONSE CN ENTRY NUMBER      #
  
# 
***   PROC FFSRCDT - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC ABORT;                    # NOS ABORT MACRO               #
        PROC FFSCFFB;                  # FLUSH FILE BUFFER - APPE/STOR #
        PROC FFSLCRP;                  # CN MGMENT REQUEST PROCESSOR   #
        PROC FFSUCDA;                  # CONVERT DISPLAY MSG TO ASCII88#
        PROC REPLACE;                  # REPLACE INDIRECT ACCESS FILE  #
        PROC RETERN;                   # RETURN A FILE                 #
        END 
  
# 
***   PROC FFSRCDT - XREF LIST END. 
# 
      ITEM INPLNG            U;        # INPUT MESSAGE LENGTH          #
      ITEM LENCHAR           U;        # BYTES IN CONVERTED MESSAGE    #
  
      ARRAY ERR$MSG [00:00] S(08);
        BEGIN 
        ITEM ERR$C1  C(00, 00, 30) =
          ["550-REQUESTED ACTION NOT TAKEN"]; 
        ITEM ERR$ZB1 U(03, 00, 60) = [0]; 
        ITEM ERR$C   C(04, 00, 30) =
          ["550 PFM ERRORS DETECTED       "]; 
        ITEM ERR$ZB2 U(07, 00, 60) = [0]; 
        END 
  
      CONTROL EJECT;
  
                                       CONTROL FTNCALL; 
# 
*     APPE/STOR 
*         FLUSH FILE BUFFER 
*         BINARY TRANSFER - WRITE CONTROL RECORD IF APPLICABLE
*         IF IA FILE TYPE & SERVER MODE, REPLACE FILE 
# 
  
      IF    (TRFRTYPE EQ S"STOR") 
         OR (TRFRTYPE EQ S"APPE") 
      THEN
        BEGIN                          # APPE/STOR                     #
        FFSCFFB;                       # BUFFER FLUSH ROUTINE          #
        IF SITEFT EQ IA$0 
         AND
           EPTFLAG EQ FTPS$ 
        THEN
          BEGIN 
          REPLACE(MBT, RETSTAT, SENDBUF); 
          IF RETSTAT NQ NEC 
          THEN
            BEGIN                      # PFM ERRORS - SEND 550 MSG     #
            INPLNG = 8; 
            FFSUCDA(ERR$MSG, INPLNG, SENDBUF, LENCHAR); 
            REQ$RCODE[RFTPCM$] = RCM"RCSENDAT"; 
            REQ$CTYPE[RFTPCM$] = RSPCN; 
            REQ$ADDR[RFTPCM$]  = LOC(SENDBUF);
            REQ$LEN[RFTPCM$]   = LENCHAR; 
            FFSLCRP;
            RETSTAT = 550;             # SET ERRORS INDICATOR          #
            GOTO FFSRCDTEND;
            END 
          END                          # FILE IS IA                    #
        END                            # APPE/STOR                     #
  
# 
*     RETR OR LIST - CLOSE DATA CONNECTION. 
# 
      IF    (TRFRTYPE EQ S"RETR") 
         OR (TRFRTYPE EQ S"LIST") 
      THEN
        BEGIN                          # RETR OR LIST                  #
        REQ$RCODE[RFTPCM$] = RCM"RCCLSCON"; 
        REQ$CTYPE[RFTPCM$] = CTYPE"CTDATA"; 
        FFSLCRP;
        END 
  
      RETSTAT = 0;
  
FFSRCDTEND: 
# 
*     IF SERVER MODE AND NOT LIST COMMAND, RETURN FILE. 
# 
      IF     (EPTFLAG EQ FTPS$) 
         AND (TRFRTYPE NQ S"LIST")
      THEN
        BEGIN 
        RETERN(MBT);
        END 
  
      REQ$RCODE[RFTPCM$] = 0; 
      REQ$LEN  [RFTPCM$] = 0; 
      RETURN; 
      END                              # FFSRCDT                       #
  
      TERM
