The following COBOL socket program is in the SEZAINST
data set.
Figure 1. EZACICSC IPv4 child
server sample
***************************************************************
* *
* Communications Server for z/OS, Version 1, Release 9 *
* *
* *
* Copyright: Licensed Materials - Property of IBM *
* *
* "Restricted Materials of IBM" *
* *
* 5694-A01 *
* *
* Copyright IBM Corp. 1993, 2007 *
* *
* US Government Users Restricted Rights - *
* Use, duplication or disclosure restricted by *
* GSA ADP Schedule Contract with IBM Corp. *
* *
* Status: CSV1R9 *
* *
* $MOD(EZACICSC),COMP(CICS),PROD(TCPIP): *
* *
***************************************************************
* $SEG(EZACICSC)
*--------------------------------------------------------------*
* *
* Module Name : EZACICSC *
* *
* Description : *
* *
* This is a sample CICS/TCP application program. It issues*
* TAKESOCKET to obtain the socket passed from MASTER *
* SERVER and perform dialog function with CLIENT program. *
* *
*--------------------------------------------------------------*
*
IDENTIFICATION DIVISION.
PROGRAM-ID. EZACICSC.
ENVIRONMENT DIVISION.
DATA DIVISION.
*
WORKING-STORAGE SECTION.
77 TASK-START PIC X(40)
VALUE IS 'TASK STARTING THRU CICS/TCPIP INTERFACE '.
77 TAKE-ERR PIC X(24)
VALUE IS ' TAKESOCKET FAIL '.
77 TAKE-SUCCESS PIC X(24)
VALUE IS ' TAKESOCKET SUCCESSFUL '.
77 READ-ERR PIC X(24)
VALUE IS ' READ SOCKET FAIL '.
77 READ-SUCCESS PIC X(24)
VALUE IS ' READ SOCKET SUCCESSFUL '.
77 WRITE-ERR PIC X(24)
VALUE IS ' WRITE SOCKET FAIL '.
77 WRITE-END-ERR PIC X(32)
VALUE IS ' WRITE SOCKET FAIL - PGM END MSG'.
77 WRITE-SUCCESS PIC X(25)
VALUE IS ' WRITE SOCKET SUCCESSFUL '.
77 CLOS-ERR PIC X(24)
VALUE IS ' CLOSE SOCKET FAIL '.
77 CLOS-SUCCESS PIC X(24)
VALUE IS 'CLOSE SOCKET SUCCESSFUL '.
77 INVREQ-ERR PIC X(24)
VALUE IS 'INTERFACE IS NOT ACTIVE '.
77 IOERR-ERR PIC X(24)
VALUE IS 'IOERR OCCURRS '.
77 LENGERR-ERR PIC X(24)
VALUE IS 'LENGERR ERROR '.
77 ITEMERR-ERR PIC X(24)
VALUE IS 'ITEMERR ERROR '.
77 NOSPACE-ERR PIC X(24)
VALUE IS 'NOSPACE CONDITION '.
77 QIDERR-ERR PIC X(24)
VALUE IS 'QIDERR CONDITION '.
77 ENDDATA-ERR PIC X(30)
VALUE IS 'RETRIEVE DATA CAN NOT BE FOUND'.
77 WRKEND PIC X(20)
VALUE 'CONNECTION END '.
77 WRITE-SW PIC X(1)
VALUE 'N'.
77 FORCE-ERROR-MSG PIC X(1)
VALUE 'N'.
01 SOKET-FUNCTIONS.
02 SOKET-ACCEPT PIC X(16) VALUE 'ACCEPT '.
02 SOKET-BIND PIC X(16) VALUE 'BIND '.
02 SOKET-CLOSE PIC X(16) VALUE 'CLOSE '.
02 SOKET-CONNECT PIC X(16) VALUE 'CONNECT '.
02 SOKET-FCNTL PIC X(16) VALUE 'FCNTL '.
02 SOKET-GETCLIENTID PIC X(16) VALUE 'GETCLIENTID '.
02 SOKET-GETHOSTBYADDR PIC X(16) VALUE 'GETHOSTBYADDR '.
02 SOKET-GETHOSTBYNAME PIC X(16) VALUE 'GETHOSTBYNAME '.
02 SOKET-GETHOSTID PIC X(16) VALUE 'GETHOSTID '.
02 SOKET-GETHOSTNAME PIC X(16) VALUE 'GETHOSTNAME '.
02 SOKET-GETPEERNAME PIC X(16) VALUE 'GETPEERNAME '.
02 SOKET-GETSOCKNAME PIC X(16) VALUE 'GETSOCKNAME '.
02 SOKET-GETSOCKOPT PIC X(16) VALUE 'GETSOCKOPT '.
02 SOKET-GIVESOCKET PIC X(16) VALUE 'GIVESOCKET '.
02 SOKET-INITAPI PIC X(16) VALUE 'INITAPI '.
02 SOKET-IOCTL PIC X(16) VALUE 'IOCTL '.
02 SOKET-LISTEN PIC X(16) VALUE 'LISTEN '.
02 SOKET-READ PIC X(16) VALUE 'READ '.
02 SOKET-RECV PIC X(16) VALUE 'RECV '.
02 SOKET-RECVFROM PIC X(16) VALUE 'RECVFROM '.
02 SOKET-SELECT PIC X(16) VALUE 'SELECT '.
02 SOKET-SEND PIC X(16) VALUE 'SEND '.
02 SOKET-SENDTO PIC X(16) VALUE 'SENDTO '.
02 SOKET-SETSOCKOPT PIC X(16) VALUE 'SETSOCKOPT '.
02 SOKET-SHUTDOWN PIC X(16) VALUE 'SHUTDOWN '.
02 SOKET-SOCKET PIC X(16) VALUE 'SOCKET '.
02 SOKET-TAKESOCKET PIC X(16) VALUE 'TAKESOCKET '.
02 SOKET-TERMAPI PIC X(16) VALUE 'TERMAPI '.
02 SOKET-WRITE PIC X(16) VALUE 'WRITE '.
01 WRKMSG.
02 WRKM PIC X(14)
VALUE IS 'DATA RECEIVED '.
*---------------------------------------------------------------*
* program's variables *
*---------------------------------------------------------------*
77 SUBTRACE PIC X(8) VALUE 'CONTRACE'.
77 RESPONSE PIC 9(9) COMP.
77 TASK-FLAG PIC X(1) VALUE '0'.
77 TAKE-SOCKET PIC 9(8) COMP.
77 SOCKID PIC 9(4) COMP.
77 SOCKID-FWD PIC 9(8) COMP.
77 ERRNO PIC 9(8) COMP.
77 RETCODE PIC S9(8) COMP.
77 AF-INET PIC 9(8) COMP VALUE 2.
01 TCP-BUF.
05 TCP-BUF-H PIC X(3) VALUE IS SPACES.
05 TCP-BUF-DATA PIC X(197) VALUE IS SPACES.
77 TCPLENG PIC 9(8) COMP.
77 RECV-FLAG PIC 9(8) COMP.
77 CLENG PIC 9(4) COMP.
77 CNT PIC 9(4) COMP.
01 ZERO-PARM PIC X(16) VALUE LOW-VALUES.
01 DUMMY-MASK REDEFINES ZERO-PARM.
05 DUMYMASK PIC X(8).
05 ZERO-FLD-8 PIC X(8).
01 ZERO-FLD REDEFINES ZERO-PARM.
05 ZERO-FWRD PIC 9(8) COMP.
05 ZERO-HWRD PIC 9(4) COMP.
05 ZERO-DUM PIC X(10).
01 TD-MSG.
03 TASK-LABEL PIC X(07) VALUE 'TASK # '.
03 TASK-NUMBER PIC 9(07).
03 TASK-SEP PIC X VALUE ' '.
03 CICS-MSG-AREA PIC X(70).
01 CICS-ERR-AREA.
03 ERR-MSG PIC X(24).
03 SOCK-HEADER PIC X(08) VALUE ' SOCKET='.
03 ERR-SOCKET PIC 9(05).
03 RETC-HEADER PIC X(09) VALUE ' RETCDE=-'.
03 ERR-RETCODE PIC 9(05).
03 ERRN-HEADER PIC X(07) VALUE ' ERRNO='.
03 ERR-ERRNO PIC 9(05).
*
01 CLIENTID-LSTN.
05 CID-DOMAIN-LSTN PIC 9(8) COMP.
05 CID-NAME-LSTN PIC X(8).
05 CID-SUBTASKNAME-LSTN PIC X(8).
05 CID-RES-LSTN PIC X(20).
01 CLIENTID-APPL.
05 CID-DOMAIN-APPL PIC 9(8) COMP.
05 CID-NAME-APPL PIC X(8).
05 CID-SUBTASKNAME-APPL PIC X(8).
05 CID-RES-APPL PIC X(20).
01 TCPSOCKET-PARM.
05 GIVE-TAKE-SOCKET PIC 9(8) COMP.
05 LSTN-NAME PIC X(8).
05 LSTN-SUBTASKNAME PIC X(8).
05 CLIENT-IN-DATA PIC X(35).
05 THREADSAFE-INDICATOR PIC X(1).
88 INTERFACE-IS-THREADSAFE VALUE '1'.
05 SOCKADDR-IN.
10 SIN-FAMILY PIC 9(4) COMP.
10 SIN-PORT PIC 9(4) COMP.
10 SIN-ADDR PIC 9(8) COMP.
10 SIN-ZERO PIC X(8).
PROCEDURE DIVISION.
MOVE 'Y' TO WRITE-SW.
EXEC CICS HANDLE CONDITION INVREQ (INVREQ-ERR-SEC)
IOERR (IOERR-SEC)
ENDDATA (ENDDATA-SEC)
LENGERR (LENGERR-SEC)
NOSPACE (NOSPACE-ERR-SEC)
QIDERR (QIDERR-SEC)
ITEMERR (ITEMERR-SEC)
END-EXEC.
PERFORM INITIAL-SEC THRU INITIAL-SEC-EXIT.
PERFORM TAKESOCKET-SEC THRU TAKESOCKET-SEC-EXIT.
MOVE '0' TO TASK-FLAG.
PERFORM CLIENT-TASK THRU CLIENT-TASK-EXIT
VARYING CNT FROM 1 BY 1 UNTIL TASK-FLAG = '1'.
CLOSE-SOCK.
*---------------------------------------------------------------*
* *
* CLOSE 'accept descriptor' *
* *
*---------------------------------------------------------------*
CALL 'EZASOKET' USING SOKET-CLOSE SOCKID
ERRNO RETCODE.
IF RETCODE < 0 THEN
MOVE 'Y' TO WRITE-SW FORCE-ERROR-MSG
MOVE CLOS-ERR TO ERR-MSG
MOVE SOCKID TO ERR-SOCKET
MOVE RETCODE TO ERR-RETCODE
MOVE ERRNO TO ERR-ERRNO
MOVE CICS-ERR-AREA TO CICS-MSG-AREA
ELSE
MOVE CLOS-SUCCESS TO CICS-MSG-AREA.
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT.
PGM-EXIT.
IF RETCODE < 0 THEN
EXEC CICS ABEND ABCODE('TCPC') END-EXEC.
MOVE SPACES TO CICS-MSG-AREA.
MOVE 'END OF EZACICSC PROGRAM' TO CICS-MSG-AREA.
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT.
EXEC CICS RETURN END-EXEC.
GOBACK.
*---------------------------------------------------------------*
*
* RECEIVE PASSED PARAMETER WHICH ARE CID *
*
*---------------------------------------------------------------*
INITIAL-SEC.
MOVE SPACES TO CICS-MSG-AREA.
MOVE 50 TO CLENG.
MOVE 'TCPC TRANSACTION START UP ' TO CICS-MSG-AREA.
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT.
MOVE 72 TO CLENG.
EXEC CICS RETRIEVE INTO(TCPSOCKET-PARM) LENGTH(CLENG)
END-EXEC.
INITIAL-SEC-EXIT.
EXIT.
*---------------------------------------------------------------*
* *
* Perform TCP SOCKET functions by passing socket command to *
* EZASOKET routine. SOCKET command are translated to pre- *
* define integer. *
* *
*---------------------------------------------------------------*
TAKESOCKET-SEC.
*---------------------------------------------------------------*
* *
* Issue 'TAKESOCKET' call to acquire a socket which was *
* given by the LISTENER program. *
* *
*---------------------------------------------------------------*
MOVE AF-INET TO CID-DOMAIN-LSTN CID-DOMAIN-APPL.
MOVE LSTN-NAME TO CID-NAME-LSTN.
MOVE LSTN-SUBTASKNAME TO CID-SUBTASKNAME-LSTN.
MOVE GIVE-TAKE-SOCKET TO TAKE-SOCKET SOCKID SOCKID-FWD.
CALL 'EZASOKET' USING SOKET-TAKESOCKET SOCKID
CLIENTID-LSTN ERRNO RETCODE.
IF RETCODE < 0 THEN
MOVE 'Y' TO WRITE-SW FORCE-ERROR-MSG
MOVE TAKE-ERR TO ERR-MSG
MOVE SOCKID TO ERR-SOCKET
MOVE RETCODE TO ERR-RETCODE
MOVE ERRNO TO ERR-ERRNO
MOVE CICS-ERR-AREA TO CICS-MSG-AREA
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT
GO TO PGM-EXIT
ELSE
MOVE SPACES TO CICS-MSG-AREA
MOVE TAKE-SUCCESS TO CICS-MSG-AREA
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT.
MOVE RETCODE TO SOCKID.
MOVE SPACES TO TCP-BUF.
MOVE TASK-START TO TCP-BUF.
MOVE 50 TO TCPLENG.
*
* REMOVE FOLLOWING STATEMENT IF USING EBCDIC CLIENT
*
CALL 'EZACIC04' USING TCP-BUF TCPLENG.
CALL 'EZASOKET' USING SOKET-WRITE SOCKID TCPLENG
TCP-BUF ERRNO RETCODE.
IF RETCODE < 0 THEN
MOVE 'Y' TO WRITE-SW FORCE-ERROR-MSG
MOVE WRITE-ERR TO ERR-MSG
MOVE SOCKID TO ERR-SOCKET
MOVE RETCODE TO ERR-RETCODE
MOVE ERRNO TO ERR-ERRNO
MOVE CICS-ERR-AREA TO CICS-MSG-AREA
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT
GO TO PGM-EXIT
ELSE
MOVE WRITE-SUCCESS TO CICS-MSG-AREA
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT.
TAKESOCKET-SEC-EXIT.
EXIT.
CLIENT-TASK.
*---------------------------------------------------------------*
* *
* Issue 'RECV' socket to receive input data from client *
* *
*---------------------------------------------------------------*
MOVE LOW-VALUES TO TCP-BUF.
MOVE 200 TO TCPLENG.
MOVE ZEROS TO RECV-FLAG.
CALL 'EZASOKET' USING SOKET-RECV SOCKID
RECV-FLAG TCPLENG TCP-BUF ERRNO RETCODE.
IF RETCODE < 0 THEN
MOVE 'Y' TO WRITE-SW FORCE-ERROR-MSG
MOVE READ-ERR TO ERR-MSG
MOVE SOCKID TO ERR-SOCKET
MOVE RETCODE TO ERR-RETCODE
MOVE ERRNO TO ERR-ERRNO
MOVE CICS-ERR-AREA TO CICS-MSG-AREA
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT
GO TO PGM-EXIT
ELSE
MOVE READ-SUCCESS TO CICS-MSG-AREA
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT.
*
* REMOVE FOLLOWING STATEMENT IF USING EBCDIC CLIENT
*
CALL 'EZACIC05' USING TCP-BUF TCPLENG.
*
* DETERMINE WHETHER THE CLIENT IS FINISHED SENDING DATA
*
IF TCP-BUF-H = 'END' OR TCP-BUF-H = 'end' THEN
MOVE '1' TO TASK-FLAG
PERFORM CLIENT-TALK-END THRU CLIENT-TALK-END-EXIT
GO TO CLIENT-TASK-EXIT.
IF RETCODE = 0 THEN
MOVE '1' TO TASK-FLAG
GO TO CLIENT-TASK-EXIT.
*---------------------------------------------------------------*
** ECHO RECEIVING DATA
*---------------------------------------------------------------*
MOVE TCP-BUF TO CICS-MSG-AREA.
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT.
MOVE RETCODE TO TCPLENG.
*
* REMOVE FOLLOWING STATEMENT IF USING EBCDIC CLIENT
*
CALL 'EZACIC04' USING TCP-BUF TCPLENG.
CALL 'EZASOKET' USING SOKET-WRITE SOCKID TCPLENG
TCP-BUF ERRNO RETCODE.
IF RETCODE < 0 THEN
MOVE 'Y' TO WRITE-SW FORCE-ERROR-MSG
MOVE WRITE-ERR TO ERR-MSG
MOVE SOCKID TO ERR-SOCKET
MOVE RETCODE TO ERR-RETCODE
MOVE ERRNO TO ERR-ERRNO
MOVE CICS-ERR-AREA TO CICS-MSG-AREA
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT
GO TO PGM-EXIT
ELSE
MOVE WRITE-SUCCESS TO CICS-MSG-AREA
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT.
CLIENT-TASK-EXIT.
EXIT.
WRITE-CICS.
MOVE 78 TO CLENG.
MOVE EIBTASKN TO TASK-NUMBER.
IF WRITE-SW = 'Y' THEN
IF INTERFACE-IS-THREADSAFE THEN
IF FORCE-ERROR-MSG = 'Y' THEN
EXEC CICS WRITEQ TD QUEUE('CSMT') FROM(TD-MSG)
LENGTH(CLENG) NOHANDLE
END-EXEC
ELSE
NEXT SENTENCE
ELSE
EXEC CICS WRITEQ TD QUEUE('CSMT') FROM(TD-MSG)
LENGTH(CLENG) NOHANDLE
END-EXEC
ELSE
NEXT SENTENCE.
MOVE SPACES TO CICS-MSG-AREA.
WRITE-CICS-EXIT.
EXIT.
CLIENT-TALK-END.
MOVE LOW-VALUES TO TCP-BUF.
MOVE WRKEND TO TCP-BUF CICS-MSG-AREA.
MOVE 50 TO TCPLENG.
*
* REMOVE FOLLOWING STATEMENT IF USING EBCDIC CLIENT
*
CALL 'EZACIC04' USING TCP-BUF TCPLENG.
CALL 'EZASOKET' USING SOKET-WRITE SOCKID TCPLENG
TCP-BUF ERRNO RETCODE.
IF RETCODE < 0 THEN
MOVE 'Y' TO WRITE-SW FORCE-ERROR-MSG
MOVE WRITE-END-ERR TO ERR-MSG
MOVE SOCKID TO ERR-SOCKET
MOVE RETCODE TO ERR-RETCODE
MOVE ERRNO TO ERR-ERRNO
MOVE CICS-ERR-AREA TO CICS-MSG-AREA
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT
GO TO PGM-EXIT.
CLIENT-TALK-END-EXIT.
EXIT.
INVREQ-ERR-SEC.
MOVE 'Y' TO WRITE-SW FORCE-ERROR-MSG
MOVE INVREQ-ERR TO CICS-MSG-AREA.
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT.
GO TO PGM-EXIT.
IOERR-SEC.
MOVE 'Y' TO WRITE-SW FORCE-ERROR-MSG
MOVE IOERR-ERR TO CICS-MSG-AREA.
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT.
GO TO PGM-EXIT.
LENGERR-SEC.
MOVE 'Y' TO WRITE-SW FORCE-ERROR-MSG
MOVE LENGERR-ERR TO CICS-MSG-AREA.
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT.
GO TO PGM-EXIT.
NOSPACE-ERR-SEC.
MOVE 'Y' TO WRITE-SW FORCE-ERROR-MSG
MOVE NOSPACE-ERR TO CICS-MSG-AREA.
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT.
GO TO PGM-EXIT.
QIDERR-SEC.
MOVE 'Y' TO WRITE-SW FORCE-ERROR-MSG
MOVE QIDERR-ERR TO CICS-MSG-AREA.
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT.
GO TO PGM-EXIT.
ITEMERR-SEC.
MOVE 'Y' TO WRITE-SW FORCE-ERROR-MSG
MOVE ITEMERR-ERR TO CICS-MSG-AREA.
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT.
GO TO PGM-EXIT.
ENDDATA-SEC.
MOVE 'Y' TO WRITE-SW FORCE-ERROR-MSG
MOVE ENDDATA-ERR TO CICS-MSG-AREA.
PERFORM WRITE-CICS THRU WRITE-CICS-EXIT.
GO TO PGM-EXIT.
z/OS Communications Server: IP CICS Sockets Guide
Copyright IBM Corporation 1990, 2014