/*****************************************************************************/
/*
                                   wAUXd.c

WASD auxiliary server wrapper.

Slow to start up is intended to provide sufficient hooks to allow WASD
WebSocket applications to be used indepedent of the WASD server package.

This is intended to be a single-threaded, largely synchronous application that
doesn't go out of its way to manage allocated memory and related resources as
it is activated by the TCP/IP Services auxiliary server and at the conclusion
of the request exits with the normal rundown actions cleaning up behind it.

Deliberately only accepts GET requests.

Can process CGI and CGIplus requests.  Of course, being single threaded, only
handles a single CGIplus request before exit..

OPERATION
---------

   main()
      |
   BeginToProcess()
         |
      NetAccept()     !set up the network connection (plain/TLS)
         |
   +-->--+
   |     |
   |  GetRequestHeader()     !read the request header (up 'til empty line)
   |     |
   |  ParseRequestHeader()   !parse the request header determining if it is a
   |     |                   !CGI(plus) script, specific file, index file
   |     |
   |  BeginRequest()   !based on the header parse begin a CGI(plus) script
   |     |             !in a subprocess, access a specific file, or in a loop
   ^     |             !try to access each of the index files in turn
   |     |
   |     +-------------------+-------------------+
   |     |                   |                   |
   |     BeginSubProcess()   BeginFile()      <loop>---BeginFile()
   |     |                   |                   |
   |     +-------------------+-------------------+                   
   |     |
   +--<--+
         |
      NetClose()
         |
      exit()



CONFIGURATION
-------------
Designed to be configured by defining, generally process-level, logical names
containing simple, sometimes comma-separated values.  Multi-valued logical
names may comprise concatenated strings up to LOGICAL_VALUE_SIZE bytes.

WAUXD_CERT     The location of the wAUXd server X509 server certificate.

WAUXD_CGI      Comma-separated list of CGI(plus)-space to file-system space.
               e.g. "/cgi-bin/=dka100:[web.cgi-bin],
                     /cgiplus-bin/=+dka100:[web.cgi-bin]"

WAUXD_DCL      A DCL command activated immediately before the script.
               e.g. "@dka200:[apps.lister]lister_setup.com"
                    "define /process LISTER_MODE "subprocess""

WAUXD_DUMP     When defined provide a hex plus printable character dump
               of DCL command, CGIplus data, SYS$OUTPUT, network records.
               (logical name WAUXD_LOG must be defined)

               '*' all of the following, otherwise
               '$' DCL commands to a subprocess
               '+' CGIplus records to a subprocess
               ':' SYS$OUTPUT records from a subprocess
               '<' network data from the client
               '>' network data to the client
               '{' WebSocket data from the client
               '}' WebSocket data to the client

WAUXD_INDEX    Comma-separated list of index/home files.
               e.g. "home.html,index.html,readme.html"
               See macro DEFAULT_INDEX_FILENAMES for defaults.

WAUXD_LOG      file specification for wAUXd log file
               no log file is generated if not defined

WAUXD_ROOT     Comma-separated list of web-space to file-system space.
               e.g. "/web/=/dka100/web/,/lister/=/dka200/apps/lister/"
               Note the file-system space must be in U*x specification.

WAUXD_TYPES    Comma-separated list of file extension to MIME type.
               e.g. ".txt=text/plain,.html=text/html,.pdf=application/pdf"
               Predefined MIME types (see GetMimeType()) can be overwritten
               or additonal types created by prefixing the vlaue with a '+'.

WAUXD_VERIFY   If defined set the DCL wrapper procedure to VERIFY.



LIB$SPAWN vs SYS$CREPRC
-----------------------
Dissatisfied with the scripting performance using the simpler lib$spawn(), on
my old PWS500 running /cgi-bin/cgi_symbols was taking 5 seconds plus, I moved
to the moderately cruftier sys$creprc() and the run time dropped to fractions
of a second.  An improvement of some 25x.  Well worth it wouldn't you say!



VERSION LOG
-----------
12-MAR-2024  MGD  initial
*/
/*****************************************************************************/

#include <ctype.h>
#include <descrip.h>
#include <fcntl.h>
#include <in.h>
#include <ints.h>
#include <stdio.h>
#include <stdlib.h>
#include <string.h>
#include <unistd.h>
#include <unixio.h>

#include <cmbdef.h>
#include <dvidef.h>
#include <iodef.h>
#include <jpidef.h>
#include <fabdef.h>
#include <lib$routines.h>
#include <libclidef.h>
#include <lnmdef.h>
#include <starlet.h>
#include <ssdef.h>
#include <ttdef.h>
#include <tt2def.h>

#define DC$_TERM 6

#include <tcpip$inetdef.h>

#include <sys/types.h>
#include <sys/socket.h>
#include <netinet/in.h>
#include <arpa/inet.h>
#include <netdb.h>

#include <openssl/crypto.h>
#include <openssl/ssl.h>
#include <openssl/err.h>

#ifndef UNT64PTR
/* mainly to allow easy use of the __unaligned directive */
#define UINTPTR __unaligned unsigned int*
#define ULONGPTR __unaligned unsigned long*
#define USHORTPTR __unaligned unsigned short*
#define UINT64PTR __unaligned uint64*
#define INT64PTR __unaligned int64*
#endif

#define FI_LI "WAUXD",__LINE__

#define CGIPLUS_BUFFER_SIZE 2048
#define DEFAULT_OUT_SIZE 16384
#define DEFAULT_READ_SIZE 4096
#define DEFAULT_INDEX_FILENAMES "home.html,index.html,readme.html"
#define DEFAULT_500_MSG "absolutely no idea what went wrong!"
#define LOGICAL_VALUE_SIZE 4096
#define QUERY_STRING_SIZE 2048
#define READ_BUF_SIZE 8192
#define REQUEST_URI_SIZE 2048
#define SYMBOL_BUF_SIZE 2048
#define MBX_PROT_MASK 0xff00

#define BUFFER_ON    -1
#define BUFFER_OFF   -2
#define BUFFER_FLUSH -3
#define BUFFER_RESET -4

static int  CliSymbolType = LIB$K_CLI_GLOBAL_SYM;

static int  dbug;
static int  secure;
static int  noWWW = 0;

static int  sockfd;
static struct in_addr  ipaddr;
static unsigned int peer_addrlen;
static struct sockaddr_in peer_addr;

static SSL_CTX  *ctx;
static SSL  *ssl;
static const SSL_METHOD  *meth;
static X509  *server_cert;
static EVP_PKEY  *pkey;
static uint  exCount;

static char  rbuf [READ_BUF_SIZE];

static int  CgiPlusInSize = 4096,
            CgiVarSize = 4096,
            HttpInputSize = 4096,
            SysCmdSize = 4096,
            SysOutSize = 4096,
            WebSockInSize = 4096,
            WebSockOutSize = 4096;

static ushort  CgiPlusInChan,
               SysCmdChan,
               HttpInputChan,
               NetBgSdc,
               SysOutChan,
               TermMbxChan,
               TermMbxUnit,
               WebSockInChan,
               WebSockOutChan;

static char  CgiPlusInDevName [64],
             CgiGatewayMrs [16],
             CgiPlusEof [32],
             CgiPlusEot [32],
             CgiPlusEsc [32],
             HttpHost [128],
             HttpInputDevName [64],
             SysCmdDevName [64],
             SysOutDevName [64],
             WebSockInDevName [64],
             WebSockInMrs [16],
             WebSockOutDevName [64],
             WebSockOutMrs [16];

static int  CgiPlusInCount,
            CgiPlusInDataLength,
            CgiPlusInDataSize,
            CgiPlusInStatus,
            CgiPlusEofLength,
            CgiPlusEotLength,
            CgiPlusEscLength,
            ChangingProtocols,
            OutputCount,
            SysCmdCount,
            SysCmdDataLength,
            SysCmdDataSize,
            SysCmdStatus,
            SysOutCount,
            SysOutSize,
            SysOutStatus,
            WebSockInCount,
            WebSockInSize,
            WebSockInStatus,
            WebSockPeek,
            WebSockOutCount,
            WebSockOutSize,
            WebSockOutStatus;

static uint  EfnNoWait,
             ScriptPid;

static char  *CgiPlusInBuffer,
             *CgiPlusInDataPtr,
             *NetReadBuffer,
             *SysCmdBuffer,
             *SysCmdDataPtr,
             *SysOutBuffer,
             *WebSockInBuffer,
             *WebSockOutBuffer;

static int  ConnectionClose,
            ContentTypeHtml,
            ContentTypePlain,
            ConfigVerify,
            HttpStatus,
            IsCgiPlus,
            IsWebSock,
            IsJustCgi,
            NetConnectClosed,
            NetReadErrorCount,
            NetWriteErrorCount,
            RequestConnectionClose,
            ResponseConnectionClose,
            ResponseContentLength,
            ResponseHeader,
            RequestCount,
            RootDirLen,
            RootUriLen,
            SysOutEscape,
            WebSockAccepted,
            WebSockKeyLen,
            WaitForClose,
            WaitForRequest,
            XBufferRecords,
            XFilterStream,
            XStreamMode,
            XRecordMode,
            XRecord0Mode;

static int64  ResponseBytes64;

static char  *CgiPathInfo,
             *CgiPathTrans,
             *CgiQueryString,
             *CgiRemoteAddr,
             *CgiRemoteHost,
             *CgiScriptName,
             *CgiScriptFileName,
             *CgiServerAddr = "*",
             *CgiServerName = "*",
             *ConfigCertFile,
             *ConfigDump,
             *ConfigCgi,
             *ConfigDcl,
             *ConfigRoot,
             *ConfigMimeTypes,
             *IndexFileNames,
             *RequestUri,
             *RootDir,
             *RootUri,
             *ScriptName;

static char  HttpUpgrade [64],
             HttpUserAgent [256],
             WebSockKey [64],
             WebSockVersion [64];

static struct IOsb {
   ushort  iosb$w_status;
   ushort  iosb$w_bcnt;
   uint    iosb$l_reserved;
};

static struct IOsb CgiPlusInIOsb;
static struct IOsb SysCmdIOsb;
static struct IOsb SysOutIOsb;
static struct IOsb TermMbxIOsb;
static struct IOsb WebSockInIOsb;
static struct IOsb WebSockOutIOsb;
static struct IOsb WebSockPeekIOsb;

typedef struct CrePrcTermStruct CREPRC_TERM;

struct CrePrcTermStruct
{
    unsigned short int acc$w_msgtyp;
    unsigned short int acc$w_msgsiz;
    unsigned int acc$l_finalsts;
    unsigned int acc$l_pid;
    unsigned int acc$l_jobid;
    unsigned int acc$q_termtime [2];
    char acc$t_account [8];
    char acc$t_username [12];
    unsigned int acc$l_cputim;
    unsigned int acc$l_pageflts;
    unsigned int acc$l_pgflpeak;
    unsigned int acc$l_wspeak;
    unsigned int acc$l_biocnt;
    unsigned int acc$l_diocnt;
    unsigned int acc$l_volumes;
    unsigned int acc$q_login [2];
    unsigned int acc$l_owner;
};

static CREPRC_TERM TermRecord;

static void CgiPlusInAst ();
static int CgiPlusInWrite (char*, int);
static void SysOutRead ();
static void SysOutAst ();
static void SysCmdAst ();
static int SysCmdWrite (char*, int);
static void ScriptTermAst (void);
static char* printOpenSSLerrors();
static char* getOpenSSLerror (SSL*, int);
int NetAccept ();
int NetClose ();
int NetRead ();
int NetWrite (char*, int);
void WebSockOut ();
void WebSockOutAst ();
void WebSockIn ();
void WebSockInAst ();
void WebSockInPeek (int);
static int WriteNow (char*, int);
static void DumpData (char*, int, char*, char*, int);

void AndExit (int);
int BeginToProcess ();
int BeginSubProcess ();
char* CgiFileName (char*);
char* GetCgiRoot (char*, int*);
char* GetFileRoot (char*, int*);
char* GetMimeType (char*);
int GetRequestHeader ();
char* GetLogical (char*);
int ParseQuery ();
int ParseRequestHeader ();
char* RandomString ();
int Response400 (char*, int, char*);
int Response403 (char*, int, char*);
int Response404 (char*, int, char*);
int Response500 (char*, int, char*);
int Response501 (char*, int, char*);
int Response502 (char*, int, char*);
char* HttpResponse (char*);
char* HttpResponse2 (char*);
int BeginFile (char*);
int BeginRequest ();
int ScriptSubProcess (void);
int SetCgiVar (char*, char*);
int strzcpy (char*, char*, int);
void timestamp (char*, int, char*);
int UrlDecode (char*);
int WebSockSecAccept ();
int WriteOut (char*, int);

static char  SoftwareID [] = "wAUXd 0.1.0";

/*****************************************************************************/
/*
Connect and accept a socket to the auxilliary server.  Peek at the first three
bytes to see if a TLS handshake preface.  If it is setup a TLS connection to
the peer.  If not just a cleartext connection.
*/

int NetAccept ()

