/*****************************************************************************/
/*
                                Persona.c

Tuck in the cape.
Don the hat and glasses.
There ... we're hardly recognizable!

For VMS versions 6.2 and later the $PERSONA system services provide a reliable
mechanism for a process to assume all the defining characteristics of another
user.  This offers a number of potential uses, in particular scripting under
non-server user names.  As the persona services affect processes job-wide (i.e.
a (sub)process tree) this facility may only be used where scripting processes
can be detached and not spawned.

For VMS versions prior to V6.2 the $PERSONA services do not exist and so this
functionality is not available.

For server NETWORK MODE operation this module is used as a convenient set of
stubs and for checking whether an account is allowed to be used for scripting
or not from the SYSUAF.  The persona of the process is never actually changed
however.


PERSONA_MACRO
-------------
For VAX VMS versions that do not support the $PERSONA services (i.e. 6.0 and
6.1) there is an unsupported alternative, the PERSONA.MAR module.  Essentially
WASD only uses the $PERSONA services to change the process username before
creating a detached or script process.  The PERSONA.MAR routine also performs
this function by explicitly manipulating the process structures in kernel mode. 
This could have been done using a C module but being unsure of any changes to
the kernel structures involved over VMS 6.0 and 6.1 it will be better to
generate the object code on the system it is going to be executing on.  A basic
integrity check of the supplied username is made (greater than zero and less
than or equal to twelve upper-case alpha-numeric/underscore characters).  No
check is performed that the supplied username exists, the process creation will
just fail if it does not.  The /PERSONA=<identifier> account restriction
mechanism is NOT available when using this kludge.  THIS IS KERNEL MODE CODE! 
I am not a VMS internals specialist!!  Use at your own risk!!!  YOU HAVE BEEN
WARNED!!!!


ENABLING PERSONA
----------------
Be aware that there are all sorts of issues surrounding scripting, and an order
of magnitude more so if under multiple accounts, and two orders of magnitude
more again if any of those accounts have anything more than the average Joe's
privileges.  Believe it!  It has been demonstrated using WASD :^(

If you must script under non-server accounts (and there are still good reasons
why this can be desireable) then take great care!

There are some features of WASD persona that help in reducing the possibility
of scripting with an unintended account.

1)  Unless the server is started with /PERSONA scripting under a non-server
account is not possible.  Persona is disabled by default.

2)  Unless the startup includes /PERSONA=RELAXED then an account with any
privilege other than NETMBX and TMPMBX is prohibited.

3)  Exactly which accounts are allowed to script can optionally be controlled
using a VMS rights identifier.  Starting the server with /PERSONA=ident-name
restricts persona scripting to those accounts granted that identifier.  The
name "WASD_SCRIPTING" is probably a reasonable choice.

4)  If the startup included /PERSONA=AUTHORIZED then only requests that have
been subject to HTTP authorization and authentication are allowed to script
under non-server accounts.

5)  If the qualifier /PERSONA=RELAXED=AUTHORIZED then privileged account are
allowed to be used for scripting but only if the request has been subject to
HTTP authorization and authentication.

Meaningful combinations of these startup parameters are possible:

  /PERSONA
  /PERSONA=ident-name
  /PERSONA=RELAXED
  /PERSONA=(ident-name,RELAXED)
  /PERSONA=AUTHORIZED
  /PERSONA=(ident-name,AUTHORIZED,RELAXED)
  /PERSONA=(ident-name,RELAXED=AUTHORIZED)

Remember to review site configuration carefully!


VERSION HISTORY
---------------
10-JUL-2013  MGD  PersonaAssume() wrap sys$persona_create() with SYSPRV
                    after modifications to DclMailboxAcl() to allow usernames
                    without associated identifiers (i.e. shared UICs)
22-JUL-2003  MGD  PersonaAllowedUai() to support network mode
16-MAR-2003  MGD  bugfix; Alpha VMS V7.1 or earlier sys$persona_assume() needs
                  to be used in the same way as for VAX (thanks Giles Burrows)
08-OCT-2002  MGD  consider UIC system group membership as privileged
16-SEP-2002  MGD  implement /PERSONA=[AUTHORIZED|RELAXED|RELAXED=AUTHORIZED]
                  to prevent inadvertant scripting using privileged accounts,
                  reorganise and refine some of the code
29-OCT-2001  MGD  PERSONA_MACRO and PERSONA.MAR for a rude-and-crude
                  (and certainly unsupported) pre-VMS 6.2 VAX persona
04-AUG-2001  MGD  support module WATCHing
19-NOV-2000  MGD  bugfix; VAX requires IMP$M_ASSUME_SECURITY 
01-OCT-2000  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

#define WASD_MODULE "PERSONA"

#ifdef PERSONA_MACRO
#  undef PERSONA_STUB
#  define PERSONA_STUB
#endif

#ifdef PERSONA_STUB 

#undef _VMS__V6__SOURCE
#define _VMS__V6__SOURCE
#undef __VMS_VER
#define __VMS_VER 70000000
#undef __CRTL_VER
#define __CRTL_VER 70000000

#else /* PERSONA_STUB */

