*DECK RCM02                        03APR81
USETEXT COMCBEG 
USETEXT COMCAPR 
USETEXT COMCCAE 
USETEXT COMQDEF 
USETEXT COMQFIL 
USETEXT COMQNET 
     PROC RCM02;
       BEGIN    # RCM02 # 
# 
**    RCM02      PROCESS COMMAND 2 (REPLY NEGATIVE).
* 
*     RCM02 EXTRACTS AND VALIDATES THE ATTRIBUTES RECEIVED WITH THE 
*     COMMAND, UPDATES THE AFT ENTRY ACCORDINGLY, AND SENDS A "STOP"
*     COMMAND TO THE REMOTE QTF.
* 
*     PROC RCM02
* 
*     ENTRY      ACN = AFT ENTRY INDEX (CONNECTION NUMBER). 
*                FILESO = TRUE (RFT SENT).
*                NHA/NTA = CURRENT MESSAGE HEADER/TEXT AREA.
* 
*     EXIT       AFT ENTRY STATUS UPDATED.
*                REPLY SENT (STOP). 
* 
*     PROCESS    IF COMMAND NOT CONTINUED,
*                  INITIALIZE ERROR FLAG
*                  IF COMMAND NOT IN SEQUENCE,
*                      CALL ILLSEQ
*                      EXIT.
*                ELSE (COMMAND CONTINUED),
*                  IF PREVIOUS COMMAND NOT RNEG,
*                    CALL ILLSEQ
*                    EXIT.
*                PROCESS ATTRIBUTES RETURNED, 
*                  IF QUALIFER IS "IGNORE", 
*                    IGNORE THIS ATTRIBUTE. 
*                  IF QUALIFIER NOT "SELECT", 
*                    CALL RCMERR. 
*                  ELSE 
*                    IF ATTRIBUTE AND QUALIFIER VALID,
*                      UPDATE AFT ENTRY.
*                    ELSE 
*                      CALL RCMERR. 
*                IF COMMAND CONTINUED (ATTRIBUTE 30), 
*                  EXIT.
*                ELSE 
*                  UPDATE AFT ENTRY (STOP REQUIRED):  
# 
  
# 
****  XREF
# 
      XREF
        BEGIN 
        PROC APFTCH;               # GET ATTRIBUTE #
        PROC CONERR;               # CONNECTION ERROR # 
        PROC CONLOG;
        PROC ILLSEQ;
        PROC PRSTXFR; 
        PROC NAME;                 # DEBUG CODE # 
        PROC RCMERR;
        PROC USRERR;
        FUNC XDXB       B;         # CONVERT CHARACTER TO INTEGER # 
        FUNC YCDZ       C(10);
        END 