{
   static $DESCRIPTOR (FaoDsc, "begin !%D\0");

   union address {
      struct sockaddr     addr;
      struct sockaddr_in  addr4;
      struct sockaddr_in6 addr6;
   };
   union address peer;

   int  retval;
   char  scratch [256];
   $DESCRIPTOR (BufDsc, scratch);

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

   sys$fao (&FaoDsc, 0, &BufDsc, 0);
   timestamp ("NETWORK", -1, scratch);

   sockfd = socket (TCPIP$C_AUXS, SOCK_STREAM, 0);
   if (sockfd < 0) return (-1);

   NetBgSdc = decc$get_sdc (sockfd);

   memset (&peer, 0, sizeof(peer));
   peer_addrlen = sizeof(peer);
   retval = getpeername (sockfd, &peer.addr, &peer_addrlen);
   if (retval < 0) return (-1);

   retval = recv (sockfd, rbuf, 3, MSG_PEEK);
   if (retval < 0) return (-1);

   /* if TLS client hello message */
   if (!memcmp (rbuf, "\x16\x03\x01", 3))
      secure = 1;
   else
      secure = 0;

   if (secure)
   {
      SSL_library_init();
      SSL_load_error_strings();

      meth = TLS_method();

      ctx = SSL_CTX_new (meth);
      if (!ctx)
      {
         fprintf (stdout, "%s:%d SSL_CTX_new()\n", FI_LI);
         ERR_print_errors_fp (stdout);
         AndExit (SS$_ABORT);
      }

      /* set the key and cert */
      if (SSL_CTX_use_certificate_file (ctx, ConfigCertFile,
                                        SSL_FILETYPE_PEM) <= 0)
      {
         fprintf (stdout, "%s:%d SSL_CTX_use_certificate_file()\n", FI_LI);
         ERR_print_errors_fp (stdout);
         AndExit (SS$_ABORT);
      }

      if (SSL_CTX_use_PrivateKey_file (ctx, ConfigCertFile,
                                       SSL_FILETYPE_PEM) <= 0)
      {
         fprintf (stdout, "%s:%d SSL_CTX_use_certificate_file()\n", FI_LI);
         ERR_print_errors_fp (stdout);
         AndExit (SS$_ABORT);
      }

      ssl = SSL_new (ctx);
      if (!ssl)
      {
         fprintf (stdout, "%s:%d SSL_new()\n", FI_LI);
         ERR_print_errors_fp (stdout);
         AndExit (SS$_ABORT);
      }

      SSL_set_fd (ssl, sockfd);

      retval = SSL_accept (ssl);
      if (retval <= 0)
      {
         fprintf (stdout, "%s:%d SSL_accept()\n", FI_LI);
         ERR_print_errors_fp (stdout);
         AndExit (SS$_ABORT);
      }
   }

   retval = getnameinfo ((struct sockaddr*)&peer.addr, peer_addrlen,
                         scratch, sizeof(scratch), 0, 0, NI_NUMERICHOST);
   if (retval)
   {
      fprintf (stdout, "%s:%d getnameinfo() %s\n", FI_LI, strerror(errno));
      AndExit (SS$_ABORT);
   }
   CgiRemoteAddr = strdup (scratch);
   retval = getnameinfo ((struct sockaddr*)&peer.addr, peer_addrlen,
                         scratch, sizeof(scratch), 0, 0, 0);
   if (retval)
   {
      fprintf (stdout, "%s:%d getnameinfo() %s\n", FI_LI, strerror(errno));
      AndExit (SS$_ABORT);
   }
   CgiRemoteHost = strdup (scratch);

   sprintf (scratch, "%s %s %s",
            secure ? "https:" : "http:", CgiRemoteAddr, CgiRemoteHost);

   timestamp ("NETWORK", -1, scratch);
}

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

int NetRead (char *bptr, int bsize)
 
{
   int  retval;
   char  *sptr;

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

   if (secure)
   {
      retval = SSL_read (ssl, bptr, bsize);
      if (retval <= 0)
      {
         if (!NetConnectClosed && NetReadErrorCount++)
         {
            sptr = getOpenSSLerror (ssl, retval);
            fprintf (stdout, "%s:%d SSL_read() %d %d %s\n",
                     FI_LI, NetReadErrorCount, retval, sptr);
            return (-(EFAIL));
         }
      }
   }
   else
   {
      retval = recv (sockfd, bptr, bsize, 0);
      if (retval < 0) return (-(errno));
   }

   if (ConfigDump) DumpData (FI_LI, "<", bptr, retval);

   return (retval);
}

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

int NetWrite (char *dptr, int dlen)
 
{
   int  retval;
   char  *sptr;

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

   if (dbug) fprintf (stdout, "%s:%d NetWrite()\n", FI_LI);

   if (ConfigDump) DumpData (FI_LI, ">", dptr, dlen);

   if (secure)
      retval = SSL_write_ex (ssl, dptr, dlen, &exCount);
   else
      retval = send (sockfd, dptr, dlen, 0);
   if (retval == -1)
   {
      if (!NetConnectClosed && NetWriteErrorCount++)
      {
         fprintf (stdout, "%s:%d %d retval %d %d\n",
                  FI_LI, NetWriteErrorCount, retval, exCount);
         exit (SS$_BUGCHECK);
      }
   }

   ResponseBytes64 += dlen;

   return (retval);
}

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

int NetClose ()
 
{
   int  retval;
   char  *sptr;

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

   if (secure)
   {
      retval = SSL_shutdown (ssl);
      if (retval <= 0)
      {
         sptr = getOpenSSLerror (ssl, retval);
         fprintf (stdout, "%s:%d SSL_read() %d %s\n", FI_LI, retval, sptr);
         return (-(EFAIL));
      }
   }
   else
   {
      retval = close (sockfd);
      if (retval < 0) return (-(errno));
   }

   NetConnectClosed = 1;

   return (0);
}

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

static char* printOpenSSLerrors()
 
{
   char  *buf, *dbuf;
   BIO  *bio;

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

   bio = BIO_new (BIO_s_mem());
   ERR_print_errors (bio);
   BIO_get_mem_data (bio, &buf);
   if (buf) dbuf = strdup (buf);
   BIO_free (bio);
   return (buf ? dbuf : buf);
}

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

static char* getOpenSSLerror (SSL *ssl, int retval)
 
{
   /*********/
   /* begin */
   /*********/

   retval = SSL_get_error (ssl, retval);
   switch (retval)
   {
      case SSL_ERROR_NONE : return ("SSL_ERROR_NONE");
      case SSL_ERROR_SSL : return ("SSL_ERROR_SSL");
      case SSL_ERROR_WANT_READ : return ("SSL_ERROR_WANT_READ");
      case SSL_ERROR_WANT_WRITE : return ("SSL_ERROR_WANT_WRITE");
      case SSL_ERROR_WANT_X509_LOOKUP : return ("SSL_ERROR_WANT_X509_LOOKUP");
      case SSL_ERROR_SYSCALL : return ("SSL_ERROR_SYSCALL");
      case SSL_ERROR_ZERO_RETURN : return ("SSL_ERROR_ZERO_RETURN");
      case SSL_ERROR_WANT_CONNECT : return ("SSL_ERROR_WANT_CONNECT");
      case SSL_ERROR_WANT_ACCEPT : return ("SSL_ERROR_WANT_ACCEPT");
      case SSL_ERROR_WANT_ASYNC : return ("SSL_ERROR_WANT_ASYNC");
      case SSL_ERROR_WANT_ASYNC_JOB : return ("SSL_ERROR_WANT_ASYNC_JOB");
      case SSL_ERROR_WANT_CLIENT_HELLO_CB : return ("SSL_ERROR_WANT_CLIENT_HELLO");
/***
      case SSL_ERROR_WANT_RETRY_VERIFY : return ("SSL_ERROR_WANT_RETRY_VERIFY");
***/
      default : return ("*");
   }
}

/*****************************************************************************/
/*
Read the request header up until the header delimiting empty line.
*/

int GetRequestHeader ()

{
   int  eoh, length, retval, remain;
   char  *sptr, *zptr;

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

   /* ten seconds for request */
   WaitForRequest = 10;

   length = 0;
   remain = sizeof(rbuf) - 1;
   zptr = (sptr = rbuf) + remain;
   for (;;)
   {
      retval = NetRead (sptr, remain);

      length += retval;
      rbuf[length] = '\0';

      /* look for the end of header empty line */
      eoh = 0;
      for (sptr = rbuf; sptr < zptr; sptr++)
      {
         if (*sptr == '\r')
            if (*(USHORTPTR)sptr == '\r\n')
               if (eoh = (*(ULONGPTR)sptr == '\r\n\r\n'))
                  break;
         if (*sptr == '\n')
            if (eoh = (*(USHORTPTR)sptr == '\n\n'))
               break;
      }
      if (eoh) break;
      sptr = rbuf + length;
   }

   if (dbug) fprintf (stdout, "%s:%d %d |%s|\n", FI_LI, length, rbuf);

   WaitForRequest = 0;

   return (length);
}

/*****************************************************************************/
/*
Provide an elementary parse of the header creating CGI variables in a structure
that will later be provided to the script as CGI symbols or a CGIplus stream.
*/

int ParseRequestHeader ()

{
   int  count, cgilen, filen, status;
   char  ch;
   char  *aptr, *cgiptr, *cptr, *sptr, *zptr;
   char  length [16];
   char  method [32];
   char  name [256];
   char  protocol [32];
   char  scratch [1024];
   char  type [256];
   char  uri [REQUEST_URI_SIZE];
   char  value [4096+128];

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

   RequestConnectionClose = 0;
   length[0] = method[0] = protocol[0] = type[0] = uri[0] = '\0';
   HttpHost[0] = HttpUpgrade[0] = WebSockKey[0] = WebSockVersion[0] = '\0';

   /****************/
   /* request line */
   /****************/

   cptr = rbuf;
   zptr = (sptr = method) + sizeof(method)-1;
   while (*cptr && *cptr != ' ' && *cptr > 31 && *cptr < 127 && sptr < zptr)
      *sptr++ = *cptr++;
   *sptr = '\0';
   if (!method[0] || *cptr <= 31 || *cptr >= 127) return (-1);

   if (strcmp (method, "GET")) return (Response501 (FI_LI, "not implemented"));

   while (*cptr && *cptr == ' ') cptr++;
   zptr = (sptr = uri) + sizeof(uri)-1;
   while (*cptr && *cptr != ' ' && *cptr > 31 && *cptr < 127 && sptr < zptr)
      *sptr++ = *cptr++;
   *sptr = '\0';
   if (!uri[0] || *cptr <= 31 || *cptr >= 127 || sptr >= zptr) return (-1);
   if (RequestUri) free (RequestUri);
   RequestUri = strdup (uri);

   while (*cptr && *cptr == ' ') cptr++;
   zptr = (sptr = protocol) + sizeof(protocol)-1;
   while (*cptr && *cptr > 31 && *cptr < 127 && sptr < zptr)
      *sptr++ = *cptr++;
   *sptr = '\0';
   if (!protocol[0]) return (-1);

   if (*cptr == '\r') *cptr++;
   if (*cptr == '\n') *cptr++;
   if (*cptr <= 31 || *cptr >= 127) return (-1);

   /********************/
   /* required storage */
   /********************/

   /* check for CGIplus URI */
   IsJustCgi = IsCgiPlus = 0;
   if (cgiptr = GetCgiRoot (uri, &cgilen))
      if (*cgiptr == '+')
      {
         cgiptr++;
         IsCgiPlus = 1;
      }
      else
         IsJustCgi = 1;

   if (IsJustCgi || IsCgiPlus)
   {
      /* need buffer space for scripting */
      SysCmdBuffer = calloc (1, SysCmdSize);
      if (!SysCmdBuffer)
      {
         fprintf (stdout, "calloc() %s:%d %%X%08.08X\n", FI_LI, vaxc$errno);
         AndExit (vaxc$errno);
      }
   }

   if (IsCgiPlus)
   {
      /* need buffer space for CGIplus stream */
      CgiPlusInBuffer = calloc (1, CgiPlusInSize);
      if (!CgiPlusInBuffer)
      {
         fprintf (stdout, "calloc() %s:%d %%X%08.08X\n", FI_LI, vaxc$errno);
         AndExit (vaxc$errno);
      }
   }

   /*********************/
   /* request variables */
   /*********************/

   HttpHost[0] = '\0';
   strcpy (name, "WWW_HTTP_");

   while (*cptr)
   {
      /* leading spaces are fatal */
      if (*cptr == ' ') break;

      /* parse the CGI variable name */
      zptr = (sptr = name) + sizeof(name)-1;
      sptr += 9;
      while (*cptr && *cptr != ':' && *cptr > 32 && *cptr < 128 && sptr < zptr)
      {
         if (*cptr == '-')
            *sptr++ = '_';
         else
         if ((*cptr >= '0' && *cptr <= '9') || (*cptr >= 'A' && *cptr <= 'Z'))
            *sptr++ = *cptr;
         else
         if (*cptr >= 'a' || *cptr <= 'z')
            *sptr++ = toupper(*cptr);
         else
         if (*cptr == '_' || *cptr == '$')
            *sptr++ = *cptr;
         cptr++;
      }
      if (sptr >= zptr) return (-1);
      if (*cptr <= 31 || *cptr >= 127) return (-1);
      *sptr = '\0';

      while (*cptr == ' ') cptr++;
      if (*cptr++ != ':') return (-1);
      while (*cptr == ' ') cptr++;

      /* parse the CGI variable value */
      zptr = (sptr = value) + sizeof(value)-1;
      while (*cptr != '\r' && *cptr != '\n' && sptr < zptr)
      {
         if ((*cptr > 31 && *cptr < 127) || (*cptr >= 128 && *cptr <= 255))
            *sptr++ = *cptr;
         /* escape double quotes */
         if (*cptr == '\"' && sptr < zptr) *sptr++ = '\"';
         /* forbid symbol substitution syntax */
         if (*cptr == '\'' && *(cptr+1) == '\'') return (-1);
         cptr++;
      }
      if (sptr >= zptr) return (-1);
      *sptr = '\0';

      if (!strcmp (name, "WWW_HTTP_CONNECTION"))
         RequestConnectionClose = !strncasecmp (value, "close", 5);
      else
      if (!strcmp (name, "WWW_HTTP_HOST"))
         strzcpy (HttpHost, value, sizeof(HttpHost));
      else
      if (!strcmp (name, "WWW_HTTP_CONTENT_LENGTH"))
         strzcpy (length, value, sizeof(length));
      else
      if (!strcmp (name, "WWW_HTTP_CONTENT_TYPE"))
         strzcpy (type, value, sizeof(type));
      else
      if (!strcmp (name, "WWW_HTTP_SEC_WEBSOCKET_KEY"))
      {
         IsWebSock = 1;
         WebSockKeyLen = strzcpy (WebSockKey, value, sizeof(WebSockKey));
         SetCgiVar (name, value);
      }
      else
      if (!strcmp (name, "WWW_HTTP_SEC_WEBSOCKET_VERSION"))
      {
         strzcpy (WebSockVersion, value, sizeof(WebSockVersion));
         SetCgiVar (name, value);
      }
      else
      if (!strcmp (name, "WWW_HTTP_UPGRADE"))
      {
         strzcpy (HttpUpgrade, value, sizeof(HttpUpgrade));
         SetCgiVar (name, value);
      }
      else
      if (!strcmp (name, "WWW_HTTP_USER_AGENT"))
      {
         strzcpy (HttpUserAgent, value, sizeof(HttpUserAgent));
         SetCgiVar (name, value);
      }
      else
         SetCgiVar (name, value);

      if (*cptr == '\r') *cptr++;
      if (*cptr == '\n') *cptr++;
      /* step over the end of header empty line */
      if (*cptr == '\r') *cptr++;
      if (*cptr == '\n') *cptr++;
   }
   if (*cptr) return (-1);

   if (!HttpHost[0]) return (Response400 (FI_LI, "header error"));

   /*******************/
   /* other variables */
   /*******************/

   SetCgiVar ("WWW_CONTENT_LENGTH", length);
   SetCgiVar ("WWW_CONTENT_TYPE", type);
   SetCgiVar ("WWW_GATEWAY_INTERFACE", "CGI/1.1");
   SetCgiVar ("WWW_GATEWAY_MRS", CgiGatewayMrs);
   SetCgiVar ("WWW_REMOTE_ADDR", CgiRemoteAddr);
   SetCgiVar ("WWW_REMOTE_HOST", CgiRemoteHost);
   SetCgiVar ("WWW_REQUEST_METHOD", method);
   SetCgiVar ("WWW_REQUEST_PROTOCOL", protocol);
   SetCgiVar ("WWW_REQUEST_SCHEME", secure ? "https:" : "http:");
   SetCgiVar ("WWW_REQUEST_URI", uri);
   SetCgiVar ("WWW_SERVER_ADDR", CgiServerAddr);
   SetCgiVar ("WWW_SERVER_HOST", CgiServerName);
   SetCgiVar ("WWW_SERVER_SOFTWARE", SoftwareID);
   SetCgiVar ("WWW_UNIQUE_ID", RandomString());

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

   for (sptr = uri; *sptr && *sptr != '?'; sptr++);
   if (*sptr) *sptr++ = '\0';

   if (CgiQueryString) free (CgiQueryString);
   if (*sptr)
      CgiQueryString = strdup(sptr);
   else
      CgiQueryString = strdup("");

   SetCgiVar ("WWW_QUERY_STRING", sptr);
   if (CgiQueryString[0])
   {
      /*******************/
      /* keywords/fields */
      /*******************/

      if (!ParseQuery (CgiQueryString))
      {
         Response502 (FI_LI, "query string problem");
         AndExit (SS$_NORMAL);
      }
   }

   if (CgiScriptName) free (CgiScriptName);
   CgiScriptName = NULL;
   if (cgiptr)
   {
      /***************/
      /* script name */
      /***************/

      for (cptr = uri + cgilen; *cptr && *cptr != '/'; cptr++);
      ch = *cptr;
      *cptr = '\0';
      SetCgiVar ("WWW_SCRIPT_NAME", uri);
      CgiScriptName = strdup (uri);
      *cptr = ch;
   }
   else
      cptr = uri;

   /*************/
   /* path info */
   /*************/

   SetCgiVar ("WWW_PATH_INFO", cptr);
   if (CgiPathInfo) free (CgiPathInfo);
   CgiPathInfo = strdup (cptr);

   cptr = GetFileRoot (CgiPathInfo, &filen);
   if (cptr)
   {
      /*******************/
      /* path translated */
      /*******************/

      zptr = (sptr = scratch) + sizeof(scratch)-1;
      while (*cptr && sptr < zptr) *sptr++ = *cptr++;
      /* any subdirectory */
      cptr = CgiPathInfo + filen;
      for (aptr = cptr; *aptr && *aptr != '/'; aptr++);
      if (*aptr)
      {
         /* yes, subdirectory */
         *(sptr-1) = '.';
         if (sptr - scratch >= 9)
            if (!strncasecmp (sptr-9, ":[000000.", 9))
               sptr -= 7; 
         while (*aptr && sptr < zptr)
         {
            /* copy this directory name in */
            while (*cptr && cptr < aptr && sptr < zptr) *sptr++ = *cptr++;
            /* look for another */
            for (aptr++; *aptr && *aptr != '/'; aptr++);
            if (*aptr)
            {
               /* yes, another */
               cptr++;
               if (sptr < zptr) *sptr++ = '.';
            }
         }
         /* nope, file name now */
         cptr++;
         if (sptr < zptr) *sptr++ = ']';
      }
      while (*cptr && sptr < zptr) *sptr++ = *cptr++;
      *sptr = '\0';
      cptr = scratch;
   }
   else
      cptr = "";

   SetCgiVar ("WWW_PATH_TRANSLATED", cptr);
   if (CgiPathTrans) free (CgiPathTrans);
   CgiPathTrans = strdup (cptr);

   if (cgiptr)
   {
      /********************/
      /* script file name */
      /********************/

      zptr = (sptr = scratch) + sizeof(scratch)-1;
      for (cptr = cgiptr; *cptr && sptr < zptr; *sptr++ = *cptr++);
      for (cptr = CgiScriptName + cgilen;
           *cptr && sptr < zptr;
           *sptr++ = *cptr++);
      *sptr = '\0';
      if (CgiScriptFileName) free (CgiScriptFileName);
      CgiScriptFileName = NULL;
      if (cptr = CgiFileName (scratch))
      {
         /* when setting the CGI variable ignore the leading character */
         SetCgiVar ("WWW_SCRIPT_FILENAME", cptr+1);
         /* keep it for use by the subprocess */
         CgiScriptFileName = strdup (cptr);
         free (cptr);
      }
   }

   return (0);
}

