Follow

Elastic COBOL EZASOKET API

The Heirloom Computing EZASOKET Interface Module translates EZASOKET API calls to Java™ Socket calls based primarily on java.net.Socket and supporting core libraries. The Heirloom Computing implementation of EZASOKET is based on the IBM™ implementation documented in SC31-8807-02, “z/OS Communications Server: IP CICS Sockets Guide Version 1 Release 5”, SC31-7131-03, “TCP/IP V3R2 for MVS: CICS TCP/IP Socket Interface Guide”, and SC31-8788-02, “Z/OS V1R4.0 CS: IP Application Programming Interface Guide.” COBOL programs written to use the EZASOKET API will function as originally designed without having to be rewritten.
Because Heirloom Computing's EZASOKET Interface Module is implemented in pure Java™ , differences found between various platform's TCP/IP support are abstracted. In the rare circumstance where duplicating the behavior of the IBM™ implementation doesn't make sense for the target platform, Heirloom Computing EZASOKET is designed to utilize the strengths of the execution environment while complying with standard behaviors found in enterprise Java applications. For example, a significant portion of the extended error codes returned in the ERRNO parameter are environment(mainframe) specific and do not make sense in distributed environments. Any differences are documented in the section describing individual EZASOKET functions.
Notes: IBM is a trademark of IBM, Corp. Java is a trademark of Oracle, Corp.


EZASOKET API usage

// CALL 'EZASOKET' USING SOC-FUNCTION__parm1, parm2, ...__ERRNO RETCODE.
/*
* SOC-FUNCTION
* A 16-byte character field, left-justified and padded on the right
* with blanks. Set to the name of the call. SOC-FUNCTION is case specific.
* It must be in uppercase.
*
* parmn
* A variable number of parameters depending on the type call.
*
* ERRNO
* If RETCODE is negative, there is an error number in ERRNO.
* This field is used in most, but not all, of the calls. It corresponds
* to the value returned by the tcperror() function in C.
*
* RETCODE
* A fullword binary variable containing a code returned by the EZASOKET call.
* This value corresponds to the normal return value of a C function.
*
*/


EZASOKET Supported Functionality

  • CLOSE:
    The CLOSE call shuts down a socket and frees all resources allocated to it. If the socket refers to an
    open TCP connection, the connection is closed.

*----------------------------------------------------------------*

*Parameter Values Returned to the Application:
*
*SOC-FUNCTION
*A 16-byte field containing 'CLOSE'. Left justify the field
*and pad it on the right with blanks.
*
*S
*A halfword binary field containing the descriptor of the
*socket to be closed.
*
*Parameter Values Set by the Application:
*
*ERRNO
*A fullword binary field. If RETCODE is negative, this field
*contains an error number. See "Sockets Extended Return Codes"
*in topic C.2, for information about ERRNO return codes.
*
*RETCODE
*A fullword binary field that returns one of the following:
*
*Value Description
*0
*Successful call
*-1
*Check ERRNO for an error code
*-----------------------------------------------------------------*

IDENTIFICATION DIVISION.
PROGRAM-ID. eclose.

WORKING-STORAGE SECTION.
      01 SOC-FUNCTION PIC X(16) VALUE IS 'CLOSE'.
      01 AF PIC 9(8) COMP VALUE 2.
      01 SOCTYPE PIC 9(8) BINARY.
           88 STREAM VALUE 1.
           88 DATAGRAM VALUE 2.
      01 PROTO PIC 9(8) BINARY.
      01 S PIC 9(4) BINARY.
      01 ERRNO PIC 9(8) BINARY.
      01 RETCODE PIC S9(8) BINARY.

PROCEDURE DIVISION.

*** create socket so that we have one to close

MOVE 'SOCKET' TO SOC-FUNCTION.
CALL 'EZASOKET' USING SOC-FUNCTION AF SOCTYPE
                          PROTO ERRNO RETCODE.
IF RETCODE < 0
    DISPLAY 'ERROR OCCURRED. ERRNO: ' ERRNO UPON SYSOUT
    GOBACK
ELSE
     DISPLAY 'RETCODE: ' RETCODE UPON SYSOUT
     MOVE RETCODE TO S
END-IF.

*** close the socket

MOVE 'CLOSE' TO SOC-FUNCTION.
CALL 'EZASOKET' USING SOC-FUNCTION S ERRNO RETCODE.
IF RETCODE < 0
    DISPLAY 'RETCODE: ' RETCODE UPON SYSOUT
    DISPLAY 'ERRNO: ' ERRNO UPON SYSOUT
