bvstone

Creating a Reverse SSL Proxy Using RPG on the IBM i - Part 2

Posted:

Creating a Reverse SSL Proxy Using RPG on the IBM i - Part 2

In the original article for this topic, we created a simple SSL Proxy using SSL, RPG and our GETURI and eRPGSDK software.  This was because of the dropping of support for older SSL Ciphers on V7R1 and older OS versions.  

Before we go further, if you are on a OS version older than V7R2 and don't have an OS upgrade planned, take some time to do that now.

Recently I was contacted by a customer who needed to set this type of service up on his network, having an old pre V7R2 system and a newer V7R2 system that could act as the proxy.  The issue was the data they were passing back and forth from the their trading partner was quite large.

The original example was only passing back and forth very small amounts of data, maybe a few bytes.  This customer need to send many megabytes of data between the systems.  So that meant it was time to update our proxy program for them.

What we did was use the HTTP APIs directly using pointers.  This meant that the max size of our data was limited to how we set up the environment, and our OS version.  It also eliminated the need for the eRPG SDK software.

We also allowed the passing in of the "real" URI that was meant to be used as an HTTP header.  This made things a LOT easier as all you needed to do in your original program was:

  • Save the URI you were using to a string
  • Change the URI to your proxy endpoint
  • Pass the saved URI (the real URI) in an HTTP header named "REALURI"

This way the proxy program can read the HTTP header value and use it directly in the call, along with any data passed in.

We still were saving data to stream files for input and output, but this is because GETURI isn't yet updated to accept pointers for data.  In fact, I am not sure if every will be as stream files are "safer" for most programmer (even me sometimes!) than pointers.  It also doesn't yet yes anything larger than 65k variables (older OS limit).  But that may change soon as we don't really support anything under V7R1 any more.