/*****************************************************************************/
/*
Parse the query string into (WASD) expected keywords or form fields.
Return a number greater than zero, or zero to indicate a parse error.
*/

int ParseQuery ()

{
   int  count;
   char  *aptr, *cptr, *qptr, *sptr, *zptr;
   char  name [256];
   char  value [4096];

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

   if (dbug) fprintf (stdout, "%s:%d ParseQuery() |%s|\n",
                      FI_LI, CgiQueryString);

   count = 0;
   for (cptr = qptr = CgiQueryString; *cptr && *cptr != '='; cptr++);
   if (!*cptr)
   {
      /************/
      /* keywords */
      /************/

      cptr = qptr;
      while (*cptr && *cptr != '+')
      {
         sprintf (name, "WWW_KEY_%d", ++count);
         zptr = (sptr = value) + sizeof(value)-1;
         while (*cptr && *cptr != '+' && sptr < zptr) *sptr++ = *cptr++;
         *sptr = '\0';
         if (sptr >= zptr) return (0);
         if (UrlDecode(value) < 0) return (0);
         SetCgiVar (name, value);
         if (*cptr) cptr++;
      }
      strcpy (name, "WWW_KEY_COUNT");
      sprintf (value, "%d", count);
      SetCgiVar (name, value);
      return (count);
   }

   strcpy (name, "WWW_KEY_COUNT");
   strcpy (value, "0");
   SetCgiVar (name, value);

   /***************/
   /* form fields */
   /***************/

   strcpy (name, "WWW_FORM_");
   cptr = qptr;
   while (*cptr && *cptr != '&')
   {
      zptr = (sptr = name) + sizeof(name)-1;
      sptr += 9;
      while (*cptr && *cptr != '=' && sptr < zptr) *sptr++ = toupper(*cptr++);
      *sptr = '\0';
      if (sptr >= zptr) return (0);
      if (UrlDecode(name) < 0) return (0);
      for (aptr = name; *aptr && (isalnum(*aptr) || *aptr == '_'); aptr++);
      if (*aptr) return (0);
      while (*cptr == '=') cptr++;
      zptr = (sptr = value) + sizeof(value)-1;
      while (*cptr && *cptr != '&' && sptr < zptr) *sptr++ = *cptr++;
      *sptr = '\0';
      if (sptr >= zptr) return (0);
      if (UrlDecode(value) < 0) return (0);
      while (*cptr == '&') cptr++;
      SetCgiVar (name, value);
      count++;
   }

   return (count);
}

/*****************************************************************************/
/*
Discover the script filename.  If not resolved return a NULL, otherwise return
an allocated string beginning with an indicative character and the resolved
file system name.
*/

char* CgiFileName (char *name)

{
   int  retval, status;
   char  *cptr, *sptr, *tptr, *zptr;
   char  scratch [256];
   stat_t  stbuf;

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

   if (dbug) fprintf (stdout, "%s:%d CgiFileName() |%s|\n", FI_LI, name);

   zptr = (sptr = scratch) + sizeof(scratch)-4;
   *sptr++ = '!';
   for (cptr = name; *cptr && sptr < zptr; *sptr++ = *cptr++);
   if (sptr >= zptr)
   {
      fprintf (stdout, "%s:%d CgiFileName() %s\n", FI_LI, strerror(EOVERFLOW));
      AndExit (SS$_BUFFEROVF);
   }
   *sptr = '\0';
   tptr = sptr;

   if (stat (scratch+1, &stbuf) == 0)
   {
      while (*sptr != '.' && sptr > scratch+1) sptr--;
      if (!strcasecmp (sptr, ".com"))
         scratch[0] = '@';
      else
      if (!strcasecmp (sptr, ".exe"))
         scratch[0] = '$';
      else
         strcpy (scratch, "eoj");
      return (strdup (scratch));
   }

   sptr = tptr;
   for (cptr = ".com"; *cptr; *sptr++ = *cptr++);
   *sptr = '\0';
   if (dbug) fprintf (stdout, "%s:%d |%s|\n", FI_LI, scratch+1);
   if (stat (scratch+1, &stbuf) == 0)
   {
      scratch[0] = '@';
      return (strdup (scratch));
   }

   sptr = tptr;
   for (cptr = ".exe"; *cptr; *sptr++ = *cptr++);
   *sptr = '\0';
   if (dbug) fprintf (stdout, "%s:%d |%s|\n", FI_LI, scratch+1);
   if (stat (scratch+1, &stbuf) == 0)
   {
      scratch[0] = '$';
      return (strdup (scratch));
   }

   return (NULL);
}

/*****************************************************************************/
/*
Decode URL-encoded string.  Resultant string is always the same size or smaller
so it can be done in-situ!  Returns the size of the resultant string or -1 to
indicate an error.
*/

int UrlDecode (char *String)

{
   unsigned char  ch,
                  pch = 0;
   char  *cptr, *sptr;

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

   cptr = sptr = String;
   while (*cptr)
   {
      switch (*cptr)
      {
         case '+' :

            *sptr++ = ' ';
            cptr++;
            pch = 0;
            continue;

         case '%' :

            cptr++;

            while (*cptr == '\r' || *cptr == '\n') cptr++;
            ch = 0;
            if (*cptr >= '0' && *cptr <= '9')
               ch = (*cptr - (int)'0') << 4;
            else
            if (toupper(*cptr) >= 'A' && toupper(*cptr) <= 'F')
               ch = (toupper(*cptr) - (int)'A' + 10) << 4;
            else
            {
               *String = '\0';
               return (-1);
            }
            if (*cptr) cptr++;
            while (*cptr == '\r' || *cptr == '\n') cptr++;
            if (*cptr >= '0' && *cptr <= '9')
               ch += (*cptr - (int)'0');
            else
            if (toupper(*cptr) >= 'A' && toupper(*cptr) <= 'F')
               ch += (toupper(*cptr) - (int)'A' + 10);
            else
            {
               *String = '\0';
               return (-1);
            }
            if (*cptr) cptr++;

            /* if URL-encoded 8 bit UTF-8 (e.g. %C3%A9) */
            if (pch == 0xc2 && ch >= 0x80 && ch <= 0xbf)
            {
               *(sptr-1) = ch;
               pch = 0;
            }
            else
            if (pch == 0xc3 && ch >= 0x80 && ch <= 0xbf)
            {
               *(sptr-1) = ch + 0x40;
               pch = 0;
            }
            else
               *sptr++ = pch = ch;

            continue;

         default :

            *sptr++ = *cptr++;
            pch = 0;

      }
   }
   *sptr = '\0';

   return (sptr-String);
}

/*****************************************************************************/
/*
Given a name and value set a CGI variable.
These later will be output as CGI symbols or a CGIplus variable stream.
*/

int SetCgiVar (char *name, char *value)

{
   static char  *aptr, *bptr, *buf;
   static char  symbols [SYMBOL_BUF_SIZE];
   static char  *SymbolsPtr = symbols;

   char  *cptr, *sptr, *zptr;
   char  record [CGIPLUS_BUFFER_SIZE];

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

   if (dbug) fprintf (stdout, "%s:%d SetCgiVar() %d |%s|%s|\n",
                      FI_LI, IsCgiPlus, name, value);

   if (!buf)
   {
      bptr = buf = aptr = calloc (1, CgiVarSize);
      if (!buf)
      {
         Response500 (FI_LI, strerror(errno));
         AndExit (vaxc$errno);
      }
   }
   if (IsCgiPlus)
   {
      if (!name)
      {
         /* end of CGIplus vars */
         *bptr++ = '\n';
         /* write all as a block */
         CgiPlusInWrite (buf, bptr - buf);
         CgiPlusInWrite (NULL, 0);
         return (bptr - buf);
      }

      zptr = buf + CgiVarSize - 2;
      sptr = bptr;

      /* CGIplus record */
      name += noWWW;
      for (cptr = name; *cptr && sptr < zptr; *sptr++ = *cptr++);
      if (sptr < zptr) *sptr++ = '=';
      for (cptr = value; *cptr && sptr < zptr; *sptr++ = *cptr++);
      *sptr++ = '\n';
      *sptr = '\0';
      bptr = sptr;

      return (bptr - buf);
   }
   else
   if (IsJustCgi)
   {
      if (!name)
      {
         /* write all as a block */
         SysCmdWrite (buf, bptr - buf);
         return (bptr - buf);
      }

      if (!name[0] || name[0] == '!') return (1);

      if (value)
      {
         /* CGI var name */
         zptr = symbols + sizeof(symbols)-1;
         sptr = SymbolsPtr;
         if (symbols[0] && sptr < zptr) *sptr++ = ',';
         for (cptr = name; *cptr && sptr < zptr; *sptr++ = *cptr++);
         if (sptr > zptr) return (-1);
         *sptr = '\0';
         SymbolsPtr = sptr;
      }
      else
      {
         name = "WWW_GATEWAY_SYMBOLS";
         value = symbols;
      }

      zptr = buf + CgiVarSize - 3;
      sptr = bptr;

      /* CGI record */
      name += noWWW;
      for (cptr = name; *cptr && sptr < zptr; *sptr++ = *cptr++);
      for (cptr = "==\""; *cptr && sptr < zptr; *sptr++ = *cptr++);
      for (cptr = value; *cptr && sptr < zptr; cptr++)
      {
         *sptr++ = *cptr;
         if (*cptr == '\"' && sptr < zptr) *sptr++ = '\"';
         /* prevent symbol substitution "''" !! */
         if (*cptr == '\'' && *(cptr+1) == '`') cptr++;
      }
      *sptr++ = '\"';
      *sptr++ = '\n';
      *sptr = '\0';
      bptr = sptr;

      return (bptr - buf);
   }
}

/*****************************************************************************/
/*
Create mailboxes to connect to SYS$COMMAND and SYS$OUTPUT, if CGIplus then
CGIPLUSIN, and optional mailboxes for WEBSOCKET$INPUT and WEBSOCKET$OUTPUT.
*/

int ScriptSubProcess (void)