ELSE
    DISPLAY 'CLOSE SUCCESSFUL' UPON SYSOUT
END-IF.
GOBACK.

  • CONNECT:
    The CONNECT call is issued by a client to establish a connection between a local socket and a remote socket. For stream sockets, the CONNECT call is issued by a client to establish connection with a server. The call performs two tasks:
      1. It completes the binding process for a stream socket if a BIND call has not been previously issued.
      2. It attempts to make a connection to a remote socket. This connection is necessary before data can be transferred.

*----------------------------------------------------------------*

*Parameter Values Set by the Application:
*
*SOC-FUNCTION
*A 16-byte field containing 'CONNECT'. Left justify
*the field and pad it on the right with blanks.
*
*S
*A halfword binary number specifying the socket descriptor
*of the socket that is to be used to establish a connection.
*
*NAME
*A structure that contains the socket address of the target
*to which the local, client socket is to be connected.
*
*FAMILY
*A halfword binary field specifying the addressing family.
*The value must be 2 for AF_INET.
*
*PORT
*A halfword binary field that is set to the server's port number
*in network byte order. For example, if the port number is 5000
*in decimal, it is stored as X'1388' in hex.
*
*IP-ADDRESS
*A fullword binary field that is set to the 32-bit internet address
*of the server's host machine in network byte order. For example,
*if the internet address is 129.4.5.12 in dotted decimal notation,
*it would be represented as '8104050C' in hex.
*
*RESERVED
*Specifies an 8-byte reserved field. This field is required,
*but is not used.
*
*Parameter Values Returned to the Application:
*
*ERRNO
*A fullword binary field. If RETCODE is negative, this field contains
*an error number. See "Sockets Extended Return Codes" in topic C.2,
*for information about ERRNO return codes.
*
*RETCODE
*A fullword binary field that returns one of the following:
*
*Value Description
*0
*Successful call
*-1
*Check ERRNO for an error code
*-----------------------------------------------------------------*

IDENTIFICATION DIVISION.
PROGRAM-ID. econnect.

WORKING-STORAGE SECTION.
      01 SOC-FUNCTION PIC X(16) VALUE IS 'CONNECT'.
      01 S PIC 9(4) BINARY.
      01 AF PIC 9(8) COMP VALUE 2.
      01 SOCTYPE PIC 9(8) BINARY.
           88 STREAM VALUE 1.
           88 DATAGRAM VALUE 2.
      01 PROTO PIC 9(8) BINARY.
      01 NAME.
           03 FAMILY PIC 9(4) BINARY.
           03 PORT PIC 9(4) BINARY.
           03 IP-ADDRESS PIC 9(8) BINARY.
           03 RESERVED PIC X(8).
      01 ERRNO PIC 9(8) BINARY.
      01 RETCODE PIC S9(8) BINARY.

PROCEDURE DIVISION.

*** create socket so that we have one to connect to

             MOVE 'SOCKET' TO SOC-FUNCTION.
             CALL 'EZASOKET' USING SOC-FUNCTION AF SOCTYPE
                                       PROTO ERRNO RETCODE.
             IF RETCODE < 0
                 DISPLAY 'ERROR OCCURRED. ERRNO: ' ERRNO UPON SYSOUT
                 GOBACK
             ELSE
                 DISPLAY 'RETCODE: ' RETCODE UPON SYSOUT
                 MOVE RETCODE TO S
             END-IF.

*** get the host id

             MOVE 'GETHOSTID' TO SOC-FUNCTION.
            CALL 'EZASOKET' USING SOC-FUNCTION RETCODE.
            IF RETCODE NOT = 0
                DISPLAY 'IP: ' RETCODE UPON SYSOUT
                MOVE RETCODE TO IP-ADDRESS
            ELSE
                DISPLAY 'ERROR::NO IP RETURNED!' UPON SYSOUT
                GOBACK
            END-IF.
*** attempt the connect

            MOVE 'CONNECT' TO SOC-FUNCTION.
            MOVE 2 TO FAMILY.
            MOVE 9000 TO PORT.
            CALL 'EZASOKET' USING SOC-FUNCTION S NAME ERRNO RETCODE.
            IF RETCODE < 0
                DISPLAY 'ERROR OCCURRED. ERRNO: ' ERRNO UPON SYSOUT
                GOBACK
            ELSE
                 DISPLAY 'CONNECT SUCCESS RETCODE: ' RETCODE UPON SYSOUT
            END-IF.
