/*****************************************************************************/
/*
                                 AuthToken.c

Licensed under the Apache License, Version 2.0 (the License);
you may not use this software except in compliance with the License.
You may obtain a copy of the License at

   http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an AS IS BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.

This module provides functions related to the authentication of
case-insensitive usernames via simple lists of names (and optional
case-insensitive passwords and user detail).

See AUTH.C for overall detail on the WASD authorization environment.


TOKEN AUTHORIZATION
-------------------
This is a niche authorisation environment for addressing niche requirements.

Reflect the authorisation applied in one environment to another using a
short-lived token supplied as a cookie.  Originally devised to allow controlled
access to very large datasets without the overhead of SSL in the transmission
but with the access credentials supplied in the privacy of an SSL connection. 
The cookie contains NO CREDENTIAL data at all and the agent manages an internal
database (in memory) of these so it can determine whether any supplied token is
valid and when that token has expired.  By default (and commonly) token
authorisation occurs in non-SSL space (http:) and the credential authorisation
in SSL space (https:) although it is possible to have the two differentiated by
port only.  The path and realm specified in both must be the same.

A common scenario is where the client starts off attempting to access a
resource in non-SSL space which is controlled by TOKEN authentication.  In the
first instance the code detects there is no access token present and redirects
the client (browser) to the SSL equivalent of that space, where credentials can
be supplied encrypted.  In this scenario this SSL area is controlled by WASD
SYSUAF  authentication (or SSL client certificate for example, or other) and
the username/password is prompted for.  When correctly entered this generates a
token.  The token is stored (with corresponding detail) as a record in a global
memory buffer and then returned to the browser as a set-cookie value (during
the redirect described in the next paragraph).

With the token data stored the browser is transparently redirected back to the
non-SSL space where the actual access is to be undertaken, this time the
browser presenting the cookie containing the token to the TOKEN authentication
code originally initiating the described activity.  This code examines the
token, looking it up in the global memory buffer.  If found, has originated
from the same IP address, represents the same authentication realm,  has not
expired, then it allows the non-SSL space access to proceed, and in the
original case the dataset transfer is initiated (in unencrypted clear-text). 
If the token is not found in the database or has expired, then the process is
repeated with a redirect back into SSL space.  If the realms differ a 403
forbidden response is issued (see configuration below).

The token is a significant sequence of pseudo-random characters, is
short-lived (configurable as anything from a few seconds to a few tens of
seconds, in fact any amount of time the site is comfortable with), and as a
consequence is frequently regenerated.  The token is just that, containing no
actual credential data at all.  It might be possible to sniff but as it
contains nothing of value in itself, expires relatively quickly, and has an
originating IP address check, the fairly remote risk of playback is just that.

The authentication agent does all the work, implicitly redirecting the user
from non-SSL space to SSL space for the original authentication, and then
back again with the token used for access in the non-SSL space.  With the
expiry of a token it undertakes that cycle again, redirecting back to the
SSL-space where the browser-cached credentials will be supplied automatically
allowing the fresh token to be issued, and then redirected back into non-SSL
space for access.  To emphasise - all this is transparent to the user.

As a consequence of this model the resource being controlled can ONLY be
accessed from non-SSL space using the controlled path.  To access the same
resource from SSL space a distinct path to the resource must be provided.

Has been developed and tested against Chrome 21.0, Firefox 15.0, MSIE 9.0,
Opera 12.0 (with some tweaking) and Safari 6.0.


TOKEN RULE
----------
The token comprises two mandatory and two optional elements.  The mandatory are
the TOKEN authentication type and the preceding realm string.  This realm
string must be the same as that used to authenticate against (see below).  The
optional elements are the leading (and throwaway) realm description and the
realm parameter (see below).

Using defaults ("WASDtoken" for the token name), default https: port (443)

  [EXAMPLE_REALM=TOKEN]
  /a/path/* r+w

Specify a non-default SSL (default https:) port with default token name
("WASDtoken") using a leading ':'

  [EXAMPLE_REALM=TOKEN+:7443]
  /a/path/* r+w

Specify a non-default http: scheme (non-SSL) port with token name default
("WASDtoken") using the scheme ':' to also delimit the port

  [EXAMPLE_REALM=TOKEN+http:7443]
  /a/path/* r+w

An optional and throwaway realm description

  ["throwaway description"=EXAMPLE_REALM=TOKEN]
  /a/path/* r+w

An optional and throwaway realm description, specify non-default https: port
7443 (realm parameter can optionally be delimited by quotes)

  ["throwaway description"=EXAMPLE_REALM=TOKEN+":7443"]
  /a/path/* r+w


TOKEN PARAMETER
---------------
Token parameters can be used with both TOKEN and other credential realms,
although the lifetime parameter only applies to non-TOKEN realms.  A realm
parameter is appended to the realm type using a plus symbol and optional quoted
string.  Parameter elements are delimited by a comma.

For example a non-standard port specified with a leading ':'

  ["VMS credentials"=EXAMPLE=ID+"token=:7080"]
  /a/path/* r+w

A non-default token (cookie) name may be specified

  ["VMS credentials"=EXAMPLE=ID+"token=example-token-name"]
  /a/path/* r+w

Variations on the token (cookie) name may be specified using an integer. 
Instead of the default "WASDtoken" cookie name the following example would use
"WASDtoken10".

  ["VMS credentials"=EXAMPLE=ID+"&10"]
  /a/path/* r+w

A non-default token lifetime may be specified using a leading '#' symbol, in
this case one of 300 seconds (or 5 minutes)

  ["VMS credentials"=EXAMPLE=ID+"token=example-token-name,#300"]
  /a/path/* r+w

By default credentials are supplied in SSL space and the token is used in
non-SSL space (by redirect) but a redirect back into SSL space may be effected
using the "https:" keyword parameter (on a different port!)

  ["VMS credentials"=EXAMPLE=ID+"token=example-token-name,https:7080"]
  /a/path/* r+w


CONFIGURATION
-------------
The automatic authorisation and redirection occurs using a combination of two
distinguishable authorisation rules, one for supplying the credentials, the
other for using the token for authorisation.  In this example (and commonly)
the resources are at "/location/" and the configuration accepts user-supplied
credentials in SSL space and uses the token in non-SSL space.  The asterisk
just indicates that in the absence of any other parameter this authorisation
rule has a complementary token rule.

  # WASD_CONFIG_AUTH
  if (ssl:) 
     ["VMS credentials"=WASD_VMS_RW=id+"TOKEN=*"]
     /location/* r+w
  else
     [WASD_VMS_RW=TOKEN]
     /location/* r+w
  endif

And in this example, the same arrangement but with non-standard ports.

  # WASD_CONFIG_AUTH
  if (ssl:) 
     ["VMS credentials"=WASD_VMS_RW=id+"TOKEN=:7080"]
     /location/* r+w
  else
     [WASD_VMS_RW=TOKEN+"TOKEN=:7443"]
     /location/* r+w
  endif

To prevent potential "thrashing", where multiple, distinct realms within a
single request are authorised using tokens, corresponding multiple token
(cookie) names must be used.  It is expected that this would be an uncommon but
not impossible scenario.  "Thrashing" would be a result of authorisation
associated with a single, particular token name.  Where a realm differs from a
previous token generated another is required.  The TOKEN authorsation scheme
forces the use of distinct token names by 403-forbidding change of realm using
the one token.   Use explicitly specified, independent token (cookie) names, or
the "&<integer>" syntax to append the integer to the base token name, ensuring
the complementary rules are using the same name/integer.

  # WASD_CONFIG_AUTH
  if (ssl:) 
     ["VMS credentials"=WASD_VMS_RW=id+"TOKEN=&42"]
     /location/* r+w
  else
     [WASD_VMS_RW=TOKEN+"TOKEN=&42"]
     /location/* r+w
  endif

For the final example, the token is contained in the non-default cookie named
"WaSd_example" and the authentication performed using an X509 client
certificate (which can only be supplied via SSL).

  # WASD_CONFIG_AUTH
  if (ssl:) 
     [X509+"TOKEN=WaSd_example"]
     /location/* r+w
  else
     [X509=TOKEN+"TOKEN=WaSd_example"]
     /location/* r+w
  endif


VERSION HISTORY
---------------
18-SEP-2012  MGD  initial
*/
/*****************************************************************************/

