/*****************************************************************************
/*
                                 HTAdmin.c

Administer the user authentication (HTA) and User List (HTL) Databases.
(This is primarly for HTA admin, but contains some lesser HTL support).
Change an authenticated username's SYSUAF password.


VERSION HISTORY
---------------
25-MAY-2021  MGD  bugfix; revert to ulong[2]s!
28-APR-2018  MGD  refactor Admin..() AST delivery
28-AUG-2012  MGD  bugfix; HTAdminModifyUser() use database name for digest
23-AUG-2009  MGD  WasdCss[] and some refinements
24-NOV-2007  MGD  force ACME on VMS V7.3 and later
30-MAY-2007  MGD  allow for CONNECT method (basically as a 'write' flag)
31-JUL-2005  MGD  refine data provided with HTA modifications
11-JUN-2005  MGD  HTAdminChangePasswordForm() allow site local instructions
23-MAR-2004  MGD  unbundle SYSUAF password change from HTAdminChangePassword()
                  into AuthVmsChangePassword() and incorporate ACME password
                  change using AuthAcmeChangePassword().
26-AUG-2003  MGD  service directory located authorization databases
01-MAR-2003  MGD  set html= change authentication header and footer
14-FEB-2003  MGD  check for form URL encoding (only that is acceptable)
05-FEB-2003  MGD  HTAdminPasswordChange() check for VMS group write,
                  bugfix; HTAdminPasswordChange() cache reset realm
26-JAN-2003  MGD  enable SYSPRV in HTAdminDatabaseSearch() and in
                  HTAdminDatabaseCreate()
27-APR-2002  MGD  use sys$setprv()
02-FEB-2002  MGD  rework POSTed query due to request body processing changes
04-AUG-2001  MGD  support module WATCHing
24-JUN-2001  MGD  bugfix; HtAdminBegin() authorization required rundown
15-FEB-2001  MGD  bugfix; HTAdminPasswordChange() call to FaoToOpcom()
22-DEC-2000  MGD  support HTL admin,
                  bugfix; cache purge keyword incorrect on menu
12-DEC-2000  MGD  username size now HTA-specific, different to '->RemoteUser'
                  (needed to support 'effective usernames' for X.509 authent)
28-MAR-2000  MGD  bugfix; SYSUAF password change username and password
                  both need to be upper case!
04-MAR-2000  MGD  use FaolToNet(), et.al.
05-FEB-2000  MGD  change HTA database type from ".HTA" to ".$HTA"
                  (due to potential conflict with Microsoft HTA technology)
03-JAN-2000  MGD  support ODS-2 and ODS-5 using ODS module
29-SEP-1999  MGD  'AuthPolicySysUafRelaxed' control password change
20-FEB-1999  MGD  password change refinements
16-JUL-1998  MGD  "https:" only flag,
                  extend HTAdminPasswordChange() to VMS (SYSUAF)
09-AUG-1997  MGD  message database
01-FEB-1997  MGD  new for HTTPd version 4
*/
/*****************************************************************************/

#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 <stdarg.h>
#include <stdio.h>
#include <string.h>

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

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

#define WASD_MODULE "HTADMIN"

/***********************/
/* module requirements */
/***********************/

#define DatabaseListSize 8
#define UserNameListSize 7

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

char  ErrorHTAdminAction [] = "Unknown action.",
      ErrorHTAdminDatabase [] = "authentication database.",
      ErrorHTAdminDatabaseEnter [] = "Enter a database name.",
      ErrorHTAdminDatabaseExists [] = "Database already exists.",
      ErrorHTAdminDatabaseNBG [] =
"Database name may contain only A..Z, 0..9, _ and - characters.",
      ErrorHTAdminDatabaseSelect[] = "Select a database.",
      ErrorHTAdminInsufficient [] = "Insufficient parameters.",
      ErrorHTAdminList [] = "authentication list.",
      ErrorHTAdminListEnter [] = "Enter a list name.",
      ErrorHTAdminListSelect[] = "Select from list.",
      ErrorHTAdminParameter [] = "Parameter out-of-range.",
      ErrorHTAdminPurgeCache [] = "purging authentication cache",
      ErrorHTAdminQuery [] = "Unknown query component.",
      ErrorHTAdminUserNotFound [] = "Username not found in database.",
      ErrorHTAdminUserEnter [] = "Enter a username.",
      ErrorHTAdminUserExists [] = "Username already exists.",
      ErrorHTAdminUserNBG [] =
"Username may contain only A..Z, 0..9, _ and - characters.",
      ErrorHTAdminUserSelect [] = "Select a username.",
      ErrorHTAdminVerify [] = "Password verification failure.";

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

extern BOOL  AuthConfigACME,
             AuthSysUafEnabled,
             AuthPolicySysUafRelaxed;

extern int  OpcomMessages;

extern int64  HttpdTime64;

extern unsigned long  SysPrvMask[];

extern char  *DayName[];

extern char  ErrorSanityCheck[],
             ServerHostPort[],
             SoftwareID[];

extern ACCOUNTING_STRUCT  *AccountingPtr;
extern CONFIG_STRUCT  Config;
extern MSG_STRUCT  Msgs;
extern WATCH_STRUCT  Watch;

/*****************************************************************************/
/*
CAUTION!!  This function is called directly by AdminBegin() when all three
call parameters are valid, and then again as an AST by BodyRead() when ONLY THE
FIRST PARAMETER IS VALID.  Buffer any additional parameters for this
contingency!
*/ 

HTAdminBegin (REQUEST_STRUCT *rqptr)