*** close the socket

            MOVE 'CLOSE' TO SOC-FUNCTION.
            CALL 'EZASOKET' USING SOC-FUNCTION S ERRNO RETCODE.
            IF RETCODE < 0
                DISPLAY 'RETCODE: ' RETCODE UPON SYSOUT
                DISPLAY 'ERRNO: ' ERRNO UPON SYSOUT
            ELSE
                DISPLAY 'CLOSE SUCCESSFUL' UPON SYSOUT
            END-IF.
            GOBACK.

  • GETHOSTBYNAME:
    The GETHOSTBYNAME call returns the alias name and the internet address of the host whose
    domain name is specified in the call. A given TCP/IP host can have multiple alias names and multiple host internet addresses. TCP/IP tries to resolve the host name through a name server, if one is present. If a name server is not present, the mainframe system would normally search the HOSTS.SITEINFO data set until a matching host is found or until the EOF marker is reached. On distributed systems, using the “etc/hosts” file is equivalent.

*----------------------------------------------------------------*

*Parameter Values Set by the Application:
*
*SOC-FUNCTION
*A 16-byte character field containing 'GETHOSTBYNAME'. The field is
*left justified and padded on the right with blanks.
*
*NAMELEN
*A value set to the length of the host name.
*
*NAME
*A character string, up to 24 characters, set to a host name. This call
*returns the address of the HOSTENT structure for this name.
*
*
*Parameter Values Returned to the Application:
*
*HOSTENT
*A fullword binary field that contains the address of the HOSTENT structure.
*
*RETCODE
*A fullword binary field that returns one of the following:
*
*Value Description
*0
*Successful call
*-1
*An error occurred
*
* _________________________________________________________________________________________________________
*|                                                                                                                                                             |
*| Hostent ____                                                                                                                                        |
*|                      |                                                                                                                                      |
*|                                                                                                                                                             |
*| Hostname ______ÿ _____________                                                                                                           |
*|                             |                     |          _____________                                                                           |
*|                             | Address of   |_____ÿ| Name X'00' |                                                                         |
*|                             |                     |         |______________|                                                                        | 
*| Alias_List _______ÿ|_____________  |                                                                                                        |
*|                             |                     |         List                                                                                          |
*|                             | Address of   |          _____________                                                                           |
*|                             |                     |_____ÿ| Address of   |______ÿAlias#1 X'00                                          |
*| Family __________ÿ|______________|         |______________|                                                                         |
*|                             |                      |         | Address of  |______ÿAlias#2 X'00                                           |
*|                             | X'00000002'  |        |______________|                                                                         |
*|                             |                      |         | Address of   |______ÿAlias#3 X'00                                          |
*| Hostaddr_Len __ÿ|______________ |         |______________|                                                                        |
*|                             |                      |         | X'00000000' |                                                                        |
*|                             | X'00000004' |         |______________ |                                                                       |
*|                             |                      |                                                                                                       |
*|  Hostaddr_List__ÿ|_______________|                                                                                                       |
*|                             |                      |        List                                                                                          |
*|                             |Address of     |         _______________                                                                       |
*|                             |                      |____ÿ| Address of     |______ÿINET Addr#1                                       |
*|                             |______________ |        |_______________|                                                                      |
*|                                                             | Address of     |______ÿINET Addr#2                                      |
*|                                                             |_______________|                                                                      |
*|                                                             | Address of     |______ÿINET Addr#3                                      |
*|                                                             |_______________|                                                                      |
*|                                                             |X'00000000'   |                                                                      |
*|                                                             |_______________|                                                                      |
*|                                                                                                                                                           |
*|______________________________________________________________________________________________________|
*Figure 76. HOSTENT Structure Returned by the GETHOSTYBYNAME Call
*
*GETHOSTBYNAME returns the HOSTENT structure shown in Figure 76.
*This structure contains:
*
*The address of the host name that is returned by the call. The name
*length is variable and is ended by X'00'.
*
*The address of a list of addresses that point to the alias names
*returned by the call. This list is ended by the pointer X'00000000'.
*Each alias name is a variable length field ended by X'00'.
*
*The value returned in the FAMILY field is always 2 for AF_INET.
*
*The length of the host internet address returned in the HOSTADDR_LEN
*field is always 4 for AF_INET.
*
*The address of a list of addresses that point to the host
*internet addresses returned by the call. The list is ended
*by the pointer X'00000000'. If the call cannot be resolved,
*the HOSTENT structure contains the ERRNO 10214.
*
*The HOSTENT structure uses indirect addressing to
*return a variable number of alias names and internet addresses.
*If you are coding in PL/I or assembler language, this structure
*can be processed in a relatively straight-forward manner. If
*you are coding in COBOL, this structure may be difficult to
*interpret. You can use the subroutine EZACIC08 to simplify
*interpretation of the information returned by the GETHOSTBYADDR
*and GETHOSTBYNAME calls. For more information about EZACIC08,
*see "EZACIC08" in topic 8.1.9.
*
*----------------------------------------------------------------*


