*DECK FFSRADT 
USETEXT TEXTFFS                        # FS SYSTEM TEXT                #
PROC FFSRADT(TRFRTYPE, RETSTAT, RSPCN); 
*CALL COPYRITE
# TITLE FFSRADT - ACTION DATA TRANSFER.                                #
  
      BEGIN                            # FFSRADT                       #
  
# 
**    FFSRADT - ACTION DATA TRANSFER. 
* 
*     CMP                              02/02/88 
* 
*     PROC FFSRADT(TRFRTYPE, RETSTAT, RSPCN)
* 
*     ENTRY     (TRFRTYPE) = TRTYPE 
*                              RETR,
*                              STOR,
*                              APPE,
*                              LIST.
*               (RSPCN)    = CONNECTION FOR RESPONSES.
* 
*     EXIT      (RETSTAT) = 0 IF NO ERRORS. 
* 
* 
# 
  
      ITEM TRFRTYPE    S:TRTYPE;       # TRANFER TYPE SET BY CALLER    #
      ITEM RETSTAT     U;              # STATUS RETURNED               #
      ITEM RSPCN       U;              # RESPONSE CN ENTRY NUMBER      #
  
# 
***   PROC FFSRADT - XREF LIST BEGIN. 
# 
  
      XREF
        BEGIN 
        PROC ABORT;                    # NOS ABORT MACRO               #
        PROC FFSCFIO;                  # FILE I-O                      #
        PROC FFSLCRP;                  # CN MGMENT REQUEST PROCESSOR   #
        PROC FFSUCDA;                  # CONVERT DISPLAY MSG TO ASCII88#
        PROC FFSUSMS;                  # SEND MESSAGE                  #
        PROC FFSUSRM;                  # SEND 550 ERROR MESSAGE        #
        PROC MESSAGE;                  # NOS MESSAGE MACRO             #
        PROC RETERN;                   # RETURN A FILE                 #
        END 
  
# 
***   PROC FFSRADT - XREF LIST END. 
# 
      ITEM LENCHAR           U;        # BYTES IN CONVERTED MESSAGE    #
  
      ARRAY INTRNL [00:00] S(4);       #INTERNAL LOGIC ERROR           #
        BEGIN 
        ITEM INTNL   C(00,00,31) =
          [" FFSRADT - INTERNAL LOGIC ERROR"];
        ITEM INTZB0  U(03,06,54) = [0]; 
        END 
  
      DEF EMLEN$    # 10 #;            # LENGTH OF ERROR MESSAGE       #
  
      ARRAY ERR$MSG [00:00] S(EMLEN$);
        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, 50) =
          ["550 INVALID CHARACTER(S) - CHECK CHARACTER SET   "];
        ITEM ERR$ZB2 U(09, 00, 60) = [0]; 
        END 
  
      BASED ARRAY TEMPMSG  [0:0] S(3);
        BEGIN 
        ITEM TEMPTEXT   C(00,00,30);
        END 
  
      CONTROL EJECT;
  
                                       CONTROL FTNCALL; 
      IF    (TRFRTYPE EQ S"STOR") 
         OR (TRFRTYPE EQ S"APPE") 
      THEN
        BEGIN 
        BYTESIN = IND$LEN[ICMFTP$];    # INPUT BYTE COUNT              #
        IF BYTESIN GR 0 
        THEN
          BEGIN                        # COUNT GR 0 - SET CALL PARAMS  #
          BUFFAD = IND$ADDR[ICMFTP$]; 
          WHCNT = (BYTESIN * BITSIBYTE) / 60 - 1; # WHOLE WORDS COUNT  #
          WDCNT = (BYTESIN * BITSIBYTE + 59) / 60 - 1; # COUNT FROM 0  #
          CURRIN = 0; 
          END 
        ELSE
          BEGIN                        # EMPTY BLOCK                   #
          RETSTAT = 0;
          RETURN; 
          END 
        END 
  
      FFSCFIO;                         # EXIT TO PERFORM DATA TRANSFER #
  
      IF STATMSG EQ 0 
      THEN
        BEGIN                          # NO STATMSG RETURNED           #
        IF    (TRFRTYPE EQ S"RETR") 
           OR (TRFRTYPE EQ S"LIST") 
        THEN
          BEGIN                        # RETR/LIST                     #
          IF OUTFCR 
          THEN
            BEGIN                      # NML EXIT AND NO F/CTRL - ERROR#
            MESSAGE(INTRNL, 0); 
            ABORT;
            END 
          ELSE
            BEGIN 
            RETSTAT = 0;
            END 
          END                          # RETR                          #
        ELSE
          BEGIN                        # APPE/STOR                     #
          RETSTAT = 0;
          END 
        END                            # STATMSG IS ZERO               #
      ELSE
        BEGIN                          # STATMSG NOT ZERO              #
        RETSTAT = STATMSG;             # PASS MESSAGE CODE TO CALLER   #
        IF STATMSG EQ 550 
        THEN
          BEGIN                        # SEND 550 MSG                  #
          IF TRFRTYPE NQ S"LIST"
          THEN
            BEGIN                      # NOT CATLIST COMMAND           #
            FFSUSMS(RSPCN, ERR$MSG,    # SEND ERROR MESSAGE            #
                    EMLEN$);
            END 
          ELSE
            BEGIN                      # CATLIST COMMAND               #
            P<TEMPMSG> = LOC(INPBUF); 
            PFM$TEXT  = TEMPTEXT; 
            FFSUSRM(RSPCN, MSG$550, PFM$);
            END 
  
          REQ$RCODE[RFTPCM$] = 0; 
          REQ$LEN  [RFTPCM$] = 0; 
  
          IF     (EPTFLAG EQ FTPS$) 
             AND (TRFRTYPE NQ S"LIST")
          THEN
            BEGIN 
            RETERN(MBT);
            END 
          END 
  
        IF STATMSG EQ 226 
        THEN
          BEGIN                        # STOR/APPE                     #
          IF    (TRFRTYPE EQ S"STOR") 
             OR (TRFRTYPE EQ S"APPE") 
          THEN
            BEGIN                      # CANNOT GET 226 FROM FFSCFIO   #
                                       # FOR STOR/APPE                 #
            MESSAGE(INTRNL, 0); 
            ABORT;
            END 
          END                          # STATMSG EQUALS 226            #
        END                            # STATMSG NON-ZERO              #
  
      RETURN; 
  
      END                              # FFSRADT                       #
  
      TERM
