Before we get to the program...
If you haven't already, the first step is to set up your own HTTP server. I followed the instructions in Scott's "Providing RPG Web Services on IBM i" presentation, in the section titled "Do It Yourself" beginning on page 20. Once you have your HTTP server set up you can do the following to use a program like my Proof of Concept included below.
---
Once you have your HTTP server set up you will need to add the following to the bottom of the server configuration file.
Code: Select all
#RESTful web services
SetEnv QIBM_CGI_LIBRARY_LIST "RESTFUL;YAJL"
ScriptAliasMatch /rest/([a-z0-9]*) /qsys.lib/restful.lib/$1.pgm
<Directory /qsys.lib/restful.lib>
Require all granted
</Directory>
#End RESTful web services1. Replace "RESTFUL;YAJL" with the library list your webservice program(s) will require.
2. Replace "rest" in ScriptAliasMatch with whatever you want to use in the URIs for your server.
3. Replace "restful.lib" in "/qsys.lib/restful.lib/$1.pgm" with the library name that will contain the programs you want to be accessible by this server.
4. Replace "restful.lib" in "<Directory /qsys.lib/restful.lib>" with the same library name.
URI NOTES:
Your URIs will look something like this - http://network.yoursite.com:10010/rest/poc0001
1. Replace "network.yoursite.com" with the public facing base URI of your network.
2. Replace "10010" with the port number you assigned to your HTTP server when you set it up.
3. Replace "rest" with whatever you defined in the ScriptAliasMatch in your HTTP server config file.
4. Replace "poc0001" with your program name (in the library you defined in the ScriptAliasMatch).
PROGRAM NOTES:
When your HTTP server setup is complete, you can copy my Proof of Concept code into a member in the library you defined in the configuration file above. Compile it and you should be off to the races!
CODE:
Code: Select all
**free
//**************************************************************************************************
// Program : POC0001 (fully functional proof of concept)
// Program Type: SQLRPGLE
// Description : Read standard input from HTTP server and write to an IFS document
//**************************************************************************************************
// set program control options
ctl-opt option (*srcstmt: *nodebugio)
debug (*yes)
dftactgrp (*no)
actgrp (*new)
bnddir ('CGIDEV2/TEMPLATE2');
//**************************************************************************************************
// Program Declarations
//**************************************************************************************************
// Declare prototype and variables for external procedure QtmhRdStin (read standard input)
dcl-pr qtmhrdstin extproc('QtmhRdStin');
stdIn char(16000000); // If you need more than 16M you will have to convert to pointers
stdInLen int(10);
stdAvlLen int(10);
stdInError char(32767);
end-pr;
dcl-s stdIn char(16000000);
dcl-s stdInLen int(10);
dcl-s stdAvlLen int(10);
dcl-s stdInError char(32767) inz('');
// Declare prototype and variables for external procedure QtmhWrStout (write standard output)
dcl-pr qtmhwrstout extproc('QtmhWrStout');
stdOut char(16000000);
stdOutLen int(10);
stdOutError char(8000);
end-pr;
dcl-s stdOut char(16000000);
dcl-s stdOutLen int(10);
dcl-s stdOutError char(8000);
// Declare program variables
dcl-s outReply varchar(8000);
dcl-s outData sqltype(xml_clob:16000000) ccsid(1208);
dcl-s outFile sqltype(xml_clob_file) ccsid(1208);
dcl-s w_index int(10);
dcl-s w_fileName varchar(5000);
dcl-s w_xmlPath varchar(5000) inz('/tmp/pocdocs/pocstdin.txt'); // insert you path here
// Declare program constants
dcl-c c_lineFeed x'15';
dcl-c c_break '<br>';
// Declare content rows for server response message
// This data structure can be loaded with XML, JSON, etc.
// Just be sure to set the content-type appropriately
dcl-ds *N;
*N char(80) inz('Content-type: text/html');
*N char(80) inz('');
*N char(80) inz('<html>');
*N char(80) inz('<h1>');
*N char(80) inz('Proof of Concept Program POC0001');
*N char(80) inz('</h1>');
*N char(80) inz('<h2>Program Completed Successfully</h2>');
*N char(80) inz('<p>The document you submitted was successfully received.</p>');
*N char(80) inz('</html>');
w_response char(80) dim(9) pos(1);
end-ds;
// Include copybooks
// NOTE: This copybook requires Scott Klement's LIBHTTP in your library list to compile.
/include ifsio_h
//**************************************************************************************************
// Main Procedure
//**************************************************************************************************
// Initialize program variables
clear stdIn;
clear stdInLen;
clear stdAvlLen;
clear stdInError;
clear stdOut;
clear stdOutLen;
clear stdOutError;
clear outData;
clear outFile;
// Ensure no document exists at planned IFS path
#deleteifsfile (w_xmlPath);
// Get the content length of the standard input data
exec sql set :stdInLen = systools.getenv('CONTENT_LENGTH');
// Read server standard input into program variables
qtmhrdstin (stdIn : stdInLen : stdAvlLen : stdInError);
// Load output variable with standard input data
monitor;
outData_data = %trim(stdIn);
on-error;
endmon;
// Set output variable length
monitor;
outData_len = %len(%trim(stdIn));
on-error;
endmon;
// Set up output file to be written to IFS
outFile_name = %trimr(w_xmlPath);
outFile_nl = %len(%trimr(outFile_name));
outFile_fo = sqfcrt;
// Write output variable to IFS output file
monitor;
exec sql set :outFile = :outData;
on-error;
endmon;
// Construct server response message
for w_index = 1 by 1 to 9;
outReply += (%trim(w_response(w_index)) + c_lineFeed);
endfor;
// Write server response message
stdOut = %trim(outReply);
stdOutLen = %len(%trim(stdOut));
qtmhwrstout (stdOut : stdOutLen : stdOutError);
// Goodbye!
*inlr = *on;
return;
//**************************************************************************************************
// Procedures
//**************************************************************************************************
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
// #deleteifsfile - Delete file at IFS path provided (NOTE: No error is returned if file not found)
//~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
dcl-proc #deleteifsfile;
dcl-pi *n;
w_ifsFilePath varchar(5000);
end-pi;
dcl-s pathLength int(10);
dcl-s namePosition int(10);
pathLength = %len(%trimr(w_ifsFilePath));
namePosition = pathLength;
dow namePosition > 0;
if %subst(w_ifsFilePath : namePosition : 1) = '/';
leave;
endif;
namePosition -= 1;
enddo;
if namePosition < pathLength
and %subst(w_ifsFilePath : namePosition : 1) = '/';
w_fileName = %subst(w_ifsFilePath: namePosition + 1);
else;
eval w_fileName = w_ifsFilePath;
endif;
unlink(%trimr(w_ifsFilePath));
end-proc;