{
   static $DESCRIPTOR (LocationDatabaseFaoDsc, "!AZ!AZ?do=!AZ\0");
   static $DESCRIPTOR (LocationListFaoDsc, "!AZ!AZ!AZ!AZ\0");

   BOOL  ForceUpperCase;
   int  status;
   unsigned long  FaoVector [32];
   unsigned short  slen;
   char  *cptr, *sptr, *qptr, *zptr;
   char  Access [32],
         DoThis [256],
         AsDatabaseName [AUTH_MAX_REALM_GROUP_LENGTH+1],
         AsUserName [AUTH_MAX_HTA_USERNAME_LENGTH+1],
         Contact [AUTH_MAX_CONTACT_LENGTH+1],
         DatabaseName [AUTH_MAX_REALM_GROUP_LENGTH+1],
         Email [AUTH_MAX_EMAIL_LENGTH+1],
         Enabled [32],
         FieldName [32],
         FieldValue [256],
         FullName [AUTH_MAX_FULLNAME_LENGTH+1],
         HttpsOnly [32],
         Location [512],
         PasswordCurrent [AUTH_MAX_PASSWORD_LENGTH+1],
         PasswordGenerate [16],
         PasswordNew [AUTH_MAX_PASSWORD_LENGTH+1],
         PasswordVerify [AUTH_MAX_PASSWORD_LENGTH+1],
         UserName [AUTH_MAX_HTA_USERNAME_LENGTH+1];
   HTADMIN_TASK  *tkptr;
   $DESCRIPTOR (LocationDsc, Location);

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN, "HTAdminBegin()");

   if (!rqptr->RemoteUser[0])
   {
      rqptr->rqResponse.HttpStatus = 403;
      ErrorGeneral (rqptr, MsgFor(rqptr,MSG_AUTH_REQUIRED), FI_LI);
      AdminEnd (rqptr);
      return;
   }

   if (!rqptr->AdminTaskPtr)
      rqptr->AdminTaskPtr = VmGetHeap (rqptr, sizeof(ADMIN_TASK));

   if (!(tkptr = rqptr->HTAdminTaskPtr))
   {
      /* set up the task structure (only ever one per request!) */
      rqptr->HTAdminTaskPtr = tkptr = (HTADMIN_TASK*)
         VmGetHeap (rqptr, sizeof(HTADMIN_TASK));

      OdsStructInit (&tkptr->SearchOds, false);

      if (!rqptr->AccountingDone++)
         InstanceGblSecIncrLong (&AccountingPtr->DoServerAdminCount);
   }

   /* if there is a request body this will called be again as an AST */
   if (rqptr->rqHeader.Method == HTTP_METHOD_POST &&
       !rqptr->rqBody.DataPtr)
   {
      /* read all the request body (special case) then AST back */
      BodyReadBegin (rqptr, &HTAdminBegin, &BodyProcessReadAll);
      return;
   }

   /* must be after task allocation as function may be called as an AST */
   if (ERROR_REPORTED (rqptr))
   {
      /* previous error, cause threaded processing to unravel */
      AdminEnd (rqptr);
      return;
   }

   if (WATCHPNT(rqptr) &&
       WATCH_CATEGORY(WATCH_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_RESPONSE,
                 "HTADMIN !AZ", rqptr->rqHeader.PathInfoPtr);

   /**********************/
   /* parse query string */
   /**********************/

   DoThis[0] = Access[0] = AsDatabaseName[0] = DatabaseName[0] =
      AsUserName[0] = Contact[0] = Email[0] = Enabled[0] = HttpsOnly[0] =
      PasswordCurrent[0] = PasswordGenerate[0] = PasswordNew[0] =
      PasswordVerify[0] = UserName[0] = '\0';

   if (rqptr->rqHeader.ContentTypePtr &&
       !ConfigSameContentType (rqptr->rqHeader.ContentTypePtr,
                               "application/x-www-form-urlencoded", -1))
   {
      rqptr->rqResponse.HttpStatus = 400;
      ErrorGeneral (rqptr, MsgFor(rqptr,MSG_REQUEST_URL_FORM), FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   if (rqptr->rqHeader.Method == HTTP_METHOD_POST)
      qptr = rqptr->rqBody.DataPtr;
   else
   if (rqptr->rqHeader.QueryStringLength)
      qptr = rqptr->rqHeader.QueryStringPtr;
   else
      qptr = "";
   while (*qptr)
   {
      status = StringParseQuery (&qptr, FieldName, sizeof(FieldName),
                                        FieldValue, sizeof(FieldValue));
      if (VMSnok (status))
      {
         /* error occured */
         if (status == SS$_IVCHAR) rqptr->rqResponse.HttpStatus = 400;
         rqptr->rqResponse.ErrorTextPtr = "parsing query string";
         ErrorVmsStatus (rqptr, status, FI_LI);
         HTAdminEnd (rqptr);
         return;
      }

      /********************/
      /* get field values */
      /********************/

      ForceUpperCase = false;
      sptr = NULL;
      if (strsame (FieldName, "acc", -1))
         zptr = (sptr = Access) + sizeof(Access);
      else
      if (strsame (FieldName, "add", -1))
         zptr = (sptr = AsDatabaseName) + sizeof(AsDatabaseName);
      else
      if (ForceUpperCase = strsame (FieldName, "anm", -1))
         zptr = (sptr = AsUserName) + sizeof(AsUserName);
      else
      if (strsame (FieldName, "con", -1))
         zptr = (sptr = Contact) + sizeof(Contact);
      else
      if (strsame (FieldName, "cxr", -1))
      {
         /* 'cxr' can be generated from an UPD edit window */
         strzcpy (DoThis, "htledit", sizeof(DoThis));
         /* just fill any old field value, doesn't matter */
         zptr = (sptr = Contact) + sizeof(Contact);
      }
      else
      if (strsame (FieldName, "dat", -1))
         zptr = (sptr = DatabaseName) + sizeof(DatabaseName);
      else
      if (strsame (FieldName, "do", -1))
         zptr = (sptr = DoThis) + sizeof(DoThis);
      else
      if (strsame (FieldName, "eml", -1))
         zptr = (sptr = Email) + sizeof(Email);
      else
      if (strsame (FieldName, "ena", -1))
         zptr = (sptr = Enabled) + sizeof(Enabled);
      else
      if (strsame (FieldName, "fnm", -1))
         zptr = (sptr = FullName) + sizeof(FullName);
      else
      if (strsame (FieldName, "hts", -1))
         zptr = (sptr = HttpsOnly) + sizeof(HttpsOnly);
      else
      if (ForceUpperCase = strsame (FieldName, "pwc", -1))
         zptr = (sptr = PasswordCurrent) + sizeof(PasswordCurrent);
      else
      if (strsame (FieldName, "pwd", -1))
         zptr = (sptr = PasswordGenerate) + sizeof(PasswordGenerate);
      else
      if (strsame (FieldName, "pin", -1))
         zptr = (sptr = PasswordGenerate+3) + sizeof(PasswordGenerate)-3;
      else
      if (ForceUpperCase = strsame (FieldName, "pwn", -1))
         zptr = (sptr = PasswordNew) + sizeof(PasswordNew);
      else
      if (ForceUpperCase = strsame (FieldName, "pwv", -1))
         zptr = (sptr = PasswordVerify) + sizeof(PasswordVerify);
      else
      if (ForceUpperCase = strsame (FieldName, "unm", -1))
         zptr = (sptr = UserName) + sizeof(UserName);

      if (sptr)
      {
         cptr = FieldValue;
         if (ForceUpperCase)
            while (*cptr && sptr < zptr) *sptr++ = to_upper(*cptr++);
         else
            while (*cptr && sptr < zptr) *sptr++ = *cptr++;
         if (sptr >= zptr)
         {
            ErrorGeneralOverflow (rqptr, FI_LI);
            HTAdminEnd (rqptr);
            return;
         }
         *sptr = '\0';
      }
      else
      {
         rqptr->rqResponse.HttpStatus = 400;
         ErrorGeneral (rqptr, ErrorHTAdminQuery, FI_LI);
         HTAdminEnd (rqptr);
         return;
      }
   }

   /*****************/
   /* special cases */
   /*****************/

   if (strsame (rqptr->rqHeader.PathInfoPtr, ADMIN_REVISE_HTA,
                sizeof(ADMIN_REVISE_HTA)-1))
   {
      tkptr->HtListAdmin = false;
      tkptr->AdminDescriptionPtr = "Administer HTA Database";
   }
   else
   if (strsame (rqptr->rqHeader.PathInfoPtr, ADMIN_VS_REVISE_HTA,
                sizeof(ADMIN_VS_REVISE_HTA)-1))
   {
      tkptr->HtListAdmin = false;
      tkptr->AdminDescriptionPtr = "Administer Service HTA Database";
   }
   else
   if (strsame (rqptr->rqHeader.PathInfoPtr, ADMIN_REVISE_HTL,
                sizeof(ADMIN_REVISE_HTL)-1))
   {
      if (!DatabaseName[0])
      {
         cptr = rqptr->rqHeader.PathInfoPtr + sizeof(ADMIN_REVISE_HTL)-1;
         zptr = (sptr = DatabaseName) + sizeof(DatabaseName)-1;
         while (*cptr && sptr < zptr) *sptr++ = *cptr++;
         *sptr = '\0';
      }
      tkptr->HtListAdmin = true;
      tkptr->AdminDescriptionPtr = "Administer HTList";
   }
   else
   if (strsame (rqptr->rqHeader.PathInfoPtr, ADMIN_VS_REVISE_HTL,
                sizeof(ADMIN_VS_REVISE_HTL)-1))
   {
      if (!DatabaseName[0])
      {
         cptr = rqptr->rqHeader.PathInfoPtr + sizeof(ADMIN_VS_REVISE_HTL)-1;
         zptr = (sptr = DatabaseName) + sizeof(DatabaseName)-1;
         while (*cptr && sptr < zptr) *sptr++ = *cptr++;
         *sptr = '\0';
      }
      tkptr->HtListAdmin = true;
      tkptr->AdminDescriptionPtr = "Administer Service HTList";
   }
   else
   if (strsame (rqptr->rqHeader.RequestUriPtr, INTERNAL_PASSWORD_CHANGE,
                sizeof(INTERNAL_PASSWORD_CHANGE)-1))
   {
      if (rqptr->rqHeader.Method == HTTP_METHOD_POST)
          HTAdminChangePassword (rqptr, PasswordCurrent,
                                 PasswordNew, PasswordVerify);
      else  
         HTAdminChangePasswordForm (rqptr);
      return;
   }

   /****************************/
   /* administration functions */
   /****************************/

   status = SS$_NORMAL;
   Location[0] = '\0';

   /* NOTE: these are the upper-case versions of the action keywords */
   if (!strcmp (DoThis, "HTALISTB") ||
       !strcmp (DoThis, "HTALISTF") ||
       !strcmp (DoThis, "HTAACCESS") ||
       !strcmp (DoThis, "HTADELETE") ||
       !strcmp (DoThis, "HTARESET") ||
       !strcmp (DoThis, "HTLDELETE"))
   {
      if (!DatabaseName[0])
      {
         rqptr->rqResponse.HttpStatus = 400;
         ErrorGeneral (rqptr, ErrorHTAdminDatabaseSelect, FI_LI);
         HTAdminEnd (rqptr);
         return;
      }
      /* force action to lower-case so it's not detected here again! */
      for (cptr = DoThis; *cptr; cptr++) *cptr = to_lower(*cptr);
      status = sys$fao (&LocationDatabaseFaoDsc, &slen, &LocationDsc,
                        rqptr->rqHeader.PathInfoPtr, DatabaseName, DoThis);
   }
   else
   if (!strcmp (DoThis, "HTACREATE"))
   {
      if (!AsDatabaseName[0])
      {
         rqptr->rqResponse.HttpStatus = 400;
         ErrorGeneral (rqptr, ErrorHTAdminDatabaseEnter, FI_LI);
         HTAdminEnd (rqptr);
         return;
      }
      /* force action to lower-case so it's not detected here again! */
      for (cptr = DoThis; *cptr; cptr++) *cptr = to_lower(*cptr);
      status = sys$fao (&LocationDatabaseFaoDsc, &slen, &LocationDsc,
                        rqptr->rqHeader.PathInfoPtr, AsDatabaseName, DoThis);
   }
   else
   if (strsame (DoThis, "HTLCREATE", -1))
   {
      if (islower(DoThis[0]))
      {
         /* begin editing the file */
         UpdBegin (rqptr, AdminEnd);
         return;
      }
      if (!AsDatabaseName[0])
      {
         rqptr->rqResponse.HttpStatus = 400;
         ErrorGeneral (rqptr, ErrorHTAdminListEnter, FI_LI);
         HTAdminEnd (rqptr);
         return;
      }
      /* force action to lower-case so it's not detected here again! */
      for (cptr = DoThis; *cptr; cptr++) *cptr = to_lower(*cptr);
      status = sys$fao (&LocationListFaoDsc, &slen, &LocationDsc,
                        rqptr->rqHeader.PathInfoPtr, AsDatabaseName,
                        "?do=", DoThis);
   }
   else
   if (strsame (DoThis, "HTLEDIT", -1))
   {
      if (islower(DoThis[0]))
      {
         /* begin editing the file */
         UpdBegin (rqptr, AdminEnd);
         return;
      }
      if (!DatabaseName[0])
      {
         rqptr->rqResponse.HttpStatus = 400;
         ErrorGeneral (rqptr, ErrorHTAdminListSelect, FI_LI);
         HTAdminEnd (rqptr);
         return;
      }
      /* force action to lower-case so it's not detected here again! */
      for (cptr = DoThis; *cptr; cptr++) *cptr = to_lower(*cptr);
      status = sys$fao (&LocationListFaoDsc, &slen, &LocationDsc,
                        rqptr->rqHeader.PathInfoPtr, DatabaseName,
                        "?do=", DoThis);
   }
   else
   if (strsame (DoThis, "HTLLIST", -1))
   {
      if (!DatabaseName[0])
      {
         rqptr->rqResponse.HttpStatus = 400;
         ErrorGeneral (rqptr, ErrorHTAdminListSelect, FI_LI);
         HTAdminEnd (rqptr);
         return;
      }
      status = sys$fao (&LocationListFaoDsc, &slen, &LocationDsc,
                        rqptr->rqHeader.PathInfoPtr, DatabaseName, "", "");
   }
   if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI);

   if (Location[0])
   {
      /* initial redirection to get file name after path */
      ResponseLocation (rqptr, Location, slen);
      HTAdminEnd (rqptr);
      return;
   }

   zptr = (sptr = DatabaseName) + sizeof(DatabaseName);
   cptr = rqptr->rqHeader.PathInfoPtr + rqptr->rqHeader.PathInfoLength;
   while (cptr > rqptr->rqHeader.PathInfoPtr && *cptr != '/') cptr--;
   if (*cptr == '/')
   {
      cptr++;
      while (*cptr && *cptr != '/' && sptr < zptr) *sptr++ = to_upper(*cptr++);
      if (sptr >= zptr)
      {
         ErrorGeneralOverflow (rqptr, FI_LI);
         HTAdminEnd (rqptr);
         return;
      }
      *sptr = '\0';
   }
   else
      DatabaseName[0] = '\0';

   if (DatabaseName[0])
   {
      for (cptr = DatabaseName; *cptr; cptr++)
      {
         if (isalnum(*cptr) || *cptr == '_' || *cptr == '-') continue;
         rqptr->rqResponse.HttpStatus = 400;
         ErrorGeneral (rqptr, ErrorHTAdminDatabaseNBG, FI_LI);
         HTAdminEnd (rqptr);
         return;
      }
   }

   /* NOTE: these are the lower-case versions of the action keywords */
   for (cptr = DoThis; *cptr; cptr++) *cptr = to_lower(*cptr);
   if (tkptr->HtListAdmin)
   {
      /******************/
      /* HTL list admin */
      /******************/

      if (rqptr->rqHeader.Method == HTTP_METHOD_POST)
      {
         /***************/
         /* POST method */
         /***************/

         if (!strcmp (DoThis, "htldelete"))
            HTAdminDatabaseDelete (rqptr, DatabaseName);
         else
         {
            rqptr->rqResponse.HttpStatus = 400;
            ErrorGeneral (rqptr, ErrorHTAdminAction, FI_LI);
            HTAdminEnd (rqptr);
            return;
         }
      }
      else
      {
         /**************/
         /* GET method */
         /**************/

         if (!strcmp (DoThis, "htldelete"))
            HTAdminDatabaseDeleteForm (rqptr, DatabaseName);
         else
         if (!strcmp (DoThis, "purge"))
            HTAdminCachePurge (rqptr);
         else
         if (!DatabaseName[0])
            HTAdminDatabaseBegin (rqptr);
         else
         {
            rqptr->rqResponse.HttpStatus = 400;
            ErrorGeneral (rqptr, ErrorHTAdminAction, FI_LI);
            HTAdminEnd (rqptr);
            return;
         }
      }
   }
   else
   if (DoThis[0])
   {
      /**********************/
      /* HTA database admin */
      /**********************/

      if (UserName[0] || AsUserName[0])
      {
         if (!strcmp (DoThis, "add"))
            cptr = AsUserName;
         else
            cptr = UserName;
         for ( /* above */ ; *cptr; cptr++)
         {
            if (isalnum(*cptr) || *cptr == '_' || *cptr == '-') continue;
            rqptr->rqResponse.HttpStatus = 400;
            ErrorGeneral (rqptr, ErrorHTAdminUserNBG, FI_LI);
            HTAdminEnd (rqptr);
            return;
         }
      }

      if (!strcmp (DoThis, "view") ||
          !strcmp (DoThis, "modify") ||
          !strcmp (DoThis, "delete"))
      {
         if (!UserName[0])
         {
            rqptr->rqResponse.HttpStatus = 400;
            ErrorGeneral (rqptr, ErrorHTAdminUserSelect, FI_LI);
            HTAdminEnd (rqptr);
            return;
         }
      }
      else
      if (!strcmp (DoThis, "add"))
      {
         if (!AsUserName[0])
         {
            rqptr->rqResponse.HttpStatus = 400;
            ErrorGeneral (rqptr, ErrorHTAdminUserEnter, FI_LI);
            HTAdminEnd (rqptr);
            return;
         }
      }

      if (rqptr->rqHeader.Method == HTTP_METHOD_POST)
      {
         /***************/
         /* POST method */
         /***************/

         if (!strcmp (DoThis, "add"))
            HTAdminModifyUser (rqptr, true, DatabaseName,
                               AsUserName, FullName, Contact, Email, Enabled,
                               Access, HttpsOnly, PasswordNew, PasswordVerify,
                               PasswordGenerate);
         else
         if (!strcmp (DoThis, "modify"))
            HTAdminModifyUser (rqptr, false, DatabaseName,
                               UserName, FullName, Contact, Email, Enabled,
                               Access, HttpsOnly, PasswordNew, PasswordVerify,
                               PasswordGenerate);
         else
         if (!strcmp (DoThis, "htacreate"))
            HTAdminDatabaseCreate (rqptr, DatabaseName);
         else
         if (!strcmp (DoThis, "htadelete"))
            HTAdminDatabaseDelete (rqptr, DatabaseName);
         else
         if (!strcmp (DoThis, "htldelete"))
            HTAdminDatabaseDelete (rqptr, DatabaseName);
         else
         if (!strcmp (DoThis, "userdelete"))
            HTAdminUserDelete (rqptr, DatabaseName, UserName);
         else
         {
            rqptr->rqResponse.HttpStatus = 400;
            ErrorGeneral (rqptr, ErrorHTAdminAction, FI_LI);
            HTAdminEnd (rqptr);
            return;
         }
      }
      else
      {
         /**************/
         /* GET method */
         /**************/

         if (!strcmp (DoThis, "view"))
            HTAdminUserView (rqptr, DatabaseName, UserName);
         else
         if (!strcmp (DoThis, "modify"))
            HTAdminModifyUserForm (rqptr, false, DatabaseName, UserName);
         else
         if (!strcmp (DoThis, "add"))
            HTAdminModifyUserForm (rqptr, true, DatabaseName, AsUserName);
         else
         if (!strcmp (DoThis, "delete"))
            HTAdminUserDeleteForm (rqptr, DatabaseName, UserName);
         else
         if (!strcmp (DoThis, "purge"))
            HTAdminCachePurge (rqptr);
         else
         if (!strcmp (DoThis, "htalistb"))
         {
            tkptr->BriefList = true;
            HTAdminListUsersBegin (rqptr, DatabaseName);
         }
         else
         if (!strcmp (DoThis, "htalistf"))
         {
            tkptr->BriefList = false;
            HTAdminListUsersBegin (rqptr, DatabaseName);
         }
         else
         if (!strcmp (DoThis, "htaaccess"))
            HTAdminDatabaseUsersBegin (rqptr, DatabaseName);
         else
         if (!strcmp (DoThis, "htacreate"))
            HTAdminDatabaseCreateForm (rqptr, DatabaseName);
         else
         if (!strcmp (DoThis, "htadelete"))
            HTAdminDatabaseDeleteForm (rqptr, DatabaseName);
         else
         if (!strcmp (DoThis, "htldelete"))
            HTAdminDatabaseDeleteForm (rqptr, DatabaseName);
         else
         {
            rqptr->rqResponse.HttpStatus = 400;
            ErrorGeneral (rqptr, ErrorHTAdminAction, FI_LI);
            HTAdminEnd (rqptr);
            return;
         }
      }
   }
   else
   if (DatabaseName[0])
      HTAdminDatabaseUsersBegin (rqptr, DatabaseName);
   else
      HTAdminDatabaseBegin (rqptr);
}

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

HTAdminEnd (REQUEST_STRUCT *rqptr)

{
   int  status;
   HTADMIN_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN, "HTAdminEnd()");

   tkptr = rqptr->HTAdminTaskPtr;

   /* ensure parse internal data structures are released */
   OdsParseRelease (&tkptr->SearchOds);

   if (tkptr->FileOds.Fab.fab$w_ifi) OdsClose (&tkptr->FileOds, NULL, 0);

   rqptr->HTAdminTaskPtr = NULL;

   AdminEnd (rqptr);
}

/*****************************************************************************/
/*
Form for a user to change their own realm password.
*/

HTAdminChangePasswordForm (REQUEST_STRUCT *rqptr)