#ifdef WASD_VMS_V7
#undef _VMS__V6__SOURCE
#define _VMS__V6__SOURCE
#undef __VMS_VER
#define __VMS_VER 70000000
#undef __CRTL_VER
#define __CRTL_VER 70000000
#endif

/* standard C header files */
#include <ctype.h>
#include <errno.h>
#include <stdio.h>
#include <string.h>

/* VMS related header files */
#include <descrip.h>
#include <secdef.h>
#include <ssdef.h>
#include <stsdef.h>

/* application related header files */
#include "wasd.h"

#define WASD_MODULE "AUTHTOKEN"

#if WATCH_MOD
#define FI_NOLI WASD_MODULE, __LINE__
#else
/* in production let's keep the exact line to ourselves! */
#define FI_NOLI WASD_MODULE, 0
#endif

/******************/
/* global storage */
/******************/

int  AuthTokenCurrentCount,
     AuthTokenGblSecPages,
     AuthTokenGblSecSize,
     AuthTokenRecordMax,
     AuthTokenRecordSize = sizeof(AUTH_TOKEN_RECORD);

AUTH_TOKEN_RECORD  *AuthTokenDataBase;

AUTH_TOKEN_GBLSEC  *AuthTokenGblSecPtr;

/********************/
/* external storage */
/********************/

extern BOOL  AuthRealmToken,
             HttpdServerStartup;

extern int  GblPageCount,
            GblSectionCount,
            HttpdTickSecond,
            InstanceNodeConfig,
            InstanceEnvNumber,
            OpcomMessages,
            AuthTokenGblSecVersion;

extern unsigned long  GblSecPrvMask[];

extern char  ErrorSanityCheck[];

extern CONFIG_STRUCT  Config;
extern HTTPD_PROCESS  HttpdProcess;
extern SYS_INFO  SysInfo;
extern WATCH_STRUCT  Watch;

/*****************************************************************************/
/*
Initialize the token authentication/authorization environment.
*/ 

AuthTokenInit ()

{
   /*********/
   /* begin */
   /*********/

   if (WATCH_MODULE(WATCH_MOD_AUTH))
      WatchThis (WATCHALL, WATCH_MOD_AUTH, "AuthTokenInit()");

   if (!AuthRealmToken) return;

   if (HttpdServerStartup)
   {
      AuthTokenRecordMax = Config.cfAuth.TokenEntriesMax;
      if (AuthTokenRecordMax < 0)
      {
         AuthTokenRecordMax = 0;
         FaoToStdout ("%HTTPD-W-AUTHTOKEN, disabled\n");
         return;
      }
      if (!AuthTokenRecordMax)
         AuthTokenRecordMax = AUTH_TOKEN_DEFAULT_RECORD_MAX;
      else
      if (AuthTokenRecordMax < AUTH_TOKEN_RECORD_MIN)
         AuthTokenRecordMax = AUTH_TOKEN_RECORD_MIN;

      AuthTokenGblSecInit ();
   }

   if (!AuthTokenGblSecPtr) return;

   AuthTokenDataBase = (AUTH_TOKEN_RECORD*)(&AuthTokenGblSecPtr->RecordPool);
}