#undef _VMS__V6__SOURCE
#define _VMS__V6__SOURCE
#undef __VMS_VER
#define __VMS_VER 60200000
#undef  __CRTL_VER
#define __CRTL_VER 60200000

#endif /* PERSONA_STUB */

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

/* VMS related header files */
#include <descrip.h>
#include <jpidef.h>
#include <prvdef.h>
#include <ssdef.h>
#include <stsdef.h>
#include <uaidef.h>

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

#ifdef PERSONA_STUB 

/*
For versions of VMS where the sys$persona...() services are not available
provide some that can be linked to but just return a detectable error.  On
these systems the WASD persona-based features will of course be unavailable
unless using the macro kernel-mode routine to change the username.
*/
#define sys$persona_create PersonaStub
#define sys$persona_delete PersonaStub
#define sys$persona_assume PersonaStub

#endif /* PERSONA_STUB */

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

#define PERSONA_DEFAULT_CACHE_SIZE 32

BOOL  PersonaMacro;

LIST_HEAD  PersonaCacheList;
int  PersonaCacheCount,
     PersonaCacheEntries;

unsigned long  CmKrnlMask [2] = { PRV$M_CMKRNL, 0 };

char  PersonaIdentName [64];

unsigned long  PersonaRightsIdent;

#ifdef PERSONA_MACRO
int  PersonaUserName12Length;
/* used solely by STARTUP.COM to detect if CMKRNL is required */
char  PersonaServerUserName12 [12],
      PersonaUserName12 [12];
char  PersonaDotMar [] = "PERSONA.MAR";
#endif

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

extern BOOL  CliPersonaAuthorized,
             CliPersonaEnabled,
             CliPersonaRelaxed,
             CliPersonaRelaxedAuthorized,
             HttpdNetworkMode;

extern int  EfnWait;

extern int  ToLowerCase[],
            ToUpperCase[];

extern unsigned long  AveJoePrvMask[],
                      SysPrvMask[];

extern char  ErrorSanityCheck[];

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

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

#ifndef PERSONA_MACRO 

   /*********************/
   /* $PERSONA SERVICES */
   /*********************/

/****************************************************************************/
/*
For $PERSONA service.
Initialize the PERSONA module. Check if an identifier is required for access to
the non-server-account scripting persona services then establish that it
exists.
*/ 

int PersonaInit ()

{
   static $DESCRIPTOR (PersonaIdentNameDsc, PersonaIdentName);

   int  status;

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL, "PersonaInit()\n");

#ifdef PERSONA_STUB

   return (SS$_UNSUPPORTED);

#else /* PERSONA_STUB */

   if (CliPersonaRelaxed) FaoToStdout ("%HTTPD-I-PERSONA, relaxed\n");

   if (!PersonaIdentName[0]) return (SS$_NORMAL);

   PersonaIdentNameDsc.dsc$w_length = strlen(PersonaIdentName);

   status = sys$asctoid (&PersonaIdentNameDsc, &PersonaRightsIdent, 0);

   if (VMSok (status))
      FaoToStdout ("%HTTPD-I-PERSONA, services identifier \'!AZ\'\n",
                   PersonaIdentName);
   else
   {
      FaoToStdout ("%HTTPD-E-PERSONA, services identifier \'!AZ\'\n-!&M\n",
                   PersonaIdentName, status);
      CliPersonaEnabled = CliPersonaRelaxed = false;
   }

   return (status);

#endif /* PERSONA_STUB */
}

/*****************************************************************************/
/*
For $PERSONA service.
Assume the 'persona' of the specified user name.  If 'UserName' is NULL then
return to the "natural" persona of the server process.
*/