The updated program looks like the following (yes, D Specs!)

     H DFTACTGRP(*NO) BNDDIR('QC2LE') BNDDIR('BVSTOOLS') ACTGRP('BVS')
     H ALLOC(*TERASPACE)
      ****************************************************************
      * /Copy Includes                                               *
      ****************************************************************
       /COPY QCOPYSRC,GETURICOPY
       /COPY QCOPYSRC,P.HTTP
       /COPY QCOPYSRC,P.IFS
       /COPY QCOPYSRC,P.LIBL
       /COPY QCOPYSRC,P.ERRNO
      ****************************************************************
      * Prototypes                                                   *
      ****************************************************************
     D #QCmdExc        PR                  ExtPgm('QCMDEXC')
     D  Cmd                       32000    Const
     D  CmdLen                       15  5 Const
      *
     D GetUriRG        pr                  extpgm('GETURIRG')
     D   G_In                              like(GetUri_In)
     D   G_Out                             like(GetUri_Out)
     D   G_Head                            like(GetUri_Head)
     D   G_Data                            like(GetUri_Data)
     D   G_MsgCd                           like(GetUri_MsgCd)
     D   G_Msg                             like(GetUri_Msg)
      ****************************************************************
      * Proxy ID Data Area
      ****************************************************************
     D proxyID         S             13S 0 dtaara('PROXYID')
      ****************************************************************
      * Work Variables
      ****************************************************************
     D CRLF            C                   x'0D25'
      *
      * 32mb max size for %alloc bif
     D MAXSIZE         S             10i 0 INZ(33554432)
      *
      * Error DS
     D WPError         DS
     D  EBytesP                      10i 0 INZ(%size(WPError))
     D  EBytesA                      10i 0
     D  EMsgID                        7
     D  EReserverd                    1
     D  EData                        40
      *
      * Content Length of Post
     D inContLen       S             10i 0
      *
      * GetEnv Stuff
     D EnvRec          S           1024
     D EnvName         S             64
     D EnvNameLen      S             10i 0
     D EnvRspLen       S             10i 0
      *
      * Other
     D dataIn@         S               *
     D dataOut@        S               *
     D fd              S             10i 0
     D rc              S             10i 0
     D rspLen          S             10i 0
     D status          S              3p 0 Inz(200)
     D reqMeth         S             10
     D outPath         S            256    Inz('/www/webservice/revproxy')
     D inStmf          S            256
     D inExist         S               N   INZ(*OFF)
     D outStmf         S            256
     D realURI         S            256
     D outMsg          S           1024
     D header          S           1024
     D proxyDebug      S                    Like(gi_Debug) INZ('*NO')
     D QCmdCmd         S          32000
      ****************************************************************
       exsr $Process;
       exsr $GetURI;
       exsr $Output;
       exsr $Return;
       //-------------------------------------------------------------/
       // Process the Data                                            /
       //-------------------------------------------------------------/
       begsr $Process;

         #pushLib('GETURI');
         outMsg = ' ';

         // get the real URI to send the request to.  This should be sent as a custom HTTP
         //  header as "REALURI"
         EnvName = 'HTTP_REALURI';
         GetEnv(EnvRec:%size(EnvRec):
                EnvRspLen:
                EnvName:%len(%trimr(EnvName)):
                WPError);

         if (EnvRspLen > 0);
           realURI = %subst(EnvRec:1:EnvRspLen);
         else;
           status = 500;
           outMsg = 'REALURI header is missing.' + %trim(realURI);
           exsr $Return;
         endif;

         // get the request method
         EnvName = 'REQUEST_METHOD';
         GetEnv(EnvRec:%size(EnvRec):
                EnvRspLen:
                EnvName:%len(%trimr(EnvName)):
                WPError);

         if (EnvRspLen > 0);
           reqMeth = %subst(EnvRec:1:EnvRspLen);
         endif;

         if (reqMeth <> 'GET') and (reqMeth <> 'POST');
           status = 500;
           outMsg = 'Request Method ' + %trimr(reqMeth) + ' is invalid.';
           exsr $Return;
         endif;

         EnvName = 'CONTENT_LENGTH';
         GetEnv(EnvRec:%size(EnvRec):
                EnvRspLen:
                EnvName:%len(%trimr(EnvName)):
                WPError);

         monitor;
           inContLen = %int(%subst(EnvRec:1:EnvRspLen));
         on-error;
           status = 500;
           outMsg = 'Invalid content-lenth.  ' +
                    'Content length = ' + %char(inContLen) + '.';
           exsr $Return;
         endmon;

         if (inContLen < 0);
           status = 500;
           outMsg = 'Invalid content-lenth.  ' +
                    'Content length = ' + %char(inContLen) + '.';
           exsr $Return;
         endif;

         if (inContLen > MAXSIZE);
           status = 500;
           outMsg = 'Data size of ' + %char(inContLen) +
                    ' is greater than max size.';
           exsr $Return;
         endif;

         exsr $GetNewID;

         if (inContLen > 0);
           dataIn@ = %alloc(inContLen);

           if (dataIn@ = *null);
             status = 500;
             outMsg = 'Error allocating input data!';
             exsr $Return;
           endif;

           RdStin(dataIn@:inContLen:rspLen:WPError);

           if (rspLen <> inContLen);
             status = 500;
             outMsg = 'Data size mismatch.  ' +
                      'Content Length: ' + %char(inContLen) +
                      ' - Response Length: ' + %char(rspLen);
             exsr $Return;
           endif;

           exsr $WriteToStmf;
         endif;

       endsr;
       //-------------------------------------------------------------/
       // Get New ID for Unique File Names                            /
       //-------------------------------------------------------------/
       begsr $GetNewID;

         in(e) *lock proxyID;

         if (%error);
           status = 500;
           outMsg = 'Error generating ID!';
           exsr $Return;
         endif;

         if (proxyID = *HIVAL);
           proxyID = 1;
         else;
           proxyID += 1;
         endif;

         out(e) proxyID;

         if (%error);
           status = 500;
           outMsg = 'Error updating ID!';
           exsr $Return;
         endif;

       endsr;
       //-------------------------------------------------------------/
       // Write POST data to Stream File                              /
       //-------------------------------------------------------------/
       begsr $WriteToStmf;

         // inStmf will contain the data from the request
         inStmf = %trimr(outPath) + '/' + %char(proxyID) + '_in.dta';

         fd = openStmf(%trimr(inStmf):
                      O_WRONLY + O_CREATE + O_CCSID + O_INHERIT + O_TEXTDATA +
                      O_TEXT_CREAT:
                      0:1252:0);

         if (fd < 0);
           en_errNo@ = GetErrNo;
           en_errMsg@ = StrError(en_errNo);
           en_errMsg = %xlate(X'00':X'40':en_errMsg);
           status = 500;
           outMsg = 'Error opening file ' + %trimr(inStmf) +
                    '. rc(' + %char(fd) +
                    ') errno(' + %char(en_errNo) +
                    ') ' + %trim(en_errMsg);
           exsr $Return;
         endif;

         inExist = *ON;
         rc = writeStmf(fd:dataIn@:inContLen);
         closeStmf(fd);

         if (rc < inContLen);
           status = 500;
           outMsg = 'Data written to stream file ' + %trim(inStmf) +
                    ' <> data received.  ' +
                    %char(rc) + ' <> ' + %char(inContLen);
           exsr $Return;
         endif;

       endsr;
       //-------------------------------------------------------------/
       // Call GETURI                                                 /
       //-------------------------------------------------------------/
       begsr $GetURI;

         // outStmf will be used to store the results of the GETURI command
         outStmf = %trimr(outPath) + '/' + %char(proxyID) + '_out.dta';

         Clear GetUri_In;
         gi_URI = %trim(realURI);
         gi_ReqMeth = reqMeth;

         if (inExist);
           gi_Data = '*STMF';
           gi_DStmf = inStmf;
         endif;

         gi_Port = 443;
         gi_SSL = '*YES';
         gi_Timeout = 1800;
         gi_CodPag = 1252;
         gi_OutType = '*STMF';
         gi_Stmf = outStmf;
         gi_SprHead = '*YES';
         gi_Debug = proxyDebug;
         gi_DebugFile = %trimr(outPath) + '/' + %char(proxyID) + '_debug.txt';
         gi_CCSID = 1252;

         monitor;
           GetUriRG(GetUri_In:GetUri_Out:GetUri_Head:GetUri_Data:
                    GetUri_MsgCd:GetUri_Msg);
         on-error;
           status = 500;
           outMsg = 'Error calling GETURI.  See debug files ' +
                    %trimr(gi_DebugFile) + ' and ' +
                    %trimr(gi_DebugFile) + '.log.';
           exsr $Return;
         endmon;

       endsr;
       //-------------------------------------------------------------/
       // Write Output                                                /
       //-------------------------------------------------------------/
       begsr $Output;

         dataOut@ = %alloc(MAXSIZE);

         if (dataOut@ = *null);
           status = 500;
           outMsg = 'Error allocating output data!';
           exsr $Return;
         endif;

         fd = openStmf(%trimr(outStmf):
                       O_RDONLY + O_CCSID + O_TEXTDATA:
                       0:0);

         if (fd < 0);
           en_errNo@ = GetErrNo;
           en_errMsg@ = StrError(en_errNo);
           en_errMsg = %xlate(X'00':X'40':en_errMsg);
           status = 500;
           outMsg = 'Error opening file ' + %trimr(outStmf) +
                    '. rc(' + %char(fd) +
                    ') errno(' + %char(en_errNo) +
                    ') ' + %trim(en_errMsg);
           exsr $Return;
         endif;

         rc = readStmf(fd:dataOut@:MAXSIZE);
         closeStmf(fd);

         if (rc < 0);
           en_errNo@ = GetErrNo;
           en_errMsg@ = StrError(en_errNo);
           en_errMsg = %xlate(X'00':X'40':en_errMsg);
           status = 500;
           outMsg = 'Error reading file ' + %trimr(outStmf) +
                    '. rc(' + %char(fd) +
                    ') errno(' + %char(en_errNo) +
                    ') ' + %trim(en_errMsg);
           exsr $Return;
         endif;

         if (rc = 0);
           status = 500;
           outMsg = 'No response in file ' + %trimr(outStmf) +
                    '.';
           exsr $Return;
         endif;

         header = 'Status: ' + %char(status) +
                  CRLF +
                  'Content-type: text/html' +
                  CRLF +
                  'Pragma: no-cache' +
                  CRLF +
                  'Expires: Saturday, February 15, 1997 10:10:10 GMT' +
                  CRLF +
                  CRLF;
         WrStout(%addr(header):%len(%trimr(header)):WPError);
         WrStout(dataOut@:rc:WPError);

       endsr;
       //-------------------------------------------------------------/
       // Return                                                      /
       //-------------------------------------------------------------/
       begsr $Return;

         if (dataIn@ <> *NULL);
           dealloc dataIn@;
         endif;

         if (dataOut@ <> *NULL);
           dealloc dataOut@;
         endif;

         if (proxyDebug <> '*YES') and (inExist);
           QCmdCmd = 'RMVLNK OBJLNK(''' + %trimr(inStmf) + ''')';
           callp(e) #QCmdExc(QCmdCmd:%len(%trimr(QCmdCmd)));
         endif;

         if (proxyDebug <> '*YES');
           QCmdCmd = 'RMVLNK OBJLNK(''' + %trimr(outStmf) + ''')';
           callp(e) #QCmdExc(QCmdCmd:%len(%trimr(QCmdCmd)));
           QCmdCmd = 'RMVLNK OBJLNK(''' + %trimr(outStmf) + '.hdr'')';
           callp(e) #QCmdExc(QCmdCmd:%len(%trimr(QCmdCmd)));
         endif;

         if (outMsg <> ' ');
           header = 'Status: ' + %char(status) +
                    CRLF +
                    'Content-type: text/html' +
                    CRLF +
                    'Pragma: no-cache' +
                    CRLF +
                    'Expires: Saturday, February 15, 1997 10:10:10 GMT' +
                    CRLF +
                    CRLF;
           WrStout(%addr(header):%len(%trimr(header)):WPError);
           WrStout(%addr(outMsg):%len(%trimr(outMsg)):WPError);
         endif;

         #popLib('GETURI');
         *INLR = *on;
         return;

       endsr;