{
   /* nowait nolognam noclisym nokeypad nocontrol */
   static uint  flags = 0x6f;
   static uint  BasePriority = 4;
   static uint  CrePrcFlags = 0;

   static uint  DevNamItem = DVI$_DEVNAM;
   static uint  JpiPidItem = JPI$_PID;
   static uint  UnitItem = DVI$_UNIT;

   static char  PrcNam [16];
   static $DESCRIPTOR (PrcNamDsc, PrcNam);
   static char  TermMbxDevName [10];
   static $DESCRIPTOR (TermMbxNameDsc, TermMbxDevName);

   static $DESCRIPTOR (LoginOutDsc, "SYS$SYSTEM:LOGINOUT.EXE");

   static $DESCRIPTOR (CgiPlusInDevNameDsc, CgiPlusInDevName);
   static $DESCRIPTOR (SysCmdDevNameDsc, SysCmdDevName);
   static $DESCRIPTOR (SysOutDevNameDsc, SysOutDevName);
   static $DESCRIPTOR (TermMbxDevNameDsc, TermMbxDevName);
   static $DESCRIPTOR (WebSockInDevNameDsc, WebSockInDevName);
   static $DESCRIPTOR (WebSockOutDevNameDsc, WebSockOutDevName);

   uint  status, JpiPid;
   ulong  LongUnit;
   ushort  slen;
   char  *aptr, *cptr, *sptr, *zptr;
   char  dclbuf [256],
         msg [48];

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

   status = lib$getjpi (&JpiPidItem, 0, 0, &JpiPid, 0, 0);
   if (dbug)
      fprintf (stdout, "%s:%d %%X%08.08X %08.08X\n", FI_LI, status, JpiPid);
   if (!(status & 1)) AndExit (status);
   slen = sprintf (PrcNam, "WAUXD_%04.04X", JpiPid & 0xffff);
   PrcNamDsc.dsc$w_length = slen;

   /*******************/
   /* command mailbox */
   /*******************/

   status = sys$crembx (0, &SysCmdChan, SysCmdSize, SysCmdSize,
                        MBX_PROT_MASK, 0, 0, CMB$M_WRITEONLY);
   if (dbug) fprintf (stdout, "%s:%d %%X%08.08X\n", FI_LI, status);
   if (!(status & 1)) AndExit (status);

   status = lib$getdvi (&DevNamItem, &SysCmdChan, 0, 0,
                        &SysCmdDevNameDsc, &slen, 0);
   if (dbug) fprintf (stdout, "%s:%d %%X%08.08X\n", FI_LI, status);
   if (!(status & 1)) AndExit (status);
   SysCmdDevNameDsc.dsc$w_length = slen;
   SysCmdDevName[slen] = '\0';
   if (dbug) fprintf (stdout, "%s:%d |%s|\n", FI_LI, SysCmdDevName);

   /******************/
   /* output mailbox */
   /******************/

   status = sys$crembx (0, &SysOutChan, SysOutSize, SysOutSize,
                        MBX_PROT_MASK, 0, 0, CMB$M_READONLY);
   if (dbug) fprintf (stdout, "%s:%d %%X%08.08X\n", FI_LI, status);
   if (!(status & 1)) AndExit (status);

   status = lib$getdvi (&DevNamItem, &SysOutChan, 0, 0,
                        &SysOutDevNameDsc, &slen, 0);
   if (dbug) fprintf (stdout, "%s:%d %%X%08.08X\n", FI_LI, status);
   if (!(status & 1)) AndExit (status);
   SysOutDevNameDsc.dsc$w_length = slen;
   SysOutDevName[slen] = '\0';
   if (dbug) fprintf (stdout, "%s:%d |%s|\n", FI_LI, SysOutDevName);

   SysOutBuffer = calloc (1, SysOutSize);
   if (!SysOutBuffer)
   {
      fprintf (stdout, "calloc() %s:%d %%X%08.08X\n", FI_LI, vaxc$errno);
      AndExit (vaxc$errno);
   }

   if (IsCgiPlus)
   {
      /*********************/
      /* CGIplusIn mailbox */
      /*********************/

      status = sys$crembx (0, &CgiPlusInChan, CgiPlusInSize, CgiPlusInSize,
                           MBX_PROT_MASK, 0, 0, CMB$M_WRITEONLY);
      if (dbug) fprintf (stdout, "%s:%d %%X%08.08X\n", FI_LI, status);
      if (!(status & 1)) AndExit (status);

      status = lib$getdvi (&DevNamItem, &CgiPlusInChan, 0, 0,
                           &CgiPlusInDevNameDsc, &slen, 0);
      if (dbug) fprintf (stdout, "%s:%d %%X%08.08X\n", FI_LI, status);
      if (!(status & 1)) AndExit (status);
      CgiPlusInDevNameDsc.dsc$w_length = slen;
      CgiPlusInDevName[slen] = '\0';
      if (dbug) fprintf (stdout, "%s:%d |%s|\n", FI_LI, CgiPlusInDevName);
   }

   if (IsWebSock)
   {
      /***************************/
      /* WebSocket input mailbox */
      /***************************/

      status = sys$crembx (0, &WebSockInChan, WebSockInSize, WebSockInSize,
                           MBX_PROT_MASK, 0, 0, CMB$M_WRITEONLY);
      if (dbug) fprintf (stdout, "%s:%d %%X%08.08X\n", FI_LI, status);
      if (!(status & 1)) AndExit (status);

      status = lib$getdvi (&DevNamItem, &WebSockInChan, 0, 0,
                           &WebSockInDevNameDsc, &slen, 0);
      if (dbug) fprintf (stdout, "%s:%d %%X%08.08X\n", FI_LI, status);
      if (!(status & 1)) AndExit (status);
      WebSockInDevNameDsc.dsc$w_length = slen;
      WebSockInDevName[slen] = '\0';
      if (dbug) fprintf (stdout, "%s:%d |%s|\n", FI_LI, WebSockInDevName);

      WebSockInBuffer = calloc (1, WebSockInSize);
      if (!WebSockInBuffer)
      {
         fprintf (stdout, "calloc() %s:%d %%X%08.08X\n", FI_LI, vaxc$errno);
         AndExit (vaxc$errno);
      }

      /****************************/
      /* WebSocket output mailbox */
      /****************************/

      status = sys$crembx (0, &WebSockOutChan, WebSockOutSize, WebSockOutSize,
                           MBX_PROT_MASK, 0, 0, CMB$M_READONLY);
      if (dbug) fprintf (stdout, "%s:%d %%X%08.08X\n", FI_LI, status);
      if (!(status & 1)) AndExit (status);

      status = lib$getdvi (&DevNamItem, &WebSockOutChan, 0, 0,
                           &WebSockOutDevNameDsc, &slen, 0);
      if (dbug) fprintf (stdout, "%s:%d %%X%08.08X\n", FI_LI, status);
      if (!(status & 1)) AndExit (status);
      WebSockOutDevNameDsc.dsc$w_length = slen;
      WebSockOutDevName[slen] = '\0';
      if (dbug) fprintf (stdout, "%s:%d |%s|\n", FI_LI, WebSockOutDevName);

      WebSockOutBuffer = calloc (1, WebSockOutSize);
      if (!WebSockOutBuffer)
      {
         fprintf (stdout, "calloc() %s:%d %%X%08.08X\n", FI_LI, vaxc$errno);
         AndExit (vaxc$errno);
      }
   }

   /**********************/
   /* more CGI variables */
   /**********************/

   if (IsWebSock)
   {
      SetCgiVar ("WWW_WEBSOCKET_OUTPUT", WebSockOutDevName);
      SetCgiVar ("WWW_WEBSOCKET_OUTPUT_MRS", WebSockOutMrs);
      SetCgiVar ("WWW_WEBSOCKET_INPUT", WebSockInDevName);
      SetCgiVar ("WWW_WEBSOCKET_INPUT_MRS", WebSockInMrs);
   }

   /* if vanilla CGI */
   if (IsJustCgi) SetCgiVar ("WWW_GATEWAY_SYMBOLS", NULL);

   /***********************/
   /* termination mailbox */
   /***********************/

   status = sys$crembx (0, &TermMbxChan, sizeof(TermRecord), sizeof(TermRecord),
                        MBX_PROT_MASK, 0, 0, CMB$M_READONLY);
   if (dbug) fprintf (stdout, "%s:%d %%X%08.08X\n", FI_LI, status);
   if (!(status & 1)) AndExit (status);

   status = lib$getdvi (&DevNamItem, &TermMbxChan, 0, 0,
                        &TermMbxDevNameDsc, &slen, 0);
   if (dbug) fprintf (stdout, "%s:%d %%X%08.08X\n", FI_LI, status);
   if (!(status & 1)) AndExit (status);
   TermMbxDevNameDsc.dsc$w_length = slen;
   TermMbxDevName[slen] = '\0';
   if (dbug) fprintf (stdout, "%s:%d |%s|\n", FI_LI, SysOutDevName);

   status = lib$getdvi (&UnitItem, &TermMbxChan, 0, &LongUnit, 0, 0, 0);
   if (dbug) fprintf (stdout, "%s:%d %%X%08.08X %d\n", FI_LI, status, LongUnit);
   if (!(status & 1)) AndExit (status);
   TermMbxUnit = (ushort)LongUnit;

   memset (&TermRecord, 0, sizeof(TermRecord));
   status = sys$qio (EfnNoWait, TermMbxChan, IO$_READLBLK,
                     &TermMbxIOsb, &ScriptTermAst, 0,
                     &TermRecord, sizeof(TermRecord), 0, 0, 0, 0);
   if (!(status & 1)) AndExit (status);

   /****************************/
   /* create scripting process */
   /****************************/

   status = sys$creprc (&ScriptPid,
                        &LoginOutDsc,
                        &SysCmdDevNameDsc,
                        &SysOutDevNameDsc,
                        0, 0, 0,
                        &PrcNamDsc,
                        BasePriority,
                        0,
                        TermMbxUnit,
                        CrePrcFlags,
                        0, 0);

   sprintf (msg, "pid:%08.08X, %s", ScriptPid, PrcNam);
   timestamp ("CREPRC", -1, msg);

   if (!(status & 1)) AndExit (status);

   SysOutRead ();

   return (status);
}

/*****************************************************************************/
/*
Subpocess completion AST.
*/

static void ScriptTermAst (void)

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

   if (dbug) fprintf (stdout, "ScriptTermAst() %s:%d %%X%08.08X\n",
                      FI_LI, TermMbxIOsb.iosb$w_status);

   ScriptPid = 0;

   if (dbug) timestamp (FI_LI, NULL);

   sys$wake (0, 0);
}

/*****************************************************************************/
/*
Writes newline delmitted records (commands) to SYS$COMMAND.
*/

int SysCmdWrite (char *dptr, int dlen)

{
   int  status;
   char  *sptr, *zptr;

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

   if (dptr)
   {
      /*******************/
      /* buffer commands */
      /*******************/

      if (dlen <= 0) dlen = strlen(dptr);
      zptr = (sptr = SysCmdBuffer) + SysCmdSize;
      sptr += SysCmdDataLength;
      while (dlen-- > 0 && sptr < zptr) *sptr++ = *dptr++;
      if (sptr >= zptr)
      {
         status = SS$_BUFFEROVF;
         fprintf (stdout, "SysCmdWrite() %s:%d %%X%08.08X\n", FI_LI, status);
         AndExit (status);
      }
      SysCmdDataLength = sptr - SysCmdBuffer;
      if (SysCmdDataPtr != SysCmdBuffer) SysCmdDataPtr = SysCmdBuffer;
      return (SysCmdDataLength);
   }

   /************/
   /* if empty */
   /************/

   SysCmdStatus = 0;

   if (SysCmdDataPtr >= SysCmdBuffer + SysCmdDataLength)
   {
      SysCmdDataPtr = SysCmdBuffer;
      SysCmdDataLength = 0;
      return (SS$_ENDOFFILE);
   }

   /******************/
   /* write commands */
   /******************/

   for (dptr = sptr = SysCmdDataPtr; *sptr != '\n'; sptr++);
   dlen = sptr - SysCmdDataPtr;
   SysCmdDataPtr = sptr + 1;   

   if (dbug) fprintf (stdout, "%s:%d |%*.*s|\n", FI_LI, dlen, dlen, dptr);

   if (ConfigDump) DumpData (FI_LI, "$", dptr, dlen);

   status = sys$qio (EfnNoWait, SysCmdChan,
                     IO$_WRITELBLK | IO$M_NORSWAIT,
                     &SysCmdIOsb, &SysCmdAst, 0,
                     dptr, dlen, 0, 0, 0, 0);

   if (status && !(status & 1))
   {
      fprintf (stdout, "%s:%d SysCmdWrite() %%X%08.08X\n", FI_LI, status);
      SysCmdStatus = status;
   }

   return (SS$_NORMAL);
}

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

void SysCmdAst ()

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

   SysCmdStatus = SysCmdIOsb.iosb$w_status;
   SysCmdCount = SysCmdIOsb.iosb$w_bcnt;

   if (SysCmdStatus && !(SysCmdStatus & 1))
   {
      fprintf (stdout, "%s:%d SysCmdAst() %%X%08.08X\n", FI_LI, SysCmdStatus);
      return;
   }

   SysCmdWrite (NULL, 0);
}

/*****************************************************************************/
/*
Writes newline delmitted records (commands) to SYS$COMMAND.
*/

int CgiPlusInWrite (char *dptr, int dlen)