IDENTIFICATION DIVISION.
PROGRAM-ID. egethost.

WORKING-STORAGE SECTION.
      01 SOC-FUNCTION PIC X(16) VALUE IS 'GETHOSTBYNAME'.
      01 NAMELEN PIC 9(8) BINARY.
      01 NAME PIC X(24).
      01 HOSTENT PIC 9(8) BINARY.
      01 RETCODE PIC S9(8) BINARY.

PROCEDURE DIVISION.
           CALL 'EZASOKET' USING SOC-FUNCTION NAMELEN NAME
           HOSTENT RETCODE.

  • GETHOSTID:
    The GETHOSTID call returns the 32-bit internet address for the current host.

$set directive"-dt:truncbin"
*----------------------------------------------------------------*
*SOC-FUNCTION
* A 16-byte character field containing 'GETHOSTID'.
* The field is left justified and padded on the right with blanks.
*
*
*RETCODE
* Returns a fullword binary field containing the 32-bit internet
* address of the host. There is no ERRNO parameter for this call.
*----------------------------------------------------------------*

IDENTIFICATION DIVISION.
PROGRAM-ID. egetlocal.

WORKING-STORAGE SECTION.
      01 SOC-FUNCTION PIC X(16) VALUE IS 'GETHOSTID'.
      01 RETCODE PIC S9(8) BINARY.

PROCEDURE DIVISION.
           CALL 'EZASOKET' USING SOC-FUNCTION RETCODE.
           IF RETCODE NOT = 0
               DISPLAY 'IP: ' RETCODE UPON SYSOUT
           ELSE
               DISPLAY 'NO IP RETURNED!' UPON SYSOUT
           END-IF.
           GOBACK.

  • INITAPI:
    The INITAPI call connects an application to the TCP/IP interface. Almost all sockets programs that are written in COBOL, PL/I, or Assembler language must issue the INITAPI macro before they issue other sockets macros INITAPI is a passthrough (NO-OP) function in Heirloom Computing EZASOKET.

*----------------------------------------------------------------*
*Parameter Values Set by the Application:
*
*SOC-FUNCTION
*A 16-byte character field containing 'INITAPI'. The field
*is left justified and padded on the right with blanks.
*
*MAXSOC
*A halfword binary field set to the maximum number of sockets
*this application will ever have open at one time. The maximum
*number is 2000 and the minimum number is 50. This value is used
*to determine the amount of memory that will be allocated for
*socket control blocks and buffers. If less than 50 are requested,
*MAXSOC defaults to 50.
*
*IDENT
*A structure containing the identities of the TCP/IP address
*space and the calling program's address space. Specify IDENT
*on the INITAPI call from an address space.
*
*TCPNAME
*An 8-byte character field which should be set to the MVS
*jobname of the TCP/IP address space with which you are connecting.
*
*ADSNAME
*An 8-byte character field set to the identity of the calling
*program's address space. It is the name of the CICS startup job.
*
*SUBTASK
*Indicates an 8-byte field, containing a unique subtask identifier
*which is used to distinguish between multiple subtasks within a
*single address space. For your subtask name, we suggest you use the
*zoned decimal value of of the CICS task ID (EIBTASKN), plus a unique
*displayable character. In CICS, if no value is specified, the
*zoned-decimal value of the CICS task ID appended with the
*letter C is used.
*
*Parameter Values Returned to the Application:
*
*MAXSNO
*A fullword binary field that contains the highest socket number
*assigned to this application. The lowest socket number is 0. If
*you have 50 sockets, they are numbered from 0 to 49. If MAXSNO
*is not specified, the value for MAXSNO is 49.
*
*ERRNO
*A fullword binary field. If RETCODE is negative, the field contains
*an error number. See "Sockets Extended Return Codes" in topic C.2,
*for information about ERRNO return codes.
*
*RETCODE
*A fullword binary field that returns one of the following:
*
*Value Description
*0
*Successful call
*-1
*Check ERRNO for an error code
*
*----------------------------------------------------------------*
IDENTIFICATION DIVISION.
PROGRAM-ID. einitapi.
WORKING-STORAGE SECTION.
      01 SOC-FUNCTION PIC X(16) VALUE IS 'INITAPI'.
      01 MAXSOC PIC 9(4) BINARY.
      01 IDENT.
           02 TCPNAME PIC X(8).
           02 ADSNAME PIC X(8).
      01 SUBTASK PIC X(8).
      01 MAXSNO PIC 9(8) BINARY.
      01 ERRNO PIC 9(8) BINARY.
      01 RETCODE PIC S9(8) BINARY.

