000100 ID DIVISION. 00010000 000200 PROGRAM-ID. TRPGM81. 00020000 000300*AUTHOR. Kenneth W. Caldwell. 00030000 000400*INSTALLATION. Train-Right. 00040000 000500*DATE-WRITTEN. January 8, 2008. 00050000 000600*DATE-COMPILED. 00060000 000700* 00070000 000800*SECURITY. This program is for students of Train-Right 00080000 000900* courses ONLY!. 00090000 001000* 00100000 001100*REMARKS. This is a TCP/IP Web based program. 00110000 001200* It receives the http request via the commarea. 00120000 001300* It sends an http response via the commarea 00130000 001400* (An http response header is required). 00140000 001500* CICS will convert the EBCDIC to ASCII. 00150000 001600* The client is a Web Browser. 00160000 001700* 00170000 001800 DATA DIVISION. 00180000 001900 WORKING-STORAGE SECTION. 00190000 002000 01. 00200000 002100 05 crlfcrlf PIC X(4) VALUE X'0D250D25'. 00210000 002200 05 crlf REDEFINES crlfcrlf PIC X(2). 00220000 002300 00230000 002400 05 http-request-length PIC S9(8) BINARY. 00240000 002500 05 temp-length PIC ++++,+++,++9. 00250000 002600 00260000 002700 05 http-cl-header PIC X(14) VALUE 'Content-Length'. 00270000 002800 05 http-cl-header-value PIC X(5). 00280000 002900 05 http-cl-header-length PIC S9(8) BINARY. 00290000 003000 05 http-body-length PIC S9(8) BINARY. 00300000 003100 00310000 003200 01 html-out. 00320000 003300 05 html-length PIC S9(8) BINARY. 00330000 003400 05 html-text PIC X(32767). 00340000 003500 00350000 003600 LINKAGE SECTION. 00360000 003700 01 dfhcommarea. 00370000 003800 05 http-request PIC X OCCURS 0 TO 32767 TIMES 00380000 003900 DEPENDING ON eibcalen. 00390000 004000 00400000 004100 PROCEDURE DIVISION. 00410000 004200 Main. 00420000 004300* No http request means not a Web client. 00430000 004400 IF eibcalen = ZERO 00440000 004500 THEN MOVE 'Client is not an HTTP Web Browser.' TO html-text 00450000 004600 EXEC CICS SEND FROM(html-text) LENGTH(34) ERASE END-EXEC00460000 004700 EXEC CICS RETURN END-EXEC 00470000 004800 END-IF. 00480000 004900 00490000 005000 Receive-Trans-Input. 00500000 005100* Http request ends with a blank line (crlfcrlf). 00510000 005200 MOVE ZERO TO http-request-length. 00520000 005300 INSPECT dfhcommarea 00530000 005400 TALLYING http-request-length 00540000 005500 FOR CHARACTERS BEFORE crlfcrlf. 00550000 005600 00560000 005700 ADD +4 TO http-request-length. 00570000 005800 00580000 005900* Determine if an HTTP message body exists. 00590000 006000 MOVE ZERO TO http-cl-header-length, 00600000 006100 http-cl-header-value. 00610000 006200 MOVE LENGTH OF http-cl-header-value 00620000 006300 TO http-cl-header-length. 00630000 006400 EXEC CICS IGNORE CONDITION LENGERR NOTFND END-EXEC. 00640000 006500 EXEC CICS WEB READ HTTPHEADER(http-cl-header) 00650000 006600 NAMELENGTH(LENGTH OF http-cl-header) 00660000 006700 VALUE(http-cl-header-value) 00670000 006800 VALUELENGTH(http-cl-header-length) 00680000 006900 END-EXEC. 00690000 007000 00700000 007100 MOVE http-cl-header-value(1:http-cl-header-length) 00710000 007200 TO http-body-length 00720000 007300 00730000 007400 ADD http-body-length TO http-request-length. 00740000 007500 MOVE http-request-length TO temp-length. 00750000 007600 00760000 007700 Process-Data. 00770000 007800* Build http response and html output. 00780000 007900 MOVE +1 TO html-length. 00790000 008000 STRING 'HTTP/1.0 200 OK' crlf 00800000 008100 'Content-Type: text/html' crlfcrlf 00810000 008200 '' 00820000 008300 'Train-Right Advanced CICS Programming Concepts' 00830000 008400 '' 00840000 008500 '' 00850000 008600 '' 00860000 008700 '

Train-Right CICS WEB COBOL - TRPGM81

' 00870000 008800 '

The http request from DFHCOMMAREA is:

' 00880000 008900 dfhcommarea(1:http-request-length) 00890000 009000 '

The http request is ' 00900000 009100 temp-length 00910000 009200 ' bytes long.' 00920000 009300 ' ' 00930000 009400 DELIMITED BY SIZE 00940000 009500 INTO html-text 00950000 009600 WITH POINTER html-length 00960000 009700 END-STRING. 00970000 009800 00980000 009900* String statement points to next byte. 00990000 010000 SUBTRACT +1 FROM html-length. 01000000 010100* Html output length includes the length field. 01010000 010200 ADD +4 TO html-length. 01020000 010300 01030000 010400 Send-Result. 01040000 010500 MOVE html-out(1:html-length) TO dfhcommarea. 01050000 010600 01060000 010700 Process-Exit. 01070000 010800 EXEC CICS RETURN END-EXEC. 01080000 010900* Dummy GOBACK. 01090000 011000 GOBACK. 01100000