/****************************************************************************/
/*
This function runs after authentication and authorisation has occured (often
but not exclusively in SSL space).  A pseudo-random token is generated and set
as a cookie during the redirection back to the non-encrypted space.  This
token, along with a expiry time and client IP address, is added to the global
section as a record.  It then redirects to the non-SSL resource.  If anything
falls over it returns false other true to indicate a redirect is effect.
*/ 

void AuthTokenGenerate (REQUEST_STRUCT* rqptr)

{
   static unsigned long  PrevSeed;

   uint64  RandomNumber;

   int  cnt, idx,
        CookieSize,
        LocationSize,
        SemiColon,
        TokenIntegerLength = 0,
        TokenLifeTime,
        TokenMaxAgeLength,
        TokenNameLength,
        TokenPortLength = 0;
   char  *cptr, *sptr, *zptr,
         *CookiePtr,
         *SchemePtr = "http:",
         *TokenMaxAgePtr = NULL,
         *TokenIntegerPtr = NULL,
         *TokenNamePtr = NULL,
         *TokenPortPtr = NULL,
         *TokenValuePtr;
   char  TokenName [64],
         TokenValue [AUTH_SIZE_TOKEN_VALUE+1];
   AUTH_TOKEN_RECORD  *atkptr;
   DICT_ENTRY_STRUCT  *denptr;

   /*********/
   /* begin */
   /*********/

   if (WATCHMOD (rqptr, WATCH_MOD_AUTH))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_AUTH, "AuthTokenGenerate()");

   if (!AuthTokenRecordMax)
   {
      if (WATCHING (rqptr, WATCH_AUTH))
          WatchThis (WATCHITM(rqptr), WATCH_AUTH, "TOKEN disabled 0 entries");
      rqptr->rqAuth.FinalStatus = AUTH_DENIED_BY_OTHER;
      return;
   }

   if (!rqptr->rqHeader.HostPtr ||
       !rqptr->rqHeader.RequestUriPtr)
   {
      if (WATCHING (rqptr, WATCH_AUTH))
          WatchThis (WATCHITM(rqptr), WATCH_AUTH, "!AZ", ErrorSanityCheck);
      rqptr->rqAuth.FinalStatus = AUTH_DENIED_BY_OTHER;
      return;
   }

   if (rqptr->rqAuth.RealmParamPtr &&
       *(cptr = rqptr->rqAuth.RealmParamPtr))
   {
      /* shouldn't even get here without this! */
      if (strsame (cptr, "TOKEN=", 6))
      {
         /**************/
         /* parameters */
         /**************/

         cptr += 6;
         while (*cptr)
         {
            if (*cptr == '*')
               cptr++;
            else
            if (*cptr == ':' && isdigit(*cptr+1))
            {
               TokenPortPtr = ++cptr;
               while (isdigit(*cptr)) cptr++;
               TokenPortLength = cptr - TokenPortPtr;
            }
            else
            if (*cptr == '#' && isdigit(*(cptr+1)))
            {
               TokenMaxAgePtr = ++cptr;
               while (isdigit(*cptr)) cptr++;
               TokenMaxAgeLength = cptr - TokenMaxAgePtr;
            }
            else
            if (*cptr == '&' && isdigit(*(cptr+1)))
            {
               TokenIntegerPtr = ++cptr;
               while (isdigit(*cptr)) cptr++;
               TokenIntegerLength = cptr - TokenIntegerPtr;
            }
            else
            if (strsame (cptr, "http:", 5))
            {
               SchemePtr = "http:";
               cptr += 5;
               if (isdigit(*cptr)) cptr--;
            }
            else
            if (strsame (cptr, "https:", 6))
            {
               SchemePtr = "https:";
               cptr += 6;
               if (isdigit(*cptr)) cptr--;
            }
            else
            if (isalpha(*cptr))
            {
               for (TokenNamePtr = cptr; *cptr && isalpha(*cptr); cptr++);
               TokenNameLength = cptr - TokenNamePtr;
            }
            else
               while (*cptr && !(ISLWS(*cptr) || *cptr == ',')) cptr++;

            while (*cptr && (ISLWS(*cptr) || *cptr == ',')) cptr++;
         }
      }
      else
      {
         if (WATCHING (rqptr, WATCH_AUTH))
             WatchThis (WATCHITM(rqptr), WATCH_AUTH, "!AZ", ErrorSanityCheck);
         rqptr->rqAuth.FinalStatus = AUTH_DENIED_BY_OTHER;
         return;
      }
   }

   if (!TokenNamePtr)
   {
      TokenNamePtr = AUTH_TOKEN_NAME_DEFAULT;
      TokenNameLength = sizeof(AUTH_TOKEN_NAME_DEFAULT)-1;
   }
   zptr = (sptr = TokenName) + sizeof(TokenName)-1;
   for (cptr = TokenNamePtr;
        TokenNameLength-- && sptr < zptr;
        *sptr++ = *cptr++);
   if (TokenIntegerLength)
      for (cptr = TokenIntegerPtr;
           TokenIntegerLength-- && sptr < zptr;
           *sptr++ = *cptr++);
   *sptr = '\0';
   TokenNameLength = sptr - TokenName;

   if (!TokenMaxAgePtr)
   {
      TokenMaxAgePtr = AUTH_TOKEN_MAXAGE_DEFAULT;
      TokenMaxAgeLength = sizeof(AUTH_TOKEN_MAXAGE_DEFAULT)-1;
   }

   TokenLifeTime = atoi(TokenMaxAgePtr);
   if (TokenLifeTime < AUTH_TOKEN_MAXAGE_MIN)
   {
      TokenMaxAgePtr = AUTH_TOKEN_MAXAGE_DEFAULT;
      TokenMaxAgeLength = sizeof(AUTH_TOKEN_MAXAGE_DEFAULT)-1;
      TokenLifeTime = atoi(TokenMaxAgePtr);
   }

   TokenValuePtr = AuthTokenFromCookie (rqptr, TokenName);

   /****************************/
   /* generate fresh PRN token */
   /****************************/

   sys$gettim (&RandomNumber);
   RandomNumber += PrevSeed;
   zptr = (sptr = TokenValue) + sizeof(TokenValue)-1;
   while (sptr < zptr)
   {
      /* cheap (no subroutine call) MTH$RANDOM() */
      RandomNumber = RandomNumber * 69069 + 1;
      cptr = (char*)&RandomNumber;
      for (cnt = sizeof(RandomNumber); cnt && sptr < zptr; cnt--)
      {
         if ((*cptr >= 'a' && *cptr <= 'z') ||
             (*cptr >= 'A' && *cptr <= 'Z') ||
             (*cptr >= '0' && *cptr <= '9')) *sptr++ = *cptr;
         cptr++;
      }
   }
   *sptr = '\0';
   PrevSeed = RandomNumber & 0xffff;

   /*******************/
   /* update database */
   /*******************/

   if (WATCHING (rqptr, WATCH_AUTH))
      WatchThis (WATCHITM(rqptr), WATCH_AUTH, "TOKEN !AZ for !ULS",
                 TokenValue, TokenLifeTime);

   InstanceMutexLock (INSTANCE_MUTEX_AUTH_TOKEN);

   /* if a previous record is not located then find one to (re)use */
   if (!(atkptr = AuthTokenFind (TokenValuePtr)))
      atkptr = AuthTokenFind (NULL);

   if (atkptr)
   {
      /* (refresh) using the new token value */
      strzcpy (atkptr->TokenValue, TokenValue, sizeof(atkptr->TokenValue));
      strzcpy (atkptr->AuthRealm, rqptr->rqAuth.RealmPtr,
               sizeof(atkptr->AuthRealm));
      strzcpy (atkptr->RemoteUser, rqptr->RemoteUser,
               sizeof(atkptr->RemoteUser));
      atkptr->RemoteUserLength = rqptr->RemoteUserLength;
      atkptr->SysUafAuthenticated = rqptr->rqAuth.SysUafAuthenticated;
      atkptr->VmsUserProfile = (rqptr->rqAuth.VmsUserProfilePtr != NULL);
      atkptr->AuthUserCan = rqptr->rqAuth.UserCan;
      atkptr->ExpireSecond = HttpdTickSecond + TokenLifeTime;
      IPADDRESS_COPY (&atkptr->ClientIpAddr, &rqptr->ClientPtr->IpAddress);
   }

   InstanceMutexUnLock (INSTANCE_MUTEX_AUTH_TOKEN);

   if (!atkptr)
   {
      FaoToStdout (
"%HTTPD-W-AUTHTOKEN, !20%D, global section exhausted at !UL records\n",
                   AuthTokenRecordMax);

      if (OpcomMessages & OPCOM_AUTHORIZATION)
         FaoToOpcom (
"%HTTPD-W-AUTHTOKEN, global section exhausted\r\n",
                     AuthTokenRecordMax);

      rqptr->rqAuth.FinalStatus = AUTH_DENIED_BY_OTHER;
      return;
   }

   /*******************/
   /* generate cookie */
   /*******************/

   SemiColon = rqptr->rqHeader.UserAgentPtr &&
               !strncmp (rqptr->rqHeader.UserAgentPtr, "Opera/", 6);

   CookieSize = TokenNameLength + 3 + AUTH_SIZE_TOKEN_VALUE;
   CookieSize += sizeof(" domain=\"\"") + rqptr->rqHeader.HostLength;
   CookieSize += sizeof(" path=\"\"") + rqptr->rqHeader.RequestUriLength;
   CookieSize += sizeof(" max-age=\"\"") + TokenMaxAgeLength;
   if (SemiColon) CookieSize += 3;
   CookiePtr = VmGetHeap (rqptr, CookieSize);

   zptr = (sptr = CookiePtr) + CookieSize;
   for (cptr = TokenName;
        TokenNameLength-- && sptr < zptr;
        *sptr++ = *cptr++);
   if (sptr < zptr) *sptr++ = '=';
   if (sptr < zptr) *sptr++ = '\"';
   for (cptr = TokenValue; *cptr && sptr < zptr; *sptr++ = *cptr++);
   if (sptr < zptr) *sptr++ = '\"';
   if (SemiColon && sptr < zptr) *sptr++ = ';';
   for (cptr = " domain=\""; *cptr && sptr < zptr; *sptr++ = *cptr++);
   for (cptr = rqptr->rqHeader.HostPtr;
        *cptr && sptr < zptr;
        *sptr++ = *cptr++);
   if (sptr < zptr) *sptr++ = '\"';
   if (SemiColon && sptr < zptr) *sptr++ = ';';
   for (cptr = " path=\""; *cptr && sptr < zptr; *sptr++ = *cptr++);
   for (cptr = rqptr->rqHeader.RequestUriPtr;
        *cptr && sptr < zptr;
        *sptr++ = *cptr++);
   if (sptr < zptr) *sptr++ = '\"';
   if (SemiColon && sptr < zptr) *sptr++ = ';';
   for (cptr = " max-age=\""; *cptr && sptr < zptr; *sptr++ = *cptr++);
   for (cptr = TokenMaxAgePtr; *cptr && sptr < zptr; *sptr++ = *cptr++);
   if (sptr < zptr) *sptr++ = '\"';
   *sptr = '\0';

   for (idx = 0; idx < RESPONSE_COOKIE_MAX; idx++)
   {
      if (!rqptr->rqResponse.CookiePtr[idx])
      {
         rqptr->rqResponse.CookiePtr[idx] = CookiePtr;
         break;
      }
   }
   if (idx >= RESPONSE_COOKIE_MAX)
   {
      if (WATCHING (rqptr, WATCH_AUTH))
         WatchThis (WATCHITM(rqptr), WATCH_AUTH, "cookie storage exhausted");
      rqptr->rqAuth.FinalStatus = AUTH_DENIED_BY_OTHER;
      return;
   }
 
   /************/
   /* redirect */
   /************/

   LocationSize = rqptr->rqHeader.HostLength + TokenPortLength +
                  rqptr->rqHeader.RequestUriLength + 11;
   /* reserves space in the dictionary that will then be populated */
   sptr = ResponseLocation (rqptr, NULL, LocationSize);
   zptr = sptr + LocationSize;

   for (cptr = SchemePtr; *cptr && sptr < zptr; *sptr++ = *cptr++);
   if (sptr < zptr) *sptr++ = '/';
   if (sptr < zptr) *sptr++ = '/';
   for (cptr = rqptr->rqHeader.HostPtr;
        *cptr && *cptr != ':' && sptr < zptr;
        *sptr++ = *cptr++);

   if (TokenPortPtr)
   {
      if (sptr < zptr) *sptr++ = ':';
      for (cptr = TokenPortPtr;
           TokenPortLength-- && sptr < zptr; 
           *sptr++ = *cptr++);
   }

   for (cptr = rqptr->rqHeader.RequestUriPtr;
        *cptr && sptr < zptr;
        *sptr++ = *cptr++);
   *sptr = '\0';

   rqptr->rqAuth.FinalStatus = AUTH_DENIED_BY_REDIRECT;
}