#define PERSONA_NETWORK_MODE 2
#define ISS$C_ID_NATURAL 1
#define IMP$M_ASSUME_SECURITY 1

int PersonaAssume (char *UserName)

{
   static int  PersonaHandle;
   static long  PersonaCreateFlags;
   static long  PersonaAssumeFlags = IMP$M_ASSUME_SECURITY;
   static $DESCRIPTOR (UserNameDsc, "");

   int  status;

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL,
                 "PersonaAssume() !&Z !8XL !&B",
                 UserName, PersonaHandle, HttpdNetworkMode);

   if (!UserName)
   {
      /* if we haven't actually been able to assume a persona */
      if (!PersonaHandle) return (SS$_NORMAL);

      /* resume being the original server persona */
      PersonaHandle = ISS$C_ID_NATURAL;
   }
   else
   if (!(PersonaHandle = PersonaCache (UserName, 0)))
   {
      UserNameDsc.dsc$a_pointer = UserName;
      UserNameDsc.dsc$w_length = strlen(UserName);

      if (HttpdNetworkMode)
      {
         /* fudge the persona create */
         PersonaHandle = PERSONA_NETWORK_MODE;
         status = SS$_NORMAL;
      }
      else
      {
         sys$setprv (1, &SysPrvMask, 0, 0);
         status = sys$persona_create (&PersonaHandle, &UserNameDsc,
                                      PersonaCreateFlags, 0, 0);
         sys$setprv (0, &SysPrvMask, 0, 0);
         if (WATCH_MODULE(WATCH_MOD_DCL))
            WatchThis (WATCHALL, WATCH_MOD_DCL,
                       "sys$persona_create() !&S", status);
      }

      if (VMSnok (status))
      {
         PersonaHandle = 0;
         return (status);
      }

      /* update the persona cache */
      PersonaCache (UserName, PersonaHandle);
   }

   if (HttpdNetworkMode)
   {
      /* fudge the persona assume */
      status = SS$_NORMAL;
   }
   else
   {
      if (SysInfo.VersionInteger >= 720)
         status = sys$persona_assume (&PersonaHandle, 0, 0, 0);
      else
         status = sys$persona_assume (&PersonaHandle, PersonaAssumeFlags);

      if (WATCH_MODULE(WATCH_MOD_DCL))
         WatchThis (WATCHALL, WATCH_MOD_DCL,
                    "sys$persona_assume() !&S", status);
   }

   if (VMSnok (status))
      PersonaHandle = 0;
   else
   if (PersonaHandle == ISS$C_ID_NATURAL)
      PersonaHandle = 0;

   return (status);
} 

/*****************************************************************************/
/*
For $PERSONA service.
Keep a linked-list of cache entries.  If 'UserName' is NULL then the list is
reset (this happen on authorization rule reload and DCL script purge).  If
'UserName' is  non-NULL and 'PersonaHandle' zero the list is searched for a
matching username and any associated persona returned.  If 'UserName' is
non-NULL and 'PersonaHandle' non-zero 'PersonaHandle' add/update a cache entry. 
If the list has reached maximum size reuse the last entry, otherwise create a
new entry.  Move/add the entry to the head of the list.  It's therefore a
first-in/first-out queue.  Cache contents remain current until demands on space
(due to new entries) cycles through the maximum available entries.  To
explicitly flush the contents reload the authorization rules. 
*/ 

