/*****************************************************************************
/*
                                 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
---------------
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 WriteFaoOpcom()
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 NetWriteFaol(), 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_V6
#undef _VMS_V6_SOURCE
#define _VMS_V6_SOURCE
#undef __VMS_VER
#define __VMS_VER 60000000
#undef __CRTL_VER
#define __CRTL_VER 60000000
#endif

/* standard C header files */
#include <ctype.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 */
/********************/

#ifdef DBUG
extern BOOL Debug;
#else
#define Debug 0 
#endif

extern BOOL  AuthConfigACME,
             AuthSysUafEnabled,
             AuthPolicySysUafRelaxed;

extern int  OpcomMessages;

extern unsigned long  HttpdBinTime[],
                      SysPrvMask[];

extern char  *DayName[];

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

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,
REQUEST_AST NextTaskFunction
)
{
   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  Length;
   char  *cptr, *sptr, *qptr, *zptr;
   char  Access [32],
         DoThis [32],
         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 (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, WATCH_MOD_HTADMIN, "HTAdminBegin()");

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

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

      /* don't want to try this when called as an AST! */
      tkptr->NextTaskFunction = NextTaskFunction;

      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 */
      SysDclAst (tkptr->NextTaskFunction, rqptr);
      return;
   }

   if (WATCHING(rqptr) &&
       WATCH_CATEGORY(WATCH_RESPONSE))
      WatchThis (rqptr, FI_LI, 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
      qptr = rqptr->rqHeader.QueryStringPtr;
   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 */
         strcpy (DoThis, "htledit");
         /* 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++ = toupper(*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 = tolower(*cptr);
      status = sys$fao (&LocationDatabaseFaoDsc, &Length, &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 = tolower(*cptr);
      status = sys$fao (&LocationDatabaseFaoDsc, &Length, &LocationDsc,
                        rqptr->rqHeader.PathInfoPtr, AsDatabaseName, DoThis);
   }
   else
   if (strsame (DoThis, "HTLCREATE", -1))
   {
      if (islower(DoThis[0]))
      {
         /* begin editing the file */
         UpdBegin (rqptr, NextTaskFunction);
         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 = tolower(*cptr);
      status = sys$fao (&LocationListFaoDsc, &Length, &LocationDsc,
                        rqptr->rqHeader.PathInfoPtr, AsDatabaseName,
                        "?do=", DoThis);
   }
   else
   if (strsame (DoThis, "HTLEDIT", -1))
   {
      if (islower(DoThis[0]))
      {
         /* begin editing the file */
         UpdBegin (rqptr, NextTaskFunction);
         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 = tolower(*cptr);
      status = sys$fao (&LocationListFaoDsc, &Length, &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, &Length, &LocationDsc,
                        rqptr->rqHeader.PathInfoPtr, DatabaseName, "", "");
   }
   if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);

   if (Location[0])
   {
      /* initial redirection to get file name after path */
      rqptr->rqResponse.LocationPtr = VmGetHeap (rqptr, Length);
      memcpy (rqptr->rqResponse.LocationPtr, Location, Length);
      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++ = toupper(*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 = tolower(*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 (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, WATCH_MOD_HTADMIN, "HTAdminEnd()");

   tkptr = rqptr->HTAdminTaskPtr;

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

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

   SysDclAst (tkptr->NextTaskFunction, 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 [] =
"<HTML>\n\
<HEAD>\n\
!AZ\
<TITLE>HTTPd !AZ ... !AZ</TITLE>\n\
</HEAD>\n\
!AZ\n\
<H2><NOBR>HTTPd !AZ</NOBR></H2>\n\
<H3>!AZ</H3>\n\
\
<FORM METHOD=GET ACTION=\"!AZ\">\n\
<TABLE CELLPADDING=5 CELLSPACING=0 BORDER=1>\n\
<TR><TH>!AZ</TH></TR>\n\
<TR><TD>\n\
<TABLE CELLPADDING=5 CELLSPACING=0 BORDER=0>\n\
<TR><TD VALIGN=top>\n\
<SELECT SIZE=!UL NAME=dat>\n";

   int  status;
   unsigned long  *vecptr;
   unsigned long  FaoVector [32];
   char  *cptr, *sptr, *zptr;
   HTADMIN_TASK  *tkptr;
   REQUEST_AST AstFunction;

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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;
   }

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   RESPONSE_HEADER_200_HTML (rqptr);

   vecptr = FaoVector;
   *vecptr++ = HtmlMetaInfo (rqptr, NULL);
   *vecptr++ = ServerHostPort;
   *vecptr++ = tkptr->AdminDescriptionPtr;
   *vecptr++ = Config.cfServer.AdminBodyTag;
   *vecptr++ = ServerHostPort;
   *vecptr++ = tkptr->AdminDescriptionPtr;
   *vecptr++ = rqptr->ScriptName;
   if (tkptr->HtListAdmin)
      *vecptr++ = "List";
   else
      *vecptr++ = "Database";
   *vecptr++ = DatabaseListSize;

   status = NetWriteFaol (rqptr, ResponseFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);

   tkptr->FileCount = 0;

   SysDclAst (&HTAdminDatabaseSearch, rqptr);
}

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

HTAdminDatabaseSearch (REQUEST_STRUCT *rqptr)

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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 (struct FAB *FabPtr)

{
   int  status;
   REQUEST_STRUCT  *rqptr;
   HTADMIN_TASK  *tkptr;

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

   rqptr = FabPtr->fab$l_ctx;

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, WATCH_MOD_HTADMIN,
                 "HTAdminDatabaseSearchAst() !&F sts:!&X stv:!&X",
                 &HTAdminDatabaseSearchAst,
                 FabPtr->fab$l_sts, FabPtr->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';
   if (Debug) fprintf (stdout, "Database |%s|\n", tkptr->SearchOds.ResFileName);

   tkptr->FileCount++;

   status = NetWriteFao (rqptr, "<OPTION VALUE=\"!#&;AZ\">!#&;AZ\n",
                         tkptr->SearchOds.NamNameLength,
                         tkptr->SearchOds.NamNamePtr,
                         tkptr->SearchOds.NamNameLength,
                         tkptr->SearchOds.NamNamePtr);
   if (VMSnok (status)) ErrorNoticed (status, "NetWriteFao()", 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 VALIGN=top>\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\
<BR><INPUT TYPE=submit VALUE=\" Do \">\n\
<INPUT TYPE=reset VALUE=\" Reset \">\n\
</TD></TR>\n\
</TABLE>\n\
<SUP>1.</SUP> !AZ\n\
<BR><SUP>2.</SUP> enter name <INPUT TYPE=text NAME=add SIZE=20>\n\
\
</TR>\n\
</TABLE>\n\
</FORM>\n\
\
</BODY>\n\
</HTML>\n";

   static char  HtlEndPageFao [] =
"</SELECT>\n\
</TD><TD VALIGN=top>\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\
<BR><INPUT TYPE=submit VALUE=\" Do \">\n\
<INPUT TYPE=reset VALUE=\" Reset \">\n\
</TD></TR>\n\
</TABLE>\n\
<SUP>1.</SUP> !AZ\n\
<BR><SUP>2.</SUP> enter name <INPUT TYPE=text NAME=add SIZE=20>\n\
\
</TR>\n\
</TABLE>\n\
</FORM>\n\
\
</BODY>\n\
</HTML>\n";

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

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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 = NetWriteFaol (rqptr, HtlEndPageFao, &FaoVector);
   else
      status = NetWriteFaol (rqptr, HtaEndPageFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);

   SysDclAst (&HTAdminEnd, rqptr);
}

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

HTAdminDatabaseUsersBegin
(
REQUEST_STRUCT *rqptr,
char *DatabaseName
)
{
   static char  ResponseFao [] =
"<HTML>\n\
<HEAD>\n\
!AZ\
<TITLE>HTTPd !AZ ... !AZ</TITLE>\n\
</HEAD>\n\
!AZ\n\
<H2><NOBR>HTTPd !AZ</NOBR></H2>\n\
<H3>!AZ</H3>\n\
\
<FORM METHOD=GET ACTION=\"!AZ\">\n\
<TABLE CELLPADDING=5 CELLSPACING=0 BORDER=1>\n\
<TR><TH>Users in !AZ</TH></TR>\n\
<TR><TD>\n\
<TABLE CELLPADDING=5 CELLSPACING=0 BORDER=0>\n\
<TR><TD VALIGN=top>\n\
<SELECT SIZE=!UL NAME=unm>\n";

   int  status;
   unsigned long  *vecptr;
   unsigned long  FaoVector [32];
   char  *cptr, *sptr, *zptr;
   HTADMIN_TASK  *tkptr;

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, WATCH_MOD_HTADMIN,
                 "HTAdminDatabaseUsersBegin() !&Z", DatabaseName);

   tkptr = rqptr->HTAdminTaskPtr;

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

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

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

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   RESPONSE_HEADER_200_HTML (rqptr);

   vecptr = FaoVector;
   *vecptr++ = HtmlMetaInfo (rqptr, NULL);
   *vecptr++ = ServerHostPort;
   *vecptr++ = tkptr->AdminDescriptionPtr;
   *vecptr++ = Config.cfServer.AdminBodyTag;
   *vecptr++ = ServerHostPort;
   *vecptr++ = tkptr->AdminDescriptionPtr;
   *vecptr++ = rqptr->rqHeader.PathInfoPtr;
   *vecptr++ = DatabaseName;
   *vecptr++ = UserNameListSize;

   status = NetWriteFaol (rqptr, ResponseFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);

   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 (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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 (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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)
      {
         if (Debug) fprintf (stdout, "RMS$_EOF\n");
         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 (Debug)
      fprintf (stdout, "%d. |%s|\n",
               tkptr->UserCount, tkptr->AuthHtRecord.UserName);

   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 (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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 = NetWriteFao (rqptr, "<OPTION VALUE=\"!&;AZ\">!&;AZ\n", cptr1, cptr1);
      if (VMSnok (status)) ErrorNoticed (status, "NetWriteFao()", 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 VALIGN=top>\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\
<BR><INPUT TYPE=submit VALUE=\" Do \">\n\
<INPUT TYPE=reset VALUE=\" Reset \">\n\
</TD></TR>\n\
</TABLE>\n\
<SUP>1.</SUP> !AZ\n\
<BR><SUP>2.</SUP> enter name <INPUT TYPE=text NAME=anm SIZE=20>\n\
\
</TR>\n\
</TABLE>\n\
</FORM>\n\
\
</BODY>\n\
</HTML>\n";

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

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, WATCH_MOD_HTADMIN, "HTAdminDatabaseUsersEnd()");

   tkptr = rqptr->HTAdminTaskPtr;

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

   status = NetWriteFaol (rqptr, EndPageFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);

   SysDclAst (&HTAdminEnd, rqptr);
}

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

HTAdminListUsersBegin
(
REQUEST_STRUCT *rqptr,
char *DatabaseName
)
{
   static char  ResponseFao [] =
"<HTML>\n\
<HEAD>\n\
!AZ\
<TITLE>HTTPd !AZ ... !AZ</TITLE>\n\
</HEAD>\n\
!AZ\n\
<H2><NOBR>HTTPd !AZ</NOBR></H2>\n\
<H3>!AZ</H3>\n\
\
<TABLE CELLPADDING=3 CELLSPACING=0 BORDER=1>\n\
<TR><TH COLSPAN=!UL>Users in !AZ</TH></TR>\n\
<TR><TD>\n\
<TABLE CELLPADDING=1 CELLSPACING=0 BORDER=0>\n\
!AZ";

   static char  BriefHeading [] =
"<TR>\
<TH></TH>\
<TH ALIGN=left><U>Username</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=left><U>Full&nbsp;Name</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=left><U>Access</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=left><U>Added</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=left><U>Accessed</U>&nbsp;&nbsp;</TH></TR>\n\
<TR><TH COLSPAN=6 HEIGHT=3></TH>\
</TR>\n";

   static char  FullHeading [] =
"<TR>\
<TH></TH>\
<TH ALIGN=left><U>Username</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=left><U>Details</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=left><U>Access</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=left><U>Added</U>&nbsp;&nbsp;</TH></TR>\n\
<TR><TD COLSPAN=2></TD>\
<TH ALIGN=left><U>Last</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=left><U>Failure</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=left><U>Changed</U>&nbsp;&nbsp;</TH>\
</TR>\n\
<TR><TH COLSPAN=5 HEIGHT=3></TH></TR>\n";

   int  status;
   unsigned long  *vecptr;
   unsigned long  FaoVector [32];
   char  *cptr, *sptr, *zptr;
   HTADMIN_TASK  *tkptr;

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, WATCH_MOD_HTADMIN,
                 "HTAdminListUsersBegin() !&Z", DatabaseName);

   tkptr = rqptr->HTAdminTaskPtr;

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

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

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

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   RESPONSE_HEADER_200_HTML (rqptr);

   vecptr = FaoVector;
   *vecptr++ = HtmlMetaInfo (rqptr, NULL);
   *vecptr++ = ServerHostPort;
   *vecptr++ = tkptr->AdminDescriptionPtr;
   *vecptr++ = Config.cfServer.AdminBodyTag;
   *vecptr++ = ServerHostPort;
   *vecptr++ = tkptr->AdminDescriptionPtr;

   if (tkptr->BriefList)
      *vecptr++ = 6;
   else
      *vecptr++ = 7;

   *vecptr++ = DatabaseName;

   if (tkptr->BriefList)
      *vecptr++ = BriefHeading;
   else
      *vecptr++ = FullHeading;

   status = NetWriteFaol (rqptr, ResponseFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);

   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 (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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 (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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)
      {
         if (Debug) fprintf (stdout, "RMS$_EOF\n");
         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 (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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 align=left>&nbsp;!3ZL&nbsp;&nbsp;</TH>\
<TH ALIGN=left>!AZ!&;AZ!AZ&nbsp;&nbsp;</TH>\
<TD><NOBR>!&;AZ&nbsp;&nbsp;</NOBR></TD>\
<TD><NOBR>!AZ!AZ&nbsp;&nbsp;</NOBR></TD>\n\
<TD><NOBR>!17%D&nbsp;&nbsp;</NOBR></TD>\
<TD><NOBR>!17%D&nbsp;(!UL)&nbsp;&nbsp;</NOBR></TD>\
</TR>\n";

   static char  FullFao [] =
"<TR>\
<TH align=left>&nbsp;!3ZL&nbsp;&nbsp;</TH>\
<TH align=left>!AZ!&;AZ!AZ&nbsp;&nbsp;</TH>\
<TD>!&;AZ&nbsp;&nbsp;</TD>\
<TD>!AZ!AZ&nbsp;&nbsp;</TD>\
<TD><NOBR>!17%D</NOBR>&nbsp;&nbsp;</TD>\
</TR>\n\
<TR><TD COLSPAN=2></TD>\
<TD COLSPAN=3 BGCOLOR=\"#eeeeee\"><PRE>!&;AZ</PRE></TD></TR>\n\
<TR><TD COLSPAN=2></TD>\
<TD COLSPAN=3 BGCOLOR=\"#eeeeee\">!&@</TD></TR>\n\
<TR><TD COLSPAN=2></TD>\
<TD BGCOLOR=\"#eeeeee\"><NOBR>!17%D&nbsp;(!UL)&nbsp;&nbsp;</NOBR></TD>\
<TD BGCOLOR=\"#eeeeee\"><NOBR>!17%D&nbsp;(!UL)&nbsp;&nbsp;</NOBR></TD>\
<TD BGCOLOR=\"#eeeeee\"><NOBR>!17%D&nbsp;(!UL)&nbsp;&nbsp;</NOBR></TD>\
</TR>\n";

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

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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->AddedBinTime;
      *vecptr++ = &rptr->LastAccessBinTime;
      *vecptr++ = rptr->AccessCount;
   }
   else
   {
      *vecptr++ = &rptr->AddedBinTime;
      *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->LastAccessBinTime;
      *vecptr++ = rptr->AccessCount;
      *vecptr++ = &rptr->LastFailureBinTime;
      *vecptr++ = rptr->FailureCount;
      *vecptr++ = &rptr->LastChangeBinTime;
      *vecptr++ = rptr->ChangeCount;
   }

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

   SysDclAst (&HTAdminListUsersList, rqptr);
}

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

HTAdminListUsersEnd (REQUEST_STRUCT *rqptr)

{
   static char  NotNoneFao [] =
"<TR><TH>&nbsp;!3ZL&nbsp;&nbsp;</TH>\
<TD COLSPAN=!UL BGCOLOR=\"#eeeeee\">&nbsp;<I>empty</I></TD></TR>\n\
</TABLE>\n\
</TD></TR>\n\
</TABLE>\n\
\
</BODY>\n\
</HTML>\n";

   static char  EndPageFao [] =
"</TABLE>\n\
</TD></TR>\n\
</TABLE>\n\
\
</BODY>\n\
</HTML>\n";

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

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, WATCH_MOD_HTADMIN, "HTAdminListUsersEnd()");

   tkptr = rqptr->HTAdminTaskPtr;

   vecptr = FaoVector;

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

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

   SysDclAst (&HTAdminEnd, rqptr);
}

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

HTAdminUserView
(
REQUEST_STRUCT *rqptr,
char *DatabaseName,
char *UserName
)
{
   static char  ResponseFao [] =
"<HTML>\n\
<HEAD>\n\
!AZ\
<TITLE>HTTPd !AZ ... !AZ</TITLE>\n\
</HEAD>\n\
!AZ\n\
<H2><NOBR>HTTPd !AZ</NOBR></H2>\n\
<H3>!AZ</H3>\n\
!20&W\n\
\
<P><TABLE CELLPADDING=5 CELLSPACING=0 BORDER=1>\n\
<TR><TD>\n\
<TABLE CELLPADDING=5 CELLSPACING=0 BORDER=0>\n\
<TR><TH COLSPAN=4>User !&;AZ in !AZ!AZ</TH></TR>\n\
<TR><TH ALIGN=right>Full&nbsp;Name:&nbsp;</TH>\
<TD COLSPAN=3>!&;AZ</TD></TR>\n\
<TR><TH ALIGN=right VALIGN=top>Contact:&nbsp;</TH>\
<TD COLSPAN=3><PRE>!&;AZ</PRE></TD></TR>\n\
<TR><TH ALIGN=right>E-mail:&nbsp;</TH>\
<TD COLSPAN=3>!&@</TD></TR>\n\
<TR><TH ALIGN=right>Access:&nbsp;</TH>\
<TD COLSPAN=3>!AZ!AZ</TD></TR>\n\
<TR><TH ALIGN=right>Password:&nbsp;</TH>\
<TD>!AZ</TD><TD></TD><TD></TD></TR>\n\
<TR><TH ALIGN=right>Added:&nbsp;</TH>\
<TD COLSPAN=2>!20&W</TD></TR>\n\
<TR><TH ALIGN=right>Changed:&nbsp;</TH>\
<TD COLSPAN=2>!20&W</TD><TD ALIGN=right>!UL</TD></TR>\n\
<TR><TH ALIGN=right>Accessed:&nbsp;</TH>\
<TD COLSPAN=2>!20&W</TD><TD ALIGN=right>!UL</TD></TR>\n\
<TR><TH ALIGN=right>Failed:&nbsp;</TH>\
<TD COLSPAN=2>!20&W</TD><TD ALIGN=right>!UL</TD></TR>\n\
</TABLE>\n\
</TD></TR>\n\
</TABLE>\n\
\
</BODY>\n\
</HTML>\n";

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

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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 = AuthAccessHtDatabase (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 */
   /**************/

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   RESPONSE_HEADER_200_HTML (rqptr);

   vecptr = FaoVector;
   *vecptr++ = HtmlMetaInfo (rqptr, NULL);
   *vecptr++ = ServerHostPort;
   *vecptr++ = tkptr->AdminDescriptionPtr;
   *vecptr++ = Config.cfServer.AdminBodyTag;
   *vecptr++ = ServerHostPort;
   *vecptr++ = tkptr->AdminDescriptionPtr;
   *vecptr++ = &rqptr->rqTime.Vms64bit;

   *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++ = "";

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

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

   if (AuthHtRecord.HashedPwd[0] || AuthHtRecord.HashedPwd[1])
      *vecptr++ = "********";
   else
      *vecptr++ = "";

   *vecptr++ = &AuthHtRecord.AddedBinTime;
   *vecptr++ = &AuthHtRecord.LastChangeBinTime;
   *vecptr++ = AuthHtRecord.ChangeCount;
   *vecptr++ = &AuthHtRecord.LastAccessBinTime;
   *vecptr++ = AuthHtRecord.AccessCount;
   *vecptr++ = &AuthHtRecord.LastFailureBinTime;
   *vecptr++ = AuthHtRecord.FailureCount;

   status = NetWriteFaol (rqptr, ResponseFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", 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 [] =
"<HTML>\n\
<HEAD>\n\
!AZ\
<TITLE>HTTPd !AZ ... !AZ</TITLE>\n\
</HEAD>\n\
!AZ\n\
<H2><NOBR>HTTPd !AZ</NOBR></H2>\n\
<H3>!AZ</H3>\n\
\
<FORM METHOD=POST ACTION=\"!AZ\">\n\
<INPUT TYPE=HIDDEN NAME=do VALUE=!AZ>\n\
<INPUT TYPE=HIDDEN NAME=!AZ VALUE=\"!AZ\">\n\
<TABLE CELLPADDING=5 CELLSPACING=0 BORDER=1>\n\
<TR><TH COLSPAN=2>!AZ !AZ !AZin !AZ</TH></TR>\n\
<TR><TD COLSPAN=2>\n\
\
<TABLE CELLPADDING=5 CELLSPACING=0 BORDER=0>\n\
<TR><TH ALIGN=right>Full&nbsp;Name:&nbsp;</TH>\
<TD><INPUT TYPE=text NAME=fnm SIZE=!UL MAXLENGTH=!UL \
VALUE=\"!&;AZ\"></TD></TR>\n\
<TR><TH ALIGN=right>Contact:&nbsp;</TH>\
<TD><TEXTAREA NAME=con COLS=!UL ROWS=!UL>!&;AZ\
</TEXTAREA></TD></TR>\n\
<TR><TH ALIGN=right>E-mail:&nbsp;</TH>\
<TD><INPUT TYPE=text NAME=eml SIZE=!UL MAXLENGTH=!UL \
VALUE=\"!&;AZ\"></TD></TR>\n\
<TR><TH ALIGN=right>Enabled:&nbsp;</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 ALIGN=right>Access:&nbsp;</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 ALIGN=right>SSL&nbsp;Only:&nbsp;</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 ALIGN=right>Password:&nbsp;</TH>\
<TD><INPUT TYPE=password NAME=pwn SIZE=!UL MAXLENGTH=!UL>\
&nbsp;&nbsp;<INPUT TYPE=checkbox NAME=pwd VALUE=\"pwd\">generate\
&nbsp;&nbsp;<INPUT TYPE=checkbox NAME=pin VALUE=\"pin\">PIN\
</TD></TR>\n\
<TR><TH ALIGN=right>Verify:&nbsp;</TH>\
<TD><INPUT TYPE=password NAME=pwv SIZE=!UL MAXLENGTH=!UL></TD></TR>\n\
\
<TR><TD></TD><TD>\
<INPUT TYPE=submit VALUE=\" !AZ \">&nbsp;&nbsp;\
<INPUT TYPE=reset VALUE=\" Reset \"></TD></TR>\n\
</TD></TR>\n\
</TABLE>\n\
</TD></TR>\n\
</TABLE>\n\
</FORM>\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 (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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 = AuthAccessHtDatabase (rqptr, false, DatabaseName,
                                     UserName, &AuthHtRecord, NULL, NULL);
      if (VMSok (status))
         AlreadyExists = true;
      else
         AlreadyExists = false;
      if (status == RMS$_EOF) status = SS$_NORMAL;
   }
   else
   {
      status = AuthAccessHtDatabase (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 */
   /**************/

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   RESPONSE_HEADER_200_HTML (rqptr);

   vecptr = FaoVector;
   *vecptr++ = HtmlMetaInfo (rqptr, NULL);
   *vecptr++ = ServerHostPort;
   *vecptr++ = tkptr->AdminDescriptionPtr;
   *vecptr++ = Config.cfServer.AdminBodyTag;
   *vecptr++ = ServerHostPort;
   *vecptr++ = tkptr->AdminDescriptionPtr;

   *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++ =
"<FONT COLOR=\"#ff0000\"> &nbsp;&nbsp;&nbsp;\
ALREADY EXISTS&nbsp;&nbsp;&nbsp; </FONT>";
      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 = NetWriteFaol (rqptr, ResponseFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", 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 char  A1DigestLoCase [16],
                  A1DigestUpCase [16],
                  PasswordScratch [16];
   MD5_HASH  Md5Hash;
   AUTH_HTAREC AuthHtRecord;
   AUTH_CREC  AuthCacheRecord;
   $DESCRIPTOR (PasswordScratchDsc, PasswordScratch);

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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 ((toupper(Enabled[0]) != 'Y' && toupper(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,
                  HttpdBinTime[0] / 1000 % 10000);
      }
      else
      {
         /* generate a six alpha-numeric character password */
         Md5Digest (&HttpdBinTime, 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 = tolower(*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 (rqptr->rqAuth.RealmDescrPtr,
                                      rqptr->RemoteUser,
                                      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 = AuthAccessHtDatabase (rqptr, true, DatabaseName,
                                  UserName, &AuthHtRecord, NULL, NULL);
   if (AddUser)
   {
      if (VMSok (status))
      {
         /* ensure the database is closed */
         AuthAccessHtDatabase (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 */
         AuthAccessHtDatabase (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)
   {
      memcpy (&AuthHtRecord.AddedBinTime, &rqptr->rqTime.Vms64bit, 8);
      AuthHtRecord.DatabaseVersion = AUTH_HTA_VERSION;
   }
   else
   {
      memcpy (&AuthHtRecord.LastChangeBinTime, &rqptr->rqTime.Vms64bit, 8);
      AuthHtRecord.ChangeCount++;
   }
   if (PasswordNew[0])
   {
      memcpy (&AuthHtRecord.HashedPwd, &HashedPwd, 8);
      memcpy (&AuthHtRecord.A1DigestLoCase, &A1DigestLoCase, 16);
      memcpy (&AuthHtRecord.A1DigestUpCase, &A1DigestUpCase, 16);
   }

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

   if (toupper(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_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_DELETE | AUTH_FLAG_GET |
                             AUTH_FLAG_HEAD | AUTH_FLAG_POST | AUTH_FLAG_PUT);
   else
   if (strsame (Access, "w", -1))
      AuthHtRecord.Flags |= (AUTH_FLAG_DELETE | AUTH_FLAG_POST | AUTH_FLAG_PUT);

   /* add/update the record, close the database file */
   if (AddUser)
      status = AuthAccessHtDatabase (NULL, false, NULL, NULL,
                                     NULL, &AuthHtRecord, NULL);
   else
      status = AuthAccessHtDatabase (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)
      WriteFaoStdout ("%!AZ-I-AUTHHTA, !20%D, add !AZ to !AZ by !AZ.\'!AZ\'@!AZ\n",
         Utility, 0, UserName, DatabaseName,
         rqptr->RemoteUser, rqptr->rqAuth.RealmPtr,
         rqptr->rqClient.Lookup.HostName);
   else
      WriteFaoStdout (
         "%!AZ-I-AUTHHTA, !20%D, modify !AZ in !AZ by !AZ.\'!AZ\'@!AZ\n",
         Utility, 0, UserName, DatabaseName,
         rqptr->RemoteUser, rqptr->rqAuth.RealmPtr, rqptr->rqClient.Lookup.HostName);

   /* 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 [] =
"<HTML>\n\
<HEAD>\n\
!AZ\
<TITLE>HTTPd !AZ ... !AZ</TITLE>\n\
</HEAD>\n\
!AZ\n\
<H2><NOBR>HTTPd !AZ</NOBR></H2>\n\
<H3>!AZ</H3>\n\
\
<FORM METHOD=POST ACTION=\"!AZ\">\n\
<INPUT TYPE=hidden NAME=do VALUE=userdelete>\n\
<INPUT TYPE=hidden NAME=unm VALUE=\"!&;AZ\">\n\
<P><TABLE CELLPADDING=5 CELLSPACING=0 BORDER=1>\n\
<TR><TD ALIGN=left VALIGN=top>\n\
<NOBR>&nbsp;<B>User:</B>&nbsp;&nbsp;!AZ&nbsp;\
<B>in</B>&nbsp;!AZ&nbsp;&nbsp;&nbsp;\
<INPUT TYPE=submit VALUE=\" Delete !! \"></NOBR>\n\
<BR>\n\
<TABLE CELLPADDING=1 CELLSPACING=0 BORDER=0>\n\
<TR><TH ALIGN=right>&nbsp;Full&nbsp;Name:&nbsp;</TH><TD>!&;AZ</TD></TR>\n\
<TR><TH ALIGN=right VALIGN=top>&nbsp;Contact:&nbsp;</TH>\
<TD><PRE>!&;AZ!&;AZ</PRE></TD></TR>\n\
</TABLE>\n\
</TD></TR>\n\
</TABLE>\n\
</FORM>\n\
\
</BODY>\n\
</HTML>\n";

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

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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 = AuthAccessHtDatabase (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 */
   /**************/

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   RESPONSE_HEADER_200_HTML (rqptr);

   vecptr = FaoVector;
   *vecptr++ = HtmlMetaInfo (rqptr, NULL);
   *vecptr++ = ServerHostPort;
   *vecptr++ = tkptr->AdminDescriptionPtr;
   *vecptr++ = Config.cfServer.AdminBodyTag;
   *vecptr++ = ServerHostPort;
   *vecptr++ = tkptr->AdminDescriptionPtr;
   *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 = NetWriteFaol (rqptr, ResponseFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);

   SysDclAst (&HTAdminEnd, rqptr);
}

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

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

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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 = AuthAccessHtDatabase (rqptr, true, DatabaseName,
                                  UserName, &AuthHtRecord, NULL, NULL);
   if (status == RMS$_EOF)
   {
      /* ensure the database is closed */
      AuthAccessHtDatabase (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 = AuthAccessHtDatabase (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 */
   /**************/

   WriteFaoStdout ("%!AZ-I-AUTHHTA, !20%D, delete !AZ from !AZ by !AZ.\'!AZ\'@!AZ\n",
      Utility, 0, UserName, DatabaseName,
      rqptr->RemoteUser, rqptr->rqAuth.RealmPtr, rqptr->rqClient.Lookup.HostName);

   /* 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);
}

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

HTAdminChangePasswordForm (REQUEST_STRUCT *rqptr)

{
   static char  ResponseFao [] =
"<HTML>\n\
<HEAD>\n\
!AZ\
<TITLE>!AZ</TITLE>\n\
</HEAD>\n\
!&@\
!&@\
<H2>!AZ</H2>\n\
!AZ!AZ!AZ\
!&@\
<P><FORM METHOD=POST ACTION=\"!AZ\">\n\
<TABLE CELLPADDING=5 CELLSPACING=0 BORDER=1>\n\
<TR><TH>!AZ.\'!&;AZ\'@!AZ</TH></TR>\n\
<TR><TD>\n\
<TABLE CELLPADDING=5 CELLSPACING=0 BORDER=0>\n\
<TR><TH ALIGN=RIGHT>!AZ:</TH>\
<TD ALIGN=LEFT><INPUT TYPE=password SIZE=!UL MAXLENGTH=!UL NAME=pwc></TD></TR>\n\
<TR><TH ALIGN=RIGHT>!AZ:</TH>\
<TD ALIGN=LEFT><INPUT TYPE=password SIZE=!UL MAXLENGTH=!UL NAME=pwn></TD></TR>\n\
<TR><TH ALIGN=RIGHT>!AZ:</TH>\
<TD ALIGN=LEFT><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\
!&@\
</BODY>\n\
</HTML>\n";

   int  status;
   unsigned long  *vecptr;
   unsigned long  FaoVector [32];
   char  *cptr;
   char  Scratch [256];

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, WATCH_MOD_HTADMIN,
                 "HTAdminChangePasswordForm()");

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   RESPONSE_HEADER_200_HTML (rqptr);

   strcpy (cptr = Scratch, MsgFor(rqptr,MSG_HTADMIN_PWD_CHANGE));

   vecptr = FaoVector;

   *vecptr++ = HtmlMetaInfo (rqptr, NULL);

   /* "Change Authentication" */
   *vecptr++ = cptr;

   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++ = Config.cfServer.ReportBodyTag;
   }

   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 CELLPADDING=5 CELLSPACING=0 BORDER=0 WIDTH=100%><TR><TD!&+AZ>\n!&@";
         *vecptr++ = rqptr->rqPathSet.HtmlHeaderTagPtr;
      }
      *vecptr++ = "!AZ\n<P>";
      *vecptr++ = rqptr->rqPathSet.HtmlHeaderPtr;
   }
   else
      *vecptr++ = "";

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

   if (rqptr->rqAuth.SysUafPwdExpired)
   {
      *vecptr++ = "<P><B>&nbsp;";
      *vecptr++ = cptr;
      *vecptr++ = "</B>\n";
   }
   else
   {
      *vecptr++ = "";
      *vecptr++ = "";
      *vecptr++ = "";
   }
   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, not the base */
   *vecptr++ = rqptr->ServicePtr->ServerHostPort;

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

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

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

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

   /* "Reset" */
   *vecptr++ = cptr;
   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 CELLPADDING=5 CELLSPACING=0 BORDER=0 WIDTH=100%><TR><TD!&+AZ>\n!&@";
      *vecptr++ = rqptr->rqPathSet.HtmlFooterTagPtr;
      *vecptr++ = "!AZ\n</TD></TR></TABLE>";
      *vecptr++ = rqptr->rqPathSet.HtmlFooterPtr;
   }
   else
      *vecptr++ = "";

   status = NetWriteFaol (rqptr, ResponseFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", 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 char  A1DigestLoCase [16],
                  A1DigestUpCase [16];
   AUTH_HTAREC AuthHtRecord;
   AUTH_CREC  AuthCacheRecord;

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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 (Config.cfAuth.SysUafUseACME)
      {
         if (!AuthConfigACME)
         {
            rqptr->rqResponse.HttpStatus = 403;
            ErrorGeneral (rqptr, MsgFor(rqptr,MSG_GENERAL_DISABLED), FI_LI);
            HTAdminChangePasswordEnd (rqptr);
            return;
         }
         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_CATEGORY(WATCH_RESPONSE))
      WatchThis (rqptr, FI_LI, 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 = AuthAccessHtDatabase (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);
   memcpy (&AuthHtRecord.LastChangeBinTime, &rqptr->rqTime.Vms64bit, 8);
   AuthHtRecord.ChangeCount++;

   /* update the record, close the database file */
   status = AuthAccessHtDatabase (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 (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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 */
   WriteFaoStdout ("%!AZ-I-PASSWORD, !20%D, change !AZ.\'!AZ\'@!AZ\n",
      Utility, 0, rqptr->RemoteUser, rqptr->rqAuth.RealmDescrPtr,
      rqptr->rqClient.Lookup.HostName);

   /* and to the operator log if so enabled */
   if (OpcomMessages & OPCOM_AUTHORIZATION)
       WriteFaoOpcom ("%!AZ-I-PASSWORD, change !AZ.\'!AZ\'@!AZ",
          Utility, rqptr->RemoteUser, rqptr->rqAuth.RealmDescrPtr,
          rqptr->rqClient.Lookup.HostName);

   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);
}

/*****************************************************************************/
/*
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 (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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 */
   WriteFaoStdout (
"%!AZ-I-AUTHCACHE, !20%D, purge authorization cache by !AZ.\'!AZ\'@!AZ\n",
      Utility, 0, rqptr->RemoteUser, rqptr->rqAuth.RealmPtr,
      rqptr->rqClient.Lookup.HostName);

   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\0");
   static char  Buffer [128];
   static $DESCRIPTOR (BufferDsc, Buffer);

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

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, WATCH_MOD_HTADMIN, "HTAdminCanString()");

   vecptr = FaoVector;

   if ((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_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_DELETE ||
          CanFlags & AUTH_FLAG_GET ||
          CanFlags & AUTH_FLAG_HEAD ||
          CanFlags & AUTH_FLAG_POST ||
          CanFlags & AUTH_FLAG_PUT)
         *vecptr++ = " <NOBR>&nbsp;(<FONT SIZE=-1> ";
      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_DELETE ||
          CanFlags & AUTH_FLAG_GET ||
          CanFlags & AUTH_FLAG_HEAD ||
          CanFlags & AUTH_FLAG_POST ||
          CanFlags & AUTH_FLAG_PUT)
         *vecptr++ = " </FONT>)</NOBR>";
      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 [] =
"<HTML>\n\
<HEAD>\n\
!AZ\
<TITLE>HTTPd !AZ ... !AZ</TITLE>\n\
</HEAD>\n\
!AZ\n\
<H2><NOBR>HTTPd !AZ</NOBR></H2>\n\
<H3>!AZ</H3>\n\
\
<FORM METHOD=POST ACTION=\"!AZ\">\n\
<INPUT TYPE=hidden NAME=do VALUE=htacreate>\n\
<P><TABLE CELLPADDING=5 CELLSPACING=0 BORDER=1>\n\
<TR><TD ALIGN=right VALIGN=top>\n\
<NOBR>&nbsp;<B>Database:</B>&nbsp;&nbsp;!AZ&nbsp;&nbsp;&nbsp;\
<INPUT TYPE=submit VALUE=\" Create \"></NOBR>\n\
</TD></TR>\n\
</TABLE>\n\
</FORM>\n\
\
</BODY>\n\
</HTML>\n";

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

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, WATCH_MOD_HTADMIN,
                 "HTAdminDatabaseCreateForm()");

   tkptr = rqptr->HTAdminTaskPtr;

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

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   RESPONSE_HEADER_200_HTML (rqptr);

   vecptr = FaoVector;
   *vecptr++ = HtmlMetaInfo (rqptr, NULL);
   *vecptr++ = ServerHostPort;
   *vecptr++ = tkptr->AdminDescriptionPtr;
   *vecptr++ = Config.cfServer.AdminBodyTag;
   *vecptr++ = ServerHostPort;
   *vecptr++ = tkptr->AdminDescriptionPtr;
   *vecptr++ = rqptr->rqHeader.PathInfoPtr;
   *vecptr++ = DatabaseName;

   status = NetWriteFaol (rqptr, ResponseFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);

   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 (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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 */
   /**************/

   WriteFaoStdout ("%!AZ-I-AUTHHTA, !20%D, create !AZ by !AZ.\'!AZ\'@!AZ\n",
      Utility, 0, DatabaseName,
      rqptr->RemoteUser, rqptr->rqAuth.RealmPtr, rqptr->rqClient.Lookup.HostName);

   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 [] =
"<HTML>\n\
<HEAD>\n\
!AZ\
<TITLE>HTTPd !AZ ... !AZ</TITLE>\n\
</HEAD>\n\
!AZ\n\
<H2><NOBR>HTTPd !AZ</NOBR></H2>\n\
<H3>!AZ</H3>\n\
\
<FORM METHOD=POST ACTION=\"!AZ!AZ\">\n\
<INPUT TYPE=hidden NAME=do VALUE=\"!AZ\">\n\
<P><TABLE CELLPADDING=5 CELLSPACING=0 BORDER=1>\n\
<TR><TD ALIGN=right VALIGN=top>\n\
<NOBR>&nbsp;<B>!AZ:</B>&nbsp;&nbsp;!AZ&nbsp;&nbsp;&nbsp;\
<INPUT TYPE=submit VALUE=\" Delete !! \"></NOBR>\n\
</TD></TR>\n\
</TABLE>\n\
</FORM>\n\
\
</BODY>\n\
</HTML>\n";

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

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, WATCH_MOD_HTADMIN,
                 "HTAdminDatabaseDeleteForm()");

   tkptr = rqptr->HTAdminTaskPtr;

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

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   RESPONSE_HEADER_200_HTML (rqptr);

   vecptr = FaoVector;
   *vecptr++ = HtmlMetaInfo (rqptr, NULL);
   *vecptr++ = ServerHostPort;
   *vecptr++ = tkptr->AdminDescriptionPtr;
   *vecptr++ = Config.cfServer.AdminBodyTag;
   *vecptr++ = ServerHostPort;
   *vecptr++ = tkptr->AdminDescriptionPtr;
   *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 = NetWriteFaol (rqptr, ResponseFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", 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 (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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'; 
      if (Debug)
         fprintf (stdout, "ExpFileName |%s|\n", tkptr->FileOds.ExpFileName);

      /* 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 */
   /**************/

   WriteFaoStdout ("%!AZ-I-AUTHHTA, !20%D, delete !AZ by !AZ.\'!AZ\'@!AZ\n",
      Utility, 0, DatabaseName,
      rqptr->RemoteUser, rqptr->rqAuth.RealmPtr, rqptr->rqClient.Lookup.HostName);

   /* 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 (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_HTADMIN))
      WatchThis (rqptr, FI_LI, 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)))
   {
      if (Debug) fprintf (stdout, "sys$connect() %%X%08.08X\n", status);
      rqptr->rqResponse.ErrorTextPtr = MapVmsPath (tkptr->AuthFileName, rqptr);
      rqptr->rqResponse.ErrorOtherTextPtr = tkptr->AuthFileName;
      ErrorVmsStatus (rqptr, status, FI_LI);
      HTAdminEnd (rqptr);
      return (status);
   }

   return (status);
}

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