/****************************************************************************/
/*
Authorisation by token is occurring (commonly in non-SSL space).  It looks for
a token delivered in a cookie.  If present it is searched for as a correspnding
record in the global section.  If found the expiry time and client IP address
are checked.  If after that all is OK the access is permitted.  If any of this
fails the request is redirected to the SSL-space equivalent where
authentication can be applied securely and from that generate the token and
associated cookie.
*/ 

void AuthTokenProcess (REQUEST_STRUCT* rqptr)

{
   BOOL  IPaddrMismatch = false,
         RealmMismatch = false,
         VmsUserProfile = false;
   int  ExpiresSecs = 0,
        LocationSize,
        TokenIntegerLength = 0,
        TokenNameLength,
        TokenPortLength = 0;
   char  *cptr, *sptr, *zptr,
         *SchemePtr = "https:",
         *TokenIntegerPtr = NULL,
         *TokenNamePtr = NULL,
         *TokenPortPtr = NULL,
         *TokenValuePtr;
   char  TokenName [64],
         TokenValue [AUTH_SIZE_TOKEN_VALUE+1];
   AUTH_TOKEN_RECORD  *atkptr = NULL;

   /*********/
   /* begin */
   /*********/

   if (WATCHMOD (rqptr, WATCH_MOD_AUTH))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_AUTH,
                 "AuthTokenProcess() !&Z", rqptr->rqHeader.CookiePtr);

   if (!AuthTokenRecordMax)
   {
      if (WATCHING (rqptr, WATCH_AUTH))
          WatchThis (WATCHITM(rqptr), WATCH_AUTH, "TOKEN disabled 0 entries");
      rqptr->rqAuth.FinalStatus = AUTH_DENIED_BY_OTHER;
      return;
   }

   if (!rqptr->rqHeader.HostPtr ||
       !rqptr->rqHeader.RequestUriPtr)
   {
      ErrorNoticed (rqptr, SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
      rqptr->rqAuth.FinalStatus = AUTH_DENIED_BY_OTHER;
      return;
   }

   if (rqptr->rqAuth.RealmParamPtr &&
       *(cptr = rqptr->rqAuth.RealmParamPtr))
   {
      if (strsame (cptr, "TOKEN=", 6))
      {
         /**************/
         /* parameters */
         /**************/

         cptr += 6;
         while (*cptr)
         {
            if (*cptr == '*')
               cptr++;
            else
            if (*cptr == ':' && isdigit(*cptr+1))
            {
               TokenPortPtr = ++cptr;
               while (isdigit(*cptr)) cptr++;
               TokenPortLength = cptr - TokenPortPtr;
            }
            else
            if (*cptr == '&' && isdigit(*(cptr+1)))
            {
               TokenIntegerPtr = ++cptr;
               while (isdigit(*cptr)) cptr++;
               TokenIntegerLength = cptr - TokenIntegerPtr;
            }
            else
            if (strsame (cptr, "http:", 5))
            {
               SchemePtr = "http:";
               cptr += 5;
               if (isdigit(*cptr)) cptr--;
            }
            else
            if (strsame (cptr, "https:", 6))
            {
               SchemePtr = "https:";
               cptr += 6;
               if (isdigit(*cptr)) cptr--;
            }
            else
            if (isalpha(*cptr))
            {
               for (TokenNamePtr = cptr; *cptr && isalpha(*cptr); cptr++);
               TokenNameLength = cptr - TokenNamePtr;
            }
            else
               while (*cptr && !(ISLWS(*cptr) || *cptr == ',')) cptr++;

            while (*cptr && (ISLWS(*cptr) || *cptr == ',')) cptr++;
         }
      }
   }

   if (!TokenNamePtr)
   {
      TokenNamePtr = AUTH_TOKEN_NAME_DEFAULT;
      TokenNameLength = sizeof(AUTH_TOKEN_NAME_DEFAULT)-1;
   }
   zptr = (sptr = TokenName) + sizeof(TokenName)-1;
   for (cptr = TokenNamePtr;
        TokenNameLength-- && sptr < zptr;
        *sptr++ = *cptr++);
   if (TokenIntegerLength)
      for (cptr = TokenIntegerPtr;
           TokenIntegerLength-- && sptr < zptr;
           *sptr++ = *cptr++);
   *sptr = '\0';

   TokenValuePtr = AuthTokenFromCookie (rqptr, TokenName);

   if (TokenValuePtr)
   {
      /****************/
      /* verify token */
      /****************/

      if (WATCHING (rqptr, WATCH_AUTH))
         WatchThis (WATCHITM(rqptr), WATCH_AUTH, "TOKEN !AZ", TokenValuePtr);

      InstanceMutexLock (INSTANCE_MUTEX_AUTH_TOKEN);

      atkptr = AuthTokenFind (TokenValuePtr);

      if (atkptr)
      {
         /* surely this could only happen subversively! */
         if (!IPADDRESS_IS_SAME(&atkptr->ClientIpAddr,
                                &rqptr->ClientPtr->IpAddress))
         {
            atkptr = NULL;
            IPaddrMismatch = true;
         }
      }

      if (atkptr)
      {
         /* compare the request and record realms */
         if (!strsame (rqptr->rqAuth.RealmPtr, atkptr->AuthRealm, -1))
         {
            /* can just be misconfiguration */
            atkptr = NULL;
            RealmMismatch = true;
         }
      }

      if (atkptr)
      {
         /* check the token has not expired */
         ExpiresSecs = atkptr->ExpireSecond - (unsigned int)HttpdTickSecond;
         if (ExpiresSecs < 0) atkptr = NULL;
      }

      if (atkptr)
      {
         /* validated so use the record */
         strzcpy (rqptr->RemoteUser, atkptr->RemoteUser,
                  sizeof(rqptr->RemoteUser));
         rqptr->RemoteUserLength = atkptr->RemoteUserLength;
         rqptr->rqAuth.UserCan = atkptr->AuthUserCan;
         rqptr->rqAuth.SysUafAuthenticated = atkptr->SysUafAuthenticated;
         VmsUserProfile = atkptr->VmsUserProfile;
      }

      InstanceMutexUnLock (INSTANCE_MUTEX_AUTH_TOKEN);

      if (IPaddrMismatch)
      {
         if (WATCHING (rqptr, WATCH_AUTH))
            WatchThis (WATCHITM(rqptr), WATCH_AUTH, "IP address MISMATCH");

         FaoToStdout (
"%HTTPD-W-AUTHTOKEN, !20%D, IP address mismatch\n\
-AUTHTOKEN-I-SERVICE, !AZ//!AZ\n\
-AUTHTOKEN-I-CLIENT, !AZ\n\
-AUTHTOKEN-I-URI, !AZ !AZ\n",
            0, rqptr->ServicePtr->RequestSchemeNamePtr,
            rqptr->ServicePtr->ServerHostPort,
            ClientHostString(rqptr),
            rqptr->rqHeader.MethodName, rqptr->rqHeader.RequestUriPtr);

         if (OpcomMessages & OPCOM_AUTHORIZATION)
            FaoToOpcom (
"%HTTPD-W-AUTHTOKEN, IP address mismatch\r\n\
-AUTHTOKEN-I-SERVICE, !AZ//!AZ\r\n\
-AUTHTOKEN-I-CLIENT, !AZ\r\n\
-AUTHTOKEN-I-URI, !AZ !AZ",
               rqptr->ServicePtr->RequestSchemeNamePtr,
               rqptr->ServicePtr->ServerHostPort,
               ClientHostString(rqptr),
               rqptr->rqHeader.MethodName, rqptr->rqHeader.RequestUriPtr);

         rqptr->rqAuth.FinalStatus = AUTH_DENIED_BY_OTHER;
         return;
      }

      if (RealmMismatch)
      {
         if (WATCHING (rqptr, WATCH_AUTH))
            WatchThis (WATCHITM(rqptr), WATCH_AUTH, "REALM MISMATCH");

         rqptr->rqAuth.FinalStatus = AUTH_DENIED_BY_OTHER;
         return;
      }

      if (WATCHING (rqptr, WATCH_AUTH))
         WatchThis (WATCHITM(rqptr), WATCH_AUTH, "EXPIRES !AZ!SLS",
                    ExpiresSecs >= 0 ? "+" : "", ExpiresSecs);
   }

   if (TokenValuePtr && atkptr)
   {
      /************/
      /* verified */
      /************/

      rqptr->rqAuth.ResolvedRemoteUser = true;
      rqptr->rqAuth.FinalStatus = SS$_NORMAL;
      if (rqptr->rqAuth.SysUafAuthenticated)
      {
         strzcpy (rqptr->rqAuth.RemoteUser, rqptr->RemoteUser,
                  sizeof(rqptr->rqAuth.RemoteUser));
         rqptr->rqAuth.RemoteUserLength = rqptr->RemoteUserLength;
         if (VmsUserProfile)
            rqptr->rqAuth.FinalStatus = AuthVmsCreateUserProfile (rqptr);
      }
   }
   else
   {
      /************/
      /* redirect */
      /************/

      LocationSize = rqptr->rqHeader.HostLength + TokenPortLength +
                     rqptr->rqHeader.RequestUriLength + 11;
      /* reserves space in the dictionary that will then be populated */
      sptr = ResponseLocation (rqptr, NULL, LocationSize);
      zptr = sptr + LocationSize;

      for (cptr = SchemePtr; *cptr && sptr < zptr; *sptr++ = *cptr++);
      if (sptr < zptr) *sptr++ = '/';
      if (sptr < zptr) *sptr++ = '/';
      for (cptr = rqptr->rqHeader.HostPtr;
           *cptr && *cptr != ':' && sptr < zptr;
           *sptr++ = *cptr++);

      if (TokenPortPtr)
      {
         if (sptr < zptr) *sptr++ = ':';
         for (cptr = TokenPortPtr;
              TokenPortLength-- && sptr < zptr; 
              *sptr++ = *cptr++);
      }

      for (cptr = rqptr->rqHeader.RequestUriPtr;
           *cptr && sptr < zptr;
           *sptr++ = *cptr++);
      *sptr = '\0';

      rqptr->rqAuth.FinalStatus = AUTH_DENIED_BY_REDIRECT;
   }
}