int PersonaCache
(
char *UserName,
int PersonaHandle
)
{
   char  *cptr, *sptr, *zptr;
   LIST_ENTRY  *leptr;
   PERSONA_ENTRY  *pcptr;

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL,
                 "PersonaCache() !&Z !UL !&B",
                 UserName, PersonaHandle, HttpdNetworkMode);

   if (!(UserName && PersonaCacheEntries))
   {
      /***************/
      /* reset cache */
      /***************/

      PersonaCacheEntries = Config.cfMisc.PersonaCacheEntries;
      if (!PersonaCacheEntries)
         PersonaCacheEntries = PERSONA_DEFAULT_CACHE_SIZE;
      PersonaCacheCount = 0;

      /* empty the list */
      leptr = PersonaCacheList.HeadPtr;
      PersonaCacheList.HeadPtr = PersonaCacheList.TailPtr = NULL;
      PersonaCacheList.EntryCount = 0;
      while (leptr)
      {
         pcptr = (PERSONA_ENTRY*)leptr;
         leptr = leptr->NextPtr;
         VmFree (pcptr, FI_LI);
      }

      if (!UserName) return (0);
   }

   if (!PersonaHandle)
   {
      /****************/
      /* search cache */
      /****************/

      /* process the cache entry list from most to least recent */
      for (leptr = PersonaCacheList.HeadPtr;
           leptr;
           leptr = leptr->NextPtr)
      {
         pcptr = (PERSONA_ENTRY*)leptr;

         /* if this one has been reset there won't be any more down the list */
         if (!pcptr->UserName[0]) break;

         /* string comparison */
         cptr = UserName;
         sptr = pcptr->UserName;
         while (*cptr && *sptr && TOUP(*cptr) == TOUP(*sptr))
         {
            cptr++;
            sptr++;
         }
         if (*cptr || *sptr) continue;

         /*************/
         /* cache hit */
         /*************/

         if ((void*)PersonaCacheList.HeadPtr != (void*)pcptr)
         {
            /* move it to the head of the list */
            ListRemove (&PersonaCacheList, pcptr);
            ListAddHead (&PersonaCacheList, pcptr, LIST_ENTRY_TYPE_PERSONA);
         }

         pcptr->HitCount++;
         sys$gettim (&pcptr->LastTime64);

         return (pcptr->PersonaHandle);
      }

      /* not found */
      return (0);
   }

   /****************/
   /* update cache */
   /****************/

   if (PersonaCacheCount < PersonaCacheEntries)
   {
      /* allocate memory for a new entry */
      pcptr = (PERSONA_ENTRY*) VmGet (sizeof (PERSONA_ENTRY));
      PersonaCacheCount++;
   }
   else
   {
      /* reuse the tail entry (least recent) */
      pcptr = PersonaCacheList.TailPtr;
      pcptr->ReuseCount++;
      ListRemove (&PersonaCacheList, pcptr);
      if (!HttpdNetworkMode)
      {
         /* delete the previous persona (uses dynamic storage) */
         if (pcptr->PersonaHandle) sys$persona_delete (&pcptr->PersonaHandle);
      }
   }

   /* add entry to the head of the user cache list (most recent) */
   ListAddHead (&PersonaCacheList, pcptr, LIST_ENTRY_TYPE_PERSONA);

   zptr = (sptr = pcptr->UserName) + sizeof(pcptr->UserName)-1;
   for (cptr = UserName; *cptr && sptr < zptr; *sptr++ = *cptr++);
   *sptr = '\0';
   pcptr->PersonaHandle = PersonaHandle;
   pcptr->HitCount = 1;
   sys$gettim (&pcptr->LastTime64);

   return (PersonaHandle);
}

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

#endif /* ifndef PERSONA_MACRO */

/****************************************************************************/
/*
For $PERSONA service.
Get the current persona's authorized privileges, UIC and process rights list. 
Make appropriate checks against it's UIC group membership and authorized
privileges.  Check for any required identifiers.  If OK to be used for
scripting return success, if not found return failure status. 
Can return other VMS error status.
*/ 