The process is quite simple.  It may look like a lot of code but in this case I decided to throw in a lot of error checking (yes, error checking in an example program! Imagine that!):

  • Get the "Real URI" from the HTTP header (GETURI initiates this program, and with GETURI it's easy to add custom headers).
  • Retrieve the request method and make sure it's GET or POST.
  • Retrieve the content length of the data passed in (for a POST).
  • Make sure the data isn't larger than the allowable size (32mb in this case).
  • Read in the data and make sure that we read in the same amount and specified in the content length.
  • Retrieve a Unique ID (for logging purposes)
  • Write the received data to a stream file
  • Call GETURI to the "Real URI"
  • Return the results to the original caller by writing them to Standard Output

Remember that this proxy request is initiated by something like GETURI, HTTPAPI, cURL, etc... a GETURI example would look like this:

GETURI URI('yourserver/reverseproxy')
DATA(*STMF)
DSTMF('/path/to/my/data')
USRHDR((REALURI 'www.myservice.com/apis/postTransaction'))  
REQMETH(*POST)

This command fires off the reverse proxy program, which uses GETURI to make the "real" request on a different server, and return the results back to the original server.

Now, contact whoever you need to and make sure you're scheduled yesterday to update to an OS version newer then V7R1.  It's already too late.  :)                