{
   static char  ResponseFao [] =
"!AZ\
<html>\n\
<head>\n\
!AZ\
!AZ\
!&@\
<title>!AZ</title>\n\
</head>\n\
!&@\
!&@\
<div class=\"wasd\">\n\
<h2>!AZ</h2>\n\
!&@\
<p><form method=\"POST\" action=\"!AZ\">\n\
<table class=\"ctgry\">\n\
<tr><th class=\"ctttl\">!AZ.\'!&;AZ\'@!AZ!&@</th></tr>\n\
<tr><td>\n\
!&@\
<table class=\"lftlft\">\n\
<tr><th class=\"targht\">!AZ:</th>\
<td><input type=\"password\" size=\"!UL\" \
maxlength=\"!UL\" name=\"pwc\"></td></tr>\n\
<tr><th class=\"targht\">!AZ:</th>\
<td><input type=\"password\" size=\"!UL\" \
maxlength=\"!UL\" name=\"pwn\"></td></tr>\n\
<tr><th class=\"targht\">!AZ:</th>\
<td><input type=\"password\" size=\"!UL\" \
maxlength=\"!UL\" name=\"pwv\"></td></tr>\n\
<tr><td colspan=\"2\"><input type=\"submit\" value=\" !AZ \">\n\
<input type=reset value=\" !AZ \"></td></tr>\n\
</table>\n\
</table>\n\
</form>\n\
!&@\
</div>\n\
</body>\n\
</html>\n";

   int  cnt, status;
   unsigned long  *vecptr;
   unsigned long  FaoVector [64];
   char  *cptr, *SitePtr;
   char  Scratch [1024];

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN,
                 "HTAdminChangePasswordForm()");

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   ResponseHeader200 (rqptr, "text/html", NULL);

   strzcpy (cptr = Scratch,
            MsgFor(rqptr,MSG_HTADMIN_PWD_CHANGE),
            sizeof(Scratch));

   /* let's see if there are any site local instructions */
   for (cnt = 7; cnt && *cptr; cnt--)
   {
      while (*cptr && *cptr != '|') cptr++;
      if (*cptr) cptr++;
   }
   SitePtr = cptr;
   cptr = Scratch;

   vecptr = FaoVector;

   *vecptr++ = WASD_DOCTYPE;
   *vecptr++ = HtmlMetaInfo (rqptr, NULL);
   *vecptr++ = AdminWasdCss ();
   if (rqptr->rqPathSet.StyleSheetPtr)
   {
      *vecptr++ = "<link rel=\"stylesheet\" type=\"text/css\" href=\"!AZ\">\n";
      *vecptr++ = rqptr->rqPathSet.StyleSheetPtr;
   }
   else
      *vecptr++ = "";

   /* "Change Authentication" (title) */
   if (*cptr)
      *vecptr++ = cptr;
   else
      *vecptr++ = "Change Authentication";

   if (rqptr->rqPathSet.HtmlBodyTagPtr)
   {
      if (rqptr->rqPathSet.HtmlBodyTagPtr[0] == '<')
         *vecptr++ = "!AZ\n";
      else
         *vecptr++ = "<body!&+AZ>\n";
      *vecptr++ = rqptr->rqPathSet.HtmlBodyTagPtr;
   }
   else
   if (rqptr->ServicePtr->BodyTag[0])
   {
      *vecptr++ = "!AZ\n";
      *vecptr++ = rqptr->ServicePtr->BodyTag;
   }
   else
   {
      *vecptr++ = "!AZ\n";
      *vecptr++ = REPORT_BODY_TAG;
   }

   if (rqptr->rqPathSet.HtmlHeaderPtr ||
       rqptr->rqPathSet.HtmlHeaderTagPtr)
   {
      if (rqptr->rqPathSet.HtmlHeaderTagPtr &&
          rqptr->rqPathSet.HtmlHeaderTagPtr[0] == '<')
      {
         *vecptr++ = "!AZ\n!&@";
         *vecptr++ = rqptr->rqPathSet.HtmlHeaderTagPtr;
      }
      else
      {
         *vecptr++ = "<table class=\"rghtlft\"><tr><td!&+AZ>\n!&@";
         *vecptr++ = rqptr->rqPathSet.HtmlHeaderTagPtr;
      }
      *vecptr++ = "!AZ\n<p>";
      *vecptr++ = rqptr->rqPathSet.HtmlHeaderPtr;
   }
   else
      *vecptr++ = "";

   /* "Change Authentication" (heading) */
   if (*cptr)
      *vecptr++ = cptr;
   else
      *vecptr++ = "Change Authentication";

   /* scan to "(password is expired)" */
   while (*cptr && *cptr != '|') cptr++;
   if (*cptr) *cptr++ = '\0';

   if (rqptr->rqPathSet.HtmlHeaderPtr ||
       rqptr->rqPathSet.HtmlHeaderTagPtr)
      *vecptr++ = "</td></tr></table>\n";
   else
      *vecptr++ = "";

   *vecptr++ = rqptr->rqHeader.PathInfoPtr;
   *vecptr++ = rqptr->RemoteUser;
   *vecptr++ = rqptr->rqAuth.RealmDescrPtr;
   /* the user is dealing with the host/port they specified */
   *vecptr++ = rqptr->ServicePtr->ServerHostPort;

   if (rqptr->rqAuth.SysUafPwdExpired)
   {
      *vecptr++ = "&nbsp;<i>!AZ</i>";
      if (*cptr)
         *vecptr++ = cptr;
      else
         *vecptr++ = "(password is expired)";
   }
   else
      *vecptr++ = "";

   if (*SitePtr)
   {
      *vecptr++ =
"<table class=\"rghtlft\">\n\
<tr><td>!AZ</td></tr>\n\
</table>\n";
      *vecptr++ = SitePtr;
   }
   else
      *vecptr++ = "";

   /* scan to "Current" */
   while (*cptr && *cptr != '|') cptr++;
   if (*cptr) *cptr++ = '\0';

   /* "Current" */
   if (*cptr)
      *vecptr++ = cptr;
   else
      *vecptr++ = "Current";

   /* skip to "New" */
   while (*cptr && *cptr != '|') cptr++;
   if (*cptr) *cptr++ = '\0';

   *vecptr++ = AUTH_MAX_PASSWORD_LENGTH;
   *vecptr++ = AUTH_MAX_PASSWORD_LENGTH;

   /* "New" */
   if (*cptr)
      *vecptr++ = cptr;
   else
      *vecptr++ = "New";

   /* skip to "Verify" */
   while (*cptr && *cptr != '|') cptr++;
   if (*cptr) *cptr++ = '\0';

   *vecptr++ = AUTH_MAX_PASSWORD_LENGTH;
   *vecptr++ = AUTH_MAX_PASSWORD_LENGTH;

   /* "Verify" */
   if (*cptr)
      *vecptr++ = cptr;
   else
      *vecptr++ = "Verify";

   /* skip to "Change" */
   while (*cptr && *cptr != '|') cptr++;
   if (*cptr) *cptr++ = '\0';

   *vecptr++ = AUTH_MAX_PASSWORD_LENGTH;
   *vecptr++ = AUTH_MAX_PASSWORD_LENGTH;

   /* "Change" */
   if (*cptr)
      *vecptr++ = cptr;
   else
      *vecptr++ = "Change";

   /* skip to "Reset" */
   while (*cptr && *cptr != '|') cptr++;
   if (*cptr) *cptr++ = '\0';

   /* "Reset" */
   if (*cptr)
      *vecptr++ = cptr;
   else
      *vecptr++ = "Reset";

   /* skip to site local instructions (if any) */
   while (*cptr && *cptr != '|') cptr++;
   if (*cptr) *cptr++ = '\0';

   if (rqptr->rqPathSet.HtmlFooterPtr ||
       rqptr->rqPathSet.HtmlFooterTagPtr)
   {
      if (rqptr->rqPathSet.HtmlFooterTagPtr &&
          rqptr->rqPathSet.HtmlFooterTagPtr[0] == '<')
         *vecptr++ = "<p>!AZ\n!&@";
      else
         *vecptr++ = "<p><table class=\"rghtlft\"><tr><td!&+AZ>\n!&@";
      *vecptr++ = rqptr->rqPathSet.HtmlFooterTagPtr;
      *vecptr++ = "!AZ\n</td></tr></table>";
      *vecptr++ = rqptr->rqPathSet.HtmlFooterPtr;
   }
   else
      *vecptr++ = "";

   status = FaolToNet (rqptr, ResponseFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI);

   SysDclAst (&HTAdminEnd, rqptr);
}

/*****************************************************************************/
/*
Changes a user's password in the on-disk HTA database or the SYSUAF database
(if realm is VMS).  User determined by 'rqptr->RemoteUser', database by
'rqptr->rqAuth.RealmPtr'.  The authorization cache is then searched for all
entries for the username and that realm and the password reset forcing it to be
revalidated the next time it is accessed. The form this request is generated by
comes from AdminPasswordChangeForm().

If the realm is VMS there _must_ be a group, as well as the realm associated
with change path.  This will normally be a site-chosen VMS rights identifier
that allows that particular account to modify it's password in such a manner. 
NOTE: The SYSUAF password change facility makes minor integrity checks on the
supplied password (length and characters contained) but does not enforce any
local password policy that may be in place.

The password change facility is in the HTADMIN.C module largely for historical
reasons.  Thisfunction contains the code for the $HTA database change but
SYSUAF and ACME password change is farmed out to fucntions in the respective
modules.
*/