int PersonaAllowed
(
REQUEST_STRUCT *rqptr,
char *UserName
)
{
   static unsigned short  RetLength;
   static unsigned long  JpiUic;
   static unsigned long  JpiAuthPriv [2];

   static struct
   {
      unsigned short  buf_len;
      unsigned short  item;
      unsigned char   *buf_addr;
      unsigned short  *short_ret_len;
   }
   JpiItems [] =
   {
      { 0, JPI$_PROCESS_RIGHTS, 0, &RetLength },
      { sizeof(JpiAuthPriv), JPI$_AUTHPRIV, &JpiAuthPriv, 0 },
      { sizeof(JpiUic), JPI$_UIC, &JpiUic, 0 },
      {0,0,0,0}
   };

   int  idx, status;
   IO_SB  IOsb;
   struct
   {
      unsigned long  identifier;
      unsigned long  attributes;
   } JpiProcessRights [PERSONA_RIGHTS_MAX+1];

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL,
                 "PersonaAllowed() !&Z !&B",
                 UserName, HttpdNetworkMode);

   if (CliPersonaRelaxed) return (SS$_NORMAL);

   if (CliPersonaAuthorized && !rqptr->RemoteUser[0])
   {
      /* the request must have been subject to authorization to use persona */
      if (WATCHING (rqptr, WATCH_REQUEST))
         WatchThis (WATCHITM(rqptr), WATCH_REQUEST,
                    "FAIL authorization mandatory");
      return (SS$_INVUSER); 
   }

   if (HttpdNetworkMode || PersonaMacro)
   {
      /* using the SYSUAF to establish this */
      status = PersonaAllowedUai (rqptr, UserName);
      return (status);
   }

   /* use the final, additional element as a zeroed sentinal */
   JpiProcessRights[PERSONA_RIGHTS_MAX].identifier = 0;
   JpiItems[0].buf_len = sizeof(JpiProcessRights) - sizeof(JpiProcessRights[0]);
   JpiItems[0].buf_addr = &JpiProcessRights;

   status = sys$getjpiw (EfnWait, 0, 0, &JpiItems, &IOsb, 0, 0);
   if (VMSok (status)) status = IOsb.Status;
   if (VMSnok (status))
   {
      ErrorNoticed (rqptr, status, NULL, FI_LI);
      return (status);
   }

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL,
"sys$getjpi() !&S uic:!8XL priv:<63-32>!8XL<31-00>!8XL id:!UL/!UL",
                 status, JpiUic, JpiAuthPriv[1], JpiAuthPriv[0],
                 RetLength, RetLength/8);

   if ((JpiUic & 0xffff0000) >> 16 <= SysInfo.MaxSysGroup ||
       JpiAuthPriv[0] & ~AveJoePrvMask[0] ||
       JpiAuthPriv[1] & ~AveJoePrvMask[1])
   {
      /* system group or something other than NETMBX and TMPMBX authorized */
      if (!CliPersonaRelaxed)
      {
         /* not a relaxed privileged environment */
         if (WATCHING (rqptr, WATCH_REQUEST))
            WatchThis (WATCHITM(rqptr), WATCH_REQUEST,
"FAIL uic:!8XL privileges <63-32>!8XL<31-00>!8XL",
                       JpiUic, JpiAuthPriv[1], JpiAuthPriv[0]);
         return (SS$_INVUSER); 
      }
      /* it is a relaxed privileged environment */
      if (CliPersonaRelaxedAuthorized && !rqptr->RemoteUser[0])
      {
         /* but must and has not been authorized */
         if (WATCHING (rqptr, WATCH_REQUEST))
            WatchThis (WATCHITM(rqptr), WATCH_REQUEST,
"FAIL uic:!8XL privileges <63-32>!8XL<31-00>!8XL authorization mandatory",
                       JpiUic, JpiAuthPriv[1], JpiAuthPriv[0]);
         return (SS$_INVUSER); 
      }
      /* bogus success message indicates a privileged account */
      status = SS$_CREATED;
   }
   else
      status = SS$_NORMAL;

   if (!PersonaRightsIdent) return (status);

   /* does the account possess the required identifier? */
   for (idx = 0; JpiProcessRights[idx].identifier; idx++)
      if (JpiProcessRights[idx].identifier == PersonaRightsIdent)
         return (status);

   if (WATCHING (rqptr, WATCH_REQUEST))
      WatchThis (WATCHITM(rqptr), WATCH_REQUEST,
                 "FAIL identifier !AZ", PersonaIdentName);
   return (SS$_INVUSER);
}

/****************************************************************************/
/*
Get the username's UAI authorized privileges and UIC and assess that.
Return success if allowed to be used for scripting, a failure status if not.
Used for both PERSONA_MACRO and network mode.
*/ 

