*******************************************
*
* MODULE NAME OBJSERV.COB
*
* DESCRIPTIVE NAME CICS for MVS/ESA CWI Graphics Server Sample Program
*
* Statement: Licensed Materials - Property of IBM
*
* CA84 SupportPac
* (c) Copyright IBM Corp. 1997
*
* All rights reserved.
*
* U.S. Government Users Restricted Rights - use,
* duplication or disclosure restricted by GSA
* ADP Schedule Contract with IBM Corp.
*
* Status: Version 1 Release 0 Modification 1
* Last Modified 10 October 1997
* Modified template manager comm-area creation step
* to set address of returned data
* Author: Steve Wall
*
* NOTES :-
* DEPENDENCIES CICS for MVS/ESA V4.1
* Internet Connection Server for MVS/ESA
*
* This program is a cobol CWI converter program which implements
* one method of delivering graphics through the CWI.
* It will serve graphics from a URL
* of the form http://your.cics.system/objserv/graphic.gif .
*
*******************************************
*******************************************
*
* PROGRAM NAME: OBJSERV
*
* TITLE: Cobol Sample CWI Graphics Server Converter Program.
*
* PROGRAM DESCRIPTION:
*
* This program will show an example of how to code a converter
* to send binary objects up to 32K in length over the web.
*
* SYSTEM LEVEL: CICS 4.1 or higher.
*
* INPUT:
*
* The target file is passed in the URL.
*
* OUTPUT:
*
* The target file is returned to the browser. If an error occurs
* then a 404 is returned.
*
*****************************************
PROCESS XOPTS(NOLINKAGE)
IDENTIFICATION DIVISION.
PROGRAM-ID. OBJSERV.
ENVIRONMENT DIVISION.
DATA DIVISION.
WORKING-STORAGE SECTION.
COPY DFHWBUCO.
******
* Data items.
******
* Simple data types used for interaction with CICS.
******
77 conv-pointer POINTER.
77 init-val PIC X VALUE LOW-VALUES.
77 resp PIC S9(4).
77 resp2 PIC S9(4).
******
* Specific stuff for the decode function.
******
77 file-name PIC X(8).
77 counter PIC S9(4) COMP.
77 url-character-ptr POINTER.
******
* Http header stuff.
******
01 mime-type.
05 filler PIC X(6) VALUE IS 'image/'.
05 extension PIC X(4) VALUE IS '****'.
01 header.
05 filler PIC X(23) VALUE IS
'HTTP/1.0 200 Image file'.
05 filler PIC X(2) VALUE IS x'0D25'.
05 filler PIC X(16) VALUE IS 'Content-Length: '.
05 clen PIC 9(5).
05 filler PIC X(2) VALUE IS x'0D25'.
05 filler PIC X(14) VALUE IS 'Content-Type: '.
05 type-of-data PIC X(10) VALUE IS '**********'.
05 filler PIC X(2) VALUE IS x'0D25'.
05 filler PIC X(2) VALUE IS x'0D25'.
01 failure-header.
05 filler PIC X(13) VALUE IS 'HTTP/1.0 404 '.
05 filler PIC X(14) VALUE IS 'File not found'.
05 filler PIC X(2) VALUE IS x'0D25'.
05 filler PIC X(2) VALUE IS x'0D25'.
******
* Data constants.
******
01 lower PIC X(26) VALUE 'abcdefghijklmnopqrstuvwxyz'.
01 filler REDEFINES lower.
05 lowerc PIC X OCCURS 26 INDEXED BY lowerc-idx.
01 upper PIC X(26) VALUE 'ABCDEFGHIJKLMNOPQRSTUVWXYZ'.
01 filler REDEFINES upper.
05 upperc PIC X OCCURS 26.
COPY DFHWBTLO.
******
* Now for the overlay structures.
******
LINKAGE SECTION.
COPY DFHEIBLC.
COPY DFHWBCDO.
01 returned-data.
05 http-len PIC 9(8) COMP.
05 header1 PIC X(76).
05 the-binary-data PIC X(32683).
77 the-url PIC X(1000).
77 url-character PIC X.
PROCEDURE DIVISION USING DFHEIBLK DFHCOMMAREA.
******
* First part: set up the pointers and structures, perform
* sanity checks and the call the decode/encode functions.
******
* Just return if no commarea because there's nowhere to work.
******
IF EIBCALEN = 0
EXEC CICS RETURN END-EXEC
END-IF
******
* Set up addressability to the commarea.
******
EXEC CICS
ADDRESS COMMAREA(conv-pointer)
END-EXEC.
SET ADDRESS OF CONVERTER-PARMS TO conv-pointer.
******
* Validate the commarea eyecatcher.
******
IF (CONVERTER-EYECATCHER NOT = DECODE-EYECATCHER-INIT)
AND (CONVERTER-EYECATCHER NOT = ENCODE-EYECATCHER-INIT)
MOVE URP-INVALID TO CONVERTER-RESPONSE
MOVE URP-CORRUPT-CLIENT-DATA TO CONVERTER-REASON
EXEC CICS
RETURN
END-EXEC
END-IF
IF CONVERTER-RESPONSE NOT = 0
EXEC CICS
RETURN
END-EXEC
END-IF
IF CONVERTER-REASON NOT = 0
EXEC CICS
RETURN
END-EXEC
END-IF
EVALUATE CONVERTER-FUNCTION
******
* If decode is set then do all the interesting stuff.
******
WHEN URP-DECODE
PERFORM DECODE
******
* If encode is set then return. (Encode is a null function)
******
WHEN URP-ENCODE
MOVE URP-OK TO CONVERTER-RESPONSE
******
* otherwise there is a problem
******
WHEN OTHER
MOVE URP-DISASTER TO CONVERTER-RESPONSE
MOVE URP-CORRUPT-CLIENT-DATA TO CONVERTER-REASON
EXEC CICS
RETURN
END-EXEC
END-EVALUATE
******
* Now we return.
******
EXEC CICS
RETURN
END-EXEC.
A999-EXIT.
EXIT.
********************
BB-DECODE SECTION.
********************
DECODE.
***************
******
* First we need to find the file name.
******
* Set up pointers to the url.
******
MOVE DECODE-RESOURCE-LENGTH TO counter
SET ADDRESS OF the-url TO DECODE-RESOURCE-PTR
SET ADDRESS OF url-character TO
ADDRESS OF the-url(counter : 1)
******
* Find the last '/' in the url.
******
PERFORM WITH TEST BEFORE UNTIL url-character = '/'
COMPUTE counter = counter - 1
SET ADDRESS OF url-character TO
ADDRESS OF the-url(counter : 1)
END-PERFORM
COMPUTE counter = counter + 1
SET ADDRESS OF the-url TO ADDRESS OF the-url(counter : 1)
******
* Save the filename and extension + convert to upper case.
******
UNSTRING the-url
DELIMITED BY ';' OR '?' OR '.' OR ' '
INTO file-name extension
PERFORM WITH TEST AFTER VARYING counter FROM 1 BY +1
UNTIL counter = 26
INSPECT file-name REPLACING ALL
lowerc(counter) BY upperc(counter)
INSPECT extension REPLACING ALL
lowerc(counter) BY upperc(counter)
END-PERFORM
******
* Create the mime type and embed it in the http header
* assume a default of 'gif' if the extension isn't recognised.
******
EVALUATE extension(1:3)
WHEN 'JPE'
MOVE 'jpeg' TO extension
WHEN 'JPG'
MOVE 'jpeg' TO extension
WHEN OTHER
MOVE 'gif' TO extension
END-EVALUATE
MOVE mime-type TO type-of-data
******
* Having found the filename we need to recover the file.
******
* Create the template manager comm-area.
******
SET ADDRESS OF returned-data TO DECODE-DATA-PTR
MOVE LOW-VALUES TO DFHWBTL-ARG
******
* Set up and run the template manager. We are using it simply
* to copy the binary image data to the data buffer, no
* symbol replacements are required.
******
MOVE 0 TO WBTL-VERSION-NO
MOVE WBTL-BUILD-HTML-PAGE TO WBTL-FUNCTION
MOVE file-name TO WBTL-TEMPLATE-NAME
SET WBTL-HTML-BUFFER-PTR TO ADDRESS OF the-binary-data
MOVE LENGTH OF the-binary-data TO WBTL-HTML-BUFFER-LEN
EXEC CICS
LINK PROGRAM('DFHWBTL')
COMMAREA(DFHWBTL-ARG)
LENGTH(56)
RESP(resp) RESP2(resp2)
END-EXEC
******
* If theres an error then handle it.
******
IF resp NOT = WBTL-OK
PERFORM CREATE-ERROR-RESPONSE
END-IF
******
* Now the binary data is in place we set up the length
* fields and add the header.
******
* Calculate the length of the http response. An extra 2
* bytes are deducted to nullify the CRLF character pair
* that the template manager automatically adds to the end
* of the data.
******
COMPUTE http-len = (LENGTH OF returned-data -
WBTL-HTML-BUFFER-LEN) - 2
COMPUTE clen = (LENGTH OF the-binary-data -
WBTL-HTML-BUFFER-LEN) - 2
******
* And finaly add the header that we've been building up.
******
MOVE header TO header1.
BB999-EXIT.
EXIT.
******************
C-ERROR SECTION.
******************
CREATE-ERROR-RESPONSE.
************************
******
* If any error is detected return a 404 to the browser.
******
COMPUTE http-len = LENGTH OF failure-header + 4
MOVE failure-header TO header1
EXEC CICS
RETURN
END-EXEC.
******
* And that's it.
******
CC999-EXIT.
EXIT.
¤ Dauer der Verarbeitung: 0.5 Sekunden
(vorverarbeitet)
¤
|
Haftungshinweis
Die Informationen auf dieser Webseite wurden
nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit,
noch Qualität der bereit gestellten Informationen zugesichert.
Bemerkung:
Die farbliche Syntaxdarstellung ist noch experimentell.
|