HTAdminChangePassword
(
REQUEST_STRUCT *rqptr,
char *PasswordCurrent,
char *PasswordNew,
char *PasswordVerify
)
{
   int  status;
   unsigned long  HashedPwd [2];
   unsigned long  *BinTimePtr;
   unsigned char  A1DigestLoCase [16],
                  A1DigestUpCase [16];
   AUTH_HTAREC AuthHtRecord;
   AUTH_CREC  AuthCacheRecord;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN, "HTAdminPasswordChange()");

   if (!(PasswordCurrent[0] && PasswordNew[0] && PasswordVerify[0]))
   {
      rqptr->rqResponse.HttpStatus = 403;
      ErrorGeneral (rqptr, MsgFor(rqptr,MSG_HTADMIN_PWD_INCOMPLETE), FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   if (!strsame (PasswordNew, PasswordVerify, -1))
   {
      rqptr->rqResponse.HttpStatus = 403;
      ErrorGeneral (rqptr, MsgFor(rqptr,MSG_HTADMIN_PWD_VERIFY), FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   if (strsame (PasswordCurrent, PasswordNew, -1))
   {
      rqptr->rqResponse.HttpStatus = 403;
      ErrorGeneral (rqptr, MsgFor(rqptr,MSG_HTADMIN_PWD_IDENTICAL), FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   if (strlen (PasswordNew) < AUTH_MIN_PASSWORD)
   {
      /* password's too short */
      rqptr->rqResponse.HttpStatus = 403;
      ErrorGeneral (rqptr, MsgFor(rqptr,MSG_HTADMIN_PWD_ERROR), FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   /* check the correct current password has been supplied */
   if (!strsame (PasswordCurrent, rqptr->RemoteUserPassword, -1))
   {
      rqptr->rqResponse.HttpStatus = 403;
      ErrorGeneral (rqptr, MsgFor(rqptr,MSG_HTADMIN_PWD_INCORRECT), FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   if (rqptr->rqAuth.SourceRealm == AUTH_SOURCE_VMS ||
       rqptr->rqAuth.SourceRealm == AUTH_SOURCE_ID ||
       rqptr->rqAuth.SourceRealm == AUTH_SOURCE_WASD_ID)
   {
      /*********************/
      /* update the SYSUAF */
      /*********************/

      if (!AuthSysUafEnabled)
      {
         rqptr->rqResponse.HttpStatus = 403;
         ErrorGeneral (rqptr, MsgFor(rqptr,MSG_GENERAL_DISABLED), FI_LI);
         HTAdminChangePasswordEnd (rqptr);
         return;
      }

      if (AuthConfigACME)
         AuthAcmeChangePassword (rqptr, PasswordCurrent, PasswordNew);
      else
         AuthVmsChangePassword (rqptr, PasswordNew);

      return;
   }

   if (rqptr->rqAuth.SourceRealm == AUTH_SOURCE_ACME)
   {
      /*******************/
      /* update via ACME */
      /*******************/

      if (!AuthConfigACME)
      {
         rqptr->rqResponse.HttpStatus = 403;
         ErrorGeneral (rqptr, MsgFor(rqptr,MSG_GENERAL_DISABLED), FI_LI);
         HTAdminChangePasswordEnd (rqptr);
         return;
      }

      AuthAcmeChangePassword (rqptr, PasswordCurrent, PasswordNew);
      return;
   }

   /***************************/
   /* update the HTA database */
   /***************************/

   if (WATCHING (rqptr, WATCH_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_RESPONSE, "CHANGE HTA password");

   if (VMSnok (status =
       AuthGenerateHashPassword (rqptr->RemoteUser, PasswordNew,
                                 &HashedPwd)))
   {
      rqptr->rqResponse.ErrorTextPtr = MsgFor(rqptr,MSG_HTADMIN_PWD_ERROR);
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   if (VMSnok (status =
       AuthGenerateDigestPassword (rqptr->rqAuth.RealmDescrPtr,
                                   rqptr->RemoteUser,
                                   PasswordNew, &A1DigestLoCase,
                                   &A1DigestUpCase)))
   {
      rqptr->rqResponse.ErrorTextPtr = MsgFor(rqptr,MSG_HTADMIN_PWD_ERROR);
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   /* look for the record, leave the database file open if found */
   status = AuthHtDatabaseAccess (rqptr, true,
                                  rqptr->rqAuth.RealmPtr,
                                  rqptr->RemoteUser,
                                  &AuthHtRecord, NULL, NULL);
   if (status == RMS$_EOF)
   {
      rqptr->rqResponse.HttpStatus = 404;
      rqptr->rqResponse.ErrorTextPtr =
         MsgFor(rqptr,MSG_HTADMIN_PWD_NOT_FOUND);
      HTAdminEnd (rqptr);
      return;
   }
   if (VMSnok (status))
   {
      rqptr->rqResponse.ErrorTextPtr = MsgFor(rqptr,MSG_HTADMIN_DATABASE);
      rqptr->rqResponse.ErrorOtherTextPtr = rqptr->rqAuth.RealmPtr;
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   memcpy (&AuthHtRecord.HashedPwd, &HashedPwd, 8);
   memcpy (&AuthHtRecord.A1DigestLoCase, &A1DigestLoCase, 16);
   memcpy (&AuthHtRecord.A1DigestUpCase, &A1DigestUpCase, 16);
   BinTimePtr = &rqptr->rqTime.BeginTime64;
   AuthHtRecord.LastChangeTime64[0] = BinTimePtr[0];
   AuthHtRecord.LastChangeTime64[1] = BinTimePtr[1];
   AuthHtRecord.ChangeCount++;

   /* update the record, close the database file */
   status = AuthHtDatabaseAccess (NULL, false, NULL, NULL,
                                  NULL, NULL, &AuthHtRecord);
   if (VMSnok (status))
   {
      rqptr->rqResponse.ErrorTextPtr = MsgFor(rqptr,MSG_HTADMIN_DATABASE);
      rqptr->rqResponse.ErrorOtherTextPtr = rqptr->rqAuth.RealmPtr;
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   HTAdminChangePasswordEnd (rqptr);
}

/*****************************************************************************/
/*
This can be called from HTAdminChangePassword() and AuthAcmeChangePassword(). 
*/

HTAdminChangePasswordEnd (REQUEST_STRUCT *rqptr)

{
   int  status;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN, "HTAdminChangePasswordEnd()");

   if (rqptr->rqResponse.ErrorReportPtr)
   {
      /* an error has been reported at some stage */
      SysDclAst (&HTAdminEnd, rqptr);
      return;
   }

   /* report this to the log */
   FaoToStdout (
"%HTTPD-I-PASSWORD, !20%D, modified\n\
-PASSWORD-I-SERVICE, !AZ//!AZ\n\
-PASSWORD-I-CLIENT, !AZ\n\
-PASSWORD-I-USERNAME, \"!AZ\" in \"!AZ\"\n",
      0, rqptr->ServicePtr->RequestSchemeNamePtr,
      rqptr->ServicePtr->ServerHostPort, ClientHostString(rqptr),
      rqptr->RemoteUser, rqptr->rqAuth.RealmDescrPtr);

   /* and to the operator log if so enabled */
   if (OpcomMessages & OPCOM_AUTHORIZATION)
      FaoToOpcom (
"%HTTPD-I-PASSWORD, modified\r\n\
-PASSWORD-I-SERVICE, !AZ//!AZ\r\n\
-PASSWORD-I-CLIENT, !AZ\r\n\
-PASSWORD-I-USERNAME, \"!AZ\" in \"!AZ\"",
      rqptr->ServicePtr->RequestSchemeNamePtr,
      rqptr->ServicePtr->ServerHostPort, ClientHostString(rqptr),
      rqptr->RemoteUser, rqptr->rqAuth.RealmDescrPtr);

   status = AuthCacheReset (rqptr, rqptr->rqAuth.RealmPtr, rqptr->RemoteUser);
   if (VMSnok (status)) return;

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   /* the user is dealing with the host/port they specified, not the base */
   ReportSuccess (rqptr, MsgFor(rqptr,MSG_HTADMIN_PWD_BEEN_CHANGED),
                  "!AZ.\'!&;AZ\'@!AZ", rqptr->RemoteUser,
                  rqptr->rqAuth.RealmDescrPtr,
                  rqptr->ServicePtr->ServerHostPort);

   SysDclAst (&HTAdminEnd, rqptr);
}

/*****************************************************************************/
/*
Begin a page providing a list of HTA Databases in a form for administering
them.  Set up search for authentication Database files.
*/

HTAdminDatabaseBegin (REQUEST_STRUCT *rqptr)

{
   static char  ResponseFao [] =
"<form method=\"GET\" action=\"!AZ\">\n\
<table class=\"ctgry\">\n\
<tr><th class=\"ctttl\">!AZ</th></tr>\n\
<tr><td>\n\
<table class=\"rghtlft\">\n\
<tr><td>\n\
<select size=\"!UL\" name=\"dat\">\n";

   int  status;
   HTADMIN_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN, "HTAdminDatabaseBegin()");

   tkptr = rqptr->HTAdminTaskPtr;

   OdsParse (&tkptr->SearchOds,
             rqptr->ParseOds.ExpFileName, rqptr->ParseOds.ExpFileNameLength,
             "*", 1, 0, NULL, rqptr);

   if (VMSnok (status = tkptr->SearchOds.Fab.fab$l_sts))
   {
      rqptr->rqResponse.ErrorTextPtr = rqptr->rqHeader.PathInfoPtr;
      rqptr->rqResponse.ErrorOtherTextPtr = rqptr->ParseOds.ExpFileName;
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   tkptr->FileCount = 0;

   HTAdminPageTitle (rqptr, tkptr->AdminDescriptionPtr, ResponseFao, 
                     rqptr->ScriptName,
                     tkptr->HtListAdmin ? "List" : "Database",
                     DatabaseListSize);

   SysDclAst (&HTAdminDatabaseSearch, rqptr);
}

/*****************************************************************************/
/*
(AST) function to invoke another sys$search() call when listing authentication
Databases.
*/ 

HTAdminDatabaseSearch (REQUEST_STRUCT *rqptr)

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN,
                 "HTAdminDatabaseSearch() !&F", &HTAdminDatabaseSearch);

   /* turn on SYSPRV to allow the directory to be searched */
   sys$setprv (1, &SysPrvMask, 0, 0);

   OdsSearch (&rqptr->HTAdminTaskPtr->SearchOds,
              &HTAdminDatabaseSearchAst, rqptr);

   sys$setprv (0, &SysPrvMask, 0, 0);
}

/*****************************************************************************/
/*
AST completion routine called each time sys$search() completes.  It will 
either point to another file name found or have "no more files found" status 
(or an error!).
*/ 

HTAdminDatabaseSearchAst (REQUEST_STRUCT *rqptr)

{
   int  status;
   HTADMIN_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN,
                 "HTAdminDatabaseSearchAst() !&F sts:!&X stv:!&X",
                 &HTAdminDatabaseSearchAst,
                 rqptr->HTAdminTaskPtr->SearchOds.Fab.fab$l_sts,
                 rqptr->HTAdminTaskPtr->SearchOds.Fab.fab$l_stv);

   tkptr = rqptr->HTAdminTaskPtr;

   if (VMSnok (status = tkptr->SearchOds.Fab.fab$l_sts))
   {
      if (status == RMS$_FNF || status == RMS$_NMF)
      {
         /* end of search */
         tkptr->SearchOds.ParseInUse = false;
         HTAdminDatabaseEnd (rqptr);
         return;
      }

      /* sys$search() error */
      rqptr->rqResponse.ErrorTextPtr = MapVmsPath (tkptr->AuthFileSpec, rqptr);
      rqptr->rqResponse.ErrorOtherTextPtr = tkptr->AuthFileSpec;
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   /* terminate following the last character in the version number */
   tkptr->SearchOds.NamVersionPtr[tkptr->SearchOds.NamVersionLength] = '\0';

   tkptr->FileCount++;

   status = FaoToNet (rqptr, "<option value=\"!#&;AZ\">!#&;AZ\n",
                      tkptr->SearchOds.NamNameLength,
                      tkptr->SearchOds.NamNamePtr,
                      tkptr->SearchOds.NamNameLength,
                      tkptr->SearchOds.NamNamePtr);
   if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI);

   SysDclAst (&HTAdminDatabaseSearch, rqptr);
}

/*****************************************************************************/
/*
End authentication Database file search.  Conclude form's HTML.
*/

HTAdminDatabaseEnd (REQUEST_STRUCT *rqptr)

{
   static char  HtaEndPageFao [] =
"</select>\n\
</td><td>\n\
<input type=\"radio\" name=\"do\" value=\"HTAACCESS\" checked>access<sup>1</sup>\n\
<br><input type=\"radio\" name=\"do\" value=\"HTALISTB\">list/brief<sup>1</sup>\n\
<br><input type=\"radio\" name=\"do\" value=\"HTALISTF\">list/full<sup>1</sup>\n\
<br><input type=\"radio\" name=\"do\" value=\"HTACREATE\">create<sup>2</sup>\n\
<br><input type=\"radio\" name=\"do\" value=\"HTADELETE\">delete<sup>1</sup>\n\
<br><input type=\"radio\" name=\"do\" value=\"purge\">purge cache\n\
<p><input type=\"submit\" value=\" Do \">\n\
<input type=reset value=\" Reset \">\n\
</td></tr>\n\
<tr><td colspan=\"2\">\n\
<sup>1.</sup> !AZ\n\
<br><sup>2.</sup> enter name <input type=\"text\" name=\"add\" size=\"20\">\n\
</td></tr>\n\
</table>\n\
\
</tr>\n\
</table>\n\
</form>\n\
\
</div>\n\
</body>\n\
</html>\n";

   static char  HtlEndPageFao [] =
"</select>\n\
</td><td>\n\
<input type=\"radio\" name=\"do\" value=\"HTLEDIT\" checked>edit<sup>1</sup>\n\
<br><input type=\"radio\" name=\"do\" value=\"HTLLIST\">list<sup>1</sup>\n\
<br><input type=\"radio\" name=\"do\" value=\"HTLCREATE\">create<sup>2</sup>\n\
<br><input type=\"radio\" name=\"do\" value=\"HTLDELETE\">delete<sup>1</sup>\n\
<br><input type=\"radio\" name=\"do\" value=\"purge\">purge cache\n\
<p><input type=\"submit\" value=\" Do \">\n\
<input type=reset value=\" Reset \">\n\
</td></tr>\n\
<tr><td colspan=\"2\">\n\
<sup>1.</sup> !AZ\n\
<br><sup>2.</sup> enter name <input type=\"text\" name=\"add\" size=\"20\">\n\
</td></tr>\n\
</table>\n\
\
</tr>\n\
</table>\n\
</form>\n\
\
</div>\n\
</body>\n\
</html>\n";

   int  status;
   unsigned long  *vecptr;
   unsigned long  FaoVector [32];
   HTADMIN_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN, "HTAdminDatabaseEnd()");

   tkptr = rqptr->HTAdminTaskPtr;

   vecptr = FaoVector;
   if (tkptr->FileCount)
      *vecptr++ = "select from list";
   else
      *vecptr++ = "<i>none available</i>";

   if (tkptr->HtListAdmin)
      status = FaolToNet (rqptr, HtlEndPageFao, &FaoVector);
   else
      status = FaolToNet (rqptr, HtaEndPageFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI);

   SysDclAst (&HTAdminEnd, rqptr);
}

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

HTAdminDatabaseUsersBegin
(
REQUEST_STRUCT *rqptr,
char *DatabaseName
)
{
   static char  ResponseFao [] =
"<form method=\"GET\" action=\"!AZ\">\n\
<table class=\"ctgry\">\n\
<tr><th class=\"ctttl\">Users in !AZ</th></tr>\n\
<tr><td>\n\
<table class=\"lftlft\">\n\
<tr><td>\n\
<select size=\"!UL\" name=\"unm\">\n";

   int  status;
   HTADMIN_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN,
                 "HTAdminDatabaseUsersBegin() !&Z", DatabaseName);

   tkptr = rqptr->HTAdminTaskPtr;

   if (VMSnok (HTAdminOpenDatabaseForRead (rqptr, DatabaseName))) return;

   /**************/
   /* begin page */
   /**************/

   tkptr->RecordCount = tkptr->UserCount = 0;

   HTAdminPageTitle (rqptr, tkptr->AdminDescriptionPtr, ResponseFao, 
                     rqptr->rqHeader.PathInfoPtr,
                     DatabaseName,
                     UserNameListSize);

   SysDclAst (&HTAdminDatabaseUsersNext, rqptr);
}

/*****************************************************************************/
/*
Queue a read of the next record from the file.  When the read completes call 
HTAdminDatabaseUsersNextAst() function.
*/ 

HTAdminDatabaseUsersNext (REQUEST_STRUCT *rqptr)

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN,
                 "HTAdminDatabaseUsersNext() !&F", &HTAdminDatabaseUsersNext);

   /* asynchronous get service */
   rqptr->HTAdminTaskPtr->FileOds.Rab.rab$l_rop |= RAB$M_ASY;
   sys$get (&rqptr->HTAdminTaskPtr->FileOds.Rab,
            &HTAdminDatabaseUsersNextAst,
            &HTAdminDatabaseUsersNextAst);
}

/*****************************************************************************/
/*
A user record has been read from the authentication Database.
*/ 

HTAdminDatabaseUsersNextAst (struct RAB *RabPtr)

{
   int  cnt, status;
   char  *cptr, *sptr;
   REQUEST_STRUCT  *rqptr;
   char  Buffer [128];
   HTADMIN_TASK  *tkptr;

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

   rqptr = RabPtr->rab$l_ctx;

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN,
                 "HTAdminDatabaseUsersNextAst() !&F sts:!&X stv:!&X !UL",
                 &HTAdminDatabaseUsersNextAst,
                 RabPtr->rab$l_sts, RabPtr->rab$l_stv, RabPtr->rab$w_rsz);

   tkptr = rqptr->HTAdminTaskPtr;

   if (VMSnok (tkptr->FileOds.Rab.rab$l_sts))
   {
      if (tkptr->FileOds.Rab.rab$l_sts == RMS$_EOF)
      {
         OdsClose (&tkptr->FileOds, NULL, 0);
         HTAdminDatabaseUsersList (rqptr);
         return;
      }

      rqptr->rqResponse.ErrorTextPtr = MapVmsPath (tkptr->AuthFileName, rqptr);
      rqptr->rqResponse.ErrorOtherTextPtr = tkptr->AuthFileName;
      ErrorVmsStatus (rqptr, tkptr->FileOds.Rab.rab$l_sts, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   /* check the version of the authorization database */
   if (tkptr->AuthHtRecord.DatabaseVersion &&
       tkptr->AuthHtRecord.DatabaseVersion != AUTH_HTA_VERSION)
   {
      rqptr->rqResponse.ErrorTextPtr = MapVmsPath (tkptr->AuthFileName, rqptr);
      rqptr->rqResponse.ErrorOtherTextPtr = tkptr->AuthFileName;
      ErrorVmsStatus (rqptr, SS$_INCOMPAT & 0xfffffffe, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   /* if the record has been removed (by zeroing) then ignore */
   if (!tkptr->AuthHtRecord.UserNameLength)
   {
      HTAdminDatabaseUsersNext (rqptr);
      return;
   }

   tkptr->UserCount++;

   if ((tkptr->UserCount * sizeof(tkptr->AuthHtRecord.UserName)) >
       tkptr->UserListLength)
   {
      /* need more (or some) list space */
      tkptr->UserListLength += 32 * sizeof(tkptr->AuthHtRecord.UserName);
      tkptr->UserListPtr = VmReallocHeap (rqptr, tkptr->UserListPtr,
                                          tkptr->UserListLength, FI_LI);
   }

   /* copy username including name terminating null */
   memcpy (tkptr->UserListPtr +
           ((tkptr->UserCount - 1) * sizeof(tkptr->AuthHtRecord.UserName)),
           tkptr->AuthHtRecord.UserName,
           sizeof(tkptr->AuthHtRecord.UserName));

   HTAdminDatabaseUsersNext (rqptr);
}

/*****************************************************************************/
/*
Humble bubble sort I'm afraid :^(  Gives the illusion that the database is
ordered (apart from that of entry sequence :^), although does provide the
advantage of viewing an ordered list.  It formats them as part of HTML
selection list.
*/ 

HTAdminDatabaseUsersList (REQUEST_STRUCT *rqptr)

{
   int  idx1, idx2, size, status,
        UserCount;
   char  *cptr1, *cptr2;
   HTADMIN_TASK  *tkptr;
   char UserName [AUTH_MAX_HTA_USERNAME_LENGTH+1];

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN,
                 "HTAdminDatabaseUsersList() !UL !UL",
                 rqptr->HTAdminTaskPtr->UserListCount,
                 rqptr->HTAdminTaskPtr->UserCount);

   tkptr = rqptr->HTAdminTaskPtr;

   size = AUTH_MAX_HTA_USERNAME_LENGTH+1;

   if (!tkptr->UserCount)
   {
      HTAdminDatabaseUsersEnd (rqptr);
      return;
   }

   /********/
   /* sort */
   /********/

   for (idx1 = 0; idx1 < tkptr->UserCount-1; idx1++)
   {
      for (idx2 = idx1+1; idx2 < tkptr->UserCount; idx2++)
      {
          cptr1 = tkptr->UserListPtr + (idx1 * size);
          cptr2 = tkptr->UserListPtr + (idx2 * size);
          if (strcmp (cptr1, cptr2) <= 0) continue;
          memcpy (UserName, cptr1, size);
          memcpy (cptr1, cptr2, size);
          memcpy (cptr2, UserName, size);
      }
   }

   /*************************/
   /* create selection list */
   /*************************/

   cptr1 = tkptr->UserListPtr;
   for (UserCount = 0; UserCount < tkptr->UserCount; UserCount++)
   {
      status = FaoToNet (rqptr, "<option value=\"!&;AZ\">!&;AZ\n",
                         cptr1, cptr1);
      if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI);
      cptr1 += AUTH_MAX_HTA_USERNAME_LENGTH+1;
   }

   HTAdminDatabaseUsersEnd (rqptr);
}

/*****************************************************************************/
/*
End user names in authentication Database.
*/

HTAdminDatabaseUsersEnd (REQUEST_STRUCT *rqptr)

{
   static char  EndPageFao [] =
"</select>\n\
</td><td>\n\
<input type=\"radio\" name=\"do\" value=\"view\" checked>view<sup>1</sup>\n\
<br><input type=\"radio\" name=\"do\" value=\"modify\">modify<sup>1</sup>\n\
<br><input type=\"radio\" name=\"do\" value=\"add\">add<sup>2</sup>\n\
<br><input type=\"radio\" name=\"do\" value=\"delete\">delete<sup>1</sup>\n\
<br><input type=\"radio\" name=\"do\" value=\"purge\">purge cache\n\
<p><input type=\"submit\" value=\" Do \">\n\
<input type=reset value=\" Reset \">\n\
</td></tr>\n\
<tr><td colspan=\"2\">\n\
<sup>1.</sup> !AZ\n\
<br><sup>2.</sup> enter name <input type=\"text\" name=\"add\" size=\"20\">\n\
</td></tr>\n\
</table>\n\
\
</tr>\n\
</table>\n\
</form>\n\
\
</div>\n\
</body>\n\
</html>\n";

   int  status;
   unsigned long  *vecptr;
   unsigned long  FaoVector [32];
   HTADMIN_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN, "HTAdminDatabaseUsersEnd()");

   tkptr = rqptr->HTAdminTaskPtr;

   vecptr = FaoVector;
   if (tkptr->UserCount)
      *vecptr++ = "select from list";
   else
      *vecptr++ = "<i>none available</i>";

   status = FaolToNet (rqptr, EndPageFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI);

   SysDclAst (&HTAdminEnd, rqptr);
}

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

HTAdminListUsersBegin
(
REQUEST_STRUCT *rqptr,
char *DatabaseName
)
{
   static char  ResponseFao [] =
"<table class=\"ctgry\">\n\
<tr><th class=\"ctttl\" colspan=\"!UL\">Users in !AZ</th></tr>\n\
<tr><td>\n\
<table class=\"lftlft\">\n\
!AZ";

   static char  BriefHeading [] =
"<tr>\
<th></th>\
<th class=\"sbttl\">Username</th>\
<th class=\"sbttl\">Full Name</th>\
<th class=\"sbttl\">Access</th>\
<th class=\"sbttl\">Added</th>\
<th class=\"sbttl\">Accessed</th></tr>\n\
</tr>\n";

   static char  FullHeading [] =
"<tr>\
<th></th>\
<th class=\"sbttl\">Username</th>\
<th class=\"sbttl\">Details<br>Last</th>\
<th class=\"sbttl\">Access<br>Failure</th>\
<th class=\"sbttl\">Added<br>Changed</th></tr>\n\
</tr>\n";

   int  status;
   HTADMIN_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN,
                 "HTAdminListUsersBegin() !&Z", DatabaseName);

   tkptr = rqptr->HTAdminTaskPtr;

   if (VMSnok (HTAdminOpenDatabaseForRead (rqptr, DatabaseName))) return;

   /**************/
   /* begin page */
   /**************/

   tkptr->RecordCount = tkptr->UserCount = 0;

   HTAdminPageTitle (rqptr, tkptr->AdminDescriptionPtr, ResponseFao, 
                     tkptr->BriefList ? 6 : 7,
                     DatabaseName,
                     tkptr->BriefList ? BriefHeading : FullHeading);

   SysDclAst (&HTAdminListUsersNext, rqptr);
}

/*****************************************************************************/
/*
Queue a read of the next record from the file.  When the read completes call 
HTAdminListUsersNextAst() function.
*/ 

HTAdminListUsersNext (REQUEST_STRUCT *rqptr)

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN,
                 "HTAdminListUsersNext() !&F", &HTAdminListUsersNext);

   /* asynchronous get service */
   rqptr->HTAdminTaskPtr->FileOds.Rab.rab$l_rop |= RAB$M_ASY;
   sys$get (&rqptr->HTAdminTaskPtr->FileOds.Rab,
            &HTAdminListUsersNextAst,
            &HTAdminListUsersNextAst);
}

/*****************************************************************************/
/*
A user record has been read from the authentication Database.
*/ 

HTAdminListUsersNextAst (struct RAB *RabPtr)

{
   int  cnt, status;
   char  *cptr, *sptr;
   REQUEST_STRUCT  *rqptr;
   HTADMIN_TASK  *tkptr;

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

   rqptr = RabPtr->rab$l_ctx;

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN,
                 "HTAdminListUsersNextAst() !&F sts:!&X stv:!&X !UL",
                 &HTAdminListUsersNextAst,
                 RabPtr->rab$l_sts, RabPtr->rab$l_stv, RabPtr->rab$w_rsz);

   tkptr = rqptr->HTAdminTaskPtr;

   if (VMSnok (tkptr->FileOds.Rab.rab$l_sts))
   {
      if (tkptr->FileOds.Rab.rab$l_sts == RMS$_EOF)
      {
         OdsClose (&tkptr->FileOds, NULL, 0);
         HTAdminListUsersListSort (rqptr);
         return;
      }

      rqptr->rqResponse.ErrorTextPtr = MapVmsPath (tkptr->AuthFileName, rqptr);
      rqptr->rqResponse.ErrorOtherTextPtr = tkptr->AuthFileName;
      ErrorVmsStatus (rqptr, tkptr->FileOds.Rab.rab$l_sts, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   /* check the version of the authorization database */
   if (tkptr->AuthHtRecord.DatabaseVersion &&
       tkptr->AuthHtRecord.DatabaseVersion != AUTH_HTA_VERSION)
   {
      rqptr->rqResponse.ErrorTextPtr = MapVmsPath (tkptr->AuthFileName, rqptr);
      rqptr->rqResponse.ErrorOtherTextPtr = tkptr->AuthFileName;
      ErrorVmsStatus (rqptr, SS$_INCOMPAT & 0xfffffffe, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   /* if the record has been removed (by zeroing) then ignore */
   if (!tkptr->AuthHtRecord.UserNameLength)
   {
      HTAdminListUsersNext (rqptr);
      return;
   }

   tkptr->UserCount++;

   if ((tkptr->UserCount * sizeof(AUTH_HTAREC)) >
       tkptr->UserListLength)
   {
      /* need more (or some) list space */
      tkptr->UserListLength += 32 * sizeof(AUTH_HTAREC);
      tkptr->UserListPtr = VmReallocHeap (rqptr, tkptr->UserListPtr,
                                          tkptr->UserListLength, FI_LI);
   }

   /* copy the entire user record into the list */
   memcpy (tkptr->UserListPtr +
           ((tkptr->UserCount - 1) * sizeof(AUTH_HTAREC)),
           &tkptr->AuthHtRecord, sizeof(AUTH_HTAREC));

   HTAdminListUsersNext (rqptr);
}

/*****************************************************************************/
/*
Humble bubble sort I'm afraid :^(  Gives the illusion that the database is
ordered (apart from that of entry sequence :^), although does provide the
advantage of viewing an ordered list.  Bit more expensive this one, copying
aroung 512 byte records.  I'll improve it someday, sigh :^(
*/ 

HTAdminListUsersListSort (REQUEST_STRUCT *rqptr)

{
   int  idx1, idx2, size;
   char  *cptr1, *cptr2;
   AUTH_HTAREC  *rptr1, *rptr2;
   AUTH_HTAREC  AuthHtRecord;
   HTADMIN_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN, "HTAdminListUsersListSort()");

   tkptr = rqptr->HTAdminTaskPtr;

   if (!tkptr->UserCount)
   {
      HTAdminListUsersEnd (rqptr);
      return;
   }

   size = sizeof(AUTH_HTAREC);

   for (idx1 = 0; idx1 < tkptr->UserCount-1; idx1++)
   {
      for (idx2 = idx1+1; idx2 < tkptr->UserCount; idx2++)
      {
          rptr1 = &((AUTH_HTAREC*)tkptr->UserListPtr)[idx1];
          rptr2 = &((AUTH_HTAREC*)tkptr->UserListPtr)[idx2];
          if (strcmp (rptr1->UserName, rptr2->UserName) <= 0) continue;
          memcpy (&AuthHtRecord, (char*)rptr1, size);
          memcpy ((char*)rptr1, (char*)rptr2, size);
          memcpy ((char*)rptr2, &AuthHtRecord, size);
      }
   }

   tkptr->UserListCount = 0;
   HTAdminListUsersList (rqptr);
}

/*****************************************************************************/
/*
This function is called for each username in the sorted list.  It reads them
sequentially, formats them as part of HTML table, then buffers the output,
ASTing back to this function for the next.
*/ 

HTAdminListUsersList (REQUEST_STRUCT *rqptr)

{
   static char  BriefFao [] =
"<tr>\
<th>!3ZL</th>\
<th>!AZ!&;AZ!AZ</th>\
<td>!&;AZ</td>\
<td>!AZ!AZ</td>\n\
<td>!17%D</td>\
<td>!17%D (!UL)</td>\
</tr>\n";

   static char  FullFao [] =
"<tr>\
<th>!3ZL</th>\
<th>!AZ!&;AZ!AZ</th>\
<td>!&;AZ</td>\
<td>!AZ!AZ</td>\
<td>!17%D</td>\
</tr>\n\
<tr class=\"hlght\"><td colspan=\"2\"></td>\
<td colspan=\"3\" style=\"white-space:pre;\">!&;AZ</td></tr>\n\
<tr><td colspan=\"2\"></td>\
<td colspan=\"3\">!&@</td></tr>\n\
<tr class=\"hlght\"><td colspan=\"2\"></td>\
<td>!17%D (!UL)</td>\
<td>!17%D (!UL)</td>\
<td>!17%D (!UL</td>\
</tr>\n";

   int  status;
   unsigned long  *vecptr;
   unsigned long  FaoVector [32];
   char  *CanStringPtr;
   AUTH_HTAREC  *rptr;
   HTADMIN_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN,
                 "HTAdminListUsersList() !UL !UL",
                 rqptr->HTAdminTaskPtr->UserListCount,
                 rqptr->HTAdminTaskPtr->UserCount);

   tkptr = rqptr->HTAdminTaskPtr;

   if (tkptr->UserListCount >= tkptr->UserCount)
   {
      HTAdminListUsersEnd (rqptr);
      return;
   }

   rptr = &((AUTH_HTAREC*)tkptr->UserListPtr)[tkptr->UserListCount];

   if (!(CanStringPtr = HTAdminCanString (rqptr, rptr->Flags, true)))
   {
      HTAdminEnd (rqptr);
      return;
   }

   tkptr->UserListCount++;

   vecptr = FaoVector;

   *vecptr++ = tkptr->UserListCount;

   if (rptr->Flags & AUTH_FLAG_ENABLED)
      *vecptr++ = "";
   else
      *vecptr++ = "<strike>";
   *vecptr++ = rptr->UserName;
   if (rptr->Flags & AUTH_FLAG_ENABLED)
      *vecptr++ = "";
   else
      *vecptr++ = "</strike>";

   *vecptr++ = rptr->FullName;
   *vecptr++ = CanStringPtr;

   if (rptr->Flags & AUTH_FLAG_HTTPS_ONLY)
      *vecptr++ = " (SSL-only)";
   else
      *vecptr++ = "";

   if (tkptr->BriefList)
   {
      *vecptr++ = &rptr->AddedTime64;
      *vecptr++ = &rptr->LastAccessTime64;
      *vecptr++ = rptr->AccessCount;
   }
   else
   {
      *vecptr++ = &rptr->AddedTime64;
      *vecptr++ = rptr->Contact;
      if (rptr->Email[0])
      {
         *vecptr++ = "<a href=\"mailto:!AZ\">!AZ</a>";
         *vecptr++ = rptr->Email;
         *vecptr++ = rptr->Email;
      }
      else
      if (rptr->Email[0] || rptr->Contact[0])
         *vecptr++ = "";
      else
         *vecptr++ = "(no contact or email)";
      *vecptr++ = &rptr->LastAccessTime64;
      *vecptr++ = rptr->AccessCount;
      *vecptr++ = &rptr->LastFailureTime64;
      *vecptr++ = rptr->FailureCount;
      *vecptr++ = &rptr->LastChangeTime64;
      *vecptr++ = rptr->ChangeCount;
   }

   if (tkptr->BriefList)
      status = FaolToNet (rqptr, BriefFao, &FaoVector);
   else
      status = FaolToNet (rqptr, FullFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI);

   SysDclAst (&HTAdminListUsersList, rqptr);
}

/*****************************************************************************/
/*
End list user information in authentication Database.
*/

HTAdminListUsersEnd (REQUEST_STRUCT *rqptr)

{
   static char  NotNoneFao [] =
"<tr><th>!3ZL</th>\
<td colspan=!UL " ADMIN_REPORT_ALTHI "><i>empty</i></td></tr>\n\
</table>\n\
</td></tr>\n\
</table>\n\
\
</div>\n\
</body>\n\
</html>\n";

   static char  EndPageFao [] =
"</table>\n\
</td></tr>\n\
</table>\n\
\
</div>\n\
</body>\n\
</html>\n";

   int  status;
   unsigned long  *vecptr;
   unsigned long  FaoVector [32];
   HTADMIN_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN, "HTAdminListUsersEnd()");

   tkptr = rqptr->HTAdminTaskPtr;

   vecptr = FaoVector;

   *vecptr++ = 0;
   if (tkptr->BriefList)
      *vecptr++ = 5;
   else
      *vecptr++ = 4;

   if (tkptr->UserCount)
      status = FaolToNet (rqptr, EndPageFao, &FaoVector);
   else
      status = FaolToNet (rqptr, NotNoneFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI);

   SysDclAst (&HTAdminEnd, rqptr);
}

/*****************************************************************************/
/*
Display an authentication database record.
*/

HTAdminUserView
(
REQUEST_STRUCT *rqptr,
char *DatabaseName,
char *UserName
)
{
   static char  ResponseFao [] =
"!20&W\n\
\
<P><table class=\"ctgry\">\n\
<tr><th class=\"ctttl\" colspan=\"4\">User !&;AZ in !AZ!AZ</th></tr>\n\
<tr><td>\n\
<table class=\"rghtlft\">\n\
<tr><th>Full Name:</th><td colspan=\"3\">!&;AZ</td></tr>\n\
<tr><th>Contact:</th><td colspan=\"3\" style=\"white-space:pre;\">!&;AZ</td></tr>\n\
<tr><th>E-mail:</th><td colspan=\"3\">!&@</td></tr>\n\
<tr><th>Access:</th><td colspan=\"3\">!AZ!AZ</td></tr>\n\
<tr><th>Password:</th><td>!AZ</td><td></td><td></td></tr>\n\
<tr><th>Added:</th><td colspan=\"2\">!20&W</td></tr>\n\
<tr><th>Changed:</th><td colspan=\"2\">!20&W</td><td>!UL</td></tr>\n\
<tr><th>Accessed:</th><td colspan=\"2\">!20&W</td><td>!UL</td></tr>\n\
<tr><th>Failed:</th><td colspan=\"2\">!20&W</td><td>!UL</td></tr>\n\
</table>\n\
</td></tr>\n\
</table>\n\
\
</div>\n\
</body>\n\
</html>\n";

   int  status;
   unsigned long  *vecptr;
   unsigned long  FaoVector [32];
   char  *CanStringPtr;
   HTADMIN_TASK  *tkptr;
   AUTH_HTAREC AuthHtRecord;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN, "HTAdminUserView()");

   tkptr = rqptr->HTAdminTaskPtr;

   if (!DatabaseName || !UserName[0])
   {
      rqptr->rqResponse.HttpStatus = 400;
      ErrorGeneral (rqptr, ErrorHTAdminInsufficient, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   /* look for the record, close the database file immediately */
   status = AuthHtDatabaseAccess (rqptr, false, DatabaseName,
                                  UserName, &AuthHtRecord, NULL, NULL);
   if (status == RMS$_EOF)
   {
      rqptr->rqResponse.HttpStatus = 404;
      ErrorGeneral (rqptr, ErrorHTAdminUserNotFound, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }
   if (VMSnok (status))
   {
      rqptr->rqResponse.ErrorTextPtr = ErrorHTAdminDatabase;
      rqptr->rqResponse.ErrorOtherTextPtr = DatabaseName;
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   if (!(CanStringPtr = HTAdminCanString (rqptr, AuthHtRecord.Flags, false)))
   {
      HTAdminEnd (rqptr);
      return;
   }

   /**************/
   /* begin page */
   /**************/

   HTAdminPageTitle (rqptr, tkptr->AdminDescriptionPtr);

   vecptr = FaoVector;
   *vecptr++ = &rqptr->rqTime.BeginTime64;

   *vecptr++ = AuthHtRecord.UserName;
   *vecptr++ = DatabaseName;
   if (AuthHtRecord.Flags & AUTH_FLAG_ENABLED)
      *vecptr++ = "";
   else
      *vecptr++ = "<font color=\"#ff0000\"> is DISABLED</font>";

   *vecptr++ = AuthHtRecord.FullName;
   *vecptr++ = AuthHtRecord.Contact;

   if (AuthHtRecord.Email[0])
   {
      *vecptr++ = "<a href=\"mailto:!&;AZ\">!&;AZ</a>";
      *vecptr++ = AuthHtRecord.Email;
      *vecptr++ = AuthHtRecord.Email;
   }
   else
      *vecptr++ = "";

   *vecptr++ = CanStringPtr;

   if (AuthHtRecord.Flags & AUTH_FLAG_HTTPS_ONLY)
      *vecptr++ = " (SSL-only)";
   else
      *vecptr++ = "";

   if (AuthHtRecord.HashedPwd)
      *vecptr++ = "********";
   else
      *vecptr++ = "";

   *vecptr++ = &AuthHtRecord.AddedTime64;
   *vecptr++ = &AuthHtRecord.LastChangeTime64;
   *vecptr++ = AuthHtRecord.ChangeCount;
   *vecptr++ = &AuthHtRecord.LastAccessTime64;
   *vecptr++ = AuthHtRecord.AccessCount;
   *vecptr++ = &AuthHtRecord.LastFailureTime64;
   *vecptr++ = AuthHtRecord.FailureCount;

   status = FaolToNet (rqptr, ResponseFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI);

   SysDclAst (&HTAdminEnd, rqptr);
}

/*****************************************************************************/
/*
Form for modify or add an authentication database record.
*/

HTAdminModifyUserForm
(
REQUEST_STRUCT *rqptr,
BOOL AddUser,
char *DatabaseName,
char *UserName
)
{
   static char  ResponseFao [] =
"<form method=\"POST\" action=\"!AZ\">\n\
<input type=\"hidden\" name=\"do\" value=\"!AZ\">\n\
<input type=\"hidden\" name=\"!AZ\" value=\"!AZ\">\n\
<table class=\"ctgry\">\n\
<tr><th class=\"ctttl\" colspan=\"2\">!AZ !AZ !AZin !AZ</th></tr>\n\
<tr><td colspan=\"2\">\n\
\
<table class=\"rghtlft\">\n\
<tr><th>Full Name:</th>\
<td><input type=\"text\" name=\"fnm\" size=\"!UL\" maxlength=\"!UL\" \
value=\"!&;AZ\"></td></tr>\n\
<tr><th>Contact:</th>\
<td><textarea name=\"con\" cols=\"!UL\" rows=\"!UL\">!&;AZ\
</textarea></td></tr>\n\
<tr><th>E-mail:</th>\
<td><input type=\"text\" name=\"eml\" size=\"!UL\" maxlength=\"!UL\" \
value=\"!&;AZ\"></td></tr>\n\
<tr><th>Enabled:</th><td>\n\
<input type=\"radio\" name=\"ena\" value=\"yes\"!AZ>yes\n\
<input type=\"radio\" name=\"ena\" value=\"no\"!AZ>no\n\
</td></tr>\n\
<tr><th>Access:</th><td>\n\
<input type=\"radio\" name=\"acc\" value=\"r\"!AZ>read-only\n\
<input type=\"radio\" name=\"acc\" value=\"r+w\"!AZ>read <b>& write</b>\n\
<input type=\"radio\" name=\"acc\" value=\"w\"!AZ>write-only\n\
</td></tr>\n\
<tr><th>SSL Only:</th><td>\n\
<input type=\"radio\" name=\"hts\" value=\"yes\"!AZ>yes\n\
<input type=\"radio\" name=\"hts\" value=\"no\"!AZ>no\n\
</td></tr>\n\
<tr><th>Password:</th>\
<td><input type=\"password\" name=\"pwn\" size=\"!UL\" maxlength=\"!UL\">\
<input type=\"checkbox\" name=\"pwd\" value=\"pwd\">generate\
<input type=\"checkbox\" name=\"pin\" value=\"pin\">PIN\
</td></tr>\n\
<tr><th>Verify:</th>\
<td><input type=\"password\" name=\"pwv\" size=\"!UL\" maxlength=\"!UL\"></td></tr>\n\
\
<tr><td></td><td>\
<input type=\"submit\" value=\" !AZ \">\n\
<input type=reset value=\" Reset \"></td></tr>\n\
</td></tr>\n\
</table>\n\
</td></tr>\n\
</table>\n\
</form>\n\
\
</div>\n\
</body>\n\
</html>\n";

   BOOL  AlreadyExists;
   int  status;
   unsigned long  *vecptr;
   unsigned short  Length;
   unsigned long  FaoVector [64];
   AUTH_HTAREC AuthHtRecord;
   HTADMIN_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN, "HTAdminModifyUserForm()");

   tkptr = rqptr->HTAdminTaskPtr;

   if (!DatabaseName[0] || !UserName[0])
   {
      rqptr->rqResponse.HttpStatus = 400;
      ErrorGeneral (rqptr, ErrorHTAdminInsufficient, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   /* look for the record, close the database file immediately */
   if (AddUser)
   {
      status = AuthHtDatabaseAccess (rqptr, false, DatabaseName,
                                     UserName, &AuthHtRecord, NULL, NULL);
      if (VMSok (status))
         AlreadyExists = true;
      else
         AlreadyExists = false;
      if (status == RMS$_EOF) status = SS$_NORMAL;
   }
   else
   {
      status = AuthHtDatabaseAccess (rqptr, false, DatabaseName,
                                     UserName, &AuthHtRecord, NULL, NULL);
      if (status == RMS$_EOF)
      {
         rqptr->rqResponse.HttpStatus = 404;
         ErrorGeneral (rqptr, ErrorHTAdminUserNotFound, FI_LI);
         HTAdminEnd (rqptr);
         return;
      }
      AlreadyExists = false;
   }
   if (VMSnok (status))
   {
      rqptr->rqResponse.ErrorTextPtr = ErrorHTAdminDatabase;
      rqptr->rqResponse.ErrorOtherTextPtr = DatabaseName;
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }
      
   if (AddUser && !AlreadyExists)
      memset (&AuthHtRecord, 0, sizeof(AUTH_HTAREC));

   /**************/
   /* begin page */
   /**************/

   HTAdminPageTitle (rqptr, tkptr->AdminDescriptionPtr);

   vecptr = FaoVector;

   *vecptr++ = rqptr->rqHeader.PathInfoPtr;
   if (AddUser && !AlreadyExists)
   {
      *vecptr++ = "add";
      *vecptr++ = "anm";
      *vecptr++ = UserName;
      *vecptr++ = "<font color=\"#ff0000\">New User</font>";
      *vecptr++ = UserName;
      *vecptr++ = "";
      *vecptr++ = DatabaseName;
   }
   else
   {     
      *vecptr++ = "modify";
      *vecptr++ = "unm";
      *vecptr++ = UserName;
      *vecptr++ = "User";
      *vecptr++ = UserName;
      if (AlreadyExists)
         *vecptr++ =
"<span style=\"color:#ff0000;\">ALREADY EXISTS</span>";
      else
         *vecptr++ = "";
      *vecptr++ = DatabaseName;
   }

   *vecptr++ = AUTH_MAX_FULLNAME_LENGTH;
   *vecptr++ = AUTH_MAX_FULLNAME_LENGTH;
   *vecptr++ = AuthHtRecord.FullName;

   *vecptr++ = 40;
   *vecptr++ = 3;
   *vecptr++ = AuthHtRecord.Contact;

   *vecptr++ = 40;
   *vecptr++ = 40;
   *vecptr++ = AuthHtRecord.Email;

   if ((AuthHtRecord.Flags & AUTH_FLAG_ENABLED) ||
       (AddUser && !AlreadyExists))
   {
      *vecptr++ = " CHECKED";
      *vecptr++ = "";
   }
   else
   {
      *vecptr++ = "";
      *vecptr++ = " CHECKED";
   }

   if ((AuthHtRecord.Flags & AUTH_FLAG_DELETE  ||
        AuthHtRecord.Flags & AUTH_FLAG_POST ||
        AuthHtRecord.Flags & AUTH_FLAG_PUT) &&
       AuthHtRecord.Flags & AUTH_FLAG_GET)
   {
      *vecptr++ = "";
      *vecptr++ = " CHECKED";
      *vecptr++ = "";
   }
   else
   if (!AuthHtRecord.Flags & AUTH_FLAG_GET)
   {
      *vecptr++ = " CHECKED";
      *vecptr++ = "";
      *vecptr++ = "";
   }
   else
   {
      *vecptr++ = " CHECKED";
      *vecptr++ = "";
      *vecptr++ = "";
   }

   if (AuthHtRecord.Flags & AUTH_FLAG_HTTPS_ONLY)
   {
      *vecptr++ = " CHECKED";
      *vecptr++ = "";
   }
   else
   {
      *vecptr++ = "";
      *vecptr++ = " CHECKED";
   }

   *vecptr++ = AUTH_MAX_PASSWORD_LENGTH;
   *vecptr++ = AUTH_MAX_PASSWORD_LENGTH;
   *vecptr++ = AUTH_MAX_PASSWORD_LENGTH;
   *vecptr++ = AUTH_MAX_PASSWORD_LENGTH;

   if (AddUser && !AlreadyExists)
      *vecptr++ = "Add";
   else
      *vecptr++ = "Modify";

   status = FaolToNet (rqptr, ResponseFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI);

   SysDclAst (&HTAdminEnd, rqptr);
}

/*****************************************************************************/
/*
Change the contents of the user's database record.
*/

HTAdminModifyUser
(
REQUEST_STRUCT *rqptr,
BOOL AddUser,
char *DatabaseName,
char *UserName,
char *FullName,
char *Contact,
char *Email,
char *Enabled,
char *Access,
char *HttpsOnly,
char *PasswordNew,
char *PasswordVerify,
char *GeneratePassword
)
{
   static $DESCRIPTOR (PasswordPinFaoDsc, "!4ZL\0");

   int  cnt, status;
   char  *cptr, *sptr;
   unsigned long  HashedPwd [2];
   unsigned long  *BinTimePtr;
   unsigned char  A1DigestLoCase [16],
                  A1DigestUpCase [16],
                  PasswordScratch [16];
   MD5_HASH  Md5Hash;
   AUTH_HTAREC AuthHtRecord;
   AUTH_CREC  AuthCacheRecord;
   $DESCRIPTOR (PasswordScratchDsc, PasswordScratch);

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN, "HTAdminModifyUser()");

   if (!DatabaseName[0] || !UserName[0] || !FullName[0] ||
       !Enabled[0] || !Access[0])
   {
      rqptr->rqResponse.HttpStatus = 400;
      ErrorGeneral (rqptr, ErrorHTAdminInsufficient, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   if ((to_upper(Enabled[0]) != 'Y' && to_upper(Enabled[0]) != 'N') ||
       (!strsame(Access, "r", -1) && !strsame(Access, "r+w", -1) &&
        !strsame(Access, "w", -1)))
   {
      rqptr->rqResponse.HttpStatus = 403;
      ErrorGeneral (rqptr, ErrorHTAdminParameter, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   if (GeneratePassword[0])
   {
      if (strsame (GeneratePassword, "pwdpin", -1))
      {
         /* generate a four digit PIN */
         sys$fao (&PasswordPinFaoDsc, 0, &PasswordScratchDsc,
                  HttpdTime64 / 1000 % 10000);
      }
      else
      {
         /* generate a six alpha-numeric character password */
         Md5Digest (&HttpdTime64, sizeof(Md5Hash), &Md5Hash);
         cptr = (char*)&Md5Hash;
         sptr = PasswordScratch;
         cnt = 0;
         while (cnt < 6)
         {
            if (cptr > (char*)&Md5Hash + sizeof(Md5Hash))
            {
               Md5Digest (&Md5Hash, sizeof(Md5Hash), &Md5Hash);
               cptr = (char*)&Md5Hash;
            }
            *cptr = to_lower(*cptr);
            if (cnt == 5)
            {
               /* digit required */
               if (*cptr >= '0' && *cptr <= '9')
               {
                  *sptr++ = *cptr;
                  cnt++;
               }
            }
            else
            if (*cptr == 'a' || *cptr == 'e' || *cptr == 'i' ||
                *cptr == 'o' || *cptr == 'u' || *cptr == 'y') 
            {
               if (cnt % 2)
               {
                  /* vowel required */
                  *sptr++ = *cptr;
                  cnt++;
               }
            }
            else
            if (*cptr >= 'a' && *cptr <= 'z' &&
                *cptr != 'a' && *cptr != 'e' && *cptr != 'i' &&
                *cptr != 'o' && *cptr != 'u' && *cptr != 'y') 
            {
               if (!(cnt % 2))
               {
                  /* consonant required */
                  *sptr++ = *cptr;
                  cnt++;
               }
            }
            cptr++;
         }
         *sptr = '\0';
      }
      PasswordNew = PasswordVerify = PasswordScratch;
   }

   if (!strsame (PasswordNew, PasswordVerify, -1))
   {
      rqptr->rqResponse.HttpStatus = 403;
      ErrorGeneral (rqptr, MsgFor(rqptr,MSG_HTADMIN_PWD_INCORRECT), FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   if (PasswordNew[0])
   {
      if (VMSnok (status =
          AuthGenerateHashPassword (UserName, PasswordNew, &HashedPwd)))
      {
         rqptr->rqResponse.ErrorTextPtr = "password hash";
         ErrorVmsStatus (rqptr, status, FI_LI);
         HTAdminEnd (rqptr);
         return;
      }

      if (VMSnok (status =
          AuthGenerateDigestPassword (DatabaseName, UserName, PasswordNew,
                                      &A1DigestLoCase, &A1DigestUpCase)))
      {
         rqptr->rqResponse.ErrorTextPtr = "password digest";
         ErrorVmsStatus (rqptr, status, FI_LI);
         HTAdminEnd (rqptr);
         return;
      }
   }

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

   /* look for the record, leave the database file open if found */
   status = AuthHtDatabaseAccess (rqptr, true, DatabaseName,
                                  UserName, &AuthHtRecord, NULL, NULL);
   if (AddUser)
   {
      if (VMSok (status))
      {
         /* ensure the database is closed */
         AuthHtDatabaseAccess (NULL, false, NULL, NULL, NULL, NULL, NULL);
         rqptr->rqResponse.HttpStatus = 404;
         ErrorGeneral (rqptr, ErrorHTAdminUserExists, FI_LI);
         HTAdminEnd (rqptr);
         return;
      }
      if (status == RMS$_EOF) status = SS$_NORMAL;
      memset (&AuthHtRecord, 0, sizeof(AUTH_HTAREC));
   }
   else
   {
      if (status == RMS$_EOF)
      {
         /* ensure the database is closed */
         AuthHtDatabaseAccess (NULL, false, NULL, NULL, NULL, NULL, NULL);
         rqptr->rqResponse.HttpStatus = 404;
         ErrorGeneral (rqptr, ErrorHTAdminUserNotFound, FI_LI);
         HTAdminEnd (rqptr);
         return;
      }
   }
   if (VMSnok (status))
   {
      rqptr->rqResponse.ErrorTextPtr = ErrorHTAdminDatabase;
      rqptr->rqResponse.ErrorOtherTextPtr = DatabaseName;
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   memcpy (&AuthHtRecord.UserName, UserName, sizeof(AuthHtRecord.UserName));
   AuthHtRecord.UserNameLength = strlen(UserName);
   memcpy (&AuthHtRecord.FullName, FullName, sizeof(AuthHtRecord.FullName));
   memcpy (&AuthHtRecord.Contact, Contact, sizeof(AuthHtRecord.Contact));
   memcpy (&AuthHtRecord.Email, Email, sizeof(AuthHtRecord.Email));
   if (AddUser)
   {
      BinTimePtr = &rqptr->rqTime.BeginTime64;
      AuthHtRecord.AddedTime64[0] = BinTimePtr[0];
      AuthHtRecord.AddedTime64[1] = BinTimePtr[1];
      AuthHtRecord.DatabaseVersion = AUTH_HTA_VERSION;
   }
   else
   {
      BinTimePtr = &rqptr->rqTime.BeginTime64;
      AuthHtRecord.LastChangeTime64[0] = BinTimePtr[0];
      AuthHtRecord.LastChangeTime64[1] = BinTimePtr[1];
      AuthHtRecord.ChangeCount++;
   }
   if (PasswordNew[0])
   {
      memcpy (&AuthHtRecord.HashedPwd, &HashedPwd, 8);
      memcpy (&AuthHtRecord.A1DigestLoCase, &A1DigestLoCase, 16);
      memcpy (&AuthHtRecord.A1DigestUpCase, &A1DigestUpCase, 16);
   }

   if (to_upper(Enabled[0]) == 'Y')
      AuthHtRecord.Flags |= AUTH_FLAG_ENABLED;
   else
      AuthHtRecord.Flags &= ~AUTH_FLAG_ENABLED;

   if (to_upper(HttpsOnly[0]) == 'Y')
      AuthHtRecord.Flags |= AUTH_FLAG_HTTPS_ONLY;
   else
      AuthHtRecord.Flags &= ~AUTH_FLAG_HTTPS_ONLY;

   /* reset all the method bits to zero */
   AuthHtRecord.Flags &= ~(AUTH_FLAG_CONNECT | AUTH_FLAG_DELETE |
                           AUTH_FLAG_GET | AUTH_FLAG_HEAD |
                           AUTH_FLAG_POST | AUTH_FLAG_PUT);
   /* now set the relevant method bits on */
   if (strsame (Access, "r", -1))
      AuthHtRecord.Flags |= (AUTH_FLAG_GET | AUTH_FLAG_HEAD);
   else
   if (strsame (Access, "r+w", -1))
      AuthHtRecord.Flags |= (AUTH_FLAG_CONNECT | AUTH_FLAG_DELETE |
                             AUTH_FLAG_GET | AUTH_FLAG_HEAD |
                             AUTH_FLAG_POST | AUTH_FLAG_PUT);
   else
   if (strsame (Access, "w", -1))
      AuthHtRecord.Flags |= (AUTH_FLAG_CONNECT | AUTH_FLAG_DELETE |
                             AUTH_FLAG_POST | AUTH_FLAG_PUT);

   /* add/update the record, close the database file */
   if (AddUser)
      status = AuthHtDatabaseAccess (NULL, false, NULL, NULL,
                                     NULL, &AuthHtRecord, NULL);
   else
      status = AuthHtDatabaseAccess (NULL, false, NULL, NULL,
                                     NULL, NULL, &AuthHtRecord);
   if (VMSnok (status))
   {
      rqptr->rqResponse.ErrorTextPtr = ErrorHTAdminDatabase;
      rqptr->rqResponse.ErrorOtherTextPtr = DatabaseName;
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   /**************/
   /* successful */
   /**************/

   if (AddUser)
      FaoToStdout (
"%HTTPD-I-AUTHTA, !20%D, add record\n\
-AUTHTA-I-BY, \"!AZ\" in \"!AZ\" at !AZ\n\
-AUTHTA-I-RECORD, \"!AZ\" to \"!AZ\"\n",
         0, rqptr->RemoteUser, rqptr->rqAuth.RealmDescrPtr,
         ClientHostString(rqptr), UserName, DatabaseName);
   else
      FaoToStdout (
"%HTTPD-I-AUTHTA, !20%D, modify record\n\
-AUTHTA-I-BY, \"!AZ\" in \"!AZ\" at !AZ\n\
-AUTHTA-I-RECORD, \"!AZ\" in \"!AZ\"\n",
         0, rqptr->RemoteUser, rqptr->rqAuth.RealmDescrPtr,
         ClientHostString(rqptr), UserName, DatabaseName);

   /* reset relevant entries in the cache */
   if (VMSnok (AuthCacheReset (rqptr, DatabaseName, UserName))) return;

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   if (GeneratePassword[0])
      ReportSuccess (rqptr,
"Record for !&;AZ in !AZ at !AZ !AZ, \
generated password &quot;<font size=\"+1\"><tt>!AZ</tt></font>&quot;.",
                     UserName, DatabaseName, ServerHostPort,
                     AddUser ? "added" : "modified", PasswordScratch);
   else
      ReportSuccess (rqptr, "Record for !&;AZ in !AZ at !AZ !AZ.",
                     UserName, DatabaseName, ServerHostPort,
                     AddUser ? "added" : "modified");

   SysDclAst (&HTAdminEnd, rqptr);
}

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

HTAdminUserDeleteForm
(
REQUEST_STRUCT *rqptr,
char *DatabaseName,
char *UserName
)
{
   static char  ResponseFao [] =
"<form method=\"POST\" action=\"!AZ\">\n\
<input type=\"hidden\" name=\"do\" value=\"userdelete\">\n\
<input type=\"hidden\" name=\"unm\" value=\"!&;AZ\">\n\
<p><table class=\"ctgry\">\n\
<tr><td>\n\
<b>User:</b> !AZ <b>in</b> !AZ \
<input type=\"submit\" value=\" Delete !! \">\n\
<br>\n\
<table class=\"rghtlft\">\n\
<tr><th>Full Name:</th><td>!&;AZ</td></tr>\n\
<tr><th>Contact:</th>\
<td style=\"white-space:pre;\">!&;AZ!&;AZ</td></tr>\n\
</table>\n\
</td></tr>\n\
</table>\n\
</form>\n\
\
</div>\n\
</body>\n\
</html>\n";

   int  status;
   unsigned long  *vecptr;
   unsigned long  FaoVector [32];
   AUTH_HTAREC AuthHtRecord;
   HTADMIN_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN, "HTAdminUserDeleteForm()");

   tkptr = rqptr->HTAdminTaskPtr;

   if (!DatabaseName[0] || !UserName[0])
   {
      rqptr->rqResponse.HttpStatus = 400;
      ErrorGeneral (rqptr, ErrorHTAdminInsufficient, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   /* look for the record, close the database file immediately */
   status = AuthHtDatabaseAccess (rqptr, false, DatabaseName,
                                  UserName, &AuthHtRecord, NULL, NULL);
   if (status == RMS$_EOF)
   {
      rqptr->rqResponse.HttpStatus = 404;
      ErrorGeneral (rqptr, ErrorHTAdminUserNotFound, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }
   if (VMSnok (status))
   {
      rqptr->rqResponse.ErrorTextPtr = ErrorHTAdminDatabase;
      rqptr->rqResponse.ErrorOtherTextPtr = DatabaseName;
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   /**************/
   /* begin page */
   /**************/

   HTAdminPageTitle (rqptr, tkptr->AdminDescriptionPtr);

   vecptr = FaoVector;

   *vecptr++ = rqptr->rqHeader.PathInfoPtr;
   *vecptr++ = AuthHtRecord.UserName;
   *vecptr++ = AuthHtRecord.UserName;
   *vecptr++ = DatabaseName;
   *vecptr++ = AuthHtRecord.FullName;
   if (AuthHtRecord.Contact[0] || AuthHtRecord.Email[0])
   {
      *vecptr++ = AuthHtRecord.Contact;
      *vecptr++ = AuthHtRecord.Email;
   }
   else
   {
      *vecptr++ = "(none)";
      *vecptr++ = "";
   }

   status = FaolToNet (rqptr, ResponseFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI);

   SysDclAst (&HTAdminEnd, rqptr);
}

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

HTAdminUserDelete
(
REQUEST_STRUCT *rqptr,
char *DatabaseName,
char *UserName
)
{
   int  status;
   AUTH_HTAREC AuthHtRecord;
   AUTH_CREC  AuthCacheRecord;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN, "HTAdminUserDelete()");

   if (!DatabaseName[0] || !UserName[0])
   {
      rqptr->rqResponse.HttpStatus = 400;
      ErrorGeneral (rqptr, ErrorHTAdminInsufficient, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   /* look for the record, leave the database file open if found */
   status = AuthHtDatabaseAccess (rqptr, true, DatabaseName,
                                  UserName, &AuthHtRecord, NULL, NULL);
   if (status == RMS$_EOF)
   {
      /* ensure the database is closed */
      AuthHtDatabaseAccess (NULL, false, NULL, NULL, NULL, NULL, NULL);
      rqptr->rqResponse.HttpStatus = 404;
      ErrorGeneral (rqptr, ErrorHTAdminUserNotFound, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }
   if (VMSnok (status))
   {
      rqptr->rqResponse.ErrorTextPtr = ErrorHTAdminDatabase;
      rqptr->rqResponse.ErrorOtherTextPtr = DatabaseName;
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   memset (&AuthHtRecord, 0, sizeof(AUTH_HTAREC));

   /* update the now zeroed record */
   status = AuthHtDatabaseAccess (NULL, false, NULL, NULL,
                                  NULL, NULL, &AuthHtRecord);
   if (VMSnok (status))
   {
      rqptr->rqResponse.ErrorTextPtr = ErrorHTAdminDatabase;
      rqptr->rqResponse.ErrorOtherTextPtr = DatabaseName;
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   /**************/
   /* successful */
   /**************/

   FaoToStdout (
"%HTTPD-I-AUTHTA, !20%D, delete record\n\
-AUTHTA-I-BY, \"!AZ\" in \"!AZ\" at !AZ\n\
-AUTHTA-I-RECORD, \"!AZ\" from \"!AZ\"\n",
      0, rqptr->RemoteUser, rqptr->rqAuth.RealmDescrPtr,
      ClientHostString(rqptr), UserName, DatabaseName);

   /* reset relevant entries in the cache */
   if (VMSnok (AuthCacheReset (rqptr, DatabaseName, UserName)))
      return;

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   ReportSuccess (rqptr,
"<font color=\"#ff0000\">Deleted</font> record for !&;AZ in !AZ at !AZ.",
                  UserName, DatabaseName, ServerHostPort);

   SysDclAst (&HTAdminEnd, rqptr);
}

/*****************************************************************************/
/*
Reset an entry in the authentication cache. The cache is searched for all
entries for the username and realm with the failure count and password reset
forcing it to be revalidated the next time it is accessed.
*/

HTAdminCachePurge (REQUEST_STRUCT *rqptr)

{
   int  status;
   char  *cptr;
   AUTH_CREC  AuthCacheRecord;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN, "HTAdminCachePurge()");

   /* purge the entire cache */
   if (VMSnok (status = AuthCachePurge (false)))
   {
      rqptr->rqResponse.ErrorTextPtr = ErrorHTAdminPurgeCache;
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   /* report this to the log */
   FaoToStdout (
"%HTTPD-I-AUTHCACHE, !20%D, purge\n\
-AUTHCACHE-I-BY, \"!AZ\" in \"!AZ\" at !AZ\n",
      0, rqptr->RemoteUser, rqptr->rqAuth.RealmDescrPtr,
      ClientHostString(rqptr));

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   ReportSuccess (rqptr, "Purge of !AZ authorization cache.", ServerHostPort);

   SysDclAst (&HTAdminEnd, rqptr);
}

/*****************************************************************************/
/*
Set string text according to capability bits in on-disk HTA database.  These
may be different to the bits in the authorization capability vector, reported
by AuthCanString().
*/

char* HTAdminCanString
(
REQUEST_STRUCT *rqptr,
unsigned long CanFlags,
BOOL Brief
)
{
   static $DESCRIPTOR (CanBriefFaoDsc, "!AZ\0");
   static $DESCRIPTOR (CanFullFaoDsc, "!AZ!AZ!AZ!AZ!AZ!AZ!AZ!AZ!AZ\0");
   static char  Buffer [128];
   static $DESCRIPTOR (BufferDsc, Buffer);

   int  status;
   unsigned long  *vecptr;
   unsigned long  FaoVector [32];

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN, "HTAdminCanString()");

   vecptr = FaoVector;

   if ((CanFlags & AUTH_FLAG_CONNECT ||
        CanFlags & AUTH_FLAG_DELETE ||
        CanFlags & AUTH_FLAG_POST ||
        CanFlags & AUTH_FLAG_PUT) &&
       CanFlags & AUTH_FLAG_GET)
      *vecptr++ = "read <b>+ write</b>";
   else
   if ((CanFlags & AUTH_FLAG_CONNECT ||
        CanFlags & AUTH_FLAG_DELETE ||
        CanFlags & AUTH_FLAG_POST ||
        CanFlags & AUTH_FLAG_PUT))
      *vecptr++ = "write-only";
   else
   if (CanFlags & AUTH_FLAG_GET)
      *vecptr++ = "read-only";
   else
      *vecptr++ = "<i>none!</i>";

   if (Brief)
      status = sys$faol (&CanBriefFaoDsc, 0, &BufferDsc, &FaoVector);
   else
   {
      if (CanFlags & AUTH_FLAG_CONNECT ||
          CanFlags & AUTH_FLAG_DELETE ||
          CanFlags & AUTH_FLAG_GET ||
          CanFlags & AUTH_FLAG_HEAD ||
          CanFlags & AUTH_FLAG_POST ||
          CanFlags & AUTH_FLAG_PUT)
         *vecptr++ = " (<span style=\"font-size:90%;\"> ";
      else
         *vecptr++ = "";
      if (CanFlags & AUTH_FLAG_CONNECT)
         *vecptr++ = " CONNECT";
      else
         *vecptr++ = "";
      if (CanFlags & AUTH_FLAG_DELETE)
         *vecptr++ = " DELETE";
      else
         *vecptr++ = "";
      if (CanFlags & AUTH_FLAG_GET)
         *vecptr++ = " GET";
      else
         *vecptr++ = "";
      if (CanFlags & AUTH_FLAG_HEAD)
         *vecptr++ = " HEAD";
      else
         *vecptr++ = "";
      if (CanFlags & AUTH_FLAG_POST)
         *vecptr++ = " POST";
      else
         *vecptr++ = "";
      if (CanFlags & AUTH_FLAG_PUT)
         *vecptr++ = " PUT";
      else
         *vecptr++ = "";
      if (CanFlags & AUTH_FLAG_CONNECT ||
          CanFlags & AUTH_FLAG_DELETE ||
          CanFlags & AUTH_FLAG_GET ||
          CanFlags & AUTH_FLAG_HEAD ||
          CanFlags & AUTH_FLAG_POST ||
          CanFlags & AUTH_FLAG_PUT)
         *vecptr++ = " </span>)";
      else
         *vecptr++ = "";

      status = sys$faol (&CanFullFaoDsc, 0, &BufferDsc, &FaoVector);
   }

   if (VMSnok (status) || status == SS$_BUFFEROVF)
   {
      rqptr->rqResponse.ErrorTextPtr = "sys$faol()";
      ErrorVmsStatus (rqptr, status, FI_LI);
      return (NULL);
   }
   return (Buffer);
}

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

HTAdminDatabaseCreateForm
(
REQUEST_STRUCT *rqptr,
char *DatabaseName
)
{
   static char  ResponseFao [] =
"<form method=\"POST\" action=\"!AZ\">\n\
<input type=\"hidden\" name=\"do\" value=\"htacreate\">\n\
<p><table class=\"ctgry\">\n\
<tr><td>\n\
<b>Database:</b> !AZ \
<input type=\"submit\" value=\" Create \">\n\
</td></tr>\n\
</table>\n\
</form>\n\
\
</div>\n\
</body>\n\
</html>\n";

   int  status;
   HTADMIN_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN,
                 "HTAdminDatabaseCreateForm()");

   tkptr = rqptr->HTAdminTaskPtr;

   if (!DatabaseName)
   {
      rqptr->rqResponse.HttpStatus = 400;
      ErrorGeneral (rqptr, ErrorHTAdminInsufficient, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   HTAdminPageTitle (rqptr, tkptr->AdminDescriptionPtr, ResponseFao, 
                     rqptr->rqHeader.PathInfoPtr,
                     DatabaseName);

   SysDclAst (&HTAdminEnd, rqptr);
}

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

HTAdminDatabaseCreate
(
REQUEST_STRUCT *rqptr,
char *DatabaseName,
char *UserName
)
{
   int  status,
        FileNameLength;
   char  *cptr, *sptr, *zptr;
   AUTH_HTAREC AuthHtRecord;
   HTADMIN_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN,
                 "HTAdminDatabaseCreate() !&Z", DatabaseName);

   tkptr = rqptr->HTAdminTaskPtr;

   if (!DatabaseName[0])
   {
      rqptr->rqResponse.HttpStatus = 400;
      ErrorGeneral (rqptr, ErrorHTAdminInsufficient, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   zptr = (sptr = tkptr->AuthFileName) + sizeof(tkptr->AuthFileName)-1;
   for (cptr = rqptr->ParseOds.NamDevicePtr;
        cptr < rqptr->ParseOds.NamNamePtr && sptr < zptr;
        *sptr++ = *cptr++);
   for (cptr = DatabaseName; *cptr && sptr < zptr; *sptr++ = *cptr++);
   for (cptr = HTA_FILE_TYPE; *cptr && sptr < zptr; *sptr++ = *cptr++);
   *sptr = '\0';
   FileNameLength = sptr - tkptr->AuthFileName;

   /* use SYSPRV to allow parse/search */
   sys$setprv (1, &SysPrvMask, 0, 0);

   OdsParse (&tkptr->FileOds,
             tkptr->AuthFileName, FileNameLength, NULL, 0,
             0, NULL, rqptr);

   if (VMSok (status = tkptr->FileOds.Fab.fab$l_sts))
   {
      OdsSearch (&tkptr->FileOds, NULL, rqptr);
      status = tkptr->FileOds.Fab.fab$l_sts;
   }

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

   if (VMSnok (status) && status != RMS$_FNF)
   {
      rqptr->rqResponse.ErrorTextPtr = ErrorHTAdminDatabase;
      rqptr->rqResponse.ErrorOtherTextPtr = DatabaseName;
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }
   else
   if (VMSok (status))
   {
      /* ensure parse internal data structures are released */
      OdsParseRelease (&tkptr->FileOds);
      rqptr->rqResponse.HttpStatus = 409;
      ErrorGeneral (rqptr, ErrorHTAdminDatabaseExists, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   /* OK, now carefully adjust some of the data in the RMS structures */
   tkptr->FileOds.Fab.fab$l_fop = FAB$M_SQO;
   tkptr->FileOds.Fab.fab$w_mrs = sizeof(AUTH_HTAREC);
   tkptr->FileOds.Fab.fab$b_rfm = FAB$C_FIX;
   tkptr->FileOds.Fab.fab$l_xab = &tkptr->FileOds.XabPro;

   tkptr->FileOds.XabPro = cc$rms_xabpro;
   /* ownded by SYSTEM ([1,4]) */
   tkptr->FileOds.XabPro.xab$w_grp = 1;
   tkptr->FileOds.XabPro.xab$w_mbm = 4;
   tkptr->FileOds.XabPro.xab$l_nxt = 0;
   /* w:,g:,o:rwed,s:rwed */
   tkptr->FileOds.XabPro.xab$w_pro = 0xff00;

   /* use SYSPRV to ensure creation of database file */
   sys$setprv (1, &SysPrvMask, 0, 0);

   status = sys$create (&tkptr->FileOds.Fab, 0, 0);

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

   /* sys$create() status */
   if (VMSnok (status))
   {
      rqptr->rqResponse.ErrorTextPtr = ErrorHTAdminDatabase;
      rqptr->rqResponse.ErrorOtherTextPtr = DatabaseName;
      ErrorVmsStatus (rqptr, tkptr->FileOds.Fab.fab$l_stv, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   OdsClose (&tkptr->FileOds, NULL, 0);
   if (VMSnok (status = tkptr->FileOds.Fab.fab$l_sts))
   {
      rqptr->rqResponse.ErrorTextPtr = ErrorHTAdminDatabase;
      rqptr->rqResponse.ErrorOtherTextPtr = DatabaseName;
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   /**************/
   /* successful */
   /**************/

   FaoToStdout (
"%HTTPD-I-AUTHTA, !20%D, create database\n\
-AUTHTA-I-BY, \"!AZ\" in \"!AZ\" at !AZ\n\
-AUTHTA-I-DATABASE, \"!AZ\"\n",
      0, rqptr->RemoteUser, rqptr->rqAuth.RealmDescrPtr,
      ClientHostString(rqptr), DatabaseName);

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   ReportSuccess (rqptr, "Created !AZdatabase !AZ at !AZ",
                  tkptr->FileOds.Nam_fnb & NAM$M_LOWVER ?
                  "<font color=\"#ff0000\">new version</font> of " : "",
                  DatabaseName, ServerHostPort);

   SysDclAst (&HTAdminEnd, rqptr);
}

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

HTAdminDatabaseDeleteForm
(
REQUEST_STRUCT *rqptr,
char *DatabaseName
)
{
   static char  ResponseFao [] =
"<form method=\"POST\" action=\"!AZ!AZ\">\n\
<input type=\"hidden\" name=\"do\" value=\"!AZ\">\n\
<p><table class=\"ctgry\">\n\
<tr><td>\n\
<b>!AZ:</b> !AZ \
<input type=\"submit\" value=\" Delete !! \">\n\
</td></tr>\n\
</table>\n\
</form>\n\
\
</div>\n\
</body>\n\
</html>\n";

   int  status;
   unsigned long  *vecptr;
   unsigned long  FaoVector [32];
   HTADMIN_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN,
                 "HTAdminDatabaseDeleteForm()");

   tkptr = rqptr->HTAdminTaskPtr;

   if (!DatabaseName)
   {
      rqptr->rqResponse.HttpStatus = 400;
      ErrorGeneral (rqptr, ErrorHTAdminInsufficient, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   HTAdminPageTitle (rqptr, tkptr->AdminDescriptionPtr);

   vecptr = FaoVector;

   *vecptr++ = rqptr->rqHeader.PathInfoPtr;
   if (tkptr->HtListAdmin)
   {
      /* use a version to induce the PUT module to delete the file */
      *vecptr++ = ";*";
      *vecptr++ = "htldelete";
      *vecptr++ = "List";
   }
   else
   {
      /* the HTADMIN module will delete this for us */
      *vecptr++ = "";
      *vecptr++ = "htadelete";
      *vecptr++ = "Database";
   }
   *vecptr++ = DatabaseName;

   status = FaolToNet (rqptr, ResponseFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI);

   SysDclAst (&HTAdminEnd, rqptr);
}

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

HTAdminDatabaseDelete
(
REQUEST_STRUCT *rqptr,
char *DatabaseName,
char *UserName
)
{
   int  status,
        FileNameLength,
        EraseCount;
   char  *cptr, *sptr, *zptr;
   HTADMIN_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN,
                 "HTAdminDatabaseDelete() !&Z", DatabaseName);

   tkptr = rqptr->HTAdminTaskPtr;

   if (!DatabaseName[0])
   {
      rqptr->rqResponse.HttpStatus = 400;
      ErrorGeneral (rqptr, ErrorHTAdminInsufficient, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   zptr = (sptr = tkptr->AuthFileName) + sizeof(tkptr->AuthFileName)-1;
   for (cptr = rqptr->ParseOds.NamDevicePtr;
        cptr < rqptr->ParseOds.NamNamePtr && sptr < zptr;
        *sptr++ = *cptr++);
   for (cptr = DatabaseName; *cptr && sptr < zptr; *sptr++ = *cptr++);
   for (cptr = HTA_FILE_TYPE; *cptr && sptr < zptr; *sptr++ = *cptr++);
   *sptr = '\0';
   FileNameLength = sptr - tkptr->AuthFileName;

   OdsParse (&tkptr->FileOds,
             tkptr->AuthFileName, FileNameLength, NULL, 0,
             0, NULL, rqptr);

   if (VMSok (status = tkptr->FileOds.Fab.fab$l_sts))
   {
      tkptr->FileOds.NamVersionPtr[0] = '\0'; 

      /* turn on SYSPRV to allow deletion of database file */
      sys$setprv (1, &SysPrvMask, 0, 0);

      EraseCount = 0;
      while (VMSok (status = sys$erase (&tkptr->FileOds.Fab, 0, 0)))
          EraseCount++;
      if (status == RMS$_FNF && EraseCount) status = SS$_NORMAL;

      sys$setprv (0, &SysPrvMask, 0, 0);
   }

   /* ensure parse internal data structures are released */
   OdsParseRelease (&tkptr->FileOds);

   if (VMSnok (status))
   {
      if (tkptr->HtListAdmin)
         rqptr->rqResponse.ErrorTextPtr = ErrorHTAdminList;
      else
         rqptr->rqResponse.ErrorTextPtr = ErrorHTAdminDatabase;
      rqptr->rqResponse.ErrorOtherTextPtr = DatabaseName;
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return;
   }

   /**************/
   /* successful */
   /**************/

   FaoToStdout (
"%HTTPD-I-AUTHTA, !20%D, delete database\n\
-AUTHTA-I-BY, \"!AZ\" in \"!AZ\" at !AZ\n\
-AUTHTA-I-DATABASE, \"!AZ\"\n",
      0, rqptr->RemoteUser, rqptr->rqAuth.RealmDescrPtr,
      ClientHostString(rqptr), DatabaseName);

   /* reset relevant entries in the cache */
   if (VMSnok (AuthCacheReset (rqptr, DatabaseName, ""))) return;

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   ReportSuccess (rqptr,
"<font color=\"#ff0000\">Deleted</font> !AZ !AZ at !AZ.",
                  tkptr->HtListAdmin ? "list" : "database",
                  DatabaseName, ServerHostPort);

   SysDclAst (&HTAdminEnd, rqptr);
}

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

HTAdminOpenDatabaseForRead
(
REQUEST_STRUCT *rqptr,
char *DatabaseName
)
{
   int  status,
        FileNameLength;
   char  *cptr, *sptr, *zptr;
   HTADMIN_TASK  *tkptr;
   $DESCRIPTOR (AuthFileNameDsc, "");

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

   if (WATCHMOD (rqptr, WATCH_MOD_HTADMIN))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_HTADMIN,
                 "HTAdminOpenDatabaseForRead() !&Z", DatabaseName);

   tkptr = rqptr->HTAdminTaskPtr;

   zptr = (sptr = tkptr->AuthFileName) + sizeof(tkptr->AuthFileName)-1;
   for (cptr = rqptr->ParseOds.NamDevicePtr;
        cptr < rqptr->ParseOds.NamNamePtr && sptr < zptr;
        *sptr++ = *cptr++);
   for (cptr = DatabaseName; *cptr && sptr < zptr; *sptr++ = *cptr++);
   for (cptr = HTA_FILE_TYPE; *cptr && sptr < zptr; *sptr++ = *cptr++);
   *sptr = '\0';
   FileNameLength = sptr - tkptr->AuthFileName;

   /* turn on SYSPRV to allow access to authentication Database file */
   sys$setprv (1, &SysPrvMask, 0, 0);

   OdsOpen (&tkptr->FileOds, tkptr->AuthFileName, FileNameLength, NULL, 0, 0,
            FAB$M_GET, FAB$M_SHRGET | FAB$M_SHRPUT | FAB$M_SHRUPD,
            NULL, rqptr);  

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

   if (VMSnok (status = tkptr->FileOds.Fab.fab$l_sts))
   {
      rqptr->rqResponse.ErrorTextPtr = ErrorHTAdminDatabase;
      rqptr->rqResponse.ErrorOtherTextPtr = DatabaseName;
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return (status);
   }

   tkptr->FileOds.Rab = cc$rms_rab;
   tkptr->FileOds.Rab.rab$l_ctx = rqptr;
   tkptr->FileOds.Rab.rab$l_fab = &tkptr->FileOds.Fab;
   /* 2 buffers of sixty-four blocks (records) each */
   tkptr->FileOds.Rab.rab$b_mbc = 64;
   tkptr->FileOds.Rab.rab$b_mbf = 2;
   /* read ahead performance option */
   tkptr->FileOds.Rab.rab$l_rop = RAB$M_RAH;
   tkptr->FileOds.Rab.rab$l_ubf = &tkptr->AuthHtRecord;
   tkptr->FileOds.Rab.rab$w_usz = sizeof(AUTH_HTAREC);

   if (VMSnok (status = sys$connect (&tkptr->FileOds.Rab, 0, 0)))
   {
      rqptr->rqResponse.ErrorTextPtr = MapVmsPath (tkptr->AuthFileName, rqptr);
      rqptr->rqResponse.ErrorOtherTextPtr = tkptr->AuthFileName;
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return (status);
   }

   return (status);
}

/*****************************************************************************/
/*
Provide HT administration page titles.  Will accept a small number of variable
arguments to provide text following the titles themselves.
*/ 

int HTAdminPageTitle
(
REQUEST_STRUCT *rqptr,
char *Title,
...
)
{
   static char PageTitleFao [] =
"!AZ\
<html>\n\
<head>\n\
!AZ\
!AZ\
!&@\
<title>WASD !AZ ... !AZ</title>\n\
</head>\n\
!AZ\n\
<div class=\"wasd\">\n\
<h2>WASD !AZ</h2>\n\
<h3>!AZ</h3>\n\
!&@";

   int  argcnt, status;
   unsigned long  *vecptr;
   unsigned long  FaoVector [32+16];
   va_list  argptr;

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

   va_count (argcnt);

   if (WATCHMOD (rqptr, WATCH_MOD__OTHER))
      WatchThis (WATCHITM(rqptr), WATCH_MOD__OTHER,
                 "HTAdminPageTitle() !UL !&Z", argcnt, Title);

   if (argcnt > 32+4)
   {
      ErrorNoticed (rqptr, SS$_OVRMAXARG, NULL, FI_LI);
      return (SS$_OVRMAXARG);
   }

   vecptr = FaoVector;

   *vecptr++ = WASD_DOCTYPE;
   *vecptr++ = HtmlMetaInfo (rqptr, NULL);
   *vecptr++ = AdminWasdCss ();
   if (rqptr->rqPathSet.StyleSheetPtr)
   {
      *vecptr++ = "<link rel=\"stylesheet\" type=\"text/css\" href=\"!AZ\">\n";
      *vecptr++ = rqptr->rqPathSet.StyleSheetPtr;
   }
   else
      *vecptr++ = "";
   *vecptr++ = ServerHostPort;
   *vecptr++ = Title;
   *vecptr++ = ADMIN_BODY_TAG;
   *vecptr++ = ServerHostPort;
   *vecptr++ = Title;

   if (argcnt > 2)
   {
      va_start (argptr, Title);
      for (argcnt -= 2; argcnt; argcnt--)
         *vecptr++ = va_arg (argptr, unsigned long);
      va_end (argptr);
   }
   else
      *vecptr++ = "";

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   ResponseHeader200 (rqptr, "text/html", NULL);

   status = FaolToNet (rqptr, PageTitleFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI);

   return (status);
}

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