# 
****  XREF END
# 
      ITEM AT         I;
      ITEM PREVAT     I;
      ITEM ST         B;
  
      DEF LEMSGDM    #26#;
      ITEM EMSGDM     C(LEMSGDM) = "MESSAGE FROM REMOTE HOST -";
  
      DEF LEMSGIP    #31#;
      ITEM EMSGIP     C(LEMSGIP) = "WRONG REMOTE APPLICATION LEVEL."; 
  
      DEF LEMSGIQ    #31#;
      ITEM EMSGIQ     C(LEMSGIQ) = "INVALID QUALIFIER OR PARAMETER."; 
  
      DEF LEMSGATR   #42#;
      ARRAY EMSGATR    S(5);
        BEGIN 
        ITEM $DATR      C(00,00,LEMSGATR) = 
                 ["                  REJECTED BY REMOTE HOST."];
        ITEM EMSGATRTXT C(00,00,17);
        END 
  
      ARRAY EMSGATV    S(6);
        BEGIN 
        ITEM ATV$HDR    C(00,00,10) = [" VALUE = ("]; 
        ITEM ATV$TEXT   C(01,00,50);
        END 
  
      DEF MAXATRBNO  #11#;
      ARRAY            [0:MAXATRBNO] S(2);
        BEGIN 
        ITEM ATR$TEXT   C(00,00,17) = 
                 ["     ATTRIBUTE NN" 
                 ,"        FILE NAME" 
                 ," DISPOSITION CODE" 
                 ,"         JOB NAME" 
                 ,"  DESTINATION LID" 
                 ,"       SOURCE LID" 
                 ,"         HOST PID" 
                 ,"        FILE SIZE" 
                 ," DATA DECLARATION" 
                 ,"ROUTING DIRECTIVE" 
                 ,"    IMPLICIT TEXT" 
                 ,"      SYSTEM TEXT" 
                 ]; 
        ITEM ATR$ATNO   C(01,30,02);
        ITEM ATR$CODE   U(01,42,18) = 
                 [0                # SENTINEL # 
                 ,AT$FN            # FILE NAME #
                 ,AT$OD            # DISP CODE #
                 ,AT$JN            # JOB NAME # 
                 ,AT$LD            # DESTINATION LID #
                 ,AT$SL            # SOURCE LID # 
                 ,AT$PD            # HOST PID # 
                 ,AT$FS            # FILE SIZE #
                 ,AT$DD            # DD # 
                 ,AT$UT            # EXPLICIT TEXT #
                 ,AT$RU            # IMPLICIT TEXT #
                 ,AT$SR            # SYSTEM ROUTING TEXT #
                 ]; 
        END 
  
      BASED ARRAY TEXTLINE   S(8);
        BEGIN 
        ITEM TEXTLINE1  C(00,00,40);
        ITEM TEXTLINE2  C(04,00,40);
        END 
  
      DEF MAXTERMLEN #7#;          # MAXIMUM TERMINATOR LENGTH #
      ITEM ERR        B;
      ITEM I          I;
      ITEM J          I;
      ITEM PAREN      C(10) = "         ("; 
      ITEM TERM1      C(MAXTERMLEN);
      ITEM TERM2      C(MAXTERMLEN);
  
  
        $BEGIN
        NAME("RCM02");             # DEBUG CODE # 
        $END
  
      IF NOT FILEBIP               # IF COMMAND NOT CONTINUED # 
      THEN
        BEGIN 
        FILECWD = 1;               # SET REQUIRED ATTRIBUTE FLAG #
        IF FILE2 NE 0              # IF RNEG SENT OR RECEIVED # 
          OR NOT FILES0            # OR RFT NOT SENT #
        THEN
          BEGIN 
          ILLSEQ;                  # INVALID MESSAGE SEQUENCE # 
          RETURN; 
          END 
        END 
  
      ELSE                         # IF COMMAND CONTINUED # 
        BEGIN 
        IF FILEBNO NE CM$RNEG      # IF NOT RNEG IN PROGRESS #
        THEN
          BEGIN 
          ILLSEQ;                  # INVALID COMMAND SEQUENCE # 
          RETURN; 
          END 
        END 
  
      ST=FALSE; 
      FILEBIP = FALSE;             # CLEAR COMMAND CONTINUED FLAG # 
      FILESTX = STO$ABORT;         # SEND ABORTED TRANSFER STATE #
      SLOWFOR AT=0 WHILE AT GQ 0   #PROCESS ATTRIBUTES #
      DO
        BEGIN 
        PREVAT = AT;               # SAVE PREVIOUS ATTRIBUTE #
        APFTCH(NTAH,AT,QUAL,ATTEXTL,ATTEXT);  # GET ATTRIBUTE # 
        QUAL=C<0,1>QUAL;           # GET QUALIFIER #
        IF AT LS 0                 # IF END OF ATTRIBUTES # 
        THEN
          BEGIN 
          CYCLE AT;                # CONTINUE LOOP (EXIT) # 
          END 
  
        IF QUAL EQ ATQ$I           # IF QUALIFIER IS "IGNORE" # 
        THEN
          BEGIN 
          CYCLE AT;                # IGNORE THIS ATTRIBUTE #
          END 
  
        IF QUAL NQ ATQ$S           # IF QUALIFIER NOT "SELECT" #
          AND AT NE AT$PI          # AND NOT PROTOCOL ID #
        THEN
          BEGIN 
          RCMERR(LOC(EMSGIQ),LEMSGIQ);
          CYCLE AT;                # CONTINUE LOOP #
          END 
  
        IF AT EQ AT$PI             # IF ATTRIBUTE = PROTOCOL ID # 
        THEN
          BEGIN 
          IF C<0,4>ATEXTWD[0] NE PROTOCL   # IF IDENT MIS-MATCH # 
          THEN
            BEGIN 
            FILERTY = 0;           # NO RETRY # 