int PersonaAllowedUai
(
REQUEST_STRUCT *rqptr,
char *UserName
)
{
   static unsigned long  Context = -1;
   static unsigned long  UaiUic;
   static unsigned long  UaiPriv [2];
   static char  GetUserName [AUTH_MAX_USERNAME_LENGTH+1];
   static $DESCRIPTOR (UserNameDsc, GetUserName);

   static struct
   {
      unsigned short  buf_len;
      unsigned short  item;
      unsigned char   *buf_addr;
      unsigned short  *short_ret_len;
   }
   UaiItems [] =
   {
      { sizeof(UaiPriv), UAI$_PRIV, &UaiPriv, 0 },
      { sizeof(UaiUic), UAI$_UIC, &UaiUic, 0 },
      {0,0,0,0}
   };

   int  status;
   char  *cptr, *sptr, *zptr;
   unsigned long  FindHeldCtx,
                  FindHeldIdent;
   unsigned long  FindHeldUic [2];

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL,
                 "PersonaAllowedUai() !&Z", UserName);

   if (CliPersonaRelaxed) return (SS$_NORMAL);

   if (CliPersonaAuthorized && !rqptr->RemoteUser[0])
   {
      /* the request must have been subject to authorization to use persona */
      if (WATCHING (rqptr, WATCH_REQUEST))
         WatchThis (WATCHITM(rqptr), WATCH_REQUEST,
                    "FAIL authorization mandatory");
      return (SS$_INVUSER); 
   }

   /* to uppercase! */
   zptr = (sptr = GetUserName) + sizeof(GetUserName)-1;
   for (cptr = UserName; *cptr && sptr < zptr; *sptr++ = TOUP(*cptr++));
   *sptr = '\0';
   UserNameDsc.dsc$w_length = sptr - GetUserName;

   /* turn on SYSPRV to allow access to SYSUAF records */
   sys$setprv (1, &SysPrvMask, 0, 0);
   status = sys$getuai (0, &Context, &UserNameDsc, &UaiItems, 0, 0, 0);
   sys$setprv (0, &SysPrvMask, 0, 0);

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL,
                 "sys$getuai() !&S uic:!8XL priv:<63-32>!8XL<31-00>!8XL",
                 status, UaiUic, UaiPriv[1], UaiPriv[0]);

   if (VMSnok (status))
   {
      ErrorNoticed (rqptr, status, "sys$getuai()", FI_LI);
      return (status);
   }

   if ((UaiUic & 0xffff0000) >> 16 <= SysInfo.MaxSysGroup ||
       UaiPriv[0] & ~AveJoePrvMask[0] ||
       UaiPriv[1] & ~AveJoePrvMask[1])
   {
      /* system group or something other than NETMBX and TMPMBX authorized */
      if (!CliPersonaRelaxed)
      {
         /* not a relaxed privileged environment */
         if (WATCHING (rqptr, WATCH_REQUEST))
            WatchThis (WATCHITM(rqptr), WATCH_REQUEST,
"FAIL uic:!8XL privileges <63-32>!8XL<31-00>!8XL",
                       UaiUic, UaiPriv[1], UaiPriv[0]);
         return (SS$_INVUSER); 
      }
      /* it is a relaxed privileged environment */
      if (CliPersonaRelaxedAuthorized && !rqptr->RemoteUser[0])
      {
         /* but must and has not been authorized */
         if (WATCHING (rqptr, WATCH_REQUEST))
            WatchThis (WATCHITM(rqptr), WATCH_REQUEST,
"FAIL uic:!8XL privileges <63-32>!8XL<31-00>!8XL authorization mandatory",
               UaiUic, UaiPriv[1], UaiPriv[0]);
         return (SS$_INVUSER); 
      }
      /* bogus success message indicates a privileged account */
      status = SS$_CREATED;
   }
   else
      status = SS$_NORMAL;

   if (!PersonaRightsIdent) return (status);

   /* does the account possess the required identifier? */
   FindHeldCtx = FindHeldUic[1] = 0;
   FindHeldUic[0] = UaiUic;
   for (;;)
   {
      status = sys$find_held (&FindHeldUic, &FindHeldIdent, 0, &FindHeldCtx);
      if (WATCH_MODULE(WATCH_MOD_DCL))
         WatchThis (WATCHALL, WATCH_MOD_DCL,
                    "sys$find_held() !&S !&X !&X",
                    status, FindHeldIdent, PersonaRightsIdent);
      if (VMSnok(status)) break;
      if (FindHeldIdent == PersonaRightsIdent)
      {
         sys$finish_rdb (&FindHeldCtx);
         return (SS$_NORMAL);
      }
   }

   if (WATCHING (rqptr, WATCH_REQUEST))
      WatchThis (WATCHITM(rqptr), WATCH_REQUEST,
                 "FAIL identifier !AZ", PersonaIdentName);
   return (SS$_INVUSER);
}

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

#ifdef PERSONA_MACRO 

   /*****************/
   /* PERSONA_MACRO */
   /*****************/