/*****************************************************************************/
/*
Find and return the token value from the cookie.  Return NULL if not found.
*/ 

char* AuthTokenFromCookie
(
REQUEST_STRUCT* rqptr,
char *TokenNamePtr
)
{
   char  *cptr, *sptr, *zptr;

   /*********/
   /* begin */
   /*********/

   if (WATCHMOD (rqptr, WATCH_MOD_AUTH))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_AUTH,
                 "AuthTokenFromCookie() !&Z", TokenNamePtr);

   if (!rqptr->rqHeader.CookiePtr) return (NULL);

   if (cptr = strstr (rqptr->rqHeader.CookiePtr, TokenNamePtr))
   {
      cptr += strlen(TokenNamePtr);
      if (*cptr++ == '=')
         if (*cptr++ == '\"')
         {
            sptr = VmGetHeap (rqptr, AUTH_SIZE_TOKEN_VALUE+1);
            zptr = (rqptr->rqAuth.AuthTokenValuePtr = sptr) +
                   AUTH_SIZE_TOKEN_VALUE;
            while (*cptr && *cptr != '\"' && sptr < zptr) *sptr++ = *cptr++;
            if (sptr == zptr && *cptr == '\"')
            {
               *sptr = '\0';
               return (rqptr->rqAuth.AuthTokenValuePtr);
            }
         }
   }

   return (NULL);
}

