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:

MAILTOOL Now Allows Email Redirection for Development and Testing MAILTOOL Now Allows Email Redirection for Development and Testing
Posted by May 27, 2023
BVSTools >> BVSTools Announcements >> eMail Tool (MAILTOOL) Specific Announcements
GreenTools for Microsoft Apps (G4MS) Now Supports Footers When Sending Email GreenTools for Microsoft Apps (G4MS) Now Supports Footers When Sending Email
Posted by March 29, 2023
BVSTools >> BVSTools Announcements >> GreenTools for Microsoft Apps (G4MS) Specific Announcements
QuickBooks Online - Subtotals and Discounts Frustration QuickBooks Online - Subtotals and Discounts Frustration
Posted by March 16, 2023
QuickBooks >> QuickBooks Online
Making the Switch From QuickBooks Desktop to QuickBooks Online - No Picnic Making the Switch From QuickBooks Desktop to QuickBooks Online - No Picnic
Posted by March 16, 2023
QuickBooks >> QuickBooks Online
BVSTools Software Verified on V7R5 and Power10 BVSTools Software Verified on V7R5 and Power10
Posted by December 9, 2022
BVSTools >> BVSTools Announcements
Microsoft Office 365 Servers and Random Errors Issue Microsoft Office 365 Servers and Random Errors Issue
Posted by November 14, 2022
BVSTools >> BVSTools Software Discussion >> Email Tools (MAILTOOL) Specific Discussion
Sending/Resending Emails Using a MIME File with MAILTOOL Sending/Resending Emails Using a MIME File with MAILTOOL
Posted by November 8, 2022
BVSTools >> BVSTools Software Discussion >> Email Tools (MAILTOOL) Specific Discussion
Sending an HTML Email on Your IBM i Using MAILTOOL Sending an HTML Email on Your IBM i Using MAILTOOL
Posted by November 1, 2022
BVSTools >> BVSTools Software Discussion >> Email Tools (MAILTOOL) Specific Discussion
Transferring License Keys from One System to Another Transferring License Keys from One System to Another
Posted by October 31, 2022
BVSTools >> BVSTools Software Discussion
Calculating the Size of a File Before Base64 Encoding Calculating the Size of a File Before Base64 Encoding
Posted by August 13, 2022
Programming >> RPG Programming
GreenTools for Microsoft Apps (G4MS) v9.12 Now Includes Function to Send Emails using MIME File GreenTools for Microsoft Apps (G4MS) v9.12 Now Includes Function to Send Emails using MIME File
Posted by August 11, 2022
BVSTools >> BVSTools Announcements >> GreenTools for Microsoft Apps (G4MS) Specific Announcements
GreenTools for Google Apps (G4G) v15.20 Now Supports Shortcuts GreenTools for Google Apps (G4G) v15.20 Now Supports Shortcuts
Posted by August 6, 2022
BVSTools >> BVSTools Announcements >> GreenTools for G Suite (Google Apps) (G4G) Specific Announcements
GreenTools for Microsoft Apps (G4MS) Groups Admin Authority Instructions GreenTools for Microsoft Apps (G4MS) Groups Admin Authority Instructions
Posted by July 26, 2022
BVSTools >> BVSTools Software Discussion >> GreenTools for Microsoft Apps (G4MS) Specific Discussion
GreenTools for Microsoft Apps (G4MS) v9.10 Now Includes OneDrive Functions that Work With Groups/Shared Drives GreenTools for Microsoft Apps (G4MS) v9.10 Now Includes OneDrive Functions that Work With Groups/Shared Drives
Posted by July 19, 2022
BVSTools >> BVSTools Announcements >> GreenTools for Microsoft Apps (G4MS) Specific Announcements
GreenTools for Google Apps (G4G) v15.10 Now Includes Drive Functions that Work With Shared Drives GreenTools for Google Apps (G4G) v15.10 Now Includes Drive Functions that Work With Shared Drives
Posted by July 15, 2022
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).