{
   int  status;
   char  *sptr, *zptr;

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

   if (dbug) fprintf (stdout, "%s:%d CgiPlusInWrite() %u %d\n",
                      FI_LI, dptr, dlen);

   if (dptr)
   {
      /*******************/
      /* buffer commands */
      /*******************/

      if (dlen <= 0) dlen = strlen(dptr);
      zptr = (sptr = CgiPlusInBuffer) + CgiPlusInSize - 1;
      sptr += CgiPlusInDataLength;
      if (!CgiPlusInDataLength)
      {
         /* start of CGIplus stream */
         *sptr++ = '!';
         *sptr++ = '\n';
      }
      while (dlen-- > 0 && sptr < zptr) *sptr++ = *dptr++;
      if (sptr >= zptr)
      {
         status = SS$_BUFFEROVF;
         fprintf (stdout, "%s:%d CgiPlusInWrite() %%X%08.08X\n", FI_LI, status);
         AndExit (status);
      }
      /* if overflow ensure the final variable is newline terminated */
      if (sptr >= zptr) *(sptr-1) = '\n';
      if (!CgiPlusInDataLength) CgiPlusInDataPtr = CgiPlusInBuffer;
      CgiPlusInDataLength = sptr - CgiPlusInBuffer;
      return (CgiPlusInDataLength);
   }

   /*****************/
   /* write records */
   /*****************/

   if (!CgiPlusInDataLength) return (SS$_NORMAL);

   zptr = (sptr = CgiPlusInBuffer) + CgiPlusInDataLength;
   while (sptr < zptr)
   {
      for (dptr = sptr; *sptr != '\n'; sptr++);
      dlen = sptr - dptr;
      sptr++;   

      if (dbug) fprintf (stdout, "%s:%d |%*.*s|\n", FI_LI, dlen, dlen, dptr);

      if (ConfigDump) DumpData (FI_LI, "+", dptr, dlen);

      status = sys$qio (EfnNoWait, CgiPlusInChan,
                        IO$_WRITELBLK | IO$M_NORSWAIT,
                        &CgiPlusInIOsb, &CgiPlusInAst, 0,
                        dptr, dlen, 0, 0, 0, 0);

      if (status && !(status & 1))
      {
         fprintf (stdout, "%s:%d CgiPlusInWrite() %%X%08.08X\n", FI_LI, status);
         AndExit (status);
      }
   }

   CgiPlusInDataPtr = CgiPlusInBuffer;
   CgiPlusInDataLength = 0;

   return (SS$_NORMAL);
}

/*****************************************************************************/
/*
With each read by the subprocess.  Bail out if there is problem.
*/

void CgiPlusInAst ()

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

   CgiPlusInStatus = CgiPlusInIOsb.iosb$w_status;
   CgiPlusInCount = CgiPlusInIOsb.iosb$w_bcnt;

   if (CgiPlusInStatus && !(CgiPlusInStatus & 1))
   {
      fprintf (stdout, "CgiPlusInAst() %s:%d %%X%08.08X\n",
               FI_LI, CgiPlusInStatus);
      AndExit (CgiPlusInStatus);
   }
}

/*****************************************************************************/
/*
Read from the script mailbox.
*/

void SysOutRead ()

{
   int  status;

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

   status = sys$qio (EfnNoWait, SysOutChan, IO$_READLBLK,
                     &SysOutIOsb, &SysOutAst, 0,
                     SysOutBuffer, SysOutSize-4, 0, 0, 0, 0);
   if (dbug) fprintf (stdout, "%s:%d sys$qio() %%X%08.08X\n", FI_LI, status);

   if (status && !(status & 1))
   {
      fprintf (stdout, "%s:%d SysOutRead() %%X%08.08X\n", FI_LI, status);
      SysOutStatus = status;
      return;
   }
}

/*****************************************************************************/
/*
Deliver output from the script mailbox.
*/

void SysOutAst ()

{
   int  alen, dlen, retval;
   char  *aptr, *dptr, *zptr;

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

   SysOutStatus = SysOutIOsb.iosb$w_status;
   SysOutCount = SysOutIOsb.iosb$w_bcnt;

   if (dbug) fprintf (stdout, "%s:%d SysOutAst() %%X%08.08X %d %d\n",
                      FI_LI, SysOutStatus, SysOutCount, WebSockAccepted);

   if (SysOutStatus && !(SysOutStatus & 1))
   {
      fprintf (stdout, "%s:%d SysOutAst() %%X%08.08X\n", FI_LI, SysOutStatus);
      AndExit (SysOutStatus);
   }

   if (ConfigDump) DumpData (FI_LI, ":", SysOutBuffer, SysOutCount);

   SysOutBuffer[SysOutCount] = '\0';

   if (dbug)
      fprintf (stdout, "%s:%d SysOutAst() %%X%08.08X |%s|\n",
               FI_LI, SysOutStatus, SysOutBuffer);

   while (SysOutCount)
   {
      /* check for the end of output sentinal */
      if (*(ULONGPTR)SysOutBuffer == *(ULONGPTR)CgiPlusEof)
      {
         if (!memcmp (SysOutBuffer, CgiPlusEof, CgiPlusEofLength))
         {
            /* if post-101 EOF just absorb */
            if (ChangingProtocols) break;

            if (dbug) fprintf (stdout, "%s:%d EOF\n", FI_LI);

            SysOutStatus = SS$_ENDOFFILE;
            sys$wake (0, 0);
            return;
         }
      }
      /* check for the escape sentinal */
      if (*(ULONGPTR)SysOutBuffer == *(ULONGPTR)CgiPlusEsc)
      {
         if (!memcmp (SysOutBuffer, CgiPlusEsc, CgiPlusEscLength))
         {
            SysOutEscape = 1;
            SysOutRead ();
            return;
         }
      }
      /* check for end of escape sentinal */
      if (*(ULONGPTR)SysOutBuffer == *(ULONGPTR)CgiPlusEot)
      {
         if (!memcmp (SysOutBuffer, CgiPlusEot, CgiPlusEotLength))
         {
            SysOutEscape = 0;
            SysOutRead ();
            return;
         }
      }
      if (SysOutEscape)
      {
         if (dbug) fprintf (stdout, "%s:%d |%s|\n", FI_LI, SysOutBuffer);
         SysOutRead ();
         return;
      }
      break;
   }

   /* ignore the CGIplus EOF following the upgrade 101 */
   if (IsWebSock && !ResponseHeader && HttpStatus == 101)
   {
      WriteOut (NULL, BUFFER_RESET);
      ResponseHeader = 1;
      WebSockAccepted = 1;
      WebSockSecAccept ();
      SysOutRead ();
      WebSockIn ();
      WebSockOut ();
      return;
   }

   /* if trailing carriage control following EOF following 101 */
   if (IsWebSock && WebSockAccepted++ == 2)
      if (SysOutBuffer[0] == '\r' && SysOutBuffer[1] == '\n')
      {
         SysOutRead ();
         return;
      }

   if (!ResponseHeader)
   {
      /*******************/
      /* response header */
      /*******************/

      /* ensure header records without carriage control have it */
      if (!SysOutCount || SysOutBuffer[SysOutCount-1] != '\n')
      {
         SysOutBuffer[SysOutCount++] = '\r';
         SysOutBuffer[SysOutCount++] = '\n';
         SysOutBuffer[SysOutCount] = '\0';
      }

      dptr = SysOutBuffer;
      dlen = SysOutCount;

      while (!ResponseHeader && dptr && *dptr)
         dptr = HttpResponse (dptr);

      if (dptr && *dptr) 
      {
         SysOutCount -= (dptr - SysOutBuffer);
         SysOutBuffer = dptr;
      }
      else
         SysOutCount = 0;

      if (!SysOutCount) 
      {
         SysOutRead ();
         return;
      }
   }

   if (ResponseHeader)
   {
      /*****************/
      /* response body */
      /*****************/

      if (!XStreamMode)
      {
         if (XRecordMode)
         {
            if (!SysOutCount || SysOutBuffer[SysOutCount-1] != '\n')
            {
               SysOutBuffer[SysOutCount++] = '\n';
               SysOutBuffer[SysOutCount] = '\0';
            }
         }
         else
         if (XRecord0Mode)
         {
            if (!SysOutCount)
            {
               SysOutBuffer[SysOutCount++] = '\n';
               SysOutBuffer[SysOutCount] = '\0';
            }
         }

         if (XFilterStream)
         {
            for (zptr = (aptr = dptr) + dlen; dptr < zptr; dptr++)
               if (isprint(*dptr) || isspace(*dptr))
                  *aptr++ = *dptr;
            SysOutCount = aptr - SysOutBuffer;
            SysOutBuffer[SysOutCount] = '\0';
         }
      }

      dptr = SysOutBuffer;
      dlen = SysOutCount;

      if (dlen) WriteOut (dptr, dlen);
   }

   SysOutRead ();
}

/*****************************************************************************/
/*
Read from the script mailbox.
*/

void WebSockOut ()

{
   int  status;

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

   if (WebSockOutBuffer)
   {
      WebSockOutBuffer = calloc (1, WebSockOutSize+4);
      if (!WebSockOutBuffer) AndExit (vaxc$errno);
   }

   status = sys$qio (EfnNoWait, WebSockOutChan, IO$_READLBLK,
                     &WebSockOutIOsb, &WebSockOutAst, 0,
                     WebSockOutBuffer, WebSockOutSize, 0, 0, 0, 0);
   if (dbug) fprintf (stdout, "%s:%d sys$qio() %%X%08.08X\n", FI_LI, status);

   if (status && !(status & 1))
   {
      fprintf (stdout, "%s:%d WebSockOut() %%X%08.08X\n", FI_LI, status);
      WebSockOutStatus = status;
      return;
   }
}

/*****************************************************************************/
/*
Deliver output from the WebSocket script mailbox.
*/

void WebSockOutAst ()

{
   int  retval;

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

   ChangingProtocols = 0;

   WebSockOutStatus = WebSockOutIOsb.iosb$w_status;
   WebSockOutCount = WebSockOutIOsb.iosb$w_bcnt;

   if (dbug) fprintf (stdout, "%s:%d WebSockOutAst() %%X%08.08X %d\n",
                      FI_LI, WebSockOutStatus, WebSockOutCount);

   if (!(WebSockOutStatus & 1) && WebSockOutStatus != SS$_ENDOFFILE)
   {
      fprintf (stdout, "%s:%d WebSockOutAst() %%X%08.08X\n",
               FI_LI, WebSockOutStatus);
      return;
   }

   if (ConfigDump) DumpData (FI_LI, "}", WebSockOutBuffer, WebSockOutCount);

   retval = WriteNow (WebSockOutBuffer, WebSockOutCount);

   WebSockOut ();
}

/*****************************************************************************/
/*
Write to the WebSocket mailbox.
*/

void WebSockIn ()

{
   int  retval, status;
   char  *sptr;

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

   if (dbug) fprintf (stdout, "%s:%d WebSockIn() %d\n", FI_LI, WebSockPeek);

   if (!WebSockInBuffer)
   {
      WebSockInBuffer = calloc (1, WebSockInSize+4);
      if (!WebSockInBuffer) AndExit (vaxc$errno);
   }

   if (!WebSockPeek)
   {
      /* wait for asynchronous data from client */
      WebSockInPeek (0);
      return;
   }

   /********************/
   /* read from client */
   /********************/

   retval = NetRead (WebSockInBuffer, WebSockInSize);
   if (retval <= 0) AndExit (SS$_ABORT);

   /**********************/
   /* write to websocket */
   /**********************/

   status = sys$qio (EfnNoWait, WebSockInChan, IO$_WRITELBLK,
                     &WebSockInIOsb, &WebSockInAst, 0,
                     WebSockInBuffer, retval, 0, 0, 0, 0);
   if (dbug) fprintf (stdout, "%s:%d sys$qio() %%X%08.08X\n", FI_LI, status);

   if (status && !(status & 1))
   {
      fprintf (stdout, "%s:%d WebSockIn() %%X%08.08X\n", FI_LI, status);
      WebSockInStatus = status;
      AndExit (WebSockInStatus);
   }
}

/*****************************************************************************/
/*
The WebSocket mailbox has been written to.
*/

void WebSockInAst ()

{
   int  alen, dlen, retval;
   char  *aptr, *dptr, *zptr;

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

   ChangingProtocols = 0;

   WebSockInStatus = WebSockInIOsb.iosb$w_status;
   WebSockInCount = WebSockInIOsb.iosb$w_bcnt;

   if (dbug) fprintf (stdout, "%s:%d WebSockInAst() %%X%08.08X %d\n",
                      FI_LI, WebSockInStatus, WebSockInCount);

   if (!(WebSockInStatus & 1) && WebSockInStatus != SS$_ENDOFFILE)
   {
      fprintf (stdout, "%s:%d WebSockInAst() %%X%08.08X\n",
               FI_LI, WebSockInStatus);
      AndExit (WebSockInStatus);
   }

   if (ConfigDump) DumpData (FI_LI, "{", WebSockInBuffer, WebSockInCount);

   WebSockInPeek (0);
}

/*****************************************************************************/
/*
Peek at the network socket device channel (SDC) wating for data to be present. 
When data is available to read call the blocking network read.
*/

void WebSockInPeek (int deliver)

{
   static char  pbuf [8];

   int  status;

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

   if (dbug) fprintf (stdout, "%s:%d WebSockInPeek() %d %%X%08.08X %d\n",
                      FI_LI, deliver, WebSockPeekIOsb.iosb$w_status,
                                      WebSockPeekIOsb.iosb$w_bcnt);

   if (deliver)
   {
      /* doesn't really matter whether the peek succeeded or failed */
      WebSockIn ();
      WebSockPeek = 0;
      return;
   }

   memset (&WebSockPeekIOsb, 0, sizeof(WebSockPeekIOsb));

   status = sys$qio (EfnNoWait, NetBgSdc, IO$_READVBLK, &WebSockPeekIOsb,
                     WebSockInPeek, 1,
                     pbuf, sizeof(pbuf), 0,
                     TCPIP$C_MSG_PEEK | TCPIP$C_MSG_BLOCKALL, 0, 0);

   if (status && !(status & 1))
   {
      fprintf (stdout, "%s:%d sys$qio() %%X%08.08X\n", FI_LI, status);
      AndExit (status);
   }

   WebSockPeek = 1;
}

/*****************************************************************************/
/*
Write to the client the specified octets.
If |dlen| is less than zero get the length of a null-terminated string.
Buffering can be enabled, disabled and flushed.
*/

int WriteOut (char* dptr, int dlen)