PROCEDURE DIVISION.
           CALL 'EZASOKET' USING SOC-FUNCTION MAXSOC IDENT SUBTASK
           MAXSNO ERRNO RETCODE.

  • RECV:
    The RECV call, like READ receives data on a socket with descriptor S. RECV applies only to
    connected sockets. If a datagram packet is too long to fit in the supplied buffers, datagram sockets
    discard extra bytes.
    For stream sockets, data is processed as streams of information with no boundaries separating the
    data. For example, if program A and B are connected with a stream socket and program A sends 1000 bytes, each call to this function can return any number of bytes, up to the entire 1000 bytes. The number of bytes returned will be contained in RETCODE. Therefore, programs using stream sockets should place RECV in a loop that repeats until all data has been received.
    If data is not available for the socket, and the socket is in blocking mode, RECV blocks the caller until data arrives. FLAGS are currently not supported by Heirloom Computing EZASOKET.

*----------------------------------------------------------------*

*Parameter Values Set by the Application:
*
*SOC-FUNCTION
*A 16-byte character field containing 'RECV'. The field is left
*justified and padded to the right with blanks.
*
*S
*A halfword binary number set to the socket descriptor of the
*socket to receive the data.
*
*FLAGS
*A fullword binary field with values as follows:
*
*____________________________________________________________________
*| Literal Value    | Binary Value  |           Description                        |
*|________________|_______________|___________________________________ |
*|                        |                       |                                                      |
*|    NO-FLAG    |         0             |            Read data.                         |
*|                        |                       |                                                      |
*|                        |                       |                                                      |
*|    OOB             |         1           | Receive out-of-band data.            |
*|                        |                      | (Stream sockets only).                   |
*|                        |                      | Even if the OOB                             |
*|                        |                      | flag is not set, out-of-band data   |
*|                        |                      | can be read if the SO-OOBINLINE |
*|                        |                      | option is set for the socket.           |
*|                        |                      | PEEK                                               |
*|                        |                      |                                                        |
*|________________|______________|_____________________________________ |
*|                        |                      |                                                        |
*|     PEEK           |         2           | Peek at the data, but do not          |
*|                        |                      | destroy data. If the peek flag is     |
*|                        |                      | set, the next RECV call will read     |
*|                        |                      | the same data.                               |
*|________________|______________|_____________________________________ |
*
*
*NBYTE
*A value or the address of a fullword binary number set to the
*size of BUF. RECV does not receive more than the number of bytes
*of data in NBYTE even if more data is available.
*
*
*Parameter Values Returned to the Application:
*
*BUF
*The input buffer to receive the data.
*
*ERRNO
*A fullword binary field. If RETCODE is negative, the field
*contains an error number. See "Sockets Extended Return Codes"
*in topic C.2, for information about ERRNO return codes.
*
*RETCODE
*A fullword binary field that returns one of the following :
*
*Value Description
*0
*The socket is closed
*>0
*A positive return code indicates the number of bytes
*copied into the buffer.
*
*-1
*Check ERRNO for an error code
*
*----------------------------------------------------------------*

IDENTIFICATION DIVISION.
PROGRAM-ID. erecv.

WORKING-STORAGE SECTION.
01 PTR PIC 9(8) VALUE 1.
01 SOC-FUNCTION PIC X(16) VALUE IS 'RECV'.
01 S PIC 9(4) BINARY.
01 FLAGS PIC 9(8) BINARY.
     88 NO-FLAG VALUE IS 0.
     88 OOB VALUE IS 1.
     88 PEEK VALUE IS 2.
01 AF PIC 9(8) COMP VALUE 2.
01 SOCTYPE PIC 9(8) BINARY.
     88 STREAM VALUE 1.
     88 DATAGRAM VALUE 2.
01 PROTO PIC 9(8) BINARY.
01 NAME.
     03 FAMILY PIC 9(4) BINARY.
     03 PORT PIC 9(4) BINARY.
     03 IP-ADDRESS PIC 9(8) BINARY.
     03 RESERVED PIC X(8).
01 NBYTE PIC 9(8) BINARY.
* 01 BUF PIC X(length of buffer).
01 BUF PIC X(1024).
01 ERRNO PIC 9(8) BINARY.
01 RETCODE PIC S9(8) BINARY.

PROCEDURE DIVISION.

