TCP/IP Programming Examples › CA ADS Examples › CA ADS TCP/IP Client Program
CA ADS TCP/IP Client Program
******************************************************************
* The following program is an example of a TCP/IP client *
* program written in ADS. *
* The processing is the following: *
* - Create a socket for the client program. *
* - Convert the known dotted string format IPA to binary. *
* - (Host IPA is defined in IPADOT, see below.) *
* - Find host information for connection. *
* - (Host port is defined in DESTPORT, see below.) *
* - Establish a connection to the host listener. *
* - Send message 1 to the listener (first 4 bytes = data length)*
* - Read message 1 from listener (first 4 bytes = data length) *
* - Send message 2 to the listener (first 4 bytes = data length)*
* - Read message 2 from listener (first 4 bytes = data length) *
* - Close socket and exit. *
******************************************************************
*** A D S C L I ***
*** IDD input ***
******************************************************************
SET OPTIONS DEFAULT IS ON INPUT 1 THRU 80.
ADD RECORD ADSCLI-WORK-RECORD.
02 WK-RETCD PIC S9(8) COMP.
02 WK-ERRNO PIC S9(8) COMP.
02 WK-RSNCD PIC S9(8) COMP.
02 SOCKDESC PIC S9(8) COMP.
02 LOOP-COUNT PIC S9(8) COMP.
02 RETLEN PIC S9(8) COMP.
02 WK-LENGTH PIC S9(8) COMP.
02 WK-SUBSCRIPT PIC S9(8) COMP.
02 HOSTIPA PIC 9(8) COMP.
02 HOSTENTP PIC 9(8) COMP.
02 MAX-LOOP PIC 9(4) COMP VALUE 2.
02 DEST-PORT PIC 9(8) COMP VALUE 12345.
02 IPA-HOST PIC X(12) VALUE '255.255.25.2'.
02 FILLER PIC X(4) VALUE SPACES.
02 IPA-HOSTL PIC S9(8) COMP VALUE 16.
ADD RECORD ADSCLI-BUFFER-RECORD.
02 BUFFER PIC X(84).
02 BUFFER-REDEF1 REDEFINES BUFFER.
03 BUFLEN PIC 9(8) COMP.
03 BUFTXT80 PIC X(80).
03 BUFTXT80-REDEF REDEFINES BUFTXT80.
04 BUFTXT-MSG PIC X(29).
04 BUFTXT-SEQ PIC X(5).
04 BUFTXT-BLANK PIC X(1).
04 BUFTXT-FILLER PIC X(45).
02 BUFFER-REDEF2 REDEFINES BUFFER.
03 BUFFER-ARRAY PIC X(1) OCCURS 84.
ADD PROCESS ADSCLI-PM MODULE SOURCE FOLLOWS
WRITE TO LOG MESSAGE TEXT = 'ADSCLI: Starting dialog.'.
!*******************************************************************
! Create a socket *
!*******************************************************************
IF (SOCKET(SOCKET-FUNCTION-SOCKET,
SOCKET-RETCD,
SOCKET-ERRNO,
SOCKET-RSNCD,
SOCKET-FAMILY-AFINET,
SOCKET-TYPE-STREAM,
SOCKET-PROTOCOL-TCP,
SOCKDESC) EQ 0)
THEN DO.
WRITE TO LOG MESSAGE TEXT = 'ADSCLI: SOCKET successful.'.
END.
ELSE DO.
WRITE TO LOG MESSAGE TEXT = 'ADSCLI: SOCKET error'.
CALL TCPERROR.
LEAVE ADS.
END.
!*******************************************************************
! Convert the IP address from dotted string format to binary. *
!*******************************************************************
IF (SOCKET(SOCKET-FUNCTION-INETPTON,
SOCKET-RETCD,
SOCKET-ERRNO,
SOCKET-RSNCD,
SOCKET-FAMILY-AFINET,
IPA-HOST,
IPA-HOSTL,
HOSTIPA) EQ 0)
THEN DO.
WRITE TO LOG MESSAGE TEXT = 'ADSCLI: INETPTON successful.'.
END.
ELSE DO.
WRITE TO LOG MESSAGE TEXT = 'ADSCLI: INETPTON error.'.
CALL TCPERROR.
CALL TCPCLOSE.
LEAVE ADS.
END.
!*******************************************************************
! Take the IP address and domain and resolve it through a name *
! server. If successful, return the information in a HOSTENT *
! structure. *
!*******************************************************************
IF (SOCKET(SOCKET-FUNCTION-GETHOSTBYADDR,
SOCKET-RETCD,
SOCKET-ERRNO,
SOCKET-RSNCD,
HOSTIPA,
SOCKET-IPADDR4L,
SOCKET-FAMILY-AFINET,
HOSTENTP) EQ 0)
THEN DO.
WRITE TO LOG MESSAGE TEXT = 'ADSCLI:GETHOSTBYADDR successful.'.
END.
ELSE DO.
WRITE TO LOG MESSAGE TEXT = 'ADSCLI: GETHOSTBYADDR error'.
CALL TCPERROR.
CALL TCPCLOSE.
LEAVE ADS.
END.
MOVE SOCKET-FAMILY-AFINET TO SIN-FAMILY.
MOVE DEST-PORT TO SIN-PORT-NUMBER.
MOVE HOSTIPA TO SIN-ADDRESS.
MOVE LOW-VALUES TO SIN-ZEROS.
IF (SOCKET(SOCKET-FUNCTION-CONNECT,
SOCKET-RETCD,
SOCKET-ERRNO,
SOCKET-RSNCD,
SOCKDESC,
SOCKADDR-IN,
SOCKADDR-IN-LENGTH) EQ 0)
THEN DO.
WRITE TO LOG MESSAGE TEXT = 'ADSCLI: CONNECT successful.'.
END.
ELSE DO.
WRITE TO LOG MESSAGE TEXT = 'ADSCLI: CONNECT error.'.
CALL TCPERROR.
CALL TCPCLOSE.
LEAVE ADS.
END.
!*******************************************************************
! Loop of write and read of messages with the server *
!*******************************************************************
MOVE 1 TO LOOP-COUNT.
WHILE LOOP-COUNT LE MAX-LOOP
REPEAT.
MOVE 'ADSCLI test message number ' TO BUFTXT-MSG.
MOVE LOOP-COUNT TO BUFTXT-SEQ.
MOVE ' ' TO BUFTXT-BLANK.
MOVE 37 TO BUFLEN.
MOVE 41 TO WK-LENGTH.
MOVE 1 TO WK-SUBSCRIPT.
CALL TCPWRITE.
! 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.
! Read the remaining data (maximum 80 characters are allowed)
IF (BUFLEN GT 80)
THEN DO.
WRITE TO LOG MESSAGE TEXT = 'ADSCLI: Data length too long.'.
CALL TCPCLOSE.
LEAVE ADS.
END.
MOVE BUFLEN TO WK-LENGTH.
MOVE 5 TO WK-SUBSCRIPT.
CALL TCPREAD.
SNAP RECORD (ADSCLI-BUFFER-RECORD).
ADD 1 TO LOOP-COUNT.
END. ! WHILE LOOP-COUNT
!*******************************************************************
! Loop completed. Close the socket and exit the program. *
!*******************************************************************
WRITE TO LOG MESSAGE TEXT = 'ADSCLI: READ/WRITE loop completed.'.
CALL TCPCLOSE.
WRITE TO LOG MESSAGE TEXT = 'ADSCLI: Dialog ended successfully.'.
LEAVE ADS.
!*******************************************************************
! Subroutine to read a message from the client *
!*******************************************************************
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 = 'ADSCLI: READ successful.'.
END.
ELSE DO.
WRITE TO LOG MESSAGE TEXT = 'ADSCLI: READ error.'.
CALL TCPERROR.
CALL TCPCLOSE.
LEAVE ADS.
END.
IF (RETLEN = 0)
THEN DO.
WRITE TO LOG MESSAGE TEXT = 'ADSCLI: READ 0 bytes'.
CALL TCPCLOSE.
LEAVE ADS.
END.
ADD RETLEN TO WK-SUBSCRIPT.
SUBTRACT RETLEN FROM WK-LENGTH.
END. ! READ LOOP
GOBACK.
!*******************************************************************
! Subroutine to send a message to the client *
!*******************************************************************
DEFINE SUBROUTINE TCPWRITE.
WHILE WK-LENGTH GT 0 REPEAT.
IF (SOCKET(SOCKET-FUNCTION-WRITE,
SOCKET-RETCD,
SOCKET-ERRNO,
SOCKET-RSNCD,
SOCKDESC,
BUFFER-ARRAY(WK-SUBSCRIPT),
WK-LENGTH,
RETLEN) EQ 0)
THEN DO.
WRITE TO LOG MESSAGE TEXT = 'ADSCLI: WRITE successful.'.
END.
ELSE DO.
WRITE TO LOG MESSAGE TEXT = 'ADSCLI: WRITE error.'.
CALL TCPERROR.
CALL TCPCLOSE.
LEAVE ADS.
END.
IF (RETLEN = 0)
THEN DO.
WRITE TO LOG MESSAGE TEXT = 'ADSCLI: WRITE 0 bytes.'.
CALL TCPCLOSE.
LEAVE ADS.
END.
ADD RETLEN TO WK-SUBSCRIPT. SUBTRACT RETLEN FROM WK-LENGTH.
END. ! WRITE 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 = 'ADSCLI: CLOSE successful.'.
END.
ELSE DO.
WRITE TO LOG MESSAGE TEXT = 'ADSCLI: 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.
Copyright © 2014 CA.
All rights reserved.
|
|