{
   static int  bsize = DEFAULT_OUT_SIZE;
   static char  *bptr, *bzptr, *buf;

   int  retval;

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

//   if (dbug) fprintf (stdout, "%s:%d WriteOut() %u %d\n", FI_LI, dptr, dlen);

   if (HttpStatus / 100 == 5) return (WriteNow (dptr, dlen));

   if (!dptr)
   {
      /****************/
      /* data is NULL */
      /****************/

      if (dlen == BUFFER_ON)
      {
         /*************/
         /* BUFFER_ON */
         /*************/

         if (!buf)
         {
            buf = calloc (1, bsize+4);
            if (!buf) AndExit (vaxc$errno);
            bzptr = buf + bsize;
         }
         bptr = buf;
         return (0);
      }
      else
      if (dlen == BUFFER_OFF)
      {
         /**************/
         /* BUFFER_OFF */
         /**************/

         /* if buffering disabled */
         if (!bptr) return (0);
         dptr = buf;
         dlen = bptr - buf;
         bptr = NULL;
         /* if nothing in the buffer */
         if (!dlen) return (0);
         /* drop through to flush the buffer */
      }
      else
      if (dlen == BUFFER_FLUSH)
      {
         /****************/
         /* BUFFER_FLUSH */
         /****************/

         /* if buffering disabled */
         if (!bptr) return (0);
         dptr = buf;
         dlen = bptr - buf;
         bptr = buf;
         /* if nothing in the buffer */
         if (!dlen) return (0);

         retval = NetWrite (dptr, dlen);
         return (retval);
      }
      else
      if (dlen == BUFFER_RESET)
      {
         /****************/
         /* BUFFER_RESET */
         /****************/

         dptr = buf;
         return (dlen = 0);
      }
   }

   /* data non-NULL and length to be calculated */
   if (dlen < 0) dlen = strlen (dptr);
   if (!dlen) return (0);

   if (bptr && XBufferRecords)
   {
      /**********/
      /* buffer */
      /**********/

      while (dlen > 0)
      {
         while (dlen > 0 && bptr < bzptr)
         {
            *bptr++ = *dptr++;
            dlen--;
         }
         if (bptr >= bzptr)
         {
            /************/
            /* overflow */
            /************/

            retval = NetWrite (buf, bptr - buf);
            bptr = buf;
         }
      }
      /* return the current length */
      return (bptr - buf);
   }

   /*******************/
   /* write to client */
   /*******************/

   retval = NetWrite (dptr, dlen);

   return (retval);
}

/*****************************************************************************/
/*
Write to client regardless of other constraints.
*/

static int WriteNow (char* dptr, int dlen)

{
   int  retval;

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

   if (dbug) fprintf (stdout, "%s:%d WriteNow() %u %d\n", FI_LI, dptr, dlen);

   if (!dptr) return (0);
   if (dlen < 0) dlen = strlen (dptr);
   if (!dlen) return (0);

   if (ConfigDump) DumpData (FI_LI, ">", dptr, dlen);

   if (secure)
      retval = SSL_write_ex (ssl, dptr, dlen, &exCount);
   else
      retval = send (sockfd, dptr, dlen, 0);
   if (dbug) fprintf (stdout, "%s:%d %d %d\n", FI_LI, retval, exCount);
   if (retval > 0) ResponseBytes64 += dlen;

   return (retval);
}

/*****************************************************************************/
/*
First line of response header.  NPH or CGI header.
*/

char* HttpResponse (char* dptr)

{
   char  *cptr, *sptr, *zptr;
   char  buf [1024];

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

   if (dbug) fprintf (stdout, "%s:%d HttpResponse() |%s|\n", FI_LI, dptr);

   if (ChangingProtocols) return (NULL);

   if (HttpStatus) return (HttpResponse2 (dptr));

   ContentTypePlain = ContentTypeHtml = ResponseConnectionClose = 0;

   if (!strncmp (dptr, "HTTP/1.", 7))
   {
      /*******/
      /* NPH */
      /*******/

      if (dbug) fprintf (stdout, "%s:%d HttpResponse() NPH\n", FI_LI);
      for (cptr = dptr + 7; *cptr != ' '; cptr++);
      while (*cptr == ' ') cptr++;
      HttpStatus = atoi(cptr);
      ResponseHeader = 1;
      return (dptr);
   }

   /*******/
   /* CGI */
   /*******/

   zptr = (sptr = buf) + sizeof(buf)-1;

   if (!HttpStatus && !strncasecmp (dptr, "Status:", 7))
   {
      dptr += 7;
      for (cptr = "HTTP/1.1"; *cptr && sptr < zptr; *sptr++ = *cptr++);
      while (*dptr && !isdigit(*dptr) && *dptr != '\n' &&
             *dptr != '\r' && sptr < zptr)
         *sptr++ = *dptr++;
      if (isdigit(*dptr)) HttpStatus = atoi(dptr);
   }
   else
   if (!HttpStatus && !strncasecmp (dptr, "Content-Type:", 13))
   {
      HttpStatus = 200;
      for (cptr = "HTTP/1.1 200 OK\r\n";
           *cptr && sptr < zptr;
           *sptr++ = *cptr++);
      for (cptr = dptr + 13; *cptr && *cptr == ' '; cptr++);
      if (!strncasecmp (cptr, "text/plain", 10))
         ContentTypePlain = 1;
      else
      if (!strncasecmp (cptr, "text/html", 9))
         ContentTypeHtml = 1;
   }
   else
   if (!HttpStatus && !strncasecmp (dptr, "Location:", 9))
   {
      HttpStatus = 301;
      for (cptr = "HTTP/1.1 301 Moved Permanently\r\n";
           *cptr && sptr < zptr;
           *sptr++ = *cptr++);
   }

   /* rest of response line */
   while (*dptr && *dptr != '\n' && *dptr != '\r' && sptr < zptr)
      *sptr++ = *dptr++;
   if (*dptr == '\r') *sptr++ = *dptr++;
   if (*dptr == '\n') *sptr++ = *dptr++;
   *sptr = '\0';

   if (sptr == buf || sptr >= zptr)
   {
      zptr = (sptr = buf) + sizeof(buf)-1;
      HttpStatus = 502;
      Response502 (FI_LI, "...bad gateway");
      ResponseHeader = 1;
      return (NULL);
   }

   if (!HttpStatus)
   {
      zptr = (sptr = buf) + sizeof(buf)-1;
      HttpStatus = 502;
      Response502 (FI_LI, "...bad CGI response");
      ResponseHeader = 1;
      return (NULL);
   }

   if (HttpStatus == 101)
   {
      /* changing protocols (WebSocket) */
      ChangingProtocols = 1;
      return (NULL);
   }

   if (dbug) fprintf (stdout, "%s:%d HttpResponse() |%s|\n", FI_LI, buf);
   WriteOut (buf, sptr - buf);

   if (!ResponseHeader && *dptr) return (HttpResponse2 (dptr));

   return (dptr);
}

/*****************************************************************************/
/*
Rest of response header.
*/

char* HttpResponse2 (char* dptr)

{
   char  *cptr, *sptr, *zptr;
   char  buf [4096];

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

   zptr = (sptr = buf) + sizeof(buf)-1;

   while (*dptr)
   {
      if (*dptr == '\n' || *dptr == '\r')
      {
         if (dbug) fprintf (stdout, "%s:%d HttpResponse2() END\n", FI_LI);
         ResponseHeader = 1;

         for (cptr = "Cache-Control: no-cache, must-revalidate\r\n";
              *cptr && sptr < zptr;
              *sptr++ = *cptr++);

         if (RequestConnectionClose ||
             ResponseConnectionClose ||
             ResponseContentLength < 0)
         {
            ConnectionClose = 1;
            for (cptr = "Connection: close\r\n";
                 *cptr && sptr < zptr;
                 *sptr++ = *cptr++);
         }

         if (*dptr == '\r' && sptr < zptr) *sptr++ = *dptr++;
         if (*dptr == '\n' && sptr < zptr) *sptr++ = *dptr++;
         *sptr = '\0';

         WriteOut (buf, sptr - buf);
         zptr = (sptr = buf) + sizeof(buf)-1;

         /* flush the response header */
         WriteOut (NULL, BUFFER_FLUSH);
         break;
      }

      if (!strncasecmp (dptr, "Content-Length:", 15))
      {
         for (cptr = dptr + 15; *cptr == ' '; cptr++);
         if (isdigit(*cptr)) ResponseContentLength = atoi(cptr);
      }
      else
      if (!strncasecmp (dptr, "Connection:", 11))
      {
         for (cptr = dptr + 11; *cptr == ' '; cptr++);
         if (!strncasecmp (cptr, "close", 5)) ResponseConnectionClose = 1;
      }

      if (!strncasecmp (dptr, "Script-Control:", 15))
      {
         for (dptr += 15; *dptr == ' '; dptr++);
         if (!strncasecmp (dptr, "X-buffer-records", 16))
         {
            /* buffer records before sending to client */
            XBufferRecords = 1;
            dptr += 16;
            if (*(USHORTPTR)dptr == '=0') XBufferRecords = 0;
         }
         else
         if (!strncasecmp (dptr, "X-filter-stream", 15))
         {
            /* remove all non-printable characters */
            XFilterStream = 1;
            dptr += 15;
            if (*(USHORTPTR)dptr == '=0') XFilterStream = 0;
         }
         else
         if (!strncasecmp (dptr, "X-record-mode", 13))
         {
            /* ensure all records have at least trailing <LF> */
            XRecordMode = 1;
            dptr += 13;
            if (*(USHORTPTR)dptr == '=0') XRecordMode = 0;
         }
         else
         if (!strncasecmp (dptr, "X-record0-mode", 14))
         {
            /* only empty records have a trailing <LF> inserted */
            XRecord0Mode = 1;
            dptr += 14;
            if (*(USHORTPTR)dptr == '=0') XRecord0Mode = 0;
         }
         else
         if (!strncasecmp (dptr, "X-stream-mode", 13))
         {
            /* do not alter records at all, WSSIWCG! */
            XStreamMode = 1;
            dptr += 13;
            if (*(USHORTPTR)dptr == '=0') XStreamMode = 0;
         }

         /* absorb unknown directive and/or rest of line */
         while (*dptr && *dptr != '\n' && *dptr != '\r') dptr++;
         if (*dptr == '\r') dptr++;
         if (*dptr == '\n') dptr++;
      }
      else
      {
         while (*dptr && *dptr != '\n' && *dptr != '\r' && sptr < zptr)
            *sptr++ = *dptr++;
         if (*dptr == '\r' && sptr < zptr) *sptr++ = *dptr++;
         if (*dptr == '\n' && sptr < zptr) *sptr++ = *dptr++;
      }
   }
   *sptr = '\0';

   if (dbug) fprintf (stdout, "%s:%d HttpResponse2() %d |%s|\n",
                      FI_LI, sptr - buf, buf);
   if (sptr - buf) WriteOut (buf, sptr - buf);

   return (dptr);
}

/****************************************************************************/
/*
Copies null-terminated string |sptr| to |dptr|.  Copies no more than |size|-1
then terminates with a null character, effectively truncating the string.
Returns length of *source* (not the copied) string.  Exit on buffer under and
over flows.
*/

int strzcpy
(
char *dptr,
char *sptr,
int size
)
{
   char  *cptr, *zptr;

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

   zptr = dptr + size;
   if (zptr <= dptr)
   {
      fprintf (stdout, "strzcpy() %s:%d %d\n", FI_LI, size);
      AndExit (SS$_BUFFEROVF);
   }
   for (cptr = sptr; *cptr && dptr < zptr; *dptr++ = *cptr++);
   if (dptr < zptr)
   {
      *dptr = '\0';
      return (cptr - sptr);
   }
   fprintf (stdout, "strzcpy() %s:%d %d\n", FI_LI, size);
   AndExit (SS$_BUFFEROVF);
}

/*****************************************************************************/
/*
Generate a "random" 23 alpha-numeric character string. 
*/

char* RandomString ()

{
   static int64  RandomNumber64;
   static char  RandomString24 [24];

   char  *cptr, *czptr, *sptr, *zptr;

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

   if (!RandomNumber64) sys$gettim (&RandomNumber64);
   zptr = (sptr = RandomString24) + sizeof(RandomString24)-1;
   while (sptr < zptr)
   {
      /* cheap (no subroutine call) MTH$RANDOM() */
      RandomNumber64 = RandomNumber64 * 69069 + 1;
      for (czptr = (cptr = (char*)&RandomNumber64) + sizeof(RandomNumber64);
           cptr < czptr && sptr < zptr;
           cptr++)
         if ((*cptr >= '0' && *cptr <= '9') || (*cptr >= 'A' && * cptr <= 'Z'))
            *sptr++ = *cptr;
   }
   *sptr = '\0';
   return (RandomString24);
}

/*****************************************************************************/
/*
Translate a logical name via LNM$FILE_DEV.  Return a pointer to the value
string, or NULL if the name does not exist.  Unused value should be free()ed.
*/

char* GetLogical (char *name)

{
   static ulong  flags = LNM$M_CASE_BLIND;
   static char  value [LOGICAL_VALUE_SIZE];
   static $DESCRIPTOR (NameDsc, "");
   static $DESCRIPTOR (ValueDsc, "");

   int  status, index, maxIndex;
   ushort  slen;
   char  *sptr, *zptr;

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

   if (dbug) fprintf (stdout, "%s:%d GetLogical() |%s|\n", FI_LI, name);

   NameDsc.dsc$a_pointer = name;
   NameDsc.dsc$w_length = strlen(name);

   zptr = (sptr = value) + sizeof(value)-1;;
   for (index = maxIndex = 0; index <= maxIndex; index++)
   {
      ValueDsc.dsc$a_pointer = sptr;
      if ((ValueDsc.dsc$w_length = zptr - sptr) > 255)
         ValueDsc.dsc$w_length = 255;

      status = lib$get_logical (&NameDsc, &ValueDsc, &slen, 0,
                                &maxIndex, &index, 0, &flags);
      if (!(status & 1))
      {
         if (dbug) fprintf (stdout, "%s:%d  %%X%08.08X |(null)|\n",
                            FI_LI, status);
         return (NULL);
      }

      sptr[slen] = '\0';
      sptr += slen;
   }

   if (dbug) fprintf (stdout, "%s:%d |%s|\n", FI_LI, value);
   return (strdup (value));
}

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

int Response400 (char *code, int line, char *reason)

{
   HttpResponse ("Status: 400 Bad Request\r\n\r\n");
   WriteOut ("...", 3);
   WriteOut (reason, -1);
   WriteOut ("\n", 1);
   if (dbug) fprintf (stdout, "%s:%d Response400()\n", code, line);
   return (0);
}

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

int Response403 (char *code, int line, char *reason)

{
   HttpResponse ("Status: 403 Forbidden\r\n\r\n");
   WriteOut ("...", 3);
   WriteOut (reason, -1);
   WriteOut ("\n", 1);
   if (dbug) fprintf (stdout, "%s:%d Response403()\n", code, line);
   return (0);
}

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

int Response404 (char *code, int line, char *reason)

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

   HttpResponse ("Status: 404 Not Found\r\n\r\n");
   WriteOut ("...", 3);
   WriteOut (reason, -1);
   WriteOut ("\n", 1);
   if (dbug) fprintf (stdout, "%s:%d Response404()\n", code, line);
   return (0);
}

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

int Response500 (char *code, int line, char *reason)

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

   if (!reason) reason = DEFAULT_500_MSG;
   HttpResponse ("Status: 500 Internal Server Error\r\n\r\n");
   WriteOut ("...", 3);
   WriteOut (reason, -1);
   WriteOut ("\n", 1);
   if (dbug) fprintf (stdout, "%s:%d Response500()\n", code, line);
   return (0);
}

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

