* 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. BSTTEZ63. * * COPYRIGHT TEI 2009-2011 * * IPV6 VERSION OF BSTTEZ13 * * BASED ON FIGURE 38 IN MVS TCP/IP SOCKETS RED BOOK. * GG24-2561-00 * * SEE COMMENTS IN BSTTEZ61. * * CHANGE LOG: * AUG 19, 2009 TT NEW PROGRAM * TT = TONY THIGPEN TONY@VSE2PDF.COM * OCT 13, 2009 TT ADDED PERFORM EZA-TERMAPI IN ABEND ROUTINE * AUG 27, 2010 TT ADDED IPADDR REQUEST SUPPORT * SEP 04, 2010 TT REMOVED BSTTEZA8 COPYBOOK * SEP 04, 2010 TT ADDED BSTTEZAR COPYBOOK ENVIRONMENT DIVISION. CONFIGURATION SECTION. DATA DIVISION. WORKING-STORAGE SECTION. 01 PROGRAM-INFOMATION. 05 PROGRAM-NAME PIC X(08) VALUE 'BSTTEZ63'. 05 PROGRAM-TITLE PIC X(26) VALUE 'EZA CICS SERVER SUBTASK'. 01 WS-AREA. 05 WS-STOP PIC X(01) VALUE SPACE. 05 WS-SOCKET-ORIGINAL PIC S9(04) COMP. 05 WS-SOCKET-ACCEPT PIC S9(04) COMP. 05 WS-SOCKET-TAKE PIC S9(04) COMP. 05 WS-TEXT-LENGTH PIC S9(04) COMP. 05 WS-IPADDRESS PIC X(16) VALUE LOW-VALUES. 05 WS-IPPORT PIC S9(04) COMP VALUE +4444. 05 WS-COUNT PIC S9(04) COMP VALUE +0. 05 WS-OURCLIENT PIC X(40) VALUE LOW-VALUES. 05 WS-FCI PIC X(01). 88 HAVE-TERMINAL VALUE X'01'. 05 WS-TIME PIC 9(06). 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. 101309 01 ABEND-INFO-SAVE PIC X(30). 01 MESSAGES. 05 MSG-DONE PIC X(14) VALUE 'BSTTEZ63 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 START-CHILD-PARM. * THIS AREA IS DOCUMENTED IN "LISTENER OUTPUT FORMAT", * FIGURE 15 IN CHAPTER 14, EXTERNAL DATA STRUCTURES, OF * "TCP/IP FOR VSE/ESA - IBM PROGRAM SETUP AND SUPPLEMENTARY * INFORMATION - SC33-6601-5" 05 START-S PIC 9(08) COMP. 05 START-CLIENTID. 15 START-C-DOMAIN PIC 9(08) COMP. 15 START-C-NAME PIC X(08). 15 START-C-TASK PIC X(08). 15 FILLER PIC X(20). 05 START-USER-DATA PIC X(35). 05 FILLER PIC X(01). 05 START-NAME. 15 START-FAMILY PIC 9(04) COMP. 15 START-PORT PIC 9(04) COMP. 15 START-ADDRESS PIC 9(08) COMP. 15 START-ZERO PIC X(08). 01 EZA-CALL-DATA. COPY BSTTEZA. 01 EZACIC06-DATA. COPY BSTTEZA6. 01 EZACIC09-DATA. COPY BSTTEZA9. 082710 LINKAGE SECTION. 082710 01 OUTPUT-IP-NAME PIC X(28). PROCEDURE DIVISION. MAINLINE SECTION. ML-START. EXEC CICS ASSIGN FCI(WS-FCI) NOHANDLE END-EXEC. 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-TAKESOCKET. EXEC CICS RETRIEVE INTO(START-CHILD-PARM) LENGTH(LENGTH OF START-CHILD-PARM) NOHANDLE END-EXEC. MOVE START-CLIENTID TO EZA-CLIENT. MOVE START-S TO EZA-S. MOVE EZA-S TO EZA-SOCRECV. PERFORM EZA-TAKESOCKET. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0002. MOVE EZA-RETCODE TO EZA-S. ML-REQUEST. IF START-USER-DATA IS EQUAL TO 'APPLID' GO TO ML-APPLID. IF START-USER-DATA IS EQUAL TO 'TIME' GO TO ML-GETTIME. 082710 IF START-USER-DATA (1 : 6) IS EQUAL TO 'IPADDR' 082710 GO TO ML-GETIPADDR. MOVE '80 UNKNOWN REQUEST' TO BUFFER-OUT. MOVE +18 TO EZA-NBYTE. GO TO ML-SEND. ML-APPLID. EXEC CICS ASSIGN APPLID(BUFFER-OUT) NOHANDLE END-EXEC. MOVE +8 TO EZA-NBYTE. GO TO ML-SEND. ML-GETTIME. EXEC CICS ASKTIME END-EXEC. MOVE EIBTIME TO WS-TIME. MOVE WS-TIME TO BUFFER-OUT. MOVE LENGTH OF WS-TIME TO EZA-NBYTE. GO TO ML-SEND. 082710 ML-GETIPADDR. 082710 STRING 082710 START-USER-DATA (7 : 8) DELIMITED BY SPACE 082710 '.LUNAME' DELIMITED BY SIZE 082710 INTO BUFFER-OUT. 082710 MOVE 15 TO EZA-NODELEN. 082710 MOVE LOW-VALUES TO EZA-ADDRINFO. 082710 MOVE EZA-INETANY TO EZA-AI-FAMILY. 082710 PERFORM EZA-GETADDRINFO. 082710 IF EZA-RETCODE IS NOT LESS THAN +0 082710 GO TO ML-EZACIC09. 082710 STRING 082710 START-USER-DATA (7 : 8) DELIMITED BY SPACE 082710 SPACE DELIMITED BY SIZE 082710 'IS NOT AN IP TERMINAL' DELIMITED BY SIZE 082710 INTO BUFFER-OUT. 082710 MOVE +32 TO EZA-NBYTE. 082710 GO TO ML-FREEADDRINFO. 082710 ML-EZACIC09. 082710 SET EZ9-RES TO EZA-RES. 082710 PERFORM EZA-RES-EXTRACT. 082710 IF EZA-RETCODE IS LESS THAN +0 082710 GO TO AR-0007. 082710 SET ADDRESS OF OUTPUT-IP-NAME TO EZ9-NAME. 082710 MOVE LOW-VALUES TO EZA-NAMEV6. 082710 MOVE OUTPUT-IP-NAME (1:EZ9-NAME-LEN) TO EZA-NAMEV6. 082710 MOVE EZA-NAME-FAMILY TO EZA-AF. 082710 IF EZA-NAME-FAMILY IS EQUAL TO EZA-INET 082710 MOVE EZA-NAME-IPADDRESS TO EZA-IPADDRESS 082710 ELSE 082710 MOVE EZA-NAMEV6-IPADDRESS TO EZA-IPADDRESS. 082710 PERFORM EZA-NTOP. 082710 MOVE EZA-PRESENTABLE TO BUFFER-OUT. 082710 MOVE EZA-PRESENTABLELEN TO EZA-NBYTE. 082710 ML-FREEADDRINFO. 082710 PERFORM EZA-FREEADDRINFO. 082710 GO TO ML-SEND. ML-SEND. TRACE * EXEC CICS WRITE OPERATOR TRACE * TEXT(BUFFER-OUT) TRACE * TEXTLENGTH(EZA-NBYTE) TRACE * END-EXEC. PERFORM EZA-EBCDIC-TO-ASCII. PERFORM EZA-SEND. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0003. ML-CLOSE. PERFORM EZA-CLOSE. IF EZA-RETCODE IS LESS THAN +0 GO TO AR-0006. ML-TERMAPI. PERFORM EZA-TERMAPI. IF HAVE-TERMINAL EXEC CICS SEND TEXT FROM(MSG-DONE) LENGTH(LENGTH OF MSG-DONE) ERASE END-EXEC EXEC CICS SEND CONTROL FREEKB END-EXEC ELSE EXEC CICS WRITE OPERATOR TEXT(MSG-DONE) TEXTLENGTH(LENGTH OF MSG-DONE) END-EXEC. EXEC CICS RETURN END-EXEC. ML-EXIT. GOBACK. * COPY IN ALL THE EZA SECTIONS COPY BSTTEZAP. COPY BSTTEZAR. 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 TEXT(MSG-EZA) TEXTLENGTH(LENGTH OF MSG-EZA) END-EXEC. 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 FROM(ABEND-INFORMATION) LENGTH(LENGTH OF ABEND-INFORMATION) ERASE END-EXEC EXEC CICS SEND CONTROL FREEKB END-EXEC. EXEC CICS WRITE OPERATOR TEXT(ABEND-INFORMATION) TEXTLENGTH(LENGTH OF ABEND-INFORMATION) END-EXEC. 101309 MOVE ABEND-INFORMATION TO ABEND-INFO-SAVE. 101309 PERFORM EZA-TERMAPI. 101309 MOVE ABEND-INFO-SAVE TO ABEND-INFORMATION. EXEC CICS ABEND ABCODE(ABEND-CODE) END-EXEC. AR-EXIT. EXIT.