/*****************************************************************************/
/*
Expects the global section to be locked.  If token is NULL then returns the
first available record for (re)use.  Returns NULL if not found or usable
records are exhausted.
*/ 

AUTH_TOKEN_RECORD* AuthTokenFind (char *TokenValue)

{
   int  idx;

   /*********/
   /* begin */
   /*********/

   if (WATCH_MODULE(WATCH_MOD_AUTH))
      WatchThis (WATCHALL, WATCH_MOD_AUTH,
                 "AuthTokenFind() !&Z in !UL of !UL records",
                 TokenValue, AuthTokenGblSecPtr->RecordCount,
                 AuthTokenRecordMax);

   if (TokenValue)
   {
      /* find the specified record */
      for (idx = 0; idx < AuthTokenGblSecPtr->RecordCount; idx++)
      {
         if (WATCH_MODULE(WATCH_MOD_AUTH))
            WatchThis (WATCHALL, WATCH_MOD_AUTH,
                       "!&Z", AuthTokenDataBase[idx].TokenValue);
         if (*(ULONGPTR)(AuthTokenDataBase[idx].TokenValue) !=
             *(ULONGPTR)TokenValue) continue;
         if (!strcmp (AuthTokenDataBase[idx].TokenValue, TokenValue))
            return (&AuthTokenDataBase[idx]);
      }
   }
   else
   {
      /* find a record that can be (re)used */
      for (idx = 0; idx < AuthTokenRecordMax; idx++)
      {
         if (WATCH_MODULE(WATCH_MOD_AUTH))
            WatchThis (WATCHALL, WATCH_MOD_AUTH,
                       "!&Z", AuthTokenDataBase[idx].TokenValue);
         if (!AuthTokenDataBase[idx].TokenValue[0])
         {
            AuthTokenGblSecPtr->RecordCount++;
            return (&AuthTokenDataBase[idx]);
         }
         if (AuthTokenDataBase[idx].ExpireSecond < HttpdTickSecond)
            return (&AuthTokenDataBase[idx]);
      }
   }

   return (NULL);
}