int Response501 (char *code, int line, char *reason)

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

   if (!reason) reason = DEFAULT_500_MSG;
   HttpResponse ("Status: 501 Internal Server Error\r\n\r\n");
   WriteOut ("...", 3);
   WriteOut (reason, -1);
   WriteOut ("\n", 1);
   if (dbug) fprintf (stdout, "%s:%d Response501()\n", code, line);
   return (0);
}

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

int Response502 (char *code, int line, char *reason)

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

   if (!reason) reason = DEFAULT_500_MSG;
   HttpResponse ("Status: 502 Bad Gateway\r\n\r\n");
   WriteOut ("...", 3);
   WriteOut (reason, -1);
   WriteOut ("\n", 1);
   if (dbug) fprintf (stdout, "%s:%d Response502()\n", code, line);
   return (0);
}

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

int BeginRequest ()

{
   int  retval;
   char  scratch [256];
   char  *aptr, *cptr, *sptr, *zptr;

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

   if (dbug) fprintf (stdout, "%s:%d BeginRequest() |%s|%s|%s|\n",
                      FI_LI, RequestUri, CgiScriptName, CgiScriptFileName);

   if (RequestCount++) timestamp ("PIPELINE", -1, "request");

   fprintf (stdout, "%%WAUXD-I-URI, %s\n", RequestUri);

   fprintf (stdout, "%%WAUXD-I-AGENT, %s\n", HttpUserAgent);

   if (strstr (CgiPathInfo, "../")) return (Response403 (FI_LI, "nope"));

   if (CgiScriptName)
   {
      if (CgiScriptFileName)
      {
         fprintf (stdout, "%%WAUXD-I-SCRIPT, %s%s %s %s\n",
                  IsCgiPlus ? "CGIplus" : "CGI",
                  IsWebSock ? " WebSocket" : "",
                  CgiScriptName, CgiScriptFileName);
         retval = BeginSubProcess ();
         return (retval);
      }
      else
         return (Response404 (FI_LI, strerror(ENOENT)));
   }

   if (*CgiPathTrans)
   {
      for (cptr = CgiPathInfo; *cptr; cptr++);
      if (*(cptr-1) != '/')
      {
         /*****************/
         /* specific file */
         /*****************/

         retval = BeginFile (CgiPathTrans);
         if (retval >= 0) return (retval);
         return (Response404 (FI_LI, strerror(-(retval))));
      }
      else
      {
         /***************/
         /* index files */
         /***************/

         zptr = (sptr = scratch) + sizeof(scratch)-1;
         for (cptr = CgiPathTrans; *cptr && sptr < zptr; *sptr++ = *cptr++);
         aptr = sptr;
         cptr = IndexFileNames;
         while (*cptr)
         {
            sptr = aptr;
            while (*cptr && *cptr != ',' && sptr < zptr) *sptr++ = *cptr++;
            *sptr = '\0';
            if (*cptr) cptr++;

            retval = BeginFile (scratch);
            if (retval >= 0) return (retval);
         }
         return (Response404 (FI_LI, strerror(-(retval))));
      }
   }

   return (Response404 (FI_LI, strerror(EFAIL)));
}

/*****************************************************************************/
/*
Returns a zero or positive number (of bytes) in length if the file exists and
is accessible, etc.  Return a negative number, the negated errno, if access
fails.  Stream format files the length is obtained directly, whereas variable
length record files are completely read the obtain the length.  Return the file
content to the client.
*/

int BeginFile (char *PathTrans)

{
   static int  bsize = DEFAULT_OUT_SIZE;
   static char  *buf;

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

   int  retval, total;
   char  *bptr, *sptr, *mtptr, *path, *trans, *rfm;
   char  lmod [32],
         size [16];
   stat_t  stbuf;
   struct  tm  gmt;
   FILE  *flptr;

   path = CgiPathInfo;
   trans = PathTrans;

   if (dbug) fprintf (stdout, "%s:%d BeginFile() |%s|%s|\n",
                      FI_LI, path, trans);

   if (stat (trans, &stbuf) < 0)
   {
      if (dbug) fprintf (stdout, "%s:%d %d %s\n",
                         FI_LI, errno, strerror(errno));
      return (-(errno));
   }
   errno = 0;  /** hmmm **/

   if (stbuf.st_fab_rfm == FAB$C_VAR ||
       stbuf.st_fab_rfm == FAB$C_VFC)
      flptr = fopen (trans, "r", "shr=put");
   else
      flptr = fopen (trans, "r", "shr=put", "ctx=bin");
   if (dbug) fprintf (stdout, "%s:%d %d %s\n", FI_LI, errno, strerror(errno));
   if (errno) return (-(errno));

   if (!buf)
   {
      buf = calloc (1, bsize);
      if (!buf) 
      {
         Response500 (FI_LI, strerror(errno));
         AndExit (vaxc$errno);
      }
   }

   HttpResponse ("Content-Type: ");
   mtptr = GetMimeType (trans);
   WriteOut (mtptr, -1);
   WriteOut ("\r\n", 2);

   if (!strncasecmp (mtptr, "text/plain", 10))
      ContentTypePlain = 1;
   else
   if (!strncasecmp (mtptr, "text/html", 9))
      ContentTypeHtml = 1;

   if (!(ConfigDump && (ContentTypePlain || ContentTypeHtml)))
   {
      if (stbuf.st_fab_rfm == FAB$C_VAR ||
          stbuf.st_fab_rfm == FAB$C_VFC)
      {
         /* clunky but hey... */
         stbuf.st_size = 0;
         while ((retval = fread (buf, 1, bsize, flptr)) > 0)
            stbuf.st_size += retval;
         rewind (flptr);
      }

      WriteOut ("Content-Length: ", 16);
      sprintf (size, "%d", stbuf.st_size);
      WriteOut (size, -1);
      WriteOut ("\r\n", 2);

      ResponseContentLength = stbuf.st_size;
   }
   else
      ResponseContentLength = -1;

   gmtime_r (&stbuf.st_mtime, &gmt);
   asctime_r (&gmt, lmod);
   WriteOut ("Last-Modified: ", 15);
   WriteOut (lmod, strlen(lmod)-1);
   WriteOut (" GMT\r\n", 6);

   /* end of header empty line */
   WriteOut ("\r\n", 2);

   switch (stbuf.st_fab_rfm)
   {
      case FAB$C_UDF : rfm = "UDF"; break;
      case FAB$C_FIX : rfm = "FIX"; break;
      case FAB$C_VAR : rfm = "VAR"; break;
      case FAB$C_VFC : rfm = "VFC"; break;
      case FAB$C_STM : rfm = "STM"; break;
      case FAB$C_STMLF : rfm = "STMLF"; break;
      case FAB$C_STMCR : rfm = "STMCR"; break;
      default : rfm = "?";
   }
   fprintf (stdout, "%%WAUXD-I-FILE, %s, %d bytes, %s, %s %s\n",
            rfm, stbuf.st_size, mtptr, path, trans);

   if (stbuf.st_fab_rfm != FAB$C_VAR &&
       stbuf.st_fab_rfm != FAB$C_VFC)
      WriteOut (NULL, BUFFER_OFF);

   total = 0;
   while ((retval = fread (buf, 1, bsize, flptr)) > 0)
   {
      WriteOut (buf, retval);
      total += retval;
   }

   if (stbuf.st_fab_rfm == FAB$C_VAR ||
       stbuf.st_fab_rfm == FAB$C_VFC)
      WriteOut (NULL, BUFFER_FLUSH);

   fclose (flptr);

   return (total);
}

/*****************************************************************************/
/*
Given a file extension (e.g. ".TXT") return a corresponding MIME type (e.g.
"text/plain").  Can return NULL if the extension makes no sense.  Default is
"application/octet-stream".
*/

char* GetMimeType (char *tptr)

{
   /* the '$' is used as a flag */
   static char mtypes[] = "$c=text/plain,"
                          ".h=text/plain,"
                          ".com=text/plain,"
                          ".css=text/css,"
                          ".gif=image/gif,"
                          ".htm=text/html,"
                          ".html=text/html,"
                          ".jpg=image/jpeg,"
                          ".jpeg=image/jpeg,"
                          ".js=text/javascript,"
                          ".json=application/json,"
                          ".png=image/png,"
                          ".pdf=application/pdf,"
                          ".txt=text/plain,"
                          ".zip=application/zip,"
                          "\0\0";
   static char  *types = mtypes;

   int  size;
   char  *aptr, *cptr, *sptr;

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

   if (ConfigMimeTypes)
   {
      /**************/
      /* initialise */
      /**************/

      size = strlen(types);
      /* if additonal types begins with '+' then add, otherwise override */
      if (ConfigMimeTypes[0] = '+')
         size += strlen(ConfigMimeTypes);
      else
         size = strlen(ConfigMimeTypes);
      aptr = sptr = calloc (1, size+2);
      if (!aptr)
      {
         fprintf (stdout, "%s:%d calloc() %s\n", FI_LI, strerror(errno));
         AndExit (vaxc$errno);
      }
      if (ConfigMimeTypes[0] = '+')
      {
         for (cptr = types; *cptr; *sptr++ = *cptr++);
         ConfigMimeTypes++;
      }
      else
         ConfigMimeTypes[0] = '$';
      for (cptr = ConfigMimeTypes; *cptr; *sptr++ = *cptr++);
      *sptr = '\0';
      ConfigMimeTypes = NULL;
      types = aptr;
   }
   if (dbug) fprintf (stdout, "%s:%d |%s|\n", FI_LI, types);

   /* the '$' is used as an initialisation flag */
   if (types[0] == '$')
   {
      types[0] = '.';
      /* convert all delimiters to nulls */
      for (cptr = types; *cptr; cptr++)
         if (*cptr == '=' || *cptr == ',')
            *cptr = '\0';
      *(USHORTPTR)cptr = '\0\0';
      /* i.e. ".ext\0type\0.ext\0type\0\0\0" */
   }

   /*********/
   /* match */
   /*********/

   if (!tptr) return (NULL);
   if (*tptr != '.')
   {
      /* not pointing at an extension, try to find one */
      for (aptr = tptr; *tptr; tptr++);
      while (*tptr != '.' && tptr > aptr) tptr--;
      if (*tptr != '.') return (NULL);
   }

   /* ".ext\0type\0.ext\0type\0\0" */
   for (cptr = types; *(USHORTPTR)cptr != '\0\0'; cptr++)
   {
      for (sptr = cptr; *sptr; sptr++);
      sptr++;
      if (!strcasecmp (cptr, tptr)) return (sptr);
      for (cptr = sptr; *cptr; cptr++);
   }
   /* default for unknown type extension */
   return ("application/octet-stream");
}

/*****************************************************************************/
/*
Given a URI (e.g. "/web/one/two.txt") find the file system root that might
contain that file (e.g. "/dka100/web/").  Note the root must be in U*x
specification.  Return NULL if no match.
*/

char* GetFileRoot (char *uptr, int *lenptr)

{
   static char  *roots;

   int  len;
   char  *cptr, *sptr;

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

   if (!roots)
   {
      /**************/
      /* initialise */
      /**************/

      /* "<web>=<root>[,<web>=<root>,<web>=<root>]" */
      roots = calloc (1, strlen(ConfigRoot)+2);
      if (!roots)
      {
         fprintf (stdout, "%s:%d calloc() %s\n", FI_LI, strerror(errno));
         AndExit (vaxc$errno);
      }
      strcpy (roots, ConfigRoot);
      /* convert all delimiters to nulls */
      for (cptr = roots; *cptr; cptr++)
         if (*cptr == '=' || *cptr == ',')
            *cptr = '\0';
      *(USHORTPTR)cptr = '\0\0';
      /* i.e. "<web>\0<root>\0<web>\0<root>\0<web>\0<root>\0\0" */
   }

   if (!uptr) return (NULL);

   /*********/
   /* match */
   /*********/

   /* i.e. "<web>\0<root>\0<web>\0<root>\0<web>\0<root>\0\0" */
   for (cptr = roots; *(USHORTPTR)cptr != '\0\0'; cptr++)
   {
      for (sptr = cptr; *sptr; sptr++);
      len = sptr - cptr;
      sptr++;
      if (!strncasecmp (cptr, uptr, len))
      {
         *lenptr = len;
         return (sptr);
      }
      for (cptr = sptr; *cptr; cptr++);
   }
   *lenptr = 0;
   return (NULL);
}

/*****************************************************************************/
/*
Given a URI (e.g. "/cgi-bin/script") find the script root that might contain
that script (e.g. "dka100:[web.cgi-bin]").  Note the root must be in VMS file
specification.  Return NULL if no match.
*/

char* GetCgiRoot (char *uptr, int *lenptr)

{
   static char  *cgis;

   int  len;
   char  *cptr, *sptr;

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

   if (!cgis)
   {
      /**************/
      /* initialise */
      /**************/

      /* "<web>=<cgi>[,<web>=<cgi>,<web>=<cgi>]" */
      cgis = calloc (1, strlen(ConfigCgi)+2);
      if (!cgis)
      {
         fprintf (stdout, "%s:%d calloc() %s\n", FI_LI, strerror(errno));
         AndExit (vaxc$errno);
      }
      strcpy (cgis, ConfigCgi);
      /* convert all delimiters to nulls */
      for (cptr = cgis; *cptr; cptr++)
         if (*cptr == '=' || *cptr == ',')
            *cptr = '\0';
      *(USHORTPTR)cptr = '\0\0';
      /* i.e. "<web>\0<cgi>\0<web>\0<cgi>\0<web>\0<cgi>\0\0" */
   }

   if (!uptr) return (NULL);

   /*********/
   /* match */
   /*********/

   /* i.e. "<web>\0<cgi>\0<web>\0<cgi>\0<web>\0<cgi>\0\0" */
   for (cptr = cgis; *(USHORTPTR)cptr != '\0\0'; cptr++)
   {
      for (sptr = cptr; *sptr; sptr++);
      len = sptr - cptr;
      sptr++;
      if (!strncasecmp (cptr, uptr, len))
      {
         *lenptr = len;
         return (sptr);
      }
      for (cptr = sptr; *cptr; cptr++);
   }
   *lenptr = 0;
   return (NULL);
}

/*****************************************************************************/
/*
Return a base64 encoded string for the Sec-WebSocket-Accept: response.
*/

int WebSockSecAccept ()

