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:

BVSTools Now Offers Interface with Infor's ION APIs BVSTools Now Offers Interface with Infor's ION APIs
Posted by May 15, 2020
BVSTools >> BVSTools Announcements
More V7R4 IFS File CCSID Issues and The Fix More V7R4 IFS File CCSID Issues and The Fix
Posted by March 4, 2020
IBM Power Systems >> (QGPL) IBM i
Error Retrieving IP Address by Name Error Retrieving IP Address by Name
Posted by February 25, 2020
BVSTools >> BVSTools Software Discussion
Logging jobs that hit an outq Logging jobs that hit an outq
Posted by February 13, 2020
Programming >> CL Programming
GreenTools for Google Apps (G4G) v12.60 Released with Shared Drive Features and More... GreenTools for Google Apps (G4G) v12.60 Released with Shared Drive Features and More...
Posted by February 4, 2020
BVSTools >> BVSTools Announcements >> GreenTools for G Suite (Google Apps) (G4G) Specific Announcements
Allowing Requests over Port 80 For SSL Validation (ie, Namecheap, etc) Allowing Requests over Port 80 For SSL Validation (ie, Namecheap, etc)
Posted by January 31, 2020
Programming >> Web Programming
GreenTools for Slack (G4SLK) v3.00 Released GreenTools for Slack (G4SLK) v3.00 Released
Posted by January 17, 2020
BVSTools >> BVSTools Announcements >> GreenTools for Slack (G4SLK) Specific Announcements
Calling a QSH Command from RPG Calling a QSH Command from RPG
Posted by December 26, 2019
Programming >> RPG Programming
SPLTOOL Print Range (PRTRNG) Function Updated to Handle Spooled Files up to 999,999,999 Pages SPLTOOL Print Range (PRTRNG) Function Updated to Handle Spooled Files up to 999,999,999 Pages
Posted by December 14, 2019
BVSTools >> BVSTools Announcements >> Spooled File Tools (SPLTOOL) Specific Announcements
GreenTools for Microsoft Apps (G4MS) Updated to v6.00 - Now Uses Microsoft Graph APIs GreenTools for Microsoft Apps (G4MS) Updated to v6.00 - Now Uses Microsoft Graph APIs
Posted by November 24, 2019
BVSTools >> BVSTools Announcements >> GreenTools for Microsoft Apps (G4MS) Specific Announcements
V7R4 Changes CCSID of Compressed File Using PASE JAR Command - Here's The Fix V7R4 Changes CCSID of Compressed File Using PASE JAR Command - Here's The Fix
Posted by November 21, 2019
IBM Power Systems >> (QGPL) IBM i
Using GETURI to Make OAuth 2.0 Requests - Custom Headers for Access Tokens Using GETURI to Make OAuth 2.0 Requests - Custom Headers for Access Tokens
Posted by November 11, 2019
BVSTools >> BVSTools Software Discussion >> Get URI (GETURI) Specific Discussion
GreenTools for Microsoft Apps (G4MS) v5.00 Released with Updated OneDrive Support and 3rd Party Functionality GreenTools for Microsoft Apps (G4MS) v5.00 Released with Updated OneDrive Support and 3rd Party Functionality
Posted by October 20, 2019
BVSTools >> BVSTools Announcements >> GreenTools for Microsoft Apps (G4MS) Specific Announcements
BVSTools is Now Running V7R4M0 BVSTools is Now Running V7R4M0
Posted by September 28, 2019
BVSTools >> BVSTools Announcements
GreenTools for G Suite (G4G) Now Includes Send Mail Functionality (G4GSMAIL Addon) GreenTools for G Suite (G4G) Now Includes Send Mail Functionality (G4GSMAIL Addon)
Posted by August 27, 2019
BVSTools >> BVSTools Announcements >> GreenTools for G Suite (Google Apps) (G4G) Specific Announcements

Reply




Copyright 1983-2020 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).