TCP/IP Programming Examples › CA ADS Examples › CA ADS TCP/IP Generic Listener Server Program

CA ADS TCP/IP Generic Listener Server Program

******************************************************************
** The following program is an example of a TCP/IP generic       *
** listener server program written in ADS.                       *
** The processing is the following:                              *
** - read a message from the client (first 4 bytes = data length)*
** - send the message back to the client program                 *
** - if the message text is equal to "STOP" or if the connection *
**   is closed, then it closes its socket and return to the      *
**   generic listener service.                                   *
** - if the message text is not equal to "STOP", then it returns *
**   to the generic listener service without closing its socket. *
******************************************************************
***               A D S L I S                                  ***
*** IDD input                                                  ***
*** Use also the following work records defined for ADSCLI:    ***
***     ADSCLI-WORK-RECORD                                     ***
***     ADSCLI-BUFFER-RECORD                                   ***
******************************************************************
       SET OPTIONS DEFAULT IS ON INPUT 1 THRU 80.

ADD PROCESS ADSLIS-PM MODULE SOURCE FOLLOWS
   WRITE TO LOG MESSAGE TEXT = 'ADSLIS: STARTING DIALOG'.
   SNAP RECORD (SOCKET-LISTENER-PARMS).
   ! Read the first 4 bytes: will contain the remaining length
   MOVE 4  TO WK-LENGTH.
   MOVE 0  TO BUFLEN.
   MOVE 1  TO WK-SUBSCRIPT.
   CALL TCPREAD.

   MOVE BUFLEN TO WK-LENGTH.         ! Read data
   MOVE 5      TO WK-SUBSCRIPT.
   CALL TCPREAD.

   IF ((BUFLEN = 4) AND (BUFTXT80 = 'STOP'))
   THEN DO.
     WRITE TO LOG MESSAGE TEXT = 'ADSLIS: STOP MESSAGE RECEIVED'.
     CALL TCPCLOSE.
     LEAVE ADS.
     END.

   MOVE BUFLEN TO WK-LENGTH.         ! Echo the message
   ADD  4    TO WK-LENGTH.           ! Include header
   MOVE 1    TO WK-SUBSCRIPT.
   WHILE WK-LENGTH GT 0 REPEAT.
     IF ( SOCKET(
             SOCKET-FUNCTION-WRITE,
             SOCKET-RETCD,
             SOCKET-ERRNO,
             SOCKET-RSNCD,
             SOCKET-LISTENER-SOCKDESC,
             BUFFER-ARRAY(WK-SUBSCRIPT),
             WK-LENGTH,
             RETLEN) NE 0)
     THEN DO.
        WRITE TO LOG MESSAGE TEXT = 'ADSLIS: WRITE ERROR'.
        CALL TCPERROR.
        CALL TCPCLOSE.
        LEAVE ADS.
        END.
     ADD RETLEN TO WK-SUBSCRIPT.
     SUBTRACT RETLEN FROM WK-LENGTH.
   END.

   WRITE TO LOG MESSAGE TEXT = 'ADSLIS: One message processed'.
   LEAVE ADS.

    !*******************************************************************
    ! Subroutine to read a message                                     *
    !*******************************************************************
   DEFINE SUBROUTINE TCPREAD.
       WHILE WK-LENGTH GT 0 REPEAT.
          IF (SOCKET(SOCKET-FUNCTION-READ,
                     SOCKET-RETCD,
                     SOCKET-ERRNO,
                     SOCKET-RSNCD,
                     SOCKDESC,
                     BUFFER-ARRAY(WK-SUBSCRIPT),
                     WK-LENGTH,
                     RETLEN) EQ 0)
          THEN DO.
             WRITE TO LOG MESSAGE TEXT = 'ADSLIS: READ successful.'.
             END.
          ELSE DO.
             WRITE TO LOG MESSAGE TEXT = 'ADSLIS: READ error.'.
             CALL TCPERROR.
             CALL TCPCLOSE.
             LEAVE ADS.
             END.
          IF (RETLEN = 0)
          THEN DO.
             WRITE TO LOG MESSAGE TEXT = 'ADSLIS: READ 0 bytes'.
             CALL TCPCLOSE.
             LEAVE ADS.
             END.
          ADD RETLEN TO WK-SUBSCRIPT.
          SUBTRACT RETLEN FROM WK-LENGTH.
          END. ! READ LOOP
       GOBACK.

    !*******************************************************************
    ! Subroutine to close the socket                                   *
    !*******************************************************************
    DEFINE SUBROUTINE TCPCLOSE.
       IF (SOCKET(SOCKET-FUNCTION-CLOSE,
                  SOCKET-RETCD,
                  SOCKET-ERRNO,
                  SOCKET-RSNCD,
                  SOCKDESC) EQ 0)
       THEN DO.
          WRITE TO LOG MESSAGE TEXT = 'ADSLIS: CLOSE successful.'.
          END.
       ELSE DO.
          WRITE TO LOG MESSAGE TEXT = 'ADSLIS: CLOSE error.'.
          CALL TCPERROR.
          LEAVE ADS.
          END.
       GOBACK.

    !*******************************************************************
    ! Subroutine to process the socket calls errors                    *
    !*******************************************************************
    DEFINE SUBROUTINE TCPERROR.
       MOVE SOCKET-RETCD TO WK-RETCD.
       MOVE SOCKET-ERRNO TO WK-ERRNO.
       MOVE SOCKET-RSNCD TO WK-RSNCD.
       SNAP RECORD (ADSCLI-WORK-RECORD).
       GOBACK.

MSEND.