* AS WRITTEN, THIS PROGRAM REQUIRES THE FOLLOWING CBL OPTIONS. * CBL MAP,XREF(SHORT),OFFSET,TEST(ALL,SYM),APOST,LIB * CBL TRUNC(BIN),NOZWB * CBL DATA(31),RMODE(ANY) IDENTIFICATION DIVISION. PROGRAM-ID. BSTTEZ12. * BASED ON FIGURE 38 IN MVS TCP/IP SOCKETS RED BOOK. * GG24-2561-00 * * SEE COMMENTS IN BSTTEZ11. * * CHANGE LOG: * MAY 07, 2002 DAT CORRECTED COMMENTS REFFERENCE. * DAT = TONY THIGPEN TONY@VSE2PDF.COM * MAY 07, 2002 DAT CORRECTED IF STATEMENT IN ML-START. * JUL 12, 2009 DAT ADDED STOP OPTION TO STOP SERVER * JUL 17, 2009 DAT WAS MISSING PERIOD BEFORE * PERFORM EZACIC06-SETUP IN ML-START. * JUL 17, 2009 DAT ADDED SEND CONTROL FREEKB AS NEEDED. * AUG 19, 2009 DAT REPLACE EZA CALLS WITH COPYBOOK BSTTEZAP ENVIRONMENT DIVISION. CONFIGURATION SECTION. DATA DIVISION. WORKING-STORAGE SECTION. 01 PROGRAM-INFOMATION. 05 PROGRAM-NAME PIC X(08) VALUE 'BSTTEZ12'. 05 PROGRAM-TITLE PIC X(25) VALUE 'EZA CICS LISTENER CLIENT'. 01 WS-AREA. 05 WS-STOP PIC X(01) VALUE SPACE. 05 WS-ORIGINAL-SOCKET PIC S9(04) COMP. 05 WS-TEXT-LENGTH PIC S9(04) COMP. 05 WS-IPADDRESS PIC X(04) VALUE X'7F000001'. 05 WS-IPPORT PIC S9(04) COMP VALUE +4444. 05 WS-FCI PIC X(01). 00001850 88 HAVE-TERMINAL VALUE X'01'. 05 WS-TERM-DATA. 10 FILLER PIC X(05). 10 WS-REQUEST PIC X(35). 05 WS-SEND-DATA. 10 WS-SD-TRANID PIC X(04) VALUE 'EZ13'. 10 FILLER PIC X(01) VALUE ','. 10 WS-SD-REQUEST PIC X(35) VALUE 'NOTHING'. 10 FILLER PIC X(03) VALUE ',,0'. 01 ABEND-INFORMATION. 03 CURRENT-FUNCTION PIC X(20) VALUE SPACES. 03 CURRENT-ERROR PIC 9(05) VALUE ZEROES. 03 FILLER PIC X(01) VALUE SPACES. 03 ABEND-CODE PIC 9(04) VALUE ZEROS. 01 MESSAGES. 05 MSG-DONE PIC X(14) VALUE 'BSTTEZ12 DONE '. 05 MSG-EZA. 10 MSG-EZA-TRAN PIC X(04). 10 FILLER PIC X(01). 10 MSG-EZA-TASK PIC 9(07). 10 FILLER PIC X(01). 10 MSG-EZA-FUNCTION PIC X(16). 01 BUFFER-IN PIC X(80) VALUE SPACES. 01 BUFFER-OUT PIC X(80) VALUE SPACES. 01 RSNDMSK PIC X(08) VALUE LOW-VALUES. 01 WSNDMSK PIC X(08) VALUE LOW-VALUES. 01 ESNDMSK PIC X(08) VALUE LOW-VALUES. 01 RRETMSK PIC X(08) VALUE LOW-VALUES. 01 WRETMSK PIC X(08) VALUE LOW-VALUES. 01 ERETMSK PIC X(08) VALUE LOW-VALUES. 01 EZA-CALL-DATA. COPY BSTTEZA. 01 EZACIC06-DATA. COPY BSTTEZA6. 01 EZACIC08-DATA. COPY BSTTEZA8. PROCEDURE DIVISION. MAINLINE SECTION. ML-START. EXEC CICS ASSIGN 00005815 FCI(WS-FCI) 00005820 NOHANDLE 00005825 END-EXEC. 00005830 IF HAVE-TERMINAL MOVE LENGTH OF BUFFER-IN TO WS-TEXT-LENGTH. EXEC CICS RECEIVE 00046600 INTO(BUFFER-IN) 00046600 LENGTH(WS-TEXT-LENGTH) 00046600 NOHANDLE END-EXEC 00046700 IF EIBRESP IS NOT EQUAL TO DFHRESP(NORMAL) 00003600 MOVE SPACES TO BUFFER-OUT MOVE BUFFER-IN (1 : WS-TEXT-LENGTH) TO BUFFER-OUT MOVE BUFFER-OUT TO WS-TERM-DATA 061209 MOVE WS-REQUEST TO WS-SD-REQUEST 061209 IF WS-REQUEST = 'STOP' 061209 OR WS-REQUEST = 'DOWN' 061209 MOVE 'DOWN' TO WS-SD-TRANID. IF HAVE-TERMINAL EXEC CICS SEND TEXT 00046600 FROM(WS-SD-REQUEST) 00046600 LENGTH(LENGTH OF WS-SD-REQUEST) 00046600 ERASE END-EXEC 00046700 071709 EXEC CICS SEND CONTROL 00046800 071709 FREEKB 071709 END-EXEC. 00046700 PERFORM EZACIC06-SETUP. ML-INITAPI. MOVE +0 TO EZA-MAXSOC. MOVE SPACES TO EZA-IDENT. MOVE SPACES TO EZA-SUBTASK. PERFORM EZA-INITAPI. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0001. ML-SOCKET. MOVE EZA-INET TO EZA-AF. PERFORM EZA-SOCKET. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0002. MOVE EZA-RETCODE TO EZA-S. ML-CONNECT. MOVE LOW-VALUES TO EZA-NAME. MOVE EZA-INET TO EZA-NAME-FAMILY. MOVE WS-IPPORT TO EZA-NAME-PORT. MOVE WS-IPADDRESS TO EZA-NAME-IPADDRESS. PERFORM EZA-CONNECT. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0003. ML-SEND. MOVE WS-SEND-DATA TO BUFFER-OUT. MOVE LENGTH OF WS-SEND-DATA TO EZA-NBYTE. PERFORM EZA-EBCDIC-TO-ASCII. PERFORM EZA-SEND. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0004. ML-SELECT. COMPUTE EZ6-SUB1 = EZA-S + 1. MOVE '1' TO EZ6-FLAG (EZ6-SUB1). PERFORM EZA-CHARACTERS-TO-BITS. COMPUTE EZA-MAXSOC-SELECT = EZA-S + 1. MOVE LOW-VALUES TO EZA-TIMEOUT. MOVE 10 TO EZA-TIMEOUT-SECONDS. MOVE LOW-VALUES TO RSNDMSK. MOVE LOW-VALUES TO WSNDMSK. MOVE LOW-VALUES TO ESNDMSK. MOVE EZ6-MASK TO RSNDMSK (1 : LENGTH OF EZ6-MASK). PERFORM EZA-SELECT. IF EZA-RETCODE IS LESS THAN +1 GO TO AR-0005. MOVE LOW-VALUES TO EZ6-MASK. MOVE LENGTH OF EZ6-MASK TO EZ6-SUB1. IF LENGTH OF ERETMSK IS LESS THAN EZ6-SUB1 MOVE LENGTH OF ERETMSK TO EZ6-SUB1. MOVE RRETMSK TO EZ6-MASK (1 : EZ6-SUB1). PERFORM EZA-BITS-TO-CHARACTERS. ML-RECV. PERFORM EZA-RECV. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0006. MOVE EZA-RETCODE TO EZA-NBYTE. PERFORM EZA-ASCII-TO-EBCDIC. IF BUFFER-IN IS NOT EQUAL TO SPACES MOVE BUFFER-IN TO MSG-DONE. TRACE * EXEC CICS WRITE OPERATOR 00771000 TRACE * TEXT(BUFFER-IN) 00772000 TRACE * TEXTLENGTH(EZA-NBYTE) 00773000 TRACE * END-EXEC. 00774000 ML-CLOSE. PERFORM EZA-CLOSE. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0007. ML-TERMAPI. PERFORM EZA-TERMAPI. IF HAVE-TERMINAL EXEC CICS SEND TEXT 00046600 FROM(MSG-DONE) 00046600 LENGTH(LENGTH OF MSG-DONE) 00046600 ERASE END-EXEC 00046700 EXEC CICS SEND CONTROL 00046800 FREEKB END-EXEC 00046700 ELSE EXEC CICS WRITE OPERATOR 00771000 TEXT(MSG-DONE) 00772000 TEXTLENGTH(LENGTH OF MSG-DONE) 00773000 END-EXEC. 00774000 EXEC CICS RETURN 00047600 END-EXEC. ML-EXIT. GOBACK. * COPY IN ALL THE EZA SECTIONS COPY BSTTEZAP. CONSOLE-TRACE SECTION. * COMMENT OUT THE WTO IF IT IS NOT WANTED CT-START. MOVE SPACES TO MSG-EZA. MOVE EIBTRNID TO MSG-EZA-TRAN. MOVE EIBTASKN TO MSG-EZA-TASK. MOVE EZA-FUNCTION TO MSG-EZA-FUNCTION. EXEC CICS WRITE OPERATOR 00771000 TEXT(MSG-EZA) 00772000 TEXTLENGTH(LENGTH OF MSG-EZA) 00773000 END-EXEC. 00774000 CT-EXIT. EXIT. ABEND SECTION. AR-0001. MOVE 0001 TO ABEND-CODE. GO TO AR-ABEND. AR-0002. MOVE 0002 TO ABEND-CODE. GO TO AR-ABEND. AR-0003. MOVE 0003 TO ABEND-CODE. GO TO AR-ABEND. AR-0004. MOVE 0004 TO ABEND-CODE. GO TO AR-ABEND. AR-0005. MOVE 0005 TO ABEND-CODE. GO TO AR-ABEND. AR-0006. MOVE 0006 TO ABEND-CODE. GO TO AR-ABEND. AR-0007. MOVE 0007 TO ABEND-CODE. GO TO AR-ABEND. AR-ABEND. MOVE EZA-ERRNO TO CURRENT-ERROR. IF HAVE-TERMINAL EXEC CICS SEND TEXT 00046600 FROM(ABEND-INFORMATION) 00046600 LENGTH(LENGTH OF ABEND-INFORMATION) 00046600 ERASE 071709 END-EXEC 071709 EXEC CICS SEND CONTROL 071709 FREEKB END-EXEC. 00046700 EXEC CICS WRITE OPERATOR 00771000 TEXT(ABEND-INFORMATION) 00046600 TEXTLENGTH(LENGTH OF ABEND-INFORMATION) 00046600 END-EXEC. 00774000 EXEC CICS ABEND 00047600 ABCODE(ABEND-CODE) END-EXEC. AR-EXIT. EXIT.