# 
*         COMPARE PROTOCOL VERSION (CHAR 1-2) AND LEVEL (CHAR 3-4). 
# 
            ERR = XDXB(C<2,2>ATEXTWD[0], 1, I)
                    OR XDXB(PROTOCLLEV, 1, J);
            IF C<0,2>ATEXTWD[0] NE PROTOCLVER 
              OR (I GT J) 
              OR ERR
            THEN
              BEGIN 
              CONERR (LOC(EMSGIP),LEMSGIP);  # BREAK CONNECTION # 
              RETURN; 
              END 
  
            ELSE
              BEGIN 
              RCMERR (LOC(EMSGIP),LEMSGIP);  # STOP TRANSFER #
              FILESTX = STO$NORTY; # NO RETRY # 
              END 
  
            END 
  
          CYCLE AT;                # CONTINUE LOOP #
          END 
  
        IF ((AT EQ AT$DM)          # IF ATTRIBUTE = DAYFILE MESSAGE # 
          OR (AT EQ AT$OM))        # OR OPERATOR MESSAGE #
        THEN
          BEGIN 
          IF PREVAT NE AT$DM       # IF LAST PARAMETER NOT MESSAGE #
            AND PREVAT NE AT$OM 
          THEN
            BEGIN 
            CONLOG(LOC(EMSGDM),LEMSGDM); # MESSAGE FROM REMOTE - #
            END 
  
          CONLOG(LOC(ATEXTWD[0]),ATTEXTL);
          CYCLE AT;                # CONTINUE LOOP #
          END 
  
        IF AT EQ AT$ST             # IF ATTRIBUTE = STATUS #
        THEN
          BEGIN 
          PRSTXFR;                 # PROCESS STATE-OF-TRANSFER #
          FILECWD = 0;             # CLEAR REQUIRED ATTRIBUTE FLAG #
          CYCLE AT; 
          END 
  
        IF AT EQ AT$AC             # IF COMMAND CONTINUED # 
        THEN
          BEGIN 
          FILEBIP = TRUE;          # SET COMMAND IN PROGRESS #
          FILEBNO = CM$RNEG;
          CYCLE AT;                # CONTINUE LOOP #
          END 
  
        ATR$CODE[0] = AT;          # MUST BE REJECTED ATTRIBUTE # 
        I = MAXATRBNO;             # SET SEARCH LIMIT # 
        ASLONGAS AT NE ATR$CODE[I]
        DO
          BEGIN 
          I = I - 1;               # SEARCH FOR KNOWN ATTRIBUTE # 
          END 
  
        IF I EQ 0                  # IF ATTRIBUTE NOT IN TABLE #
        THEN
          BEGIN 
          ATR$ATNO[0] = YCDZ(AT,2); # PUT ATTR NUMBER IN NAME # 
          END 
  
        EMSGATRTXT = ATR$TEXT[I];  # MOVE ATTR NAME TO MESSAGE #
        USRERR(LOC(EMSGATR),LEMSGATR); # ISSUE MESSAGE #
        IF ATTEXTL GT 0            # IF ATTRIBUTE VALUE RETURNED #
        THEN
          BEGIN 
          TERM1 = ").";            # SET DEFAULT TERMINATORS #
          TERM2 = ")."; 
          P<TEXTLINE> = LOC(ATEXTWD[0]);
          IF ATTEXTL GT 80         # IF VALUE OVERFLOWS BOTH LINES #
          THEN
            BEGIN 
            ATTEXTL = 80; 
            TERM2 = " ... ).";     # SET OVERFLOW TERMINATOR #
            END 
  
          J = ATTEXTL;             # LINE LENGTH #
          ATTEXTL = ATTEXTL - 40; 
          IF ATTEXTL GT 0          # IF VALUE OVERFLOWS FIRST LINE #
          THEN
            BEGIN 
            J = 40; 
            TERM1 = ")";
            END 
  
          C<0,J>ATV$TEXT = C<0,J>TEXTLINE1; 
          C<J,MAXTERMLEN>ATV$TEXT = TERM1;
          CONLOG(LOC(EMSGATV),J+10+MAXTERMLEN);  # ISSUE MESSAGE #
          IF ATTEXTL GT 0          # IF SECOND LINE # 
          THEN
            BEGIN 
            J = ATTEXTL;           # BUILD SECOND LINE #
            PAREN == ATV$HDR;      # REMOVE * VALUE =* #
            C<0,J>ATV$TEXT = C<0,J>TEXTLINE2; 
            C<J,MAXTERMLEN>ATV$TEXT = TERM2;
            CONLOG(LOC(EMSGATV),J+10+MAXTERMLEN); 
            PAREN == ATV$HDR;      # RESTORE * VALUE =* # 
            END 
  
          END                      # ATTRIBUTE VALUE RETURNED # 
  
        END 
  
      IF NOT FILEBIP               # IF COMMAND NOT CONTINUED # 
      THEN
        BEGIN 
        FILER2 = TRUE;             # SET RNEG RECEIVED #
        IF (NOT FILEUER)           # IF NO USER ERROR SET # 
          AND (FILECWD NE 0)       # AND NO STATE-OF-TRANSFER # 
        THEN
          BEGIN 
          EMSGATRTXT = "         TRANSFER"; 
          USRERR(LOC(EMSGATR),LEMSGATR);
          END 
  
        FILEFTS = FTS$STPREQ;      # STOP REQUIRED #
        END 
  
      END      # RCM02 #
    TERM