*** create socket so that we have one to connect to

MOVE 'SOCKET' TO SOC-FUNCTION.
CALL 'EZASOKET' USING SOC-FUNCTION AF SOCTYPE
                          PROTO ERRNO RETCODE.
IF RETCODE < 0
    DISPLAY 'ERROR OCCURRED. ERRNO: ' ERRNO UPON SYSOUT
    GOBACK
ELSE
    DISPLAY 'RETCODE: ' RETCODE UPON SYSOUT
    MOVE RETCODE TO S
END-IF.

*** get the host id

MOVE 'GETHOSTID' TO SOC-FUNCTION.
CALL 'EZASOKET' USING SOC-FUNCTION RETCODE.
IF RETCODE NOT = 0
    DISPLAY 'IP: ' RETCODE UPON SYSOUT
    MOVE RETCODE TO IP-ADDRESS
ELSE
    DISPLAY 'ERROR::NO IP RETURNED!' UPON SYSOUT
    GOBACK
END-IF.

*** attempt the connect

MOVE 'CONNECT' TO SOC-FUNCTION.
MOVE 2 TO FAMILY.
MOVE 9000 TO PORT.
CALL 'EZASOKET' USING SOC-FUNCTION S NAME ERRNO RETCODE.
IF RETCODE < 0
    DISPLAY 'CONNECT ERROR OCCURRED. ERRNO: '
          ERRNO UPON SYSOUT
    GOBACK
ELSE
    DISPLAY 'CONNECT SUCCESS RETCODE: ' RETCODE UPON SYSOUT
END-IF.

*** attempt write to socket

MOVE 'WRITE' TO SOC-FUNCTION.
MOVE 1 TO PTR.
MOVE 0 TO RETCODE.
STRING 'EZASOKET TEST ' DELIMITED BY SIZE
             'MESSAGE ' DELIMITED BY SPACE
    INTO BUF
    WITH POINTER PTR
END-STRING.
display 'PTR: ' PTR upon sysout.
MOVE PTR TO NBYTE.
CALL 'EZASOKET' USING SOC-FUNCTION
                                        S
                                        NBYTE
                                        BUF
                                        ERRNO
                                        RETCODE.
IF RETCODE < 0
    DISPLAY 'WRITE ERROR OCCURRED. ERRNO: ' ERRNO UPON SYSOUT
    GOBACK
ELSE
    DISPLAY 'WRITE SUCCESS BYTES WRITTEN: '
    RETCODE UPON SYSOUT
END-IF.

*** attempt to receive from socket

MOVE 'RECV' TO SOC-FUNCTION.
MOVE 50 TO NBYTE.
MOVE SPACES TO BUF.
MOVE 0 TO RETCODE.
CALL 'EZASOKET' USING SOC-FUNCTION S FLAGS NBYTE BUF
                           ERRNO RETCODE.
IF RETCODE < 0
    DISPLAY 'RECV ERROR OCCURRED. ERRNO: ' ERRNO UPON SYSOUT
    GOBACK
ELSE
    DISPLAY 'RECV SUCCESS BYTES RECEIVED: '
                   RETCODE UPON SYSOUT
    DISPLAY 'BUF: ' BUF UPON SYSOUT
END-IF.

*** close the socket

MOVE 'CLOSE' TO SOC-FUNCTION.
CALL 'EZASOKET' USING SOC-FUNCTION S ERRNO RETCODE.
IF RETCODE < 0
    DISPLAY 'CLOSE RETCODE: ' RETCODE UPON SYSOUT
    DISPLAY 'CLOSE ERRNO: ' ERRNO UPON SYSOUT
ELSE
    DISPLAY 'CLOSE SUCCESSFUL' UPON SYSOUT
END-IF.
GOBACK.

  •  
  • WRITE:
    The WRITE call writes data on a connected socket. This call is similar to SEND, except that it lacks the control flags available with SEND.

*----------------------------------------------------------------*

*Parameter Values Set by the Application:
*
*SOC-FUNCTION
*A 16-byte character field containing 'WRITE'. The field
*is left justified and padded on the right with blanks.
*
*S
*A halfword binary field set to the socket descriptor.
*
*NBYTE
*A fullword binary field set to the number of bytes of data
*to be transmitted.
*
*BUF
*Specifies the buffer containing the data to be transmitted.
*
*Parameter Values Returned to the Application:
*
*ERRNO
*A fullword binary field. If RETCODE is negative, the field
*contains an error number. See "Sockets Extended Return Codes"
*in topic C.2, for information about ERRNO return codes.
*
*RETCODE
*A fullword binary field that returns one of the following:
*
*Value Description
*0 or >0
*A successful call. A return code greater than 0 indicates the
*number of bytes of data written.
*-1
*Check ERRNO for an error code
*----------------------------------------------------------------*