/*****************************************************************************/
/*
If only one instance can execute (from configuration) then allocate a block of
process-local dynamic memory and point to that as the cache.  If multiple
instances create and map a global section and point to that.  This is not
permananent and so requires no deletion function.
*/ 

AuthTokenGblSecInit ()

{
   static char  GblSecReport [] =
"%HTTPD-I-AUTHTOKEN, for !UL records in !AZ of !UL page(let)s\n";

   /* global, allocate space, system, in page file, writable */
   static int CreFlags = SEC$M_GBL | SEC$M_EXPREG | SEC$M_SYSGBL |
                         SEC$M_PAGFIL | SEC$M_WRT;
   static int DelFlags = SEC$M_SYSGBL;
   /* system & owner full access, group and world no access */
   static unsigned long  ProtectionMask = 0xff00;
   /* it is recommended to map into any virtual address in the region (P0) */
   static unsigned long  InAddr [2] = { 0x200, 0x200 };

   int  attempt, status,
        BaseGblSecPages,
        TokenRecordPoolSize,
        PageCount,
        SetPrvStatus;
   short  ShortLength;
   unsigned long  RetAddr [2];
   char  GblSecName [32];
   $DESCRIPTOR (GblSecNameDsc, GblSecName);
   AUTH_TOKEN_GBLSEC  *gsptr;

   /*********/
   /* begin */
   /*********/

   if (WATCH_MODULE(WATCH_MOD_AUTH))
      WatchThis (WATCHALL, WATCH_MOD_AUTH, "AuthTokenGblSecInit()");

   TokenRecordPoolSize = AuthTokenRecordSize * AuthTokenRecordMax;
   AuthTokenGblSecSize = sizeof(AUTH_TOKEN_GBLSEC) + TokenRecordPoolSize;
   AuthTokenGblSecPages = AuthTokenGblSecSize / 512;
   if (AuthTokenGblSecSize & 0x1ff) AuthTokenGblSecPages++;

   if (InstanceNodeConfig <= 1)
   {
      /* no need for a global section, just use process-local storage */
      AuthTokenGblSecPtr =
         (AUTH_TOKEN_GBLSEC*)VmGet (AuthTokenGblSecPages * 512);
      sys$gettim (&AuthTokenGblSecPtr->SinceTime64);
      FaoToStdout (GblSecReport, AuthTokenRecordMax,
                   "local storage", AuthTokenGblSecPages);
      return (SS$_CREATED);
   }

   FaoToBuffer (GblSecName, sizeof(GblSecName), &ShortLength,
                GBLSEC_NAME_FAO, HTTPD_NAME, AUTH_TOKEN_GBLSEC_VERSION_NUMBER,
                InstanceEnvNumber, "AUTH_TOKEN");
   GblSecNameDsc.dsc$w_length = ShortLength;

   if VMSnok ((SetPrvStatus = sys$setprv (1, &GblSecPrvMask, 0, 0)))
      ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);

   for (attempt = 1; attempt <= 2; attempt++)
   {
      /* create and/or map the specified global section */
      sys$setprv (1, &GblSecPrvMask, 0, 0);
      status = sys$crmpsc (&InAddr, &RetAddr, 0, CreFlags,
                           &GblSecNameDsc, 0, 0, 0, AuthTokenGblSecPages, 0,
                           ProtectionMask, AuthTokenGblSecPages);
      sys$setprv (0, &GblSecPrvMask, 0, 0);

      if (WATCH_MODULE(WATCH_MOD_AUTH))
         WatchThis (WATCHALL, WATCH_MOD_AUTH,
                    "sys$crmpsc() !&S begin:!UL end:!UL",
                    status, RetAddr[0], RetAddr[1]);

      PageCount = (RetAddr[1]+1) - RetAddr[0] >> 9;
      AuthTokenGblSecPtr = gsptr = (AUTH_TOKEN_GBLSEC*)RetAddr[0];
      AuthTokenGblSecPages = PageCount;
      if (VMSnok (status) || status == SS$_CREATED) break;

      /* section already exists, break if 'same size' and version! */
      if (gsptr->GblSecVersion &&
          gsptr->GblSecVersion == AuthTokenGblSecVersion &&
          gsptr->GblSecLength == AuthTokenGblSecSize)
         break;

      /* delete the current global section, have one more attempt */
      sys$setprv (1, &GblSecPrvMask, 0, 0);
      status = sys$dgblsc (DelFlags, &GblSecNameDsc, 0);
      sys$setprv (0, &GblSecPrvMask, 0, 0);
      status = SS$_IDMISMATCH;
   }

   if (VMSnok (status))
   {
      /* must have this global section! */
      char  String [256];
      FaoToBuffer (String, sizeof(String), NULL,
                   "1 global section, !UL global pages",
                   AuthTokenGblSecPages);
      ErrorExitVmsStatus (status, String, FI_LI);
   }

   if (WATCH_MODULE(WATCH_MOD_AUTH))
      WatchThis (WATCHALL, WATCH_MOD_AUTH,
         "GBLSEC \"!AZ\" page(let)s:!UL !&S",
         GblSecName, PageCount, status);

   FaoToStdout (GblSecReport, AuthTokenRecordMax,
                status == SS$_CREATED ? "a new global section" :
                                        "an existing global section",
                AuthTokenGblSecPages);

   if (status == SS$_CREATED)
   {
      /* first time it's been mapped */
      memset (gsptr, 0, PageCount * 512);
      gsptr->GblSecVersion = AuthTokenGblSecVersion;
      gsptr->GblSecLength =  AuthTokenGblSecSize;
      sys$gettim (&AuthTokenGblSecPtr->SinceTime64);
   }

   GblSectionCount++;
   GblPageCount += PageCount;

   return (status);
}

/****************************************************************************/

