*=====================================================================
*
* RPG ILE MODULE CGIDEV2/COOKIE2
*
* CRTBNDRPG CGIDEV2/COOKIE2 DFTACTGRP(*NO) ACTGRP(COOKIE2) DBGVIEW(*SOURCE)
*
* To execute this program,
* enter the following in your WEB browser command line:
* http://.../cgidev2p/cookie2.pgm
*
*=====================================================================
/copy CGIDEV2/qrpglesrc,hspecs
/copy CGIDEV2/qrpglesrc,hspecsbnd
*=====================================================================
* Includes to be used in CGIs
*=====================================================================
/copy CGIDEV2/qrpglesrc,prototypeb
/copy CGIDEV2/qrpglesrc,usec
/copy CGIDEV2/qrpglesrc,variables3
*=====================================================================
* Variables specific to this module
*=====================================================================
** Variables used to build the http header "Set-Cookie"
** through subprocedure "CrtCookie"
D SetMyCookie s 1000 varying
D CookieNam s 1000 varying
D CookieVal s 4000 varying
D RetCode s 10i 0
D Domain s 1000 varying
D Path s 1000 varying
D Secure s n
D Expires s z
D HttpOnly s n
D xdocloc s 512
** Other variables
D TimeNow s z
D r1 s 10i 0
D r2 s 10i 0
*=====================================================================
* Main line
*=====================================================================
/free
// Get broswer input
nbrVars=zhbgetinput(savedquerystring:qusec);
// Load external html, if not loaded yet
gethtml('DEMOHTML':'CGIDEV2':'COOKIE2':'');
// Create the Set-Cookie header
exsr CrtMyCook;
// Start the output html
updhtmlvar('setmycookie':SetMyCookie);
wrtsection('top');
// Retrieve cookie current value and display it
exsr RtvMyCook;
updHtmlVar('cookienam':CookieNam);
updHtmlVar('cookieval':CookieVal);
if CookieVal=' ';
wrtsection('cookieno');
else;
wrtsection('cookieyes');
endif;
// End the output html
UpdHtmlVar('timenow':%trim(%char(TimeNow)));
wrtsection('endhtml *fini');
return;
/end-free
*=====================================================================
* Create a cookie
* Name: ThreeMonths
* Value: current timestamp
* Domain: current CGI domain
* Path: /
* Secure: no
* Expires: three months from now
*=====================================================================
/free
Begsr CrtMyCook;
//Retrieve the server domain into variable "Domain"; trim off the port number
exsr RtvDomain;
//Reset the domain to blank. The WEB browser assumes the host name of the server
// generating the cookie
Domain=' ';
//Set cookie name, cookie value and cookie path
CookieNam='ThreeMonths';
CookieVal=randomString(10);
Path='/';
//Set cookie expiration date & time
TimeNow=%timestamp;
Expires=TimeNow+%months(3);
//Set cookie HttpOnly flag
//In this way the cookie can be accessed (created or read) only from the HTTP server.
//This prevents access from malicious javascripts (XSS).
HttpOnly=*on;
//In this example the "secure" flag is not used.
//It may be used to restrict the cookie access only to HTTPS (HTTP would not be able to
//access the cookie)
//Create the Set-Cookie header
SetMyCookie=CrtCookie(CookieNam:CookieVal:RetCode:Domain:
Path:*off:Expires:HttpOnly);
Endsr;
/end-free
*=====================================================================
* Retrieve the server domain
* The server domain is the one the URL of a document starts with,
* As an example, in the URL
* http://www.easy400.net/easy400p/maindown.html
* the server domain is
* www.easy400.net
*
* HOW TO SET THE DOMAIN OF THE COOKIE
* 1-APPROACH NUMBER ONE (deprecated)
* Usually, there is no easy way through which your CGI can find out
* what the server domain is.
* One way I found, is to have the document URL retrieved from some javascript
* and have it passed in an input variable of the form invoking the CGI.
* Example:
*
* In this way the document URL is passed in the input variable "xdocloc".
* NOTE, however, that if a port number is specified, the port number is returned
* with the URL and it should not be part of the domain.
* 2-APPROACH NUMBER TWO (suggested)
* The easiest way is to specify no domain for the cookie. When this is done, the
* WEB browser assumes as domain of the cookie the name of the host creating the cookie.
*
* Though this subroutine uses approach number ONE to retrieve the domain name for the
* cookie, the program sets the domain name for the cookie to blank, thus making the
* WEB browser default the cookie domain to the name of the host creating the cookie.
*
*=====================================================================
/free
Begsr RtvDomain;
Domain=' ';
xdocloc=zhbgetvar('xdocloc'); //document location ("http://domain:port/...")
//Remove the URI ("/...") and the port number (if any)
r1=%scan('http://':xdocloc);
if r1=1;
r2=%scan('/':xdocloc:8);
if r2>8;
Domain=%subst(xdocloc:8:r2-8);
r1=%scan(':':Domain);
if r1>1;
Domain=%subst(Domain:1:r1-1);
endif;
endif;
endif;
Endsr;
/end-free
*=====================================================================
* Retrieve a cookie of given name
* Returns a string containing the current value of the cookie,
* or blanks if cookie not found
*=====================================================================
/free
Begsr RtvMyCook;
CookieNam='ThreeMonths';
CookieVal=GetCookieByName(CookieNam);
Endsr;
|