In the past we've connected to those services using a pseudo-synchronous approach. CICS put a message on a request queue which an ESB watched. The ESB picked up the request, made the HTTP call, and then shipped the response back on a reply queue.
The approach worked well enough, but we often ran into resource constraints getting the translation code created, and that extra translation step just seemed unnecessary, especially in a service oriented architecture. Thankfully, CICS has some newer (relative...) features which simplify this process. The following code shows a working example calling a REST service to retrieve an agency's email address.
001000 WORKING-STORAGE SECTION. 001200*** COPY WEBCONV0 001300 01 WEB-CONVERSE-PARAMS. 001400 03 WC-SESSTOKEN PIC X(8). 001500 03 WC-PATH PIC X(200). 001600 03 WC-PATH-LGTH PIC S9(8) COMP. 001800 03 WC-RESP PIC S9(8) COMP. 001900 03 WC-RESP2 PIC S9(8) COMP. 002000 03 WC-RESP-DISP PIC 9(8). 002100 03 WC-RESP2-DISP PIC 9(8). 002200 03 WC-USERNAME-LGTH PIC S9(8) COMP VALUE 4. 002300 03 WC-PASSWORD-LGTH PIC S9(8) COMP VALUE 7. 002400 03 WC-HTTP-RESP-CODE PIC S9(4) COMP. 002500 88 WC-HTTP-VALID-RESP VALUE 100 THRU 599. 002600 88 WC-HTTP-OK-RESP VALUE 200. 002700 88 WC-HTTP-BAD-REQ VALUE 400. 002800 88 WC-HTTP-NOT-AUTH VALUE 401. 002900 88 WC-HTTP-FORBIDDEN VALUE 403. 003000 88 WC-HTTP-NOT-FOUND VALUE 404. 003100 88 WC-HTTP-ERROR VALUE 500. 003200 03 WC-HTTP-RESP-REAS PIC X(100). 003300 03 WC-HTTP-RESP-REAS-LGTH PIC S9(8) COMP VALUE 100. 003400 03 WC-HTTP-RESP-CODE-DISP PIC 9(4). 003500 03 WC-HTTP-RESP PIC X(200). 003600 03 WC-HTTP-RESP-LGTH PIC S9(8) COMP. 003700 003800 01 WS-VARIABLES. 003900 03 WS-ERR-MSG PIC X(200). 004000 03 WS-OUT-MSG PIC X(200). 004100 03 WS-OUT-LGTH PIC S9(4) COMP. 004200 03 WS-AGENCY-URL. 004300 05 FILLER PIC X(21) VALUE '/Agency/EmailAddress/'. 004500 05 WS-AGENCY-CODE PIC X(8). 004600 05 FILLER PIC X(4) VALUE '.xml'. 004700 005500 LINKAGE SECTION. 005700 01 DFHCOMMAREA. 005800 03 DFH-AGENCY-CODE PIC X(8). 005900 006000 PROCEDURE DIVISION. 007000 PERFORM 1000-CONNECT. 007100 IF WS-ERR-MSG <= SPACE 007200 PERFORM 2000-GET-AGENCY-EMAIL 007300 END-IF. 007500 IF WS-ERR-MSG <= SPACE 007600 MOVE WC-HTTP-RESP TO WS-OUT-MSG 007700 MOVE WC-HTTP-RESP-LGTH TO WS-OUT-LGTH 007800 ELSE 007900 MOVE WS-ERR-MSG TO WS-OUT-MSG 008000 MOVE LENGTH OF WS-ERR-MSG TO WS-OUT-LGTH 008100 END-IF. 008200 008300*==> WRITE OUT MESSAGE TO SCREEN 008400 EXEC CICS SEND TEXT FROM(WS-OUT-MSG)
008500 END-EXEC.
008600 008700 EXEC CICS RETURN 008800 END-EXEC. 008900 009000 1000-CONNECT. 009100*==> OPEN HTTP CONNECTION 009200 EXEC CICS WEB OPEN 009300 SESSTOKEN(WC-SESSTOKEN) 009400 HOST ('www.agency.com') 009500 HTTP 009600 RESP (WC-RESP) 009700 RESP2 (WC-RESP2) 009800 END-EXEC. 009900 010000 IF WC-RESP NOT = DFHRESP(NORMAL) 010100 MOVE WC-RESP TO WC-RESP-DISP 010200 MOVE WC-RESP2 TO WC-RESP2-DISP 010300 STRING 'OPEN FAILED:' 010400 WC-RESP-DISP '-' WC-RESP2-DISP 010500 DELIMITED BY SIZE INTO WS-ERR-MSG END-STRING 010600 END-IF. 010800 010900 2000-GET-AGENCY-EMAIL. 011000 MOVE DFH-AGENCY-CODE TO WS-AGENCY-CODE. 011100 MOVE WS-AGENCY-URL TO WC-PATH. 011200 MOVE LENGTH OF WS-AGENCY-URL TO WC-PATH-LGTH. 011300 011400*==> CALL WEB SERVER 011500 EXEC CICS WEB CONVERSE 011600 GET 011700 SESSTOKEN (WC-SESSTOKEN) 011800 PATH (WC-PATH) 011900 PATHLENGTH (WC-PATH-LGTH) 012000 BASICAUTH 012100 USERNAME ('USER') 012200 USERNAMELEN (WC-USERNAME-LGTH) 012300 PASSWORD ('*******') 012400 PASSWORDLEN (WC-PASSWORD-LGTH) 012500 STATUSCODE (WC-HTTP-RESP-CODE) 012600 STATUSTEXT (WC-HTTP-RESP-REAS) 012700 STATUSLEN (WC-HTTP-RESP-REAS-LGTH) 012800 INTO (WC-HTTP-RESP)
012900 TOLENGTH (WC-HTTP-RESP-LGTH) 013000 CLOSE 013100 RESP (WC-RESP) 013200 RESP2 (WC-RESP2) 013300 END-EXEC. 013400 013500 IF WC-HTTP-VALID-RESP AND NOT WC-HTTP-OK-RESP 013600 MOVE WC-HTTP-RESP-CODE TO WC-HTTP-RESP-CODE-DISP 013700 STRING 'GET FAILED: ' 013800 WC-HTTP-RESP-CODE-DISP 013900 '-' 014000 WC-HTTP-RESP-REAS(1:WC-HTTP-RESP-REAS-LGTH) 014100 DELIMITED BY SIZE INTO WS-ERR-MSG END-STRING 014200 014300 ELSE IF WC-RESP NOT = DFHRESP(NORMAL) 014400 MOVE WC-RESP TO WC-RESP-DISP 014500 MOVE WC-RESP2 TO WC-RESP2-DISP 014600 STRING 'GET FAILED:' 014700 WC-RESP-DISP '-' WC-RESP2-DISP 014800 DELIMITED BY SIZE INTO WS-ERR-MSG END-STRING 014900 END-IF.
Of course, we don't want the user-id/password hard coded into the program, so my next step is looking into the XWBATUH user exit which allows those credentials to be stored in CICS configuration. Also the host name won't always be www.agency.com in the development life cycle, we'll need to connect to dev servers, so that can't be hardcoded either. Another CICS configuration, the URIMAP can externalize those URI resources. So there a few more steps to make this production ready.
The other issue with this approach is that typically REST services return JSON encoded data. That works great for a lot of platforms, most notably JavaScript, but CICS cannot digest JSON data easily. CICS can handle XML really well, so ideally we'd like the service provider to return XML.
Thankfully, many of our services are exposed use Spring MVC which makes returning either XML or JSON trivial. The RequestMapping annotation has a produces attribute which identifies which types of content can be returned. Spring will change the return type based on, among other attributes, the extension at the end of the request. So, you'll notice the WS-AGENCY-URL variable ends with .xml which causes the controller below to return XML,
@RestController class ContentTypeTester { @RequestMapping(value="/Agency/EmailAddress",
produces=["application/json", "application/xml"]) EmailData getEmailData() { return new EmailData(name: 'BBOS', address: 'bostastic@gmail.com') } class EmailData { String name String address } }
Post a Comment