{
   static char magicGUID [] = "258EAFA5-E914-47DA-95CA-C5AB0DC85B11";

   int  len;
   char  scratch [256];
   char  *cptr, *sptr, *zptr;
   uchar  digest [SHA_DIGEST_LENGTH];
   SHA_CTX shactx;

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

   zptr = (sptr = scratch) + sizeof(scratch)-1;
   for (cptr = WebSockKey; *cptr && sptr < zptr; *sptr++ = *cptr++);
   for (cptr = magicGUID; *cptr && sptr < zptr; *sptr++ = *cptr++);
   *sptr = '\0';
   len = sptr - scratch;

   SHA1_Init (&shactx);
   SHA1_Update (&shactx, (uchar*)scratch, len);
   SHA1_Final (digest, &shactx);

   len = EVP_EncodeBlock ((uchar*)scratch, digest, SHA_DIGEST_LENGTH);

   WriteOut ("HTTP/1.1 101 Switching Protocols\r\n"
             "Upgrade: websocket\r\n"
             "Connection: Upgrade\r\n"
             "Sec-WebSocket-Accept: ", 97);
   WriteOut (scratch, len);
   WriteOut ("\r\n\r\n", 4);
   WriteOut (NULL, BUFFER_FLUSH);

   return (0);
}

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

int BeginSubProcess ()

{
   int  status;

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

   if (dbug) fprintf (stdout, "%s:%d BeginSubProcess() |%s|\n",
                      FI_LI, CgiScriptFileName);

   status = ScriptSubProcess ();
   if (!(status & 1)) AndExit (status);
   if (dbug) timestamp (FI_LI, NULL);

   /************************/
   /* initial DCL commands */
   /************************/

   SysCmdWrite ("!'f$verify(0)\n", 14);

   if (ConfigVerify)
      SysCmdWrite (
"write sys$output \"HTTP/1.1 200 OK\"\n"
"write sys$output \"Content-Type: text/plain\"\n"
"write sys$output \"\"\n"
"set verify\n", -1);

   SysCmdWrite ("set noon\n", 9);
   SysCmdWrite ("defpn=\"define/process/nolog\"\n", 29);

   /* no chance of a POST */
   SysCmdWrite ("defpn HTTP$INPUT \"NL:\"\n", 23);

   SysCmdWrite ("defpn CGIPLUSEOT \"", 18);
   SysCmdWrite (CgiPlusEot, CgiPlusEotLength);
   SysCmdWrite ("\"\n", 2);

   SysCmdWrite ("defpn CGIPLUSESC \"", 18);
   SysCmdWrite (CgiPlusEsc, CgiPlusEscLength);
   SysCmdWrite ("\"\n", 2);

   if (IsCgiPlus)
   {
      SysCmdWrite ("defpn CGIPLUSEOF \"", 18);
      SysCmdWrite (CgiPlusEof, CgiPlusEofLength);
      SysCmdWrite ("\"\n", 2);

      SysCmdWrite ("defpn CGIPLUSIN \"", 17);
      SysCmdWrite (CgiPlusInDevName, -1);
      SysCmdWrite ("\"\n", 2);

      if (IsWebSock)
      {
         SysCmdWrite ("defpn WEBSOCKET_INPUT \"", 23);
         SysCmdWrite (WebSockInDevName, -1);
         SysCmdWrite ("\"\n", 2);

         SysCmdWrite ("defpn WEBSOCKET_OUTPUT \"", 24);
         SysCmdWrite (WebSockOutDevName, -1);
         SysCmdWrite ("\"\n", 2);
      }
   }

   /* write all the CGI variables; DCL symbols or CGIplus stream  */
   SetCgiVar (NULL, NULL);

   /***********************/
   /* activate the script */
   /***********************/

   if (ConfigDcl)
   {
      /* any pre- script activation DCL */
      SysCmdWrite (ConfigDcl, -1);
      SysCmdWrite ("\n", 1);
   }

   if (CgiScriptFileName[0] == '@')
      SysCmdWrite (CgiScriptFileName, -1);
   else
   if (CgiScriptFileName[0] == '$')
   {
      SysCmdWrite ("mcr ", 4);
      SysCmdWrite (CgiScriptFileName+1, -1);
   }
   else
      SysCmdWrite (CgiScriptFileName, -1);
   SysCmdWrite ("\n", 1);

   /************************/
   /* close the connection */
   /************************/

   SysCmdWrite ("!'f$verify(0)\n", 14);

   /* just in case the script spat before issueing the EOF */ 
   SysCmdWrite ("say=\"write sys$output\"\n", 23);
   SysCmdWrite ("say \"", 5);
   SysCmdWrite (CgiPlusEof, CgiPlusEofLength);
   SysCmdWrite ("\"\n", 2);

   /* flush the DCL commands */
   SysCmdWrite (NULL, 0);

   if (dbug) timestamp (FI_LI, NULL);

   sys$hiber();

   if (SysCmdStatus)
      fprintf (stdout, "%%WAUXD-E-SYSCMD, %%X%08.08X\n", SysCmdStatus);

   if (SysOutStatus && SysOutStatus != SS$_ENDOFFILE)
      fprintf (stdout, "%%WAUXD-E-SYSOUT, %%X%08.08X\n", SysOutStatus);

   if (!HttpStatus)
   {
      ResponseBytes64 = 0;
      Response500 (FI_LI, NULL);
   }

   WriteOut (NULL, BUFFER_FLUSH);

   return (0);
}

/*****************************************************************************/
/*
Write to client regardless of other constraints.
*/

static void DumpData (char* code, int line, char *iptr, char *dptr, int dlen)

{
   static char  snip[] = { 133, 133, 133, 133, 133,
                           133, 133, 133, 133, 133,
                           133, 133, 133, 133, 133,
                           133, 133, 133, 133, 133,
                           133, 133, 133, 133, 133,
                           133, 133, 133, 133, 133, 133, 133, 10 };

   static char  PreTag[] = "<pre style=\"font-family:monospace;"
                           "font-size:10pt;font-style:normal;\">";

   char  *cptr, *cdptr, *czptr, *dzptr, *sptr;
   char  buf [256],
         buf2 [1024];
   FILE  *flptr;

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

   if (dbug) fprintf (stdout, "%s:%d DumpData() %c %u %d\n",
                      code, line, *iptr, dptr, dlen);

   if (!code)
   {
      if (!(ContentTypePlain || ContentTypeHtml)) return;
      WriteOut (NULL, BUFFER_OFF);
      cdptr = ConfigDump;
      ConfigDump = NULL;
      if (ContentTypeHtml) NetWrite (PreTag, sizeof(PreTag)-1);
      NetWrite (snip, sizeof(snip));
      fsync (STDOUT_FILENO);

      flptr = fdopen (fileno(stdout), "w");
      if (!flptr)
      {
         dlen = sprintf (buf, "%%X%08.08X\n", vaxc$errno);
         NetWrite (buf, dlen);
         WriteOut (NULL, BUFFER_ON);
         return;
      }
      rewind (flptr);
      while (fgets (buf, sizeof(buf), flptr))
      {
         if (ContentTypePlain)
            NetWrite (buf, strlen(buf));
         else
         {
            dzptr = (sptr = buf2) + sizeof(buf2)-8;
            for (cptr = buf; *cptr && sptr < dzptr; cptr++)
            {
               if (*cptr == '<')
               {
                  strcpy (sptr, "&lt;");
                  sptr += 4;
                  continue;
               }
               if (*cptr == '>')
               {
                  strcpy (sptr, "&gt;");
                  sptr += 4;
                  continue;
               }
               if (*cptr == '&')
               {
                  strcpy (sptr, "&amp;");
                  sptr += 5;
                  continue;
               }
               *sptr++ = *cptr;
            }
            NetWrite (buf2, sptr - buf2);
         }
      }
      fclose (flptr);

      if (ContentTypeHtml) NetWrite ("</pre>", 6);
      ConfigDump = cdptr;
      WriteOut (NULL, BUFFER_ON);
      return;
   }

   if (ConfigDump[0] != '*' && *iptr != '*')
   {
      for (cptr = ConfigDump; *cptr && *cptr != *iptr; cptr++);
      if (*cptr != *iptr) return;
   }

   if (dlen < 0) dlen = strlen (dptr);

   if (!dlen)
   {
      fprintf (stdout, "%c %*.*s||\n", *iptr, 32*3, 32*3, "");
      return;
   }

   dzptr = (cptr = dptr) + dlen;
   while (cptr < dzptr)
   {
      czptr = cptr + 32;
      sptr = buf;
      *sptr++ = *iptr;
      *sptr++ = ' ';
      while (cptr < czptr && cptr < dzptr)
         sptr += sprintf (sptr, "%02.02x ", *(uchar*)cptr++);
      while (cptr < czptr)
      {
         *sptr++ = ' ';
         *sptr++ = ' ';
         *sptr++ = ' ';
         cptr++;
      }
      *sptr++ = '|';
      for (cptr = dptr; cptr < czptr && cptr < dzptr; cptr++)
      {
         if (isprint(*(uchar*)cptr)) {
            sptr += sprintf (sptr, "%c", *cptr);
         }
         else
            *sptr++ = '.';
      }
      *sptr++ = '|';
      *sptr = '\0';
      fprintf (stdout, "%s\n", buf);
      cptr = (dptr += 32);
   }
}

/*****************************************************************************/
/*
If |line| is positive or zero then generate a total duration timestamp.
If negative then an informational delta since the next most recent timestamp.
If positive then a dbug statement.  Otherwise an informational message.
*/

void timestamp (char *code, int line, char *msg)

{
   static int64  delta64, start64;
   static char  DeltaTime [16];
   static $DESCRIPTOR (FaoDsc, "!%T\0");
   static $DESCRIPTOR (DeltaDsc, DeltaTime);

   int64  time64, result64;

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

   if (!start64)
   {
      /* initialisation */
      sys$gettim (&start64);
      delta64 = start64;
      return;
   }
   sys$gettim (&time64);
   if (line >= 0)
      lib$sub_times (&time64, &start64, &result64);
   else
      lib$sub_times (&time64, &delta64, &result64);
   sys$fao (&FaoDsc, 0, &DeltaDsc, &result64);

   if (line > 0)
      fprintf (stdout, "%s:%d ***** %s *****\n", code, line, DeltaTime);
   else
   {
      if (msg)
         fprintf (stdout, "%%WAUXD-I-%s, %s, %s\n", code, DeltaTime, msg);
      else
         fprintf (stdout, "%%WAUXD-I-%s, %s\n", code, DeltaTime);
      sys$gettim (&delta64);
   }
}

/*****************************************************************************/
/*
Every second check for events that count down to zero and respond with an AST.
*/

void OneSecTick ()

{
   static int64  DeltaOneSec = ((int64)-10000000);

   int  status;

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

   if (WaitForRequest > 0)
      if (!(--WaitForRequest))
      {
         WaitForClose = 1;
         sys$dclast (NetClose, 0);
      }

   if (WaitForClose > 0)
      if (!(--WaitForClose))
         AndExit (SS$_NORMAL);

   status = sys$setimr (0, &DeltaOneSec, OneSecTick, OneSecTick, 0);
   if (!(status & 1)) AndExit (status);
}

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

void AndExit (int status)

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

   if (dbug)
      fprintf (stdout, "%s:%d AndExit() %%X%08.08X\n", FI_LI, status);

   if (!(status & 1)) fprintf (stdout, "%%X%08.08X\n", status);

   exit (status);
}

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

int BeginToProcess ()

{
   int  retval, status;
   char  msg [48];

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

   status = lib$get_ef (&EfnNoWait);
   if (!(status & 1))
   {
      fprintf (stdout, "lib$get_ef() %s:%d %%X%08.08X\n", FI_LI, status);
      AndExit (status);
   }

   sprintf (CgiGatewayMrs, "%d", SysOutSize);
   sprintf (WebSockOutMrs, "%d", WebSockOutSize);
   sprintf (WebSockInMrs, "%d", WebSockInSize);
   CgiPlusEofLength = sprintf (CgiPlusEof, "$Z-%s-", RandomString());
   CgiPlusEotLength = sprintf (CgiPlusEot, "$D-%s-", RandomString());
   CgiPlusEscLength = sprintf (CgiPlusEsc, "$E-%s-", RandomString());

   /* initiate one second timer */
   OneSecTick ();

   /* by default output is buffered */
   WriteOut (NULL, BUFFER_ON);

   retval = NetAccept ();

   while (retval >= 0)
   {
      ResponseContentLength = -1;
      ResponseConnectionClose = 0;

      if (retval >= 0) retval = GetRequestHeader ();
      if (dbug) timestamp (FI_LI, NULL);

      if (retval >= 0) retval = ParseRequestHeader ();
      if (dbug) timestamp (FI_LI, NULL);

      if (retval >= 0) retval = BeginRequest ();

      /* just in case */
      WriteOut (NULL, BUFFER_FLUSH);

      if (retval >= 0)
      {
         sprintf (msg, "%d, %lld bytes", HttpStatus, ResponseBytes64);
         timestamp ("RESPONSE", 0, msg);
      }

      if (ConfigDump && (ContentTypePlain || ContentTypeHtml))
         DumpData (NULL, 0, "*", NULL, 0);

      fsync (STDOUT_FILENO);

      if (ConnectionClose) break;
   }

   return (retval);
}

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

int main (int argc, char *argv[])

{
   int  retval;
   char  *cptr, *sptr, *zptr;
   char  scratch [256];

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

   if (cptr = GetLogical ("WAUXD_LOG"))
   {
      stdout = freopen (cptr, "w+", stdout, "shr=put");
      if (!stdout) exit (vaxc$errno);
      if (cptr = GetLogical("WAUXD_DUMP")) ConfigDump = strdup (cptr);
      dbug = (GetLogical ("WAUXD_DBUG") != NULL);
      if (dbug) ConfigDump = "*";
   }

   /* initialise the delta time */
   timestamp (0, 0, NULL);

   if (dbug) timestamp (FI_LI, NULL);

   XRecordMode = 1;
   if (GetLogical ("WAUXD_NO_BUFFER"))
      XBufferRecords = 0;
   else
      XBufferRecords = 1;

   ConfigVerify = (GetLogical ("WAUXD_VERIFY") != NULL);
   ConfigCertFile = GetLogical("WAUXD_CERT");
   ConfigMimeTypes = GetLogical("WAUXD_TYPES");
   IndexFileNames = GetLogical("WAUXD_INDEX");
   if (!IndexFileNames) IndexFileNames = DEFAULT_INDEX_FILENAMES;
   ConfigDcl = GetLogical("WAUXD_DCL");
   if (!(ConfigRoot = GetLogical("WAUXD_ROOT"))) exit (SS$_ABORT);
   if (!(ConfigCgi = GetLogical("WAUXD_CGI"))) exit (SS$_ABORT);

   BeginToProcess ();

   AndExit (SS$_NORMAL);
}

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