/****************************************************************************/
/*
For PERSONA_MACRO kludge.
Get the current account username for resuming that identity (using $GETJPIW as
this routine can be used before the server proper is actually initialized).
*/ 

int PersonaInit ()

{
   static $DESCRIPTOR (PersonaIdentNameDsc, PersonaIdentName);

   static int  Pid = 0;
   static struct
   {
      unsigned short  buf_len;
      unsigned short  item;
      unsigned char  *buf_addr;
      void  *ret_len;
   }
   JpiItems [] =
   {
     { sizeof(PersonaServerUserName12), JPI$_USERNAME,
       &PersonaServerUserName12, 0 },
     { 0,0,0,0 }
   };

   int  status;
   IO_SB  IOsb;

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL,
                 "PersonaInit() PERSONA_MACRO\n");

   /* ensure that CMKRNL privilege is available */
   status = sys$setprv (1, &CmKrnlMask, 0, 0);
   sys$setprv (0, &CmKrnlMask, 0, 0);
   if (status == SS$_NOTALLPRIV) status = SS$_NOCMKRNL;
   if (VMSnok (status))
   {
      FaoToStdout ("%HTTPD-W-PERSONA, services MACRO\n-!&M\n", status);
      CliPersonaEnabled = CliPersonaRelaxed = false;
      return (status);
   }

   /* used for resuming the original (server account) username */
   status = sys$getjpiw (EfnWait, &Pid, 0, &JpiItems, &IOsb, 0, 0);
   if (VMSok (status)) status = IOsb.Status;
   if (VMSnok (status)) return (status);

   if (CliPersonaRelaxed) FaoToStdout ("%HTTPD-I-PERSONA, relaxed\n");

   /* set a flag indicating that this kludge is in use */
   PersonaMacro = true;

   return (SS$_NORMAL);
}

/*****************************************************************************/
/*
For PERSONA_MACRO kludge.
Change the JIB username to that supplied.  If 'UserName' is NULL then return to
the server username of the process.  Returns a VMS status value.
*/

int PersonaAssume (char *UserName)

{
   static $DESCRIPTOR (UserNameDsc, "");

   int  cnt, status;
   char  *cptr, *sptr;

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL,
                 "PersonaAssume() PERSONA_MACRO !&Z", UserName);

   status = sys$setprv (1, &CmKrnlMask, 0, 0);
   if (VMSnok (status)) return (status);

   if (!UserName)
   {
      status = MACRO_SET_USERNAME (PersonaServerUserName12);
      memset (PersonaUserName12, 0, sizeof(PersonaUserName12));
      PersonaUserName12Length = 0;
   }
   else
   {
      /* perform a basic check of the username string being passed */
      status = SS$_NORMAL;
      cptr = UserName;
      sptr = PersonaUserName12;
      for (cnt = 12; cnt; cnt--)
      {
         if (*cptr)
         {
            if (!isalnum(*cptr) && *cptr != '_' && *cptr != '$')
            {
               status = SS$_BADPARAM;
               break;
            }
            *sptr++ = TOUP(*cptr++);
         }
         else
         {
            if (!PersonaUserName12Length)
               PersonaUserName12Length = sptr - PersonaUserName12;
            *sptr++ = ' ';
         }
      }
      if (PersonaUserName12[0] == ' ' || *cptr) status = SS$_BADPARAM;
      if (!PersonaUserName12Length) PersonaUserName12Length = 12;

      if (VMSok (status)) status = MACRO_SET_USERNAME (PersonaUserName12);
   }

   sys$setprv (0, &CmKrnlMask, 0, 0);

   return (status);
} 

/*****************************************************************************/
/*
For PERSONA_MACRO kludge.
Just a stub for calling from AUTHCONFIG.C and DCL.C!
*/ 

int PersonaCache
(
char *UserName,
int PersonaHandle
)
{
   /*********/
   /* begin */
   /*********/

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL,
                 "PersonaCache() PERSONA_MACRO !&Z !UL",
                 UserName, PersonaHandle);

   return (0);
}

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

#endif /* PERSONA_MACRO  */

   /****************/
   /* PERSONA_STUB */
   /****************/

/*****************************************************************************/
/*
See note in module macro section.
*/

int PersonaStub (...)

{
   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL, "PersonaStub()");

   ErrorNoticed (NULL, 0, "feature not supported on this platform", FI_LI);

   return (SS$_ABORT);
}

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