IDENTIFICATION DIVISION.
PROGRAM-ID. ewrite.

WORKING-STORAGE SECTION.
      01 PTR PIC 9(8) VALUE 1.
      01 SOC-FUNCTION PIC X(16) VALUE IS 'CONNECT'.
      01 S PIC 9(4) BINARY.
      01 AF PIC 9(8) COMP VALUE 2.
      01 SOCTYPE PIC 9(8) BINARY.
           88 STREAM VALUE 1.
           88 DATAGRAM VALUE 2.
      01 PROTO PIC 9(8) BINARY.
      01 NAME.
           03 FAMILY PIC 9(4) BINARY.
           03 PORT PIC 9(4) BINARY.
           03 IP-ADDRESS PIC 9(8) BINARY.
           03 RESERVED PIC X(8).
      01 NBYTE PIC 9(8) BINARY.
* 01 BUF PIC X(length of buffer).
      01 BUF PIC X(1024).
      01 ERRNO PIC 9(8) BINARY.
      01 RETCODE PIC S9(8) BINARY.

PROCEDURE DIVISION.

*** create socket so that we have one to connect to

MOVE 'SOCKET' TO SOC-FUNCTION.
CALL 'EZASOKET' USING SOC-FUNCTION AF SOCTYPE
                           PROTO ERRNO RETCODE.
IF RETCODE < 0
    DISPLAY 'ERROR OCCURRED. ERRNO: ' ERRNO UPON SYSOUT
    GOBACK
ELSE
    DISPLAY 'RETCODE: ' RETCODE UPON SYSOUT
    MOVE RETCODE TO S
END-IF.

*** get the host id

MOVE 'GETHOSTID' TO SOC-FUNCTION.
CALL 'EZASOKET' USING SOC-FUNCTION RETCODE.
IF RETCODE NOT = 0
    DISPLAY 'IP: ' RETCODE UPON SYSOUT
    MOVE RETCODE TO IP-ADDRESS
ELSE
    DISPLAY 'ERROR::NO IP RETURNED!' UPON SYSOUT
    GOBACK
END-IF.

*** attempt the connect

MOVE 'CONNECT' TO SOC-FUNCTION.
MOVE 2 TO FAMILY.
MOVE 9000 TO PORT.
CALL 'EZASOKET' USING SOC-FUNCTION S NAME ERRNO RETCODE.
IF RETCODE < 0
    DISPLAY 'CONNECT ERROR OCCURRED. ERRNO: '
                   ERRNO UPON SYSOUT
    GOBACK
ELSE
    DISPLAY 'CONNECT SUCCESS RETCODE: ' RETCODE UPON SYSOUT
END-IF.

*** attempt write to socket

MOVE 'WRITE' TO SOC-FUNCTION.
MOVE 1 TO PTR.
MOVE 0 TO RETCODE.
STRING 'EZASOKET TEST ' DELIMITED BY SIZE
             'MESSAGE ' DELIMITED BY SPACE
    INTO BUF
    WITH POINTER PTR
END-STRING.
display 'PTR: ' PTR upon sysout.
MOVE PTR TO NBYTE.
CALL 'EZASOKET' USING SOC-FUNCTION
                                        S
                                        NBYTE
                                        BUF
                                        ERRNO
                                        RETCODE.
IF RETCODE < 0
    DISPLAY 'WRITE ERROR OCCURRED. ERRNO: ' ERRNO UPON SYSOUT
    GOBACK
ELSE
    DISPLAY 'WRITE SUCCESS BYTES WRITTEN: '
    RETCODE UPON SYSOUT
END-IF.

*** close the socket

MOVE 'CLOSE' TO SOC-FUNCTION.
CALL 'EZASOKET' USING SOC-FUNCTION S ERRNO RETCODE.
IF RETCODE < 0
    DISPLAY 'CLOSE RETCODE: ' RETCODE UPON SYSOUT
    DISPLAY 'CLOSE ERRNO: ' ERRNO UPON SYSOUT
ELSE
    DISPLAY 'CLOSE SUCCESSFUL' UPON SYSOUT
END-IF.
GOBACK.

  • TIMEOUTS:

    The TIMEOUTS call setups communication related timeout settings. The timeout settings must be set before creating new socket with SOCKET function

