* $$ JOB JNM=BSTTEZ20,CLASS=0,LDEST=(,TTHIGPEN),PDEST=(,TTHIGPEN) * $$ LST JSEP=0,CLASS=O * $$ PUN JSEP=0,CLASS=0,DISP=I // JOB BSTTEZ20 // EXEC LIBR,SIZE=512K ACC S=BSILIB.TTDEV CATALOG BSTTEZ20.C R=YES * 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. BSTTEZ20. * * COPYRIGHT TEI 2008-2011 * * THIS PROGRAM ACTS AS A MINI-FTP CLIENT UNDER CICS. * * A USER PROGRAM THAT NEEDS TO PERFORM SOME TYPE OF FTP * FUNCTION WILL BUILD A REQUREST AREA IN COMMAREA AND * LINK TO THIS PROGRAM. THE FOLLOWING SAMPLE PROGRAMS * ARE ALSO PROVIDED TO SHOW A CORRECT CALLING SEQUENCE. * BSTTEZ21 (PERFORMS BASIC FUNCTIONS) * BSTTEZ22 (PERFORMS FUNCTIONS THAT RETURN DATA) * BSTTEZ23 (PERFORMS FILE TRANSFER FUNCTIONS) * * YOU WILL NEED 3 CICS TRANSACTIONS TO RUN THE ABOVE PROGRAMS. * THEY CAN BE ANY NAME, BUT WE USED 'EZ21', 'EZ22' AND 'EZ23'. * * THE COMMAREA CONTAINS TWO SECTIONS, A HEADER (RI-HEADER) * THAT CONTAINS CONNECTION AND CONTROL INFORMATION, AND * A TABLE (RI-COMMANDS) OF FTP COMMANDS (AND OPTIONS) TO BE * ISSUED. * * RI-HEADER: * RI-SYSID - THE ID OF THE TCP/IP STACK. * NOTE: WORKS FOR ALL RELEASES OF THE BSI TCP/IP PRODUCT BUT * ONLY WORKS FOR VSE 4.2.0 AND LATER WITH THE CSI PRODUCT. * RI-DEBUG-FLAG - TURNS ON DEBUG LOGGING. * RI-HOST - THE FTP HOST TO BE CONTACTED. THE VALUE CAN BE * EITHER A RESOVABLE HOST OR DOTTED DECIMAL FORMAT. * THE FIELD MUST BE LEFT-JUSTIFIED. * (EXAMPLE: "FTP.BSIOPTI.COM" OR "192.168.1.22") * RI-PORT - THE FTP PORT TO BE USED. THIS FIELD WILL * DEFAULT TO THE STANDARD FTP PORT VALUE OF "21". * RI-USERID/RI-PASSWORD - SECURITY FIELDS FOR LOGGING ON * TO THE FTP SERVER. * RI-DIRECTORY - THE INITIAL DIRECTORY TO BE SWITCHED TO * (USING 'CWD') WHEN FIRST CONTACTING THE FTP SERVER. * RI-COMMAND-COUNT - THEN NUMBER OF COMMAND OCCURANCES IN * THE RI-COMMANDS TABLE. THE MAXIMUM IS 59 DUE TO THE * CICS RESTRICTION THAT COMMAREA BE LESS THAN 32K-1 BYTES. * RI-COMMAND-COUNT-DONE - THIS FIELD WILL BE SET TO THE * NUMBER OF COMMANDS PROCESSED BEFORE A TERMINALLY * FAILING COMMAND. * RI-COMMAND-COUNT-ERRORS - THIS FIELD WILL BE SET TO THE * NUMBER OF COMMANDS PROCESSED THAT HAD 'SOFT' ERRORS. * NOTE: ANY ERRORS WHILE CONTACTING THE FTP SERVER, * LOGGING ON THE HOST, OR CHANGING TO THE INTIAL * DIRECTORY WILL RESULT IN RI-COMMAND-COUNT-DONE AND * RI-COMMAND-COUNT-ERRORS BEING RETURNED AS ZEROES. * RI-ERROR-MSG - ANY ERRORS WHILE CONTACTING THE FTP SERVER, * LOGGING ON THE HOST, OR CHANGING TO THE INTIAL * DIRECTORY WILL RESULT IN RI-ERROR-MSG BEING SET TO * INDICATE THE NATURE OF THE ERROR. * * RI-COMMANDS: * RI-COMMAND - THE FTP COMMAND STRING TO BE ISSUED. * THE FIELD MUST BE LEFT-JUSTIFIED. * RI-TSQ - THE NAME OF THE TSQ THAT CONTAINS EITHER THE * SENDING DATA (STOR, STRU, & APPE ONLY), THE RECEIVED * DATA (RETR) OR THE OUTPUT FROM THE COMMAND (N/A FOR * STOR, STRU, APPE, AND RETR). * IT IS THE CALLER'S RESPONSIBLITY TO DELETE THE QUEUE * PRIOR TO CALLING BSTTEZ20 AND AFTER READING THE QUEUE. * THIS FIELD IS REQUIRED FOR: * STOR, STRU, APPE, RETR, LIST, NLIST * RI-TSQ-RECSIZE - THE RECORD SIZE OF THE DATA TO BE * TRANSFERED. IF SET TO +0, THE TRANSFER IS PERFORMED AS * A VARIABLE LENGTH RECORD TRANSFER. WHEN SENDING DATA, * RECORD TRANSFERED IS SENT WITH THE SAME LENGTH AS WAS * READ FROM THE TSQ. WHEN RECEIVING DATA, THE EACH TSQ * ITEM IS CREATED USING THE ACTUAL LENGTH OF DATA * RECEIVED. IF THIS FIELD IS SET TO ANY POSITIVE VALUE, * THE TRANSFER IS PERFORMED AS A FIXED LENTH RECORD * TRANSFER. THE DATA SENT/RECEIVED IS EITHER TRUNCATED * OR PADDED WITH SPACES TO THE LENGTH SPECIFIED. * NOTE: THE RECSIZE IS REQUIRED FOR A BINARY SEND. * RI-TSQ-COUNT - FOR A RECEIVE, WILL CONTAIN UPON RETURN THE * NUMBER OF TSQ ITEMS WRITTEN. SINCE SOME TRANSFERS MAY * TRANSFER ZERO ITEMS (AN EMPTY FILE OR DIRECTORY), IT IS * POSSIBLE TO HAVE A GOOD COMPLETION CODE, YET NO TSQ * WAS CREATED. WHEN SENDING A TSQ, THE COUNT IS ONLY * TESTED TO SEE IF IT IS NOT ZERO. IF THE COUNT IS ZERO, * THEN A 'NOT FOUND' TSQ IS NOT CONSIDERED AN ERROR, BUT * INSTEAD IT IS CONSIDERED AN EMPTY FILE. FOR SENDING, * ALL ITEMS IN THE TSQ ARE SENT WITHOUT REGUARD TO THIS * VALUE. * RI-TSQ-ENCODING - THIS FIELD INDICATES THE FORMAT OF THE * TSQ ITEMS. IF THE TSQ ENCODING IS SET TO EBCDIC, THEN * ALL DATA IS TRANSLATED BEFORE SENDING OR AFTER * RECEPTION. PAIRS ARE ADDED OR STRIPPED OF AS * NEEDED. (FOR RECEIVED DATA, A SINGE IS TREATED AS * IF A HAD BEEN RECEIVED.) IF THE TSQ ENCODING IS * SET TO BINARY, NO TRANSFER OR ACTION OCCURS. * EACH TSQ ENTRY IS SENT AS-IS. FOR A BINARY RECEIVE, * RI-TSQ-RECSIZE MUST BE SPECIFIED. * RI-OPTIONAL - A FLAG THAT IS USED BY THE CALLER TO * SPECIFY THAT AN ERROR ON THIS COMMAND IS TO BE TREATED * AS A SOFT ERROR AND THAT PROCESSING SHOULD CONTINUE * EVEN IF THERE WAS AN ERROR. * RI-STATUS - UPON RETURN FROM BSTTEZ20, THIS FIELD WILL * CONTAIN THE GOOD OR BAD STATUS OF THE ISSUED COMMAND. * RI-RC - UPON RETURN FROM BSTTEZ20, THIS FIELD WILL CONTAIN * THE THREE DIGIT RESPONSE NUMBER RECEIVED FROM THE FTP * SERVER. * RI-MESSAGE - UPON RETURN FROM BSTTEZ20, THIS FIELD WILL * CONTAIN THE CONTENTS OF THE FIRST MESSAGE LINE RECEIVED * FROM THE FTP SERVER. * * * CHANGE LOG: * MAR 24, 2008 TT NEW PROGRAM. * TT = TONY THIGPEN TONY@VSE2PDF.COM * MAR 27, 2008 TT ADD 125 AS GOOD RC JUST BEFORE PC-DATA * MAR 27, 2008 TT UPDATED VALID RETURN CODES TABLE * APR 07, 2008 TT CHANGED TO HANDLE STACKED RESPONSES * APR 07, 2008 TT ADDED RI-TSQ-COUNT * APR 07, 2008 TT ADDED ITEM NUMBER TO FIRST TSQ READ * JUL 08, 2008 TT ADDED STATUS RI-EOF-FOUND-AND-DROPPED * AUG 19, 2009 TT REPLACE EZA CALLS WITH COPYBOOK BSTTEZAP * SEP 01, 2009 TT ADD QUIT COMMAND PRIOR TO CLOSING THE SOCKET * SEP 04, 2010 TT ADDED BSTTEZAH COPYBOOK ENVIRONMENT DIVISION. CONFIGURATION SECTION. DATA DIVISION. WORKING-STORAGE SECTION. 01 PROGRAM-INFOMATION. 05 PROGRAM-NAME PIC X(08) VALUE 'BSTTEZ20'. 05 PROGRAM-TITLE PIC X(26) VALUE 'EZA CICS FTP CLIENT'. 01 COMMANDS. 05 WS-CSUB1 PIC S9(09) COMP. 05 WS-CTOP PIC S9(09) COMP VALUE +0. 05 WS-CMAX PIC S9(09) COMP VALUE +0026. 05 WS-CRMAX PIC S9(09) COMP VALUE +0010. 05 CMD-TABLE. 10 CMD-ACCT PIC X(40) VALUE 'ACCT 230202 '. 10 CMD-CWD PIC X(40) VALUE 'CWD 250 '. 10 CMD-CDUP PIC X(40) VALUE 'CDUP 200250 '. 10 CMD-SMNT PIC X(40) VALUE 'SMNT 202250 '. 10 CMD-TYPE PIC X(40) VALUE 'TYPE 200 '. 10 CMD-STRU PIC X(40) VALUE 'STRU 226250 '. 10 CMD-MODE PIC X(40) VALUE 'MODE 200 '. 10 CMD-RETR PIC X(40) VALUE 'RETR O 226250 '. 10 CMD-STOR PIC X(40) VALUE 'STOR I 226250 '. 10 CMD-STOU PIC X(40) VALUE 'STOU I 226250 '. 10 CMD-APPE PIC X(40) VALUE 'APPE I 226250 '. 10 CMD-ALLO PIC X(40) VALUE 'ALLO 200202 '. 10 CMD-RNFR PIC X(40) VALUE 'RNFR 350 '. 10 CMD-RNTO PIC X(40) VALUE 'RNTO 250 '. 10 CMD-ABOR PIC X(40) VALUE 'ABOR 225226 '. 10 CMD-DELE PIC X(40) VALUE 'DELE 250 '. 10 CMD-RMD PIC X(40) VALUE 'RMD 250 '. 10 CMD-MKD PIC X(40) VALUE 'MKD 257 '. 10 CMD-PWD PIC X(40) VALUE 'PWD 257 '. 10 CMD-LIST PIC X(40) VALUE 'LIST AO 226250 '. 10 CMD-NLST PIC X(40) VALUE 'NLST AO 226250 '. 10 CMD-SITE PIC X(40) VALUE 'SITE 200202 '. 10 CMD-SYST PIC X(40) VALUE 'SYST 215 '. 10 CMD-STAT PIC X(40) VALUE 'STAT 211212213 '. 10 CMD-HELP PIC X(40) VALUE 'HELP 211214 '. 10 CMD-NOOP PIC X(40) VALUE 'NOOP 200 '. 05 CMD-TABLE-R REDEFINES CMD-TABLE. 10 CMD-INFORMATION OCCURS 26. 15 CMD-NAME PIC X(04). 15 CMD-RESPONSE PIC X(01). 88 CMD-NORESPONSE VALUE 'N'. 15 CMD-EOL PIC X(01). 88 CMD-EOL-ASCII VALUE 'A'. 15 CMD-TSQ PIC X(01). 88 CMD-TSQ-IN VALUE 'I'. 88 CMD-TSQ-OUT VALUE 'O'. 15 FILLER PIC X(01). 15 FILLER PIC X(01). 15 FILLER PIC X(01). 15 CMD-GOOD-RC PIC X(03) OCCURS 10. 01 WS-AREA. 05 WS-SUB0 PIC S9(09) COMP. 05 WS-SUB1 PIC S9(09) COMP. 05 WS-SUB2 PIC S9(09) COMP. 05 WS-SUB3 PIC S9(09) COMP. 05 WS-SUB10 PIC S9(09) COMP. 05 WS-SUB11 PIC S9(09) COMP. 05 WS-SUB12 PIC S9(09) COMP. 05 WS-RISUB1 PIC S9(09) COMP. 05 WS-WASUB1X. 10 WS-WASUB1 PIC S9(09) COMP. 05 WS-LF PIC X(01) VALUE X'25'. 05 WS-RC-MESSAGE. 10 WS-RC PIC X(03). 10 WS-TEXT PIC X(253). 05 WS-S-CONTROL PIC S9(04) COMP. 05 WS-S-DATA PIC S9(04) COMP. 05 WS-IPADDRESSX. 10 WS-IPADDRESS PIC 9(09) COMP. 05 WS-IPADDRESSB REDEFINES WS-IPADDRESSX. 10 WS-IPADDRESSB1 PIC 9(04) COMP. 10 WS-IPADDRESSB2 PIC 9(04) COMP. * VALUE X'C0A8014D'. 05 WS-WORK9LIT PIC X(03). 05 WS-WORK9 PIC 9(09). 05 WS-IPPORTX. 10 WS-IPPORT PIC 9(09) COMP. 05 WS-PASV-RESPONSE. 10 WS-PASV-1 PIC 9(04). 10 WS-PASV-2 PIC 9(04). 10 WS-PASV-3 PIC 9(04). 10 WS-PASV-4 PIC 9(04). 10 WS-PASV-5 PIC 9(04). 10 WS-PASV-6 PIC 9(04). 10 WS-JUNK PIC X(256). 10 WS-PASV-WORK-1 PIC X(256). 10 WS-PASV-WORK-2 PIC X(256). 05 WS-LOGGING PIC X(01). 88 WS-LOG-ALL VALUE '0'. 88 WS-NO-CONSOLE VALUE '1'. 88 WS-NO-TSQ VALUE '2'. 05 WS-FCI PIC X(01). 88 HAVE-TERMINAL VALUE X'01'. 01 ABEND-INFORMATION. 03 FILLER PIC X(09) VALUE 'ABEND IN '. 03 CURRENT-TRAN PIC X(04) VALUE SPACES. 03 FILLER PIC X(01) VALUE SPACES. 03 CURRENT-TASK PIC 9(07) VALUE ZEROES. 03 FILLER PIC X(01) VALUE SPACES. 03 CURRENT-FUNCTION PIC X(20) VALUE SPACES. 03 FILLER PIC X(01) 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(10) VALUE 'EZ20 DONE '. 05 MSG-INVALID-RESPONSE PIC X(31) VALUE 'EZ20 INVALID RESPONSE RECEIVED.'. 05 WS-MESSAGE-TAG PIC X(03). 05 WS-MESSAGE PIC X(100). 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-SIZES. 05 BUFFER-IN-LENGTH PIC S9(09) COMP. 05 BUFFER-OUT-LENGTH PIC S9(09) COMP. 05 WORK-AREA-LENGTH PIC S9(09) COMP. 01 BUFFER-IN PIC X(32767) VALUE SPACES. 01 BUFFER-OUT PIC X(32767) VALUE SPACES. 01 WORK-AREA. 05 WA-BYTE PIC X(01) OCCURS 32767. 01 RESPONSE-AREA. 05 WS-RASUB1 PIC S9(09) COMP. 05 WS-RESUB1 PIC S9(09) COMP. 05 WS-RATOP PIC S9(09) COMP VALUE +0. 05 WS-RETOP PIC S9(09) COMP VALUE +0. 05 WS-RAMAX PIC S9(09) COMP VALUE +0100. 05 WS-REMAX PIC S9(09) COMP VALUE +0512. 05 WS-RACUR PIC S9(09) COMP VALUE +0. 05 WS-RACURSAVE PIC S9(09) COMP VALUE +0. 05 RA-TABLE. 10 RA-ENTRY OCCURS 0100. 15 RE-LINE-LENGTH PIC S9(04) COMP. 15 RE-LINE. 20 RE-RC PIC X(03). 20 RE-CONTINUE PIC X(01). 20 RC-REST PIC X(508). 15 FILLER REDEFINES RE-LINE. 20 RE-POS PIC X(01) OCCURS 0512. 01 FTP-COMMANDS. 05 FTP-USER PIC X(05) VALUE 'USER '. 05 FTP-PASS PIC X(05) VALUE 'PASS '. 05 FTP-CRLF PIC X(02) VALUE X'0D25'. 05 FTP-CRLF-ASCII PIC X(02) VALUE X'0D0A'. 05 FTP-CWD PIC X(04) VALUE 'CWD '. 05 FTP-PASV PIC X(04) VALUE 'PASV'. 090109 05 FTP-QUIT PIC X(04) VALUE 'QUIT'. 01 SELECT-MASKS. 05 RSNDMSK PIC X(08) VALUE LOW-VALUES. 05 WSNDMSK PIC X(08) VALUE LOW-VALUES. 05 ESNDMSK PIC X(08) VALUE LOW-VALUES. 05 RRETMSK PIC X(08) VALUE LOW-VALUES. 05 WRETMSK PIC X(08) VALUE LOW-VALUES. 05 ERETMSK PIC X(08) VALUE LOW-VALUES. 01 EZA-CALL-DATA. COPY BSTTEZA. 01 EZACIC06-DATA. COPY BSTTEZA6. 01 EZACIC08-DATA. COPY BSTTEZA8. LINKAGE SECTION. 01 DFHCOMMAREA. 05 RI-HEADER. 10 RI-SYSID PIC X(02). 10 RI-DEBUG-FLAG PIC X(01). 88 RI-DEBUG-CONSOLE VALUE 'C'. 10 RI-HOST PIC X(128). 10 RI-PORT PIC 9(04) COMP. 10 RI-USERID PIC X(32). 10 RI-PASSWORD PIC X(32). 10 RI-DIRECTORY PIC X(32). 10 RI-COMMAND-COUNT PIC S9(04) COMP. 10 RI-COMMAND-COUNT-DONE PIC S9(04) COMP. 10 RI-COMMAND-COUNT-ERRORS PIC S9(04) COMP. 10 RI-ERROR-MSG PIC X(30). 05 RI-COMMANDS OCCURS 0060. 10 RI-COMMAND PIC X(256). 10 RI-TSQ PIC X(08). 10 RI-TSQ-RECSIZE PIC 9(09). 10 RI-TSQ-COUNT PIC 9(09). 10 RI-TSQ-ENCODING PIC X(01). 88 RI-TSQ-ASCII VALUE 'A'. 88 RI-TSQ-BINARY VALUE 'B'. 88 RI-TSQ-EBCDIC VALUE 'E'. 10 RI-OPTIONAL PIC X(01). 88 RI-IS-OPTIONAL VALUE 'Y'. 10 RI-STATUS PIC X(01). 88 RI-NOT-PROCESSED VALUE 'N'. 88 RI-GOOD VALUE 'G'. 88 RI-EOF-FOUND-AND-DROPPED VALUE 'E'. 88 RI-BAD-RESPONSE VALUE 'B'. 88 RI-INCOMPLETE-TRANSFER VALUE 'I'. 88 RI-INVALID-QUEUE VALUE 'Q'. 88 RI-RESPONSE-TRUNCATED VALUE 'T'. 88 RI-ERRORS VALUE 'B' 'I' 'Q' 'T'. 10 RI-RC PIC X(03). 10 RI-MESSAGE PIC X(256). PROCEDURE DIVISION. MAINLINE SECTION. ML-START. EXEC CICS ASSIGN FCI(WS-FCI) NOHANDLE END-EXEC. MOVE LENGTH OF BUFFER-IN TO BUFFER-IN-LENGTH. MOVE LENGTH OF BUFFER-OUT TO BUFFER-OUT-LENGTH. MOVE LENGTH OF WORK-AREA TO WORK-AREA-LENGTH. MOVE +0 TO WS-RISUB1. IF EIBCALEN IS LESS THAN LENGTH OF RI-HEADER MOVE 'NO COMMAREA' TO CURRENT-FUNCTION GO TO AR-0001. ML-CLEAR-HEADER. MOVE +0 TO RI-COMMAND-COUNT-DONE. MOVE +0 TO RI-COMMAND-COUNT-ERRORS. * CHECKING FOR SPACES INSTAD OF A NUMBER IN RI-COMMAND-COUNT IF RI-COMMAND-COUNT IS EQUAL TO 16448 MOVE +0 TO RI-COMMAND-COUNT. IF RI-PORT IS EQUAL TO 0 MOVE +21 TO RI-PORT. ML-INITAPI. MOVE +0 TO EZA-MAXSOC. MOVE SPACES TO EZA-IDENT. IF RI-SYSID IS NOT EQUAL TO SPACES AND RI-SYSID IS NOT EQUAL TO LOW-VALUES MOVE 'SOCKET' TO EZA-IDENT-TAG MOVE RI-SYSID TO EZA-IDENT-SYSID. MOVE SPACES TO EZA-SUBTASK. PERFORM EZA-INITAPI. IF EZA-RETCODE IS LESS THAN +0 MOVE '600 TCPIP NOT AVAIALABLE' TO RI-ERROR-MSG GO TO ML-TERMAPI. ML-GETHOSTBYNAME. MOVE RI-HOST TO BUFFER-OUT. MOVE LENGTH OF RI-HOST TO EZA-NBYTE. PERFORM TRUNCATE-BUFFER. MOVE EZA-NBYTE TO EZA-NAMELEN. PERFORM EZA-GETHOSTBYNAME. IF EZA-RETCODE IS LESS THAN +0 MOVE '601 BAD GETHOSTBYNAME' TO RI-ERROR-MSG GO TO ML-TERMAPI. MOVE LOW-VALUES TO EZACIC08-DATA. MOVE +0 TO EZ8-HOSTALIAS-SEQ. MOVE +0 TO EZ8-HOSTADDR-SEQ. PERFORM EZA-HOSTENT-EXTRACT. IF EZA-RETCODE IS LESS THAN +0 MOVE '602 BAD HOSTENT EXTRACT' TO RI-ERROR-MSG GO TO ML-TERMAPI. MOVE LOW-VALUES TO EZA-NAME. MOVE EZ8-HOSTADDR-TYPE TO EZA-NAME-FAMILY. MOVE RI-PORT TO EZA-NAME-PORT. IF EZ8-HOSTADDR-COUNT IS NOT GREATER THAN +0 MOVE '603 HOST IS UNRESOLVABLE' TO RI-ERROR-MSG GO TO ML-TERMAPI. ML-SOCKET. MOVE EZA-INET TO EZA-AF. PERFORM EZA-SOCKET. IF EZA-RETCODE IS LESS THAN +0 MOVE '610 AQUIRE SOCKET FAILED' TO RI-ERROR-MSG GO TO ML-TERMAPI. MOVE EZA-RETCODE TO EZA-S. MOVE EZA-S TO WS-S-CONTROL. ML-CONNECT. MOVE LOW-VALUES TO EZA-NAME. MOVE EZ8-HOSTADDR-TYPE TO EZA-NAME-FAMILY. MOVE RI-PORT TO EZA-NAME-PORT. MOVE EZ8-HOSTADDR-VALUE-X TO EZA-NAME-IPADDRESS. PERFORM EZA-CONNECT. IF EZA-RETCODE IS LESS THAN +0 MOVE '620 UNABLE TO CONTACT HOST' TO RI-ERROR-MSG GO TO ML-TERMAPI. ML-CONNECT-RECV. PERFORM RECV-RESPONSE. IF EZA-RETCODE IS LESS THAN +0 MOVE '650 CONNECTION DISCONNECTED' TO RI-ERROR-MSG GO TO ML-TERMAPI. IF WS-RC IS NOT EQUAL TO '220' MOVE WS-RC-MESSAGE TO RI-ERROR-MSG GO TO ML-TERMAPI. ML-USERID. PERFORM CLEAR-BUFFER-OUT. COMPUTE WS-SUB0 = EZA-NBYTE + 1. MOVE FTP-USER TO BUFFER-OUT (WS-SUB0:LENGTH OF FTP-USER). ADD LENGTH OF FTP-USER TO EZA-NBYTE. COMPUTE WS-SUB0 = EZA-NBYTE + 1. MOVE RI-USERID TO BUFFER-OUT (WS-SUB0:) ADD LENGTH OF RI-USERID TO EZA-NBYTE. PERFORM ADD-CRLF. PERFORM EZA-EBCDIC-TO-ASCII. PERFORM EZA-SEND. IF EZA-RETCODE IS LESS THAN +0 MOVE '640 INVALID SIGN ON' TO RI-ERROR-MSG GO TO ML-TERMAPI. ML-USERID-RECV. PERFORM RECV-RESPONSE. IF EZA-RETCODE IS LESS THAN +0 MOVE '641 INVALID SIGN ON' TO RI-ERROR-MSG GO TO ML-TERMAPI. IF WS-RC IS EQUAL TO '230' GO TO ML-CWD. IF WS-RC IS NOT EQUAL TO '331' MOVE WS-RC-MESSAGE TO RI-ERROR-MSG GO TO ML-TERMAPI. ML-PASSWORD. PERFORM CLEAR-BUFFER-OUT. COMPUTE WS-SUB0 = EZA-NBYTE + 1. MOVE FTP-PASS TO BUFFER-OUT (WS-SUB0:LENGTH OF FTP-PASS). ADD LENGTH OF FTP-PASS TO EZA-NBYTE. COMPUTE WS-SUB0 = EZA-NBYTE + 1. MOVE RI-PASSWORD TO BUFFER-OUT (WS-SUB0:) ADD LENGTH OF RI-USERID TO EZA-NBYTE. PERFORM ADD-CRLF. PERFORM EZA-EBCDIC-TO-ASCII. PERFORM EZA-SEND. IF EZA-RETCODE IS LESS THAN +0 MOVE '642 INVALID SIGN ON' TO RI-ERROR-MSG GO TO ML-TERMAPI. ML-PASSWORD-RECV. PERFORM RECV-RESPONSE. IF EZA-RETCODE IS LESS THAN +0 MOVE '643 INVALID SIGN ON' TO RI-ERROR-MSG GO TO ML-TERMAPI. IF WS-RC IS NOT EQUAL TO '230' MOVE WS-RC-MESSAGE TO RI-ERROR-MSG GO TO ML-TERMAPI. ML-CWD. IF RI-DIRECTORY IS EQUAL TO SPACES OR RI-DIRECTORY IS EQUAL TO LOW-VALUES GO TO ML-STATUS. PERFORM CLEAR-BUFFER-OUT. COMPUTE WS-SUB0 = EZA-NBYTE + 1. MOVE FTP-CWD TO BUFFER-OUT (WS-SUB0:LENGTH OF FTP-CWD). ADD LENGTH OF FTP-CWD TO EZA-NBYTE. COMPUTE WS-SUB0 = EZA-NBYTE + 1. MOVE RI-DIRECTORY TO BUFFER-OUT (WS-SUB0:) ADD LENGTH OF RI-USERID TO EZA-NBYTE. PERFORM ADD-CRLF. PERFORM EZA-EBCDIC-TO-ASCII. PERFORM EZA-SEND. IF EZA-RETCODE IS LESS THAN +0 MOVE '651 CONNECTION DISCONNECTED' TO RI-ERROR-MSG GO TO ML-TERMAPI. ML-CWD-RECV. PERFORM RECV-RESPONSE. IF EZA-RETCODE IS LESS THAN +0 MOVE '652 CONNECTION DISCONNECTED' TO RI-ERROR-MSG GO TO ML-TERMAPI. IF WS-RC IS NOT EQUAL TO '250' AND WS-RC IS NOT EQUAL TO '257' MOVE WS-RC-MESSAGE TO RI-ERROR-MSG GO TO ML-TERMAPI. ML-STATUS. MOVE +0 TO WS-RISUB1. ML-STATUS-LOOP. ADD +1 TO WS-RISUB1. IF WS-RISUB1 IS GREATER THAN RI-COMMAND-COUNT GO TO ML-COMMANDS. SET RI-NOT-PROCESSED (WS-RISUB1) TO TRUE. GO TO ML-STATUS-LOOP. ML-COMMANDS. MOVE +0 TO WS-RISUB1. ML-COMMAND-LOOP. ADD +1 TO WS-RISUB1. IF WS-RISUB1 IS GREATER THAN RI-COMMAND-COUNT GO TO ML-COMMAND-END. ADD +1 TO RI-COMMAND-COUNT-DONE. PERFORM PROCESS-COMMANDS. IF RI-ERRORS (WS-RISUB1) ADD +1 TO RI-COMMAND-COUNT-ERRORS. IF RI-IS-OPTIONAL (WS-RISUB1) GO TO ML-COMMAND-LOOP. IF RI-GOOD (WS-RISUB1) GO TO ML-COMMAND-LOOP. ML-COMMAND-END. 090109 ML-QUIT. 090109 PERFORM CLEAR-BUFFER-OUT. 090109 COMPUTE WS-SUB0 = EZA-NBYTE + 1. 090109 MOVE FTP-QUIT TO BUFFER-OUT (WS-SUB0:LENGTH OF FTP-QUIT). 090109 ADD LENGTH OF FTP-QUIT TO EZA-NBYTE. 090109 PERFORM ADD-CRLF. 090109 PERFORM EZA-EBCDIC-TO-ASCII. 090109 PERFORM EZA-SEND. 090109 IF EZA-RETCODE IS LESS THAN +0 090109 MOVE '649 INVALID QUIT' TO RI-ERROR-MSG 090109 GO TO ML-TERMAPI. ML-CLOSE. PERFORM EZA-CLOSE. IF EZA-RETCODE IS LESS THAN +0 MOVE '653 CONNECTION DISCONNECTED' TO RI-ERROR-MSG GO TO ML-TERMAPI. 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. ML-RETURN. EXEC CICS RETURN END-EXEC. ML-EXIT. GOBACK. PROCESS-COMMANDS SECTION. PC-START. MOVE +0 TO WS-CSUB1. IF RI-DEBUG-CONSOLE EXEC CICS WRITE OPERATOR TEXT(RI-COMMAND(WS-RISUB1)) TEXTLENGTH(80) END-EXEC. PC-FIND-CMD. ADD +1 TO WS-CSUB1. IF WS-CSUB1 IS GREATER THAN WS-CMAX GO TO PC-UNKNOWN. IF RI-COMMAND (WS-RISUB1) (1:4) IS NOT EQUAL TO CMD-NAME (WS-CSUB1) GO TO PC-FIND-CMD. PC-MATCH. IF NOT (CMD-TSQ-IN (WS-CSUB1) OR CMD-TSQ-OUT (WS-CSUB1)) GO TO PC-COMMAND-SEND. PERFORM GET-PASSIVE-PORT. PC-COMMAND-SEND. PERFORM CLEAR-BUFFER-OUT. COMPUTE WS-SUB0 = EZA-NBYTE + 1. MOVE RI-COMMAND (WS-RISUB1) TO BUFFER-OUT (WS-SUB0:LENGTH OF RI-COMMAND). ADD LENGTH OF RI-COMMAND TO EZA-NBYTE. PERFORM ADD-CRLF. PERFORM EZA-EBCDIC-TO-ASCII. PERFORM EZA-SEND. IF EZA-RETCODE IS LESS THAN +0 MOVE '654 CONNECTION DISCONNECTED' TO RI-ERROR-MSG GO TO ML-TERMAPI. PC-COMMAND-RECV. IF CMD-NORESPONSE (WS-CSUB1) GO TO PC-GOOD. DEBUG * EXEC CICS DELAY INTERVAL(03) END-EXEC. PERFORM RECV-RESPONSE. IF EZA-RETCODE IS LESS THAN +0 MOVE '655 CONNECTION DISCONNECTED' TO RI-ERROR-MSG GO TO ML-TERMAPI. MOVE EZA-RETCODE TO EZA-NBYTE. PERFORM EZA-ASCII-TO-EBCDIC. MOVE WS-RC TO RI-RC (WS-RISUB1). IF NOT (CMD-TSQ-IN (WS-CSUB1) OR CMD-TSQ-OUT (WS-CSUB1)) GO TO PC-TEST-RC. IF WS-RC IS NOT EQUAL TO '125' AND WS-RC IS NOT EQUAL TO '150' GO TO PC-BAD-RC. PC-DATA. MOVE WS-S-DATA TO EZA-S. IF CMD-TSQ-IN (WS-CSUB1) PERFORM SEND-DATA. IF CMD-TSQ-OUT (WS-CSUB1) PERFORM RECV-DATA. PERFORM CLOSE-PASSIVE-PORT. MOVE WS-S-CONTROL TO EZA-S. PC-DATA-RECV. PERFORM RECV-RESPONSE. IF EZA-RETCODE IS LESS THAN +0 MOVE '656 CONNECTION DISCONNECTED' TO RI-ERROR-MSG GO TO ML-TERMAPI. MOVE EZA-RETCODE TO EZA-NBYTE. PERFORM EZA-ASCII-TO-EBCDIC. MOVE WS-RC TO RI-RC (WS-RISUB1). PC-TEST-RC. MOVE +0 TO WS-SUB1. PC-TEST-RC-LOOP. ADD +1 TO WS-SUB1. IF WS-SUB1 IS GREATER THAN WS-CRMAX GO TO PC-BAD-RC. IF CMD-GOOD-RC (WS-CSUB1 WS-SUB1) IS EQUAL TO SPACES GO TO PC-BAD-RC. IF WS-RC IS EQUAL TO CMD-GOOD-RC (WS-CSUB1 WS-SUB1) GO TO PC-GOOD. GO TO PC-TEST-RC-LOOP. PC-GOOD. IF RI-NOT-PROCESSED (WS-RISUB1) SET RI-GOOD (WS-RISUB1) TO TRUE. GO TO PC-EXIT. PC-UNKNOWN. PC-BAD-RC. SET RI-BAD-RESPONSE (WS-RISUB1) TO TRUE. PC-EXIT. EXIT. CLEAR-BUFFER-OUT SECTION. CBO-START. MOVE LOW-VALUES TO BUFFER-OUT. MOVE +0 TO EZA-NBYTE. CBO-EXIT. EXIT. RECV-RESPONSE SECTION. * RETURNS RESPONSE NUMBER IN WS-RC RR-START. IF WS-RACUR IS GREATER THAN +0 COMPUTE WS-RACURSAVE = WS-RACUR + 1 GO TO RR-LOOP. MOVE LOW-VALUES TO RA-TABLE. MOVE +1 TO WS-RATOP. MOVE +0 TO WS-RETOP. MOVE +0 TO WS-RACUR. MOVE +1 TO WS-RACURSAVE. PERFORM GET-CONTROL. RR-LOOP. ADD +1 TO WS-RACUR. IF WS-RACUR IS NOT LESS THAN WS-RATOP PERFORM GET-CONTROL. PERFORM STORE-RESPONSE. IF RE-RC (WS-RACUR) IS NOT EQUAL TO RE-RC (WS-RACURSAVE) GO TO RR-LOOP. IF RE-CONTINUE (WS-RACUR) IS NOT EQUAL TO '-' GO TO RR-LAST. GO TO RR-LOOP. RR-LAST. MOVE RE-LINE (WS-RACURSAVE) TO WS-RC-MESSAGE. IF WS-RISUB1 IS GREATER THAN +0 MOVE WS-RC-MESSAGE TO RI-MESSAGE (WS-RISUB1). COMPUTE WS-RACUR = WS-RACUR + 1. IF WS-RACUR IS NOT LESS THAN WS-RATOP MOVE +0 TO WS-RACUR. SUBTRACT +1 FROM WS-RACUR. RR-EXIT. EXIT. GET-CONTROL SECTION. GT-START. PERFORM EZA-RECV. IF EZA-RETCODE IS LESS THAN +0 MOVE '657 CONNECTION DISCONNECTED' TO RI-ERROR-MSG GO TO ML-TERMAPI. MOVE EZA-RETCODE TO EZA-NBYTE. PERFORM EZA-ASCII-TO-EBCDIC. PERFORM DEBLOCK-RESPONSE. IF WS-RETOP IS NOT EQUAL TO +0 GO TO GT-START. IF WS-RATOP IS NOT GREATER THAN WS-RACUR GO TO GT-START. GT-EXIT. EXIT. DEBLOCK-RESPONSE SECTION. DR-START. MOVE +0 TO WS-SUB2. DR-NEXT. ADD +1 TO WS-SUB2. IF WS-SUB2 IS GREATER THAN EZA-NBYTE GO TO DR-FINAL. IF BUFFER-IN (WS-SUB2:2) IS NOT EQUAL TO FTP-CRLF GO TO DR-LF. MOVE WS-RETOP TO RE-LINE-LENGTH (WS-RATOP). ADD +1 TO WS-RATOP. MOVE +0 TO WS-RETOP. ADD +1 TO WS-SUB2. GO TO DR-NEXT. DR-LF. IF BUFFER-IN (WS-SUB2:1) IS NOT EQUAL TO WS-LF GO TO DR-MOVE. MOVE WS-RETOP TO RE-LINE-LENGTH (WS-RATOP). ADD +1 TO WS-RATOP. MOVE +0 TO WS-RETOP. GO TO DR-NEXT. DR-MOVE. ADD +1 TO WS-RETOP. IF WS-RETOP IS GREATER THAN WS-REMAX SET RI-RESPONSE-TRUNCATED (WS-RISUB1) TO TRUE GO TO DR-MOVE. MOVE BUFFER-IN (WS-SUB2:1) TO RE-POS (WS-RATOP WS-RETOP). GO TO DR-NEXT. DR-FINAL. IF WS-RETOP IS GREATER THAN +0 MOVE WS-RETOP TO RE-LINE-LENGTH (WS-RATOP) ADD +1 TO WS-RATOP MOVE +0 TO WS-RETOP. * IF RE-LINE-LENGTH (WS-RATOP) IS EQUAL TO +0 * SUBTRACT +1 FROM WS-RATOP. DR-EXIT. EXIT. STORE-RESPONSE SECTION. SR-START. IF WS-RISUB1 IS EQUAL TO +0 OR WS-NO-TSQ GO TO SR-NOTSQ. IF CMD-TSQ-IN (WS-CSUB1) OR CMD-TSQ-OUT (WS-CSUB1) GO TO SR-NOTSQ. IF RI-TSQ(WS-RISUB1) IS NOT GREATER THAN SPACES GO TO SR-NOTSQ. EXEC CICS WRITEQ TS QUEUE(RI-TSQ(WS-RISUB1)) FROM(RE-LINE(WS-RACUR)) LENGTH(RE-LINE-LENGTH(WS-RACUR)) END-EXEC. IF EIBRESP IS EQUAL TO DFHRESP(NORMAL) ADD +1 TO RI-TSQ-COUNT (WS-RISUB1). SR-NOTSQ. IF WS-NO-CONSOLE GO TO SR-EXIT. IF NOT RI-DEBUG-CONSOLE GO TO SR-EXIT. SR-CONSOLE. MOVE 'R>' TO WS-MESSAGE-TAG. MOVE LENGTH OF WS-MESSAGE-TAG TO WS-SUB0. IF RE-LINE-LENGTH (WS-RACUR) IS GREATER THAN LENGTH OF WS-MESSAGE ADD LENGTH OF WS-MESSAGE TO WS-SUB0 ELSE ADD RE-LINE-LENGTH (WS-RACUR) TO WS-SUB0. IF WS-SUB0 IS LESS THAN +1 MOVE +1 TO WS-SUB0. MOVE RE-LINE (WS-RACUR) TO WS-MESSAGE. EXEC CICS WRITE OPERATOR TEXT(WS-MESSAGE-TAG) TEXTLENGTH(WS-SUB0) END-EXEC. SR-EXIT. EXIT. RECV-DATA SECTION. RD-START. MOVE +0 TO RI-TSQ-COUNT (WS-RISUB1). IF CMD-EOL-ASCII (WS-CSUB1) OR RI-TSQ-RECSIZE (WS-RISUB1) IS EQUAL TO ZERO GO TO RD-VARIABLE. RD-FIXED. MOVE +1 TO WS-WASUB1. MOVE RI-TSQ-RECSIZE (WS-RISUB1) TO WS-SUB12. RD-FIXED-RECV. PERFORM EZA-RECV. IF EZA-RETCODE IS LESS THAN +0 AND EZA-ERRNO IS EQUAL TO 1121 GO TO RD-EOD. IF EZA-RETCODE IS LESS THAN +0 MOVE '658 CONNECTION DISCONNECTED' TO RI-ERROR-MSG GO TO ML-TERMAPI. MOVE EZA-RETCODE TO EZA-NBYTE. IF EZA-NBYTE IS EQUAL TO +0 GO TO RD-EOD. IF RI-TSQ-EBCDIC (WS-RISUB1) PERFORM EZA-ASCII-TO-EBCDIC. PERFORM UNBLOCK-DATA. GO TO RD-FIXED-RECV. RD-VARIABLE. MOVE +1 TO WS-WASUB1. RD-VARIABLE-RECV. PERFORM EZA-RECV. IF EZA-RETCODE IS LESS THAN +0 AND EZA-ERRNO IS EQUAL TO 1121 GO TO RD-EOD. IF EZA-RETCODE IS LESS THAN +0 MOVE '659 CONNECTION DISCONNECTED' TO RI-ERROR-MSG GO TO ML-TERMAPI. MOVE EZA-RETCODE TO EZA-NBYTE. IF EZA-NBYTE IS EQUAL TO +0 GO TO RD-EOD. PERFORM EZA-ASCII-TO-EBCDIC. PERFORM DEBLOCK-DATA. GO TO RD-VARIABLE-RECV. RD-EOD. IF WS-WASUB1 IS GREATER THAN +1 SET RI-INCOMPLETE-TRANSFER (WS-RISUB1) TO TRUE. IF WS-WASUB1 IS EQUAL TO +2 AND (NOT RI-TSQ-EBCDIC (WS-RISUB1)) AND WA-BYTE (1) IS EQUAL TO X'1A' SET RI-EOF-FOUND-AND-DROPPED (WS-RISUB1) TO TRUE. IF WS-WASUB1 IS EQUAL TO +2 AND RI-TSQ-EBCDIC (WS-RISUB1) AND WA-BYTE (1) IS EQUAL TO X'3F' SET RI-EOF-FOUND-AND-DROPPED (WS-RISUB1) TO TRUE. RD-EXIT. EXIT. DEBLOCK-DATA SECTION. DD-START. * WS-SUB10-12 ARE POINTERS INTO THE BUFFER AREA. * WS-SUB10 IS THE START OF THE CURRENT 'RECORD'. * WS-SUB11 IS THE BYTE TO WORK WITH. * WS-SUB12 IS UNUSED BY THIS ROUTINE. * WS-WASUB1 IS THE NEXT BYTE OF WORK-AREA TO MOVE INTO. MOVE +1 TO WS-SUB10. MOVE +0 TO WS-SUB11. DD-FIND-EOL. ADD +1 TO WS-SUB11. IF WS-SUB11 IS GREATER THAN EZA-NBYTE GO TO DD-EOB. DD-CRLF. IF BUFFER-IN (WS-SUB11:2) IS NOT EQUAL TO FTP-CRLF GO TO DD-LF. COMPUTE WS-SUB1 = WS-SUB11 - WS-SUB10. MOVE BUFFER-IN (WS-SUB10:WS-SUB1) TO WORK-AREA (WS-WASUB1:WS-SUB1). ADD WS-SUB1 TO WS-WASUB1. ADD +1 TO WS-SUB11. GO TO DD-WRITE. DD-LF. IF BUFFER-IN (WS-SUB11:1) IS NOT EQUAL TO WS-LF GO TO DD-FIND-EOL. COMPUTE WS-SUB1 = WS-SUB11 - WS-SUB10. MOVE BUFFER-IN (WS-SUB10:WS-SUB1) TO WORK-AREA (WS-WASUB1:WS-SUB1). ADD WS-SUB1 TO WS-WASUB1. DD-WRITE. SUBTRACT +1 FROM WS-WASUB1. IF WS-WASUB1 IS LESS THAN +1 MOVE +1 TO WS-WASUB1 MOVE SPACES TO WORK-AREA (1:1). EXEC CICS WRITEQ TS QUEUE(RI-TSQ(WS-RISUB1)) FROM(WORK-AREA) LENGTH(WS-WASUB1X(3:2)) END-EXEC. IF EIBRESP IS EQUAL TO DFHRESP(NORMAL) ADD +1 TO RI-TSQ-COUNT (WS-RISUB1). MOVE +1 TO WS-WASUB1. COMPUTE WS-SUB10 = WS-SUB11 + 1. GO TO DD-FIND-EOL. DD-EOB. COMPUTE WS-SUB1 = WS-SUB11 - WS-SUB10. MOVE BUFFER-IN (WS-SUB10:WS-SUB1) TO WORK-AREA (WS-WASUB1:WS-SUB1). ADD WS-SUB1 TO WS-WASUB1. DD-EXIT. EXIT. UNBLOCK-DATA SECTION. UD-START. * WS-SUB10-12 ARE POINTERS INTO THE BUFFER AREA. * WS-SUB10 IS NOT USED BY THIS ROUTINE. * WS-SUB11 IS THE BYTE TO WORK WITH. * WS-SUB12 IS THE SIZE OF EACH RECORD. * WS-WASUB1 IS THE NEXT BYTE OF WORK-AREA TO MOVE INTO. MOVE +1 TO WS-SUB11. UD-BUILD-BLOCK. COMPUTE WS-SUB1 = WS-SUB12 - WS-WASUB1 + 1 COMPUTE WS-SUB0 = EZA-NBYTE - WS-SUB11 + 1. IF WS-SUB0 IS LESS THAN WS-SUB1 MOVE WS-SUB0 TO WS-SUB1. MOVE BUFFER-IN (WS-SUB11:WS-SUB1) TO WORK-AREA (WS-WASUB1:WS-SUB1). ADD WS-SUB1 TO WS-SUB11. ADD WS-SUB1 TO WS-WASUB1. IF WS-WASUB1 IS NOT GREATER THAN WS-SUB12 GO TO UD-EXIT. UD-WRITE. SUBTRACT +1 FROM WS-WASUB1. EXEC CICS WRITEQ TS QUEUE(RI-TSQ(WS-RISUB1)) FROM(WORK-AREA) LENGTH(WS-WASUB1X(3:2)) END-EXEC. IF EIBRESP IS EQUAL TO DFHRESP(NORMAL) ADD +1 TO RI-TSQ-COUNT (WS-RISUB1). MOVE +1 TO WS-WASUB1. GO TO UD-BUILD-BLOCK. UD-EXIT. EXIT. SEND-DATA SECTION. * WS-SUB10-12 ARE POINTERS INTO THE BUFFER AREA. * WS-SUB10 IS NOT USED BY THIS ROUTINE. * WS-SUB11 IS NOT USED BY THIS ROUTINE. * WS-SUB12 IS THE SIZE OF EACH RECORD. * WS-WASUB1 IS THE LAST BYTE OF WORK-AREA USED. * EZA-NBYTE IS THE NEXT BYTE OF BUFFER-OUT TO MOVE INTO. SD-START. MOVE +0 TO EZA-NBYTE. MOVE RI-TSQ-RECSIZE (WS-RISUB1) TO WS-SUB12. MOVE ALL 'X' TO WORK-AREA. MOVE WORK-AREA-LENGTH TO WS-WASUB1. EXEC CICS READQ TS QUEUE(RI-TSQ(WS-RISUB1)) INTO(WORK-AREA) ITEM(1) LENGTH(WS-WASUB1X(3:2)) NOHANDLE END-EXEC. GO TO SD-READQ-RESP. SD-READQ. MOVE WORK-AREA-LENGTH TO WS-WASUB1. TRACE * MOVE '1 ' TO WS-WORK9LIT. TRACE * MOVE WS-WASUB1 TO WS-WORK9. TRACE * EXEC CICS WRITE OPERATOR TRACE * TEXT(WS-WORK9LIT) TRACE * TEXTLENGTH(12) TRACE * END-EXEC. EXEC CICS READQ TS QUEUE(RI-TSQ(WS-RISUB1)) INTO(WORK-AREA) LENGTH(WS-WASUB1X(3:2)) NOHANDLE END-EXEC. SD-READQ-RESP. IF EIBRESP IS EQUAL TO DFHRESP(QIDERR) AND RI-TSQ-COUNT (WS-RISUB1) IS EQUAL TO +0 GO TO SD-EOF. IF EIBRESP IS EQUAL TO DFHRESP(QIDERR) SET RI-INVALID-QUEUE (WS-RISUB1) TO TRUE GO TO SD-EXIT. IF EIBRESP IS EQUAL TO DFHRESP(ITEMERR) GO TO SD-EOF. IF RI-TSQ-BINARY (WS-RISUB1) GO TO SD-BINARY. IF CMD-EOL-ASCII (WS-CSUB1) OR RI-TSQ-RECSIZE (WS-RISUB1) IS EQUAL TO ZERO GO TO SD-VARIABLE. SD-FIXED. COMPUTE WS-SUB1 = WS-SUB12 + WS-WASUB1 IF WS-SUB1 IS GREATER THAN +0 COMPUTE WS-SUB0 = WS-WASUB1 + 1 MOVE SPACES TO WORK-AREA(WS-SUB0:WS-SUB1) MOVE WS-SUB12 TO WS-WASUB1. * MUST FALL INTO SD-VARIABLE. SD-VARIABLE. COMPUTE WS-SUB0 = WS-WASUB1 + 1. IF RI-TSQ-ASCII (WS-RISUB1) MOVE FTP-CRLF-ASCII TO WORK-AREA(WS-SUB0:2) ELSE MOVE FTP-CRLF TO WORK-AREA(WS-SUB0:2). ADD +2 TO WS-WASUB1. GO TO SD-BLOCK. SD-BINARY. * NOTHING TO DO FOR BINARY. SD-BLOCK. COMPUTE WS-SUB1 = EZA-NBYTE + WS-WASUB1. IF WS-SUB1 IS GREATER THAN BUFFER-OUT-LENGTH PERFORM SEND-BLOCK. COMPUTE WS-SUB0 = EZA-NBYTE + 1. MOVE WORK-AREA(1:WS-WASUB1) TO BUFFER-OUT (WS-SUB0:WS-WASUB1). ADD WS-WASUB1 TO EZA-NBYTE. GO TO SD-READQ. SD-EOF. PERFORM SEND-BLOCK. SD-EXIT. EXIT. SEND-BLOCK SECTION. SB-START. IF EZA-NBYTE IS NOT GREATER THAN +0 GO TO SB-EXIT. IF RI-TSQ-ASCII (WS-RISUB1) OR RI-TSQ-BINARY (WS-RISUB1) GO TO SB-SEND. PERFORM EZA-EBCDIC-TO-ASCII. SB-SEND. PERFORM EZA-SEND. IF EZA-RETCODE IS LESS THAN +0 SET RI-INCOMPLETE-TRANSFER (WS-RISUB1) TO TRUE. MOVE +0 TO EZA-NBYTE. SB-EXIT. EXIT. ADD-CRLF SECTION. AC-START. PERFORM TRUNCATE-BUFFER. COMPUTE WS-SUB0 = EZA-NBYTE + 1. MOVE FTP-CRLF TO BUFFER-OUT (WS-SUB0:LENGTH OF FTP-CRLF). ADD LENGTH OF FTP-CRLF TO EZA-NBYTE. AC-EXIT. EXIT. TRUNCATE-BUFFER SECTION. TB-START. IF EZA-NBYTE IS LESS THAN +1 GO TO TB-EXIT. IF BUFFER-OUT (EZA-NBYTE:1) IS EQUAL TO SPACE GO TO TB-REMOVE. IF BUFFER-OUT (EZA-NBYTE:1) IS EQUAL TO LOW-VALUES GO TO TB-REMOVE. GO TO TB-EXIT. TB-REMOVE. SUBTRACT 1 FROM EZA-NBYTE. GO TO TB-START. TB-EXIT. EXIT. GET-PASSIVE-PORT SECTION. GPP-START. SET WS-NO-TSQ TO TRUE. MOVE -1 TO WS-S-DATA. PERFORM CLEAR-BUFFER-OUT. COMPUTE WS-SUB0 = EZA-NBYTE + 1. MOVE FTP-PASV TO BUFFER-OUT (WS-SUB0:LENGTH OF FTP-PASV). ADD LENGTH OF FTP-PASV TO EZA-NBYTE. PERFORM ADD-CRLF. PERFORM EZA-EBCDIC-TO-ASCII. PERFORM EZA-SEND. IF EZA-RETCODE IS LESS THAN +0 MOVE '660 CONNECTION DISCONNECTED' TO RI-ERROR-MSG GO TO ML-TERMAPI. GPP-RECV. PERFORM RECV-RESPONSE. IF EZA-RETCODE IS LESS THAN +0 MOVE '661 CONNECTION DISCONNECTED' TO RI-ERROR-MSG GO TO ML-TERMAPI. IF WS-RC IS NOT EQUAL TO '227' GO TO GPP-INVALID-RC. UNSTRING WS-RC-MESSAGE DELIMITED BY '(' INTO WS-JUNK WS-PASV-WORK-1. UNSTRING WS-PASV-WORK-1 DELIMITED BY ')' INTO WS-PASV-WORK-2. UNSTRING WS-PASV-WORK-2 DELIMITED BY ',' OR SPACE INTO WS-PASV-1 WS-PASV-2 WS-PASV-3 WS-PASV-4 WS-PASV-5 WS-PASV-6. COMPUTE WS-WORK9 = WS-PASV-1 * 256 + WS-PASV-2. MOVE WS-WORK9 TO WS-IPADDRESSB1. COMPUTE WS-WORK9 = WS-PASV-3 * 256 + WS-PASV-4. MOVE WS-WORK9 TO WS-IPADDRESSB2. COMPUTE WS-WORK9 = WS-PASV-5 * 256 + WS-PASV-6. MOVE WS-WORK9 TO WS-IPPORT. GPP-SOCKET. PERFORM EZA-SOCKET. IF EZA-RETCODE IS LESS THAN +0 MOVE '611 AQUIRE SOCKET FAILED' TO RI-ERROR-MSG GO TO ML-TERMAPI. MOVE EZA-RETCODE TO EZA-S. MOVE EZA-S TO WS-S-DATA. GPP-CONNECT. MOVE LOW-VALUES TO EZA-NAME. MOVE +2 TO EZA-NAME-FAMILY. MOVE WS-IPPORTX (3:2) TO EZA-NAME-PORTX. MOVE WS-IPADDRESSX TO EZA-NAME-IPADDRESS. PERFORM EZA-CONNECT. IF EZA-RETCODE IS LESS THAN +0 MOVE '621 UNABLE TO CONTACT HOST' TO RI-ERROR-MSG GO TO ML-TERMAPI. GPP-INVALID-RC. GPP-RESET. SET WS-LOG-ALL TO TRUE. MOVE WS-S-CONTROL TO EZA-S. GPP-EXIT. EXIT. CLOSE-PASSIVE-PORT SECTION. CPP-START. IF WS-S-DATA IS EQUAL TO -1 GO TO CPP-RESET-S. MOVE WS-S-DATA TO EZA-S. MOVE -1 TO WS-S-DATA. PERFORM EZA-CLOSE. IF EZA-RETCODE IS LESS THAN +0 MOVE '662 CONNECTION DISCONNECTED' TO RI-ERROR-MSG GO TO ML-TERMAPI. CPP-RESET-S. MOVE WS-S-CONTROL TO EZA-S. CPP-EXIT. EXIT. * COPY IN ALL THE EZA SECTIONS COPY BSTTEZAP. COPY BSTTEZAH. CONSOLE-TRACE SECTION. CT-START. IF RI-DEBUG-CONSOLE GO TO CT-CONSOLE. GO TO CT-EXIT. CT-CONSOLE. 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-ABEND. MOVE EIBTRNID TO CURRENT-TRAN. MOVE EIBTASKN TO CURRENT-TASK. 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. EXEC CICS ABEND ABCODE(ABEND-CODE) END-EXEC. AR-EXIT. EXIT. /+ /* // ASSGN SYS005,SYSRDR // EXEC IESINSRT $ $$ JOB JNM=BSTTEZ20,CLASS=Y,DISP=D,LDEST=(,TTHIGPEN) $ $$ LST CLASS=O,DISP=D #/ JOB BSTTEZ20 // LIBDEF *,CATALOG=BSILIB.WORK // LIBDEF *,SEARCH=(BSILIB.TTDEV,BSILIB.EZA, X PRD2.SCEECICS,PRD2.SCEEBASE) // OPTION LIST,CATAL,ERRS,NODECK,SYM,NOLISTX,NODUMP // OPTION CATAL,NODECK,ALIGN,NOXREF ACTION MAP PHASE BSTTEZ20,* INCLUDE DFHELII // EXEC IGYCRCTL,SIZE=512K PARM='EXIT(PRTEXIT(EQALIST))' CBL MAP,XREF(SHORT),OFFSET,TEST(ALL,SYM),APOST,LIB CBL TRUNC(BIN),NOZWB CBL DATA(31),RMODE(ANY) * $$ END /. PREP // UPSI X1 < DONT GENERATE A RES CICS OPTION // EXEC DFHECP1$,SIZE=512K,PARM=',SP,NOP,NOSOURCE,COBOL3' * $$ SLI MEM=BSTTEZ20.C,S=BSILIB.TTDEV /* // ASSGN SYS005,SYSRDR // EXEC IESINSRT /* // IF $RC < 8 THEN // GOTO LINKEDT * CP MSG TTHIGPEN COMPILE OF BSTTEZ12 HAD A NON-ZERO RETURN CODE /. LINKEDT // LIBDEF *,SEARCH=(BSILIB.TTDEV,BSILIB.EZA, X PRD2.SCEECICS,PRD2.SCEEBASE) // EXEC LNKEDT,SIZE=512K /* #& $ $$ EOJ * $$ END /& * $$ EOJ