Latest Posts:

Non HTTPS Callbacks Removed from GreenTools for G Suite (G4G) Non HTTPS Callbacks Removed from GreenTools for G Suite (G4G)
Posted by April 15, 2018
BVSTools >> BVSTools Announcements >> GreenTools for G Suite (Google Apps) (G4G) Specific Announcements
IBM i Related Survey Available IBM i Related Survey Available
Posted by April 7, 2018
IBM Power Systems >> (QGPL) IBM i
BVSTools Releases Braintree Webhook Open Source Application - Node.js BVSTools Releases Braintree Webhook Open Source Application - Node.js
Posted by April 5, 2018
Programming >> Open Source
BVSTools Now Offering Web Services (BETA) BVSTools Now Offering Web Services (BETA)
Posted by April 3, 2018
BVSTools >> BVSTools Announcements
Creating a Reverse SSL Proxy Using RPG on the IBM i - Part 2 Creating a Reverse SSL Proxy Using RPG on the IBM i - Part 2
Posted by March 29, 2018
Programming >> Web Programming
Still on V7R1 or Earlier?  Here's Why You Should Upgrade NOW! Still on V7R1 or Earlier? Here's Why You Should Upgrade NOW!
Posted by February 21, 2018
IBM Power Systems >> (QGPL) IBM i
Converting a MMDDYY date format to YYMMDD for Sorting Using SQL Converting a MMDDYY date format to YYMMDD for Sorting Using SQL
Posted by February 16, 2018
Programming >> RPG Programming
Moving All Files from a Google Drive Folder to the Trash Using GreenTools for Google Apps (G4G) Moving All Files from a Google Drive Folder to the Trash Using GreenTools for Google Apps (G4G)
Posted by February 3, 2018
BVSTools >> BVSTools Software Discussion >> GreenTools for G Suite (Google Apps) (G4G) Specific Discussion
Removing Unwanted Characters from a String with RPG Removing Unwanted Characters from a String with RPG
Posted by February 2, 2018
Programming >> RPG Programming
GETURI Version 8.10 Released GETURI Version 8.10 Released
Posted by January 23, 2018
BVSTools >> BVSTools Announcements >> Get URI (GETURI) Specific Announcements
BVSTools is Now a Sponsor of ALLAS400S.com BVSTools is Now a Sponsor of ALLAS400S.com
Posted by January 17, 2018
BVSTools >> BVSTools Announcements
Service Pack SP171219 Released for G4PP v3.10 Service Pack SP171219 Released for G4PP v3.10
Posted by December 20, 2017
BVSTools >> BVSTools Announcements >> GreenTools for PayPal (G4PP) Specific Announcements
GETURI Now Requires Minimum OS of V7R1 or Higher GETURI Now Requires Minimum OS of V7R1 or Higher
Posted by December 12, 2017
BVSTools >> BVSTools Software Discussion >> Get URI (GETURI) Specific Discussion
Need Help Updating Your Software Versions?  We Can Help. Need Help Updating Your Software Versions? We Can Help.
Posted by December 8, 2017
BVSTools >> BVSTools Announcements
Parsing the Response from GreenTools for PayPal (G4PP) Refund Transaction Parsing the Response from GreenTools for PayPal (G4PP) Refund Transaction
Posted by November 27, 2017
BVSTools >> BVSTools Software Discussion >> GreenTools for PayPal (G4PP) Specific Discussion

Reply




Copyright 1983-2018 BVSTools
GreenBoard(v3) Powered by the eRPG SDK, MAILTOOL Plus!, GreenTools for Google Apps, jQuery, jQuery UI, BlockUI, CKEditor and running on the IBM i (AKA AS/400, iSeries, System i).