** 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
      *   HttpOnly:yes
      *=====================================================================
      /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 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:
      *  <form name=cookie2 method=post action="/cgidev2p/cookie2.pgm">
      *  <script language=javascript>
      *  document.write("<input type=hidden name=xdocloc value='"+document.location+"'>")
      *  </script>
      *      ....
      *  </form>
      *  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;