*Parameter Values Set by the Application:
*
*SOC-FUNCTION
*A 16-byte character field containing 'TIMEOUTS'. The field is
*left justified and padded on the right with blanks.
*
*CONNECTTO
*A fullword binary field set to the connecting timeout in milliseconds.
*
*Value Description
*<0, setting connecting timeout is omitted
*
*0, connecting timeout value is interpreted as an infinite timeout
*
*>0, connecting timeout is set to the specified amount of time
*
*Default value is 10000 (10 seconds);
*
*
*READTO
*A fullword binary field set to read operations timeout in milliseconds.
*
*Value Description
*<0, setting read timeout is omitted
*
*0, read timeout value is interpreted as an infinite timeout
*
*>0, connecting timeout is set to the specified amount of time
*
*Default value is 10000 (10 seconds);
*
*CLOSETO
*A fullword binary field set to linger-on-close timeout in seconds.
*
*Value Description
*<0, disable linger-on-close timeout
*
*between 0 and 65535, linger-on-close timeout is set to the specified amount of time
*
*>65535, linger-on-close timeout is reduced to 65535
*
*Default value is 10 seconds
*
*KEEPALIVE
*A halfword binary field set to flag whether or not to keep socket alive
*
*0, keep alive socket is set to off
*<> 0, keep alive socket is set to on
*
*Default value: keep alive socket set to off
*
*Parameter Values Returned to the Application:
*
*ERRNO
*A fullword binary field. If RETCODE is negative, the field
*contains an error number. See "Sockets Extended Return Codes"
*in topic C.2, for information about ERRNO return codes.
*
*RETCODE
*A fullword binary field that returns one of the following:
*
*Value Description
*> or = 0
*Contains the new socket descriptor
*-1
*Check ERRNO for an error code
*
*----------------------------------------------------------------*

 

The timeouts default properties could be configured by the user by adding the following parameters in the deploy.properties file.

 

Property name Description Default value
ezasoket-closeTimeout Linger-on-close timeout that is set to the specified amount of time in seconds 10
ezasoket-keepAlive A flag to indicate to whether or not to keep socket alive. The allowed values are true/false false
ezasoket-readTimeout Read operations timeout in milliseconds 10000
ezasoket-connectTimeout The connecting timeout in milliseconds 10000

 

In the event of incorrect format/value in the property file, the default value would be used.


 IDENTIFICATION DIVISION.
 PROGRAM-ID. etimeouts.

 WORKING-STORAGE SECTION.

***EZASOKET data section

       01 SOC-FUNCTION PIC X(16) VALUE IS 'RECV'.
       01 ERRNO PIC 9(8) BINARY.
       01 RETCODE PIC S9(8) BINARY.

*** EZASOKET timeouts section

      01 CONNECTTO PIC S9(8) BINARY VALUE IS -1.
      01 READTO PIC S9(8) BINARY VALUE IS -1. 
      01 CLOSETO PIC S9(8) BINARY VALUE IS -1.
      01 KEEPALIVE PIC 9 BINARY VALUE IS 0.

 PROCEDURE DIVISION.

*** set socket/connection timeouts
            MOVE 'TIMEOUTS' TO SOC-FUNCTION.
            MOVE 20000 TO CONNECTTO
            MOVE 15000 TO READTO
            MOVE 30 TO CLOSETO
            MOVE 1 TO KEEPALIVE 

            CALL 'EZASOKET' USING SOC-FUNCTION CONNECTTO
                          READTO CLOSETO KEEPALIVE ERRNO RETCODE.
            IF RETCODE < 0
                DISPLAY 'ETIMEOTS - TIMEOUTS' UPON SYSOUT
                DISPLAY 'ERROR OCCURRED. ERRNO: ' ERRNO UPON SYSOUT
            ELSE
                DISPLAY 'RETCODE: ' RETCODE UPON SYSOUT
            END-IF.
            GOBACK

  • EZASOKET Currently Unsupported Functionality
  1. ACCEPT
  2. BIND
  3. FCNTL
  4. GETCLIENTID
  5. GETHOSTBYADDR
  6. GETHOSTNAME
  7. GETPEERNAME
  8. GETSOCKNAME
  9. GETSOCKOPT
  10. GIVESOCKET
  11. IOCTL
  12. LISTEN
  13. READ
  14. READV
  15. RECVFROM
  16. RECVMSG
  17. SELECTEX
  18. SENDMSG
  19. SENDTO
  20. SETSOCKOPT
  21. SHUTDOWN
  22. TAKESOCKET
  23. WRITEV
Was this article helpful?
0 out of 0 found this helpful
Have more questions? Submit a request

0 Comments

Please sign in to leave a comment.
Powered by Zendesk