/*****************************************************************************/
/*
                                WebSock(et).c

WebSocket protocol based on the RFC published December 2011 below:

  https://tools.ietf.org/html/rfc6455
  https://datatracker.ietf.org/doc/rfc6455/
  https://www.rfc-editor.org/rfc/rfc6455.txt

The WebSocket protocol is an emerging techncology that enables two-way
communication between a user agent running untrusted code  running in a
controlled environment to a remote host that has opted-in to communications
from that code.

  http://websocket.org/

This module deals exclusively with WebSocket scripting.  Also see DCL.C.

For WASD a WebSocket script is one that is activated in the same fashion as an
equivalent CGI/CGIplus/RTE and has an identical CGI environment (variables,
streams, etc.) but which uses a unique HTTP response and communicates with its
client using the WebSocket protocol.

Firstly, the WebSocket connection is an asynchronous, bi-directional channel. 
WASD already implements this for its scripts.  The major difference is the use
of dedicated channels (mailboxes) for the WebSocket IPC.  Client supplied data
is available to the script via the WEBSOCKET_INPUT mailbox and data from the
script supplied via the WEBSOCKET_OUTPUT mailbox (indicated via CGI variables).
Communication using a WebSocket requires the use of a framing protocol while
WEBSOCKET_INPUT and WEBSOCKET_OUTPUT are opaque octet-streams pushing stream
processing onto the script (which best knows what it is trying to accomplish
anyway).  CGI variables WEBSOCKET_INPUT_MRS and WEBSOCKET_OUTPUT_MRS indicate
the respective mailbox capacity.

Secondly, the WASD server just acts as a conduit for the WebSocket client
octet-stream.  It is up to the server application (script) to perform all of
the protocol framing, etc.  In WASD's case this is largely available through
the wsLIB.c library.

Long-lived WebSocket scripts by default have timeouts and other limits set to
infinite.  If control is required it must be exercised using the appropriate
mapping SETings or DCL callouts.


MULTI-CLIENT SCRIPT PROCESSES
-----------------------------
A WebSocket connection to a script is maintained by the WEBSOCKET_INPUT and
WEBSOCKET_OUTPUT channels remaining connected to the script.  If the script
closes them (or the image or process exits, etc.) the WebSocket connection is
closed.  WebSocket requests are maintained as long as the script maintains
them, for a CGIplus script, until it exits.  If a CGIplus script requires to
disconnect from a WebSocket client without exiting it must do so explicitly (by
closing C streams, deassigning channels, etc.)

Of course this is an advantage because it allows a single CGIplus script to
maintain connections with multiple WebSocket clients.  Provided the script
remains connected to the WebSocket IPC mailboxes and processes that I/O
asynchronously (via ASTs or POSIX Threads for example) a single script can
concurrently handle multiple clients.  The script just processes each request
it is given, adding the new client to the existing group (and removing them as
the IPC indicates they disconnect).

Obviously the script must remain resident via CGIplus or RTE.

The server will continue to provide requests to the script for as long as it
appears idle (i.e. the sentinal EOF is returned even though concurrent
processing may continue).  Obviously a single scripting process cannot accept
an unlimited number of concurrent WebSockets.  When a script decides it can
process no more it should not return the sentinal EOF from the most recent
request until it is in a position to process more, when it then provides the
EOF and the server again will supply another request.

The original request is access logged at request run-down (when the WebSocket
is finally closed either because the client disconnected or the script closed
its connection to the WEBSOCKET_.. mailboxes).  The access log status is 101
(Switching Protocols) and the bytes rx and tx reflect the total for the
duration.


PROTOCOL VERSION SUPPORT
------------------------
Normally WASD supports the current base protocol number and any higher.  At
some time in the future it may be necessary to limit that down to a supported
version number or set of numbers.  Defining WASD_WEBSOCKET_VERSION to be one or
more comma-separated numbers will limit the supported protocol versions.  For
example

  $ DEFINE /SYSTEM WASD_WEBSOCKET_VERSION "10, 9, 8"

limits requests to protocol version 10 (current), 9 (earlier) and 8 (earliest). 
Logical name is only tested  once for each server startup (the first WebSocket
request received).  This logical name only controls server handshake support
and behaviour.  The underlying WebSocket libarary used by the application (e.g.
wsLIB.c) supports version idiosyncracies for other aspects.

This string is also used as the list of versions reported in a 426 (upgrade
required) response when the requested version is not supported.


WEBSOCKET THROTTLING
--------------------
Throttle mapping rules may be applied to WebSocket requests.  There is however,
a FUNDAMENTAL DIFFERENCE between request throttling and WebSocket throttling
though.  HTTP request throttling applies control to the entire life of the
response.  WebSocket throttling applies only to establishing connection to the
underlying script/application.  Once the script responds to accept the
connection (status 101) or reject it (error status) throttling is concluded.

Long-lived WebSocket connections are considered less suitable to full
life-cycle throttling and should use internal mechanisms to control resource
utilisation (i.e. using the delayed sentinal EOF mechanism described above). 
Essentially it is used to limit the impact concurrent requests have on the
number of supporting script processes allowed to be instantiated to support the
application.

For example, the rule

  set /cgi-bin/ws_application throttle=1

will only allow one new request at a time attempt to connect to and/or create a
WebSocket application script.  This will effectively limit the number of
supporting processes to one however many clients wish to connect.

To support concurrent requests distributed across multiple application scripts
specify the throttle value as the number of separate scripts

  set /cgi-bin/ws_application throttle=5

and if each script is to support a maximum number of individual connections
then have it delay the EOF sentinal (described above) to block the server
selecting it for the next request.  Requests will be allocated until all
processes have blocked after which they will be queued.

To return a "too busy" 503 to clients (almost) immediately upon all processes
become full and blocking (maximum application concurrency has been reached)
then set the 't/o-busy' value to 1 second. 

  set /cgi-bin/ws_application throttle=5,,,,,1


RAW [WEB]SOCKET
---------------
A WASD variant on the WebSocket theme is the "raw" socket.  This is NOT really
a WebSocket at all but does use the WASD WebSocket script processing
infrastructure to process otherwise network communication.  This activates a
script which operates in the CGI(plus) request environment.  The request detail
is available using CGI variables.  A "100 Continue" response header signals the
server the script is active but is NOT relayed to the client.  Once activated,
only the raw network octets from the client are provided to the script, and
only the raw octets from the script are transmitted to the client.  The script
application can effectively perform asynchronous, bidirectional input/output
with the client.  Intended for communication with non-HTTP (non-WebSocket)
networking clients (e.g. telnet, SSH, IMAP, POP "server" scripts, and the
like).

The [ServiceRawSocket] directive makes a service process RawSockets.

  # WASD_CONFIG_SERVICE
  [[http:*:1234]]
  [ServiceRawSocket]  enabled

The script to be activated must then be mapped to the service.
 
  # WASD_CONFIG_MAP
  [[*:1234]]
  map * /cgiplus-bin/rawsocket.com



VERSION HISTORY
---------------
01-DEC-2016  MGD  "raw" WebSocket
16-SEP-2012  MGD  bugfix; WebSockEnd() do not NetCloseSocket()
12-DEC-2011  MGD  bugfix; WebSockCloseMailboxes() logic
                  http://www.rfc-editor.org/rfc/rfc6455.txt finally!
30-SEP-2011  MGD  draft-ietf-hybi-thewebsocketprotocol-17
31-AUG-2011  MGD  draft-ietf-hybi-thewebsocketprotocol-13
23-AUG-2011  MGD  draft-ietf-hybi-thewebsocketprotocol-11
11-JUL-2011  MGD  draft-ietf-hybi-thewebsocketprotocol-10
13-JUN-2011  MGD  draft-ietf-hybi-thewebsocketprotocol-09
07-JUN-2011  MGD  draft-ietf-hybi-thewebsocketprotocol-07 (BANG!)
25-FEB-2011  MGD  draft-ietf-hybi-thewebsocketprotocol-06
05-FEB-2011  MGD  draft-ietf-hybi-thewebsocketprotocol-05
11-JAN-2011  MGD  draft-ietf-hybi-thewebsocketprotocol-04
17-OCT-2010  MGD  draft-ietf-hybi-thewebsocketprotocol-03
24-SEP-2010  MGD  draft-ietf-hybi-thewebsocketprotocol-02
26-AUG-2010  MGD  draft-ietf-hybi-thewebsocketprotocol-01
26-JUN-2010  MGD  initial
*/
/*****************************************************************************/

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

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

/* VMS related header files */
#include <descrip.h>
#include <iodef.h>
#include <lnmdef.h>
#include <rms.h>
#include <rmsdef.h>
#include <ssdef.h>
#include <stsdef.h>

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

#define WASD_MODULE "WEBSOCK"
#define FI_LI WASD_MODULE, __LINE__

#define CMB$M_READONLY 0x01
#define CMB$M_WRITEONLY 0x02

#define DVI$_DEVNAM 32
#define DVI$_UNIT 12

/* version(s) supported, current (most recent) first */
#define WEBSOCKET_VERSION "13, 8"

/* number of individual versions supported */
#define WEBSOCKET_VERSION_MAX 32

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

int  WebSockCurrent,
     WebSockOutputSize;

LIST_HEAD  WebSockList;

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

extern int  DclMailboxBytLmRequired,
            DclSysOutputSize,
            EfnNoWait,
            EfnWait,
            NetAcceptBytLmRequired,
            NetReadBufferSize;

extern char  ErrorSanityCheck[];

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

/*****************************************************************************/
/*
Ensure the WebSocket request makes sense and can be supported.
Return TRUE if it does, else end the request and return FALSE if it doesn't.
*/ 

BOOL WebSockRequest (REQUEST_STRUCT *rqptr)

{
   static int  VersionCount;
   static int  VersionArray [WEBSOCKET_VERSION_MAX];
   /* times four as two digits plus one comma plus one space */
   static char  SecWebSocketVersion [25+(WEBSOCKET_VERSION_MAX*4)+1],
                WebSocketVersion [WEBSOCKET_VERSION_MAX*4];

   int  idx, status;
   char  *cptr;
   DICT_ENTRY_STRUCT  *denptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_DCL, "WebSockRequest()");

   if (rqptr->RawSocketRequest) return (true);

   if (!WebSocketVersion[0])
   {
      /* initialise */
      if (cptr = SysTrnLnm (WASD_WEBSOCKET_VERSION))
         strzcpy (WebSocketVersion, cptr, sizeof(WebSocketVersion)-2);
      else
         strzcpy (WebSocketVersion, WEBSOCKET_VERSION, sizeof(WebSocketVersion)-2);
      VersionCount = 0;
      cptr = WebSocketVersion;
      while (*cptr && VersionCount < WEBSOCKET_VERSION_MAX)
      {
         VersionArray[VersionCount++] = atoi(cptr);
         while (isdigit(*cptr)) cptr++;
         while (*cptr && !isdigit(*cptr)) cptr++;
      }
      if (VersionCount >= WEBSOCKET_VERSION_MAX)
         ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
      FaoToBuffer (SecWebSocketVersion, sizeof(SecWebSocketVersion), NULL,
                   "Sec-WebSocket-Version: !AZ\r\n", WebSocketVersion);
   }

   if (denptr = DictLookup (rqptr->rqDictPtr, DICT_TYPE_REQUEST,
                            "sec-websocket-key", 17))
      rqptr->rqHeader.SecWebSocketKeyPtr = DICT_GET_VALUE(denptr);

   if (denptr = DictLookup (rqptr->rqDictPtr, DICT_TYPE_REQUEST,
                            "sec-websocket-protocol", 22))
      rqptr->rqHeader.SecWebSocketProtocolPtr = DICT_GET_VALUE(denptr);

   if (denptr = DictLookup (rqptr->rqDictPtr, DICT_TYPE_REQUEST,
                            "sec-websocket-version", 21))
      rqptr->rqHeader.WebSocketVersion = atoi(DICT_GET_VALUE(denptr));

   if (!rqptr->rqHeader.SecWebSocketKeyPtr)
   {
      ErrorNoticed (rqptr, SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
      return (SS$_BUGCHECK);
   }

   if (rqptr->rqHeader.Method != HTTP_METHOD_GET ||
       !rqptr->rqHeader.SecWebSocketKeyPtr)
   {
      InstanceGblSecIncrLong (&AccountingPtr->RequestErrorCount);
      rqptr->rqResponse.HttpStatus = 400;
      ErrorGeneral (rqptr, MsgFor(rqptr,MSG_REQUEST_FORMAT), FI_LI);
      RequestEnd (rqptr);
      return (false);
   }

   for (idx = 0; idx < VersionCount; idx++)
      if (VersionArray[idx] == rqptr->rqHeader.WebSocketVersion) break;

   if (idx >= VersionCount)
   {
      /* version not supported */
      InstanceGblSecIncrLong (&AccountingPtr->RequestErrorCount);
      ResponseHeader (rqptr, 426, NULL, 0, NULL, SecWebSocketVersion);
      RequestEnd (rqptr);
      return (false);
   }

   InstanceGblSecIncrLong (&AccountingPtr->DoWebSockCount);

   return (true);
}

/****************************************************************************/
/*
Generate a WebSocket 101 Switching Protocols response.
*/

int WebSockSwitchResponse (REQUEST_STRUCT *rqptr)

{
   static char  WebSockHand [] =
"HTTP/1.1 101 Switching Protocols\r\n\
Upgrade: websocket\r\n\
Connection: Upgrade\r\n\
Sec-WebSocket-Accept: ";

   static char  WebSockExts [] = "\r\nSec-WebSocket-Extensions: ",
                WebSockProt [] = "\r\nSec-WebSocket-Protocol: ";

   int  AcceptBase64Length;
   char  *cptr, *sptr, *zptr;
   char  AcceptBase64 [48],
         Buffer [1024],
         KeyGuid [96];
   unsigned char  KeyGuidHash [20];
   SHA1Context  Sha1Ctx;

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

   if (WATCHMOD (rqptr, WATCH_MOD_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE,
                 "WebSockSwitchResponse()");

   /* no update to status code counters as this is an intermediate response */
   rqptr->rqResponse.HttpStatus = 101;
   rqptr->rqResponse.HeaderSent = true;

   /* if it's a WebSocket then by default do-not-disturb */
   if (rqptr->DclTaskPtr)
      if (rqptr->DclTaskPtr->LifeTimeSecond != DCL_DO_NOT_DISTURB)
         rqptr->DclTaskPtr->LifeTimeSecond = DCL_WEBSOCKET_DND;
   HttpdTimerSet (rqptr, TIMER_OUTPUT, -1);
   HttpdTimerSet (rqptr, TIMER_NOPROGRESS, -1);

   if (rqptr->RawSocketRequest) return (SS$_NORMAL);

   zptr = (sptr = KeyGuid) + sizeof(KeyGuid)-1;
   for (cptr = rqptr->rqHeader.SecWebSocketKeyPtr;
        *cptr && sptr < zptr;
        *sptr++ = *cptr++);
   for (cptr = "258EAFA5-E914-47DA-95CA-C5AB0DC85B11";
        *cptr && sptr < zptr;
        *sptr++ = *cptr++);
   *sptr = '\0';

   SHA1Reset (&Sha1Ctx);
   SHA1Input (&Sha1Ctx, KeyGuid, sptr-KeyGuid);
   if (!SHA1Result (&Sha1Ctx))
      ErrorNoticed (rqptr, SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
   /* copy into the hash buffer (converting from big to little endian) */
   SHA1LitEnd (&Sha1Ctx, KeyGuidHash);

   AcceptBase64Length = sizeof(AcceptBase64)-1;
   base64_encode (AcceptBase64, &AcceptBase64Length,
                  KeyGuidHash, sizeof(KeyGuidHash));

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

   for (cptr = WebSockHand; *cptr && sptr < zptr; *sptr++ = *cptr++);
   for (cptr = AcceptBase64; *cptr && sptr < zptr; *sptr++ = *cptr++);

   if (rqptr->rqHeader.SecWebSocketProtocolPtr)
   {
      for (cptr = WebSockProt; *cptr && sptr < zptr; *sptr++ = *cptr++);
      for (cptr = rqptr->rqHeader.SecWebSocketProtocolPtr;
           *cptr && sptr < zptr;
           *sptr++ = *cptr++);
   }

   for (cptr = "\r\n\r\n"; *cptr && sptr < zptr; *sptr++ = *cptr++);

   if (WATCHING (rqptr, WATCH_RESPONSE_HEADER))
   {
      WatchThis (WATCHITM(rqptr), WATCH_RESPONSE_HEADER,
                 "HEADER !UL bytes", sptr-Buffer);
      WatchData (Buffer, sptr-Buffer);
   }

   /* synchronous network write (just for the convenience of it!) */
   NetWrite (rqptr, NULL, Buffer, sptr-Buffer);

   return (SS$_NORMAL);
}

/*****************************************************************************/
/*
These are emphemeral mailboxes and will be deleted as soon as there are no
channels assigned to them (with the loss of any data still buffered).
*/ 

WebSockCreateMailboxes (REQUEST_STRUCT *rqptr)

{
   static unsigned long  DevNamItem = DVI$_DEVNAM,
                         UnitItem = DVI$_UNIT;

   int  status;
   unsigned short  Length;
   unsigned long  BytLmAfter,
                  BytLmBefore,
                  LongUnit;
   struct RequestWebSocketStruct  *wsptr;
   struct dsc$descriptor_s  *dscptr;

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

   BytLmBefore = GetJpiBytLm ();

   if (WATCHMOD (rqptr, WATCH_MOD_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_DCL,
                 "WebSockCreateMailboxes() !UL !UL",
                 BytLmBefore, DclMailboxBytLmRequired);

   if (!WebSockOutputSize) WebSockOutputSize = DclSysOutputSize;

   /* ensure we're leaving enough BYTLM for client socket creation at least */
   if (DclMailboxBytLmRequired &&
       BytLmBefore - DclMailboxBytLmRequired <=
       NetAcceptBytLmRequired * Config.cfServer.ProcessMax)
   {
      ErrorNoticed (NULL, 0, "BYTLM exhausted", FI_LI);
      return (SS$_EXQUOTA);
   }

   wsptr = &rqptr->rqWebSocket;

   wsptr->RequestPtr = rqptr;

   ListAddHead (&WebSockList, wsptr, LIST_ENTRY_TYPE_WEBSOCKET);

   /***************************/
   /* WEBSOCKET_INPUT mailbox */
   /***************************/

   if (rqptr->rqPathSet.WebSocketInputSize)
      wsptr->InputSize = rqptr->rqPathSet.WebSocketInputSize;
   else
      wsptr->InputSize = NetReadBufferSize;
   if (wsptr->InputSize < WEBSOCKET_INPUT_MIN)
      wsptr->InputSize = WEBSOCKET_INPUT_MIN;

   if (VMSnok (status =
       sys$crembx (0,
                   &wsptr->InputChannel,
                   wsptr->InputSize, wsptr->InputSize,
                   DCL_PROCESS_MBX_PROT_MASK,
                   0, 0, CMB$M_WRITEONLY)))
      goto WebSockCreateMailboxesError;

   dscptr = &wsptr->InputDevNameDsc;
   dscptr->dsc$w_length = sizeof(wsptr->InputDevName);
   dscptr->dsc$a_pointer = wsptr->InputDevName;
   dscptr->dsc$b_class = DSC$K_CLASS_S;
   dscptr->dsc$b_dtype = DSC$K_DTYPE_T;

   if (VMSnok (status =
       lib$getdvi (&DevNamItem, &wsptr->InputChannel,
                   0, 0, &wsptr->InputDevNameDsc, &Length)))
      goto WebSockCreateMailboxesError;
   wsptr->InputDevName[dscptr->dsc$w_length = Length] = '\0';

   if (VMSnok (status =
       DclMailboxAcl (wsptr->InputDevName,
                      rqptr->DclTaskPtr->CrePrcUserName)))
      goto WebSockCreateMailboxesError;

   if (WATCHMOD (rqptr, WATCH_MOD_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_DCL,
                 "$CREMBX() WEBSOCKET_INPUT !AZ !UL",
                 wsptr->InputDevName, NetReadBufferSize);

   /****************************/
   /* WEBSOCKET_OUTPUT mailbox */
   /****************************/

   if (rqptr->rqPathSet.WebSocketOutputSize)
      wsptr->OutputSize = rqptr->rqPathSet.WebSocketOutputSize;
   else
      wsptr->OutputSize = WebSockOutputSize;
   if (wsptr->OutputSize < WEBSOCKET_OUTPUT_MIN)
      wsptr->OutputSize = WEBSOCKET_OUTPUT_MIN;

   wsptr->OutputPtr = VmGetHeap (rqptr, wsptr->OutputSize);

   if (VMSnok (status =
       sys$crembx (0,
                   &wsptr->OutputChannel,
                   wsptr->OutputSize, wsptr->OutputSize,
                   DCL_PROCESS_MBX_PROT_MASK,
                   0, 0, CMB$M_READONLY)))
      goto WebSockCreateMailboxesError;

   dscptr = &wsptr->OutputDevNameDsc;
   dscptr->dsc$w_length = sizeof(wsptr->OutputDevName);
   dscptr->dsc$a_pointer = wsptr->OutputDevName;
   dscptr->dsc$b_class = DSC$K_CLASS_S;
   dscptr->dsc$b_dtype = DSC$K_DTYPE_T;

   if (VMSnok (status =
       lib$getdvi (&DevNamItem, &wsptr->OutputChannel,
                   0, 0, &wsptr->OutputDevNameDsc, &Length)))
      goto WebSockCreateMailboxesError;
   wsptr->OutputDevName [dscptr->dsc$w_length = Length] = '\0';

   if (VMSnok (status =
       DclMailboxAcl (wsptr->OutputDevName,
                      rqptr->DclTaskPtr->CrePrcUserName)))
      goto WebSockCreateMailboxesError;

   if (WATCHMOD (rqptr, WATCH_MOD_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_DCL,
                 "$CREMBX() WEBSOCKET_OUTPUT !AZ !UL",
                 wsptr->OutputDevName, WebSockOutputSize);

   /******/
   /* OK */
   /******/

   if (WATCHING (rqptr, WATCH_DCL))
   {
      WatchThis (WATCHITM(rqptr), WATCH_DCL, "WEBSOCKET connected");
      WatchThis (WATCHITM(rqptr), WATCH_DCL, "MBX WEBSOCKET_INPUT !AZ size:!UL",
                 wsptr->InputDevName, wsptr->InputSize);
      WatchThis (WATCHITM(rqptr), WATCH_DCL, "MBX WEBSOCKET_OUTPUT !AZ size:!UL",
                 wsptr->OutputDevName, wsptr->OutputSize);
   }

   if (!DclMailboxBytLmRequired)
   {
      BytLmAfter = GetJpiBytLm ();
      DclMailboxBytLmRequired = BytLmBefore - BytLmAfter;
      if (WATCH_MODULE(WATCH_MOD_DCL))
         WatchThis (WATCHALL, WATCH_MOD_DCL, "BytLm: !UL",
                    DclMailboxBytLmRequired);
   }

   return (SS$_NORMAL);

   /*********/
   /* ERROR */
   /*********/

WebSockCreateMailboxesError:

   ErrorNoticed (rqptr, status, "$CREMBX()", FI_LI);

   if (wsptr->InputChannel) sys$dassgn (wsptr->InputChannel);
   if (wsptr->OutputChannel) sys$dassgn (wsptr->OutputChannel);
   wsptr->InputChannel = wsptr->OutputChannel = 0;

   return (status);
}

/*****************************************************************************/
/*
Discard any outstanding WebSocket I/O and deassign respective channels.  Wait
for all outstanding I/O.  Return true when all I/O complete and channels have
been deassigned, false until then.
*/ 

BOOL WebSockCloseMailboxes (REQUEST_STRUCT *rqptr)

{
   int  status;
   struct RequestWebSocketStruct  *wsptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_DCL,
"WebSockCloseMailboxes() netin:!UL mbxin:!UL:!UL mbxout:!UL:!UL netout:!UL",
                 rqptr->rqWebSocket.QueuedNetRead,
                 rqptr->rqWebSocket.InputChannel,
                 rqptr->rqWebSocket.QueuedInput,
                 rqptr->rqWebSocket.OutputChannel,
                 rqptr->rqWebSocket.QueuedOutput,
                 rqptr->rqWebSocket.QueuedNetWrite);

   wsptr = &rqptr->rqWebSocket;

   if (wsptr->QueuedInput)
   {
      /* cancel outstanding I/O but keep channel for EOF */
      sys$cancel (wsptr->InputChannel);
   }
   else
   if (wsptr->InputChannel)
   {
      /* give any scripting process a subsequent heads-up */
      status = sys$qio (EfnNoWait, wsptr->InputChannel,
                        IO$_WRITEOF | IO$M_NORSWAIT | IO$M_READERCHECK,
                        0, &WebSockDassgnInput, wsptr->InputChannel,
                        0, 0, 0, 0, 0, 0);
      /* if the AST is not going to be delivered deassign it here! */
      if (VMSnok (status)) sys$dassgn (wsptr->InputChannel);
      wsptr->InputChannel = 0;
   }

   if (wsptr->OutputChannel)
   {
      /* deassign will cancel outstanding I/O */
      sys$dassgn (wsptr->OutputChannel);
      wsptr->OutputChannel = 0;
   }

   if (wsptr->QueuedInput || wsptr->QueuedOutput) return (false);

   if (wsptr->InputChannel || wsptr->OutputChannel) return (false);

   return (true);
}

/*****************************************************************************/
/*
After EOF delivery (or otherwise) deassign the WEBSOCKET_INPUT mailbox channel.
*/ 

WebSockDassgnInput (unsigned short InputChannel)

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL,
                 "WebSockDassgnInput() !UL", InputChannel);

   sys$dassgn (InputChannel);
}

/*****************************************************************************/
/*
When the mailboxes have been closed and no network I/O then call RequestEnd().
*/ 

WebSockClose (REQUEST_STRUCT *rqptr)

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

   if (WATCHMOD (rqptr, WATCH_MOD_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_DCL, "WebSockClose()");

   NetCloseSocket (rqptr);

   if (WebSockCloseMailboxes (rqptr))
      if (!(rqptr->rqWebSocket.QueuedNetRead ||
            rqptr->rqWebSocket.QueuedNetWrite)) RequestEnd (rqptr);
}

/*****************************************************************************/
/*
Return true if a WebSocket request is ready for the finale, false otherwise.
*/ 

BOOL WebSockEnd (REQUEST_STRUCT *rqptr)

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

   if (WATCHMOD (rqptr, WATCH_MOD_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_DCL,
                 "WebSockEnd() dcl:!&B netread:!UL netwrite:!UL",
                 rqptr->DclTaskPtr && rqptr->DclTaskPtr->ScriptProcessPid,
                 rqptr->rqWebSocket.QueuedNetRead,
                 rqptr->rqWebSocket.QueuedNetWrite);

   if (!WebSockCloseMailboxes (rqptr)) return (false);

   if (rqptr->rqWebSocket.QueuedNetRead ||
       rqptr->rqWebSocket.QueuedNetWrite) return (false);

   if (rqptr->DclTaskPtr &&
       rqptr->DclTaskPtr->ScriptProcessPid) return (false);

   WebSockRemove (rqptr);

   if (WATCHING (rqptr, WATCH_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_DCL, "WEBSOCKET disconnected");

   return (true);
}

/*****************************************************************************/
/*
Remove the request from the WebSocket request list.
*/ 

WebSockRemove (REQUEST_STRUCT *rqptr)

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

   if (WATCHMOD (rqptr, WATCH_MOD_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_DCL, "WebSockRemove()");

   if (!rqptr->rqWebSocket.RequestPtr) return;

   if (rqptr == rqptr->rqWebSocket.RequestPtr)
      ListRemove (&WebSockList, &rqptr->rqWebSocket);
   else
   if (rqptr->rqWebSocket.RequestPtr)
      ErrorNoticed (rqptr, SS$_BUGCHECK, ErrorSanityCheck, FI_LI);

   rqptr->rqWebSocket.RequestPtr = NULL;
}

/*****************************************************************************/
/*
Specifically for running down the request from DCL EOF sentinal received.
*/ 

WebSockIfEnd (REQUEST_STRUCT *rqptr)

{
   struct RequestWebSocketStruct  *wsptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_DCL,
"WebSockIfEnd() read:!UL in:!UL out:!UL write:!UL",
                 rqptr->rqWebSocket.QueuedNetRead,
                 rqptr->rqWebSocket.InputChannel,
                 rqptr->rqWebSocket.OutputChannel,
                 rqptr->rqWebSocket.QueuedNetWrite);

   wsptr = &rqptr->rqWebSocket;

   if (wsptr->InputChannel) return;
   if (wsptr->OutputChannel) return;
   if (wsptr->QueuedNetRead) return;
   if (wsptr->QueuedNetWrite) return;

   RequestEnd (rqptr);
}

/*****************************************************************************/
/*
Queue up a read from the script process WEBSOCKET_OUTPUT mailbox.  When the
read completes call function WebSockOutputAst(), do any post-processing
required and write the data to the client over the network.
*/ 

WebSockOutput (REQUEST_STRUCT *rqptr)

{
   int  status;
   struct RequestWebSocketStruct  *wsptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_DCL,
                 "WebSockOutput() !8XL",
                 rqptr->rqWebSocket.ScriptProcessPid);

   wsptr = &rqptr->rqWebSocket;

   if (!wsptr->OutputChannel)
   {
      WebSockClose (rqptr);
      return;
   }

   wsptr->QueuedOutput++;

   status = sys$qio (EfnNoWait, wsptr->OutputChannel,
                     IO$_READLBLK, &wsptr->OutputIOsb,
                     &WebSockOutputAst, rqptr,
                     wsptr->OutputPtr,
                     wsptr->OutputSize,
                     0, 0, 0, 0);

   if (VMSok (status)) return;

   ErrorNoticed (NULL, status, "sys$qio", FI_LI);

   /* report error via the AST */
   wsptr->OutputIOsb.Status = status;
   SysDclAst (&WebSockOutputAst, rqptr);
}

/*****************************************************************************/
/*
A queued read from the script process WEBSOCKET_OUTPUT mailbox has completed.
*/ 

WebSockOutputAst (REQUEST_STRUCT *rqptr)

{
   int  cnt, status;
   char  *cptr;
   struct RequestWebSocketStruct  *wsptr;
   struct dsc$descriptor_s  *dscptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_DCL,
         "WebSockOutputAst() !&F !8XL", &WebSockOutputAst,
         rqptr->rqWebSocket.ScriptProcessPid);

   wsptr = &rqptr->rqWebSocket;

   if (WATCHING (rqptr, WATCH_DCL))
   {
      if (VMSnok (wsptr->OutputIOsb.Status))
         WatchThis (WATCHITM(rqptr), WATCH_DCL,
                    "READ WEBSOCKET_OUTPUT !&S",
                    wsptr->OutputIOsb.Status);
      else
      {
         WatchThis (WATCHITM(rqptr), WATCH_DCL,
                    "READ WEBSOCKET_OUTPUT !&S !UL byte!%s",
                    wsptr->OutputIOsb.Status,
                    wsptr->OutputIOsb.Count);
         if (wsptr->OutputIOsb.Count)
            WatchDataDump (wsptr->OutputPtr, wsptr->OutputIOsb.Count);
      }
   }

   if (wsptr->QueuedOutput) wsptr->QueuedOutput--;

   if (VMSnok (wsptr->OutputIOsb.Status))
   {
      WebSockClose (rqptr);
      return;
   }

   cptr = wsptr->OutputPtr;
   cnt = wsptr->OutputIOsb.Count;

   if (rqptr->rqCgi.EscLength)
   {
      if (cnt >= rqptr->rqCgi.EscLength &&
          cnt <= rqptr->rqCgi.EscLength+2 &&
          MATCH0 (cptr, rqptr->rqCgi.EscStr, rqptr->rqCgi.EscLength))
      {
         /***********************/
         /* escape from output! */
         /***********************/

         wsptr->CalloutInProgress = true;
         /* queue the next read from WEBSOCKET_OUTPUT */
         WebSockOutput (rqptr);
         return;
      }
   }

   if (wsptr->CalloutInProgress)
   {
      if (cnt >= rqptr->rqCgi.EotLength &&
          cnt <= rqptr->rqCgi.EotLength+2 &&
          MATCH0 (cptr, rqptr->rqCgi.EotStr, rqptr->rqCgi.EotLength))
      {
         /******************/
         /* end of escape! */
         /******************/

         wsptr->CalloutInProgress = false;
         /* queue the next read from WEBSOCKET_OUTPUT */
         WebSockOutput (rqptr);
         return;
      }

      /***********/
      /* callout */
      /***********/

      WebSockCallout (rqptr);
      /* queue the next read from WEBSOCKET_OUTPUT */
      WebSockOutput (rqptr);
      return;
   }

   wsptr->QueuedNetWrite++;

   NetWrite (rqptr, &WebSockOutputWriteAst, cptr, cnt);
}

/*****************************************************************************/
/*
A queued asynchronous write of script process WEBSOCKET_OUTPUT (mailbox) to
the client over the network has completed.
*/ 

WebSockOutputWriteAst (REQUEST_STRUCT *rqptr)

{
   int  status;
   struct RequestWebSocketStruct  *wsptr;

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

   wsptr = &rqptr->rqWebSocket;

   if (WATCHMOD (rqptr, WATCH_MOD_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_DCL,
                 "WebSockOutputWriteAst() !&F !8XL !&S",
                 &WebSockOutputWriteAst, rqptr->rqWebSocket.ScriptProcessPid,
                 rqptr->NetIoPtr->WriteStatus);

   if (wsptr->QueuedNetWrite) wsptr->QueuedNetWrite--;

   if (VMSnok (rqptr->NetIoPtr->WriteStatus))
   {
      WebSockClose (rqptr);
      return;
   }

   /* queue the next read of the script process' WEBSOCKET_OUTPUT */
   WebSockOutput (rqptr);
}

/*****************************************************************************/
/*
Get (more) data directly from the WebSocket client.
*/ 

WebSockInput (REQUEST_STRUCT *rqptr)

{
   unsigned int  DataCount;
   unsigned char  *DataPtr;
   struct RequestWebSocketStruct  *wsptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_DCL,
                 "WebSockInput() !8XL", rqptr->rqWebSocket.ScriptProcessPid);

   wsptr = &rqptr->rqWebSocket;

   if (!wsptr->InputChannel)
   {
      WebSockClose (rqptr);
      return;
   }

   wsptr->QueuedNetRead++;

   NetRead (rqptr, &WebSockInputAst,
            rqptr->rqNet.ReadBufferPtr,
            rqptr->rqNet.ReadBufferSize);
}

/*****************************************************************************/
/*
WebSocket client read has completed.
*/ 

WebSockInputAst (REQUEST_STRUCT *rqptr)

{
   int  status;
   unsigned int  DataCount;
   unsigned char  *DataPtr;
   struct RequestWebSocketStruct  *wsptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_DCL,
                 "WebSockInputAst() !&F !8XL !&S !UL", &WebSockInputAst,
                 rqptr->rqWebSocket.ScriptProcessPid,
                 rqptr->NetIoPtr->ReadStatus,
                 rqptr->NetIoPtr->ReadCount);

   wsptr = &rqptr->rqWebSocket;

   if (wsptr->QueuedNetRead) wsptr->QueuedNetRead--;

   if (VMSnok (rqptr->NetIoPtr->ReadStatus))
   {
      WebSockClose (rqptr);
      return;
   }

   DataCount = rqptr->NetIoPtr->ReadCount;
   DataPtr = rqptr->rqNet.ReadBufferPtr;

   if (WATCHING (rqptr, WATCH_DCL))
   {
      WatchThis (WATCHITM(rqptr), WATCH_DCL,
                 "WRITE WEBSOCKET_INPUT !UL byte!%s", DataCount);
      WatchDataDump (DataPtr, DataCount);
   }

   if (!rqptr->rqWebSocket.InputChannel)
   {
      WebSockClose (rqptr);
      return;
   }

   wsptr->QueuedInput++;

   status = sys$qio (EfnNoWait, rqptr->rqWebSocket.InputChannel,
                     IO$_WRITELBLK, &rqptr->rqWebSocket.InputIOsb,
                     &WebSockInputWriteAst, rqptr,
                     DataPtr, DataCount, 0, 0, 0, 0);
   if (VMSok (status)) return;

   ErrorNoticed (NULL, status, "sys$qio", FI_LI);

   /* report error via the AST */
   rqptr->rqWebSocket.InputIOsb.Status = status;
   SysDclAst (&WebSockInputWriteAst, rqptr);
}

/*****************************************************************************/
/*
A queued write to the script process WEBSOCKET_INPUT mailbox has completed.
*/ 

WebSockInputWriteAst (REQUEST_STRUCT *rqptr)

{
   int  status;
   struct RequestWebSocketStruct  *wsptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_DCL,
         "WebSockInputWriteAst() !&F !8XL", &WebSockInputWriteAst,
         rqptr->rqWebSocket.ScriptProcessPid);

   wsptr = &rqptr->rqWebSocket;

   if (WATCHING (rqptr, WATCH_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_DCL,
                 "WRITE WEBSOCKET_INPUT !&S",
                 rqptr->rqWebSocket.InputIOsb.Status);

   if (wsptr->QueuedInput) wsptr->QueuedInput--;

   /* abort if an error writing WebSocket stream to script process */
   if (VMSnok (rqptr->rqWebSocket.InputIOsb.Status))
   {
      WebSockClose (rqptr);
      return;
   }

   /* get more from the client */
   WebSockInput (rqptr);
}

/*****************************************************************************/
/*
(Currently) a basic callout allowing WATCHing of WebSocket scripts.
*/ 

WebSockCallout (REQUEST_STRUCT *rqptr)

{
   static char  RspBadParam [] = "400 Bad parameter",
                RspUnauthorized [] = "401 Unauthorized",
                RspForbidden [] = "403 Forbidden",
                RspSuccess [] = "200 Success",
                RspUnknown [] = "400 Unknown request";

   BOOL  ProvideResponse;
   int  status,
        OutputCount;
   char  *cptr,
         *OutputPtr;
   struct RequestWebSocketStruct  *wsptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_DCL, "WebSockCallout()");

   wsptr = &rqptr->rqWebSocket;

   OutputPtr = wsptr->OutputPtr;
   OutputCount = wsptr->OutputIOsb.Count;

   if (OutputPtr[0] == '!' || OutputPtr[0] == '#')
   {
      ProvideResponse = false;
      OutputPtr++;
      OutputCount--;
   }
   else
      ProvideResponse = true;

   if (to_upper(OutputPtr[0]) == 'N')
   {
      if (strsame (OutputPtr, "NOOP:", 5))
      {
         /*********/
         /* NOOP: */
         /*********/

         /* used for WATCHable debugging information, comments, etc. */
         if (ProvideResponse)
            WebSockCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1);
         return;
      }
   }

   if (to_upper(OutputPtr[0]) == 'W')
   {
      if (strsame (OutputPtr, "WATCH:", 6))
      {
         /**********/
         /* WATCH: */
         /**********/

         /* WATCHing script */
         if (WATCHING (rqptr, WATCH_SCRIPT))
         {
            for (cptr = OutputPtr+6; *cptr && isspace(*cptr); cptr++);
            WatchThis (WATCHITM(rqptr), WATCH_SCRIPT, "!#AZ",
                       OutputCount-(cptr-OutputPtr), cptr);
            if (ProvideResponse)
               WebSockCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1);
         }
         else
         if (ProvideResponse)
            WebSockCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1);
         return;
      }
   }

   if (ProvideResponse)
      WebSockCalloutQio (rqptr, RspUnknown, sizeof(RspUnknown)-1);
}

/*****************************************************************************/
/*
Obviously, for this not to be confused with client input, it be identifiable
from the client data stream.  Callout responses (where required) are
encapsulated by a leading ESC sentinal (record) and a trailing EOT sentinal
(record), both the same sequences as used to make the callout.  The intervening
record contains the response.  Each callout response requires three $QIOs; the
actual response is sandwiched between ESC and EOT records.
*/ 

WebSockCalloutQio
(
REQUEST_STRUCT *rqptr,
char *DataPtr,
int DataCount
)
{
   int  status;

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

   if (WATCHMOD (rqptr, WATCH_MOD_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_DCL,
                 "WebSockCalloutQio() !UL !&Z",
                 rqptr->rqWebSocket.QueuedInput, DataPtr);

   if (!rqptr->rqWebSocket.InputChannel) return;

   if (rqptr->rqWebSocket.QueuedInput > 32)
   {
      /* getting a bit suspicious - let's not compound things */
      return;
   }

   status = sys$qio (EfnNoWait, rqptr->rqWebSocket.InputChannel,
                     IO$_WRITELBLK, 0,
                     WebSockCalloutQioAst, rqptr,
                     rqptr->rqCgi.EscStr, rqptr->rqCgi.EscLength, 0, 0, 0, 0);
   if (VMSok (status))
   {
      rqptr->rqWebSocket.QueuedInput++;

      status = sys$qio (EfnNoWait, rqptr->rqWebSocket.InputChannel,
                        IO$_WRITELBLK, 0,
                        WebSockCalloutQioAst, rqptr,
                        DataPtr, DataCount, 0, 0, 0, 0);
      if (VMSok (status))
      {
         rqptr->rqWebSocket.QueuedInput++;

         status = sys$qio (EfnNoWait, rqptr->rqWebSocket.InputChannel,
                           /* IO status block reports on the final $QIO */
                           IO$_WRITELBLK, &rqptr->rqWebSocket.CalloutIOsb,
                           WebSockCalloutQioAst, rqptr,
                           rqptr->rqCgi.EotStr, rqptr->rqCgi.EotLength, 
                           0, 0, 0, 0);
         if (VMSok (status)) rqptr->rqWebSocket.QueuedInput++;
      }
   }

   if (VMSnok (status) && status != SS$_IVCHAN)
   {
      ErrorNoticed (NULL, status, "sys$qio", FI_LI);
      WebSockClose (rqptr);
   }
}

/*****************************************************************************/
/*
WebSocket callout response write (to input) has completed (three per callout).
*/ 

WebSockCalloutQioAst (REQUEST_STRUCT *rqptr)

{
   int  status;
   struct RequestWebSocketStruct  *wsptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_DCL))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_DCL,
"WebSockCalloutQioAst() !&F !8XL !&S !UL", &WebSockCalloutQioAst,
                 rqptr->rqWebSocket.ScriptProcessPid,
                 rqptr->rqWebSocket.CalloutIOsb.Status,
                 rqptr->rqWebSocket.CalloutIOsb.Count);

   wsptr = &rqptr->rqWebSocket;

   if (wsptr->QueuedInput) wsptr->QueuedInput--;

   if (status = rqptr->rqWebSocket.CalloutIOsb.Status)
   {
      /* IO status block reports on the final of three $QIO */
      if (VMSnok (status))
      {
         /* error */
         ErrorNoticed (NULL, status, "sys$qio", FI_LI);
         WebSockClose (rqptr);
      }
   }
}

/*****************************************************************************/
/*
Return the number of WebSocket requests connected to the scripting process PID.
*/ 

int WebSockCount (unsigned long ScriptProcessPid)

{
   int  Count = 0;
   REQUEST_STRUCT  *rqeptr;
   LIST_ENTRY  *leptr;

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL,
         "WebSockCount() !8XL", ScriptProcessPid);

   if (!ScriptProcessPid) return (0);
   for (leptr = WebSockList.HeadPtr; leptr; leptr = leptr->NextPtr)
   {
      rqeptr = ((struct RequestWebSocketStruct*)leptr)->RequestPtr;
      if (rqeptr->rqWebSocket.ScriptProcessPid != ScriptProcessPid) continue;
      Count++;
   }
   return (Count);
}

/*****************************************************************************/
/*
Disconnect WebSockets from their clients.  Return count of disconnections.
*/ 

int WebSockControl
(
int ConnectNumber,
char *ScriptName,
char *UserName
)
{
   int  Count = 0;
   REQUEST_STRUCT  *rqeptr;
   LIST_ENTRY  *leptr, *dleptr;
   DCL_TASK  *tkptr;

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL,
                 "WebSockControl() !UL !&Z !&Z",
                 ConnectNumber, ScriptName, UserName);

   for (leptr = WebSockList.HeadPtr; leptr; leptr = leptr->NextPtr)
   {
      rqeptr = ((struct RequestWebSocketStruct*)leptr)->RequestPtr;
      if (!rqeptr->WebSocketRequest) continue;

      /* if we're looking for a particular request and this is not it */
      if (ConnectNumber && rqeptr->ConnectNumber != ConnectNumber)
         continue;

      /* only matching scripts */
      if (ScriptName && ScriptName[0])
      {
         if (!rqeptr->rqWebSocket.ScriptProcessPid) continue;
         if (!StringMatch (NULL, rqeptr->ScriptName, ScriptName)) continue;
      }

      /* only WebSocket scripts running as a specific VMS user */
      if (UserName && UserName[0])
      {
         if (!rqeptr->rqWebSocket.ScriptProcessPid) continue;
         for (dleptr = DclTaskList.HeadPtr; dleptr; dleptr = dleptr->NextPtr)
         {
            tkptr = (DCL_TASK*)dleptr;
            if (tkptr->ScriptProcessPid !=
                rqeptr->rqWebSocket.ScriptProcessPid) continue;
            if (StringMatch (NULL, tkptr->CrePrcUserName, UserName)) break;
         }
         if (!dleptr) continue;
      }

      /* make the closure asynchronous to this list traversal */
      SysDclAst (WebSockClose, rqeptr);
      Count++;
   }

   return (Count);
}

/*****************************************************************************/
/*
Return a report on current WebSocket requests.
This function blocks while executing.
*/ 

WebSockReport (REQUEST_STRUCT *rqptr)

{
   /* the final column just adds a little white-space on the page far right */
   static char  BeginPageFao [] =
"<p><table class=\"rghtrght\">\n\
<tr><th></th>\
<th class=\"sbttl talft\"><u>Service&nbsp;/&nbsp;Client</th>\
<th class=\"sbttl talft\"><u>Time&nbsp;/&nbsp;Request</th>\
<th class=\"sbttl\">Rx</th>\
<th class=\"sbttl\">Tx</th>\
<th class=\"sbttl\">Bytes/Sec</th>\
<th class=\"sbttl\">Duration</th>\
<th class=\"sbttl\">Script&nbsp;PID</th>\
<th class=\"sbttl\">WATCH</th>\
<th class=\"sbttl\">Connect</u></th>\
</tr>\n";

   static char  WebSocketFao [] =
"<tr>\
<th>!3ZL</th>\
<td class=\"talft\">!AZ//!AZ</td>\
<td class=\"talft\">!20%D</td>\
<td>!&,@UQ</td>\
<td>!&,@UQ</td>\
<td>!&L</td>\
<td>!AZ</td>\
<td>!8XL</td>\
<td>!&@</td>\
<td>!UL</td>\
</tr>\n\
<tr class=\"hlght\"><th></th>\
<td class=\"talft\">!&@</td>\
<td class=\"talft maxvis\" colspan=\"8\"><tt>!AZ&nbsp;!AZ</tt></td>\
</tr>\n";

   static char  NoneFao [] =
"<tr class=\"hlght\">\
<th><b>000</b></th>\
<td class=\"talft\" colspan=\"9\"><i>none</i></td>\
</tr>\n";

   static char  EndPageFao [] =
"</table>\n\
<p><table class=\"lftlft\">\n\
<tr><td>\n\
<form method=\"GET\" action=\"!AZ\">\n\
<input type=\"submit\" value=\" Force Disconnect \">\n\
</form>\n\
</td></tr>\n\
</table>\n\
!AZ\
</div>\n\
</body>\n\
</html>\n";

   int  status,
        DisplayCount,
        ReportType;
   unsigned long  *vecptr;
   unsigned long  FaoVector [32];
   int64  Time64,
          Duration64,
          ResultTime64;
   char  *cptr;
   REQUEST_STRUCT  *rqeptr;
   LIST_ENTRY  *leptr;

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

   if (WATCH_MODULE(WATCH_MOD_REQUEST))
      WatchThis (WATCHALL, WATCH_MOD_REQUEST, "WebSockReport()");

   AdminPageTitle (rqptr, "WebSocket Report");

   status = FaolToNet (rqptr, BeginPageFao, NULL);
   if (VMSnok (status)) ErrorNoticed (rqptr, status, "FaolToNet()", FI_LI);

   DisplayCount = 0;

   sys$gettim (&Time64);

   /* process web socket list from least to most recent */
   for (leptr = WebSockList.HeadPtr; leptr; leptr = leptr->NextPtr)
   {
      rqeptr = ((struct RequestWebSocketStruct*)leptr)->RequestPtr;

      vecptr = FaoVector;

      *vecptr++ = ++DisplayCount;
      *vecptr++ = rqeptr->ServicePtr->RequestSchemeNamePtr;
      *vecptr++ = rqeptr->ServicePtr->ServerHostPort;
      *vecptr++ = &rqeptr->rqTime.BeginTime64;

      *vecptr++ = &rqeptr->NetIoPtr->BytesRawRx64;
      *vecptr++ = &rqeptr->NetIoPtr->BytesRawTx64;

      Duration64 = rqeptr->rqTime.BeginTime64 - Time64;
      *vecptr++ = BytesPerSecond (&rqeptr->NetIoPtr->BytesRawRx64,
                                  &rqeptr->NetIoPtr->BytesRawTx64,
                                  &Duration64);

      *vecptr++ = DurationString (rqptr, &Duration64);
      *vecptr++ = rqeptr->rqWebSocket.ScriptProcessPid;

      *vecptr++ =
"<nobr>[<a href=\"!AZ?at=!UL\">P</a>]\
[<a href=\"!AZ?at=!UL&this=!UL\">+</a>]\
[<a href=\"!AZ?this=!UL\">W</a>]</nobr>";
      *vecptr++ = ADMIN_REPORT_WATCH;
      *vecptr++ = rqeptr->ConnectNumber;
      *vecptr++ = ADMIN_REPORT_WATCH;
      *vecptr++ = rqeptr->ConnectNumber;
      *vecptr++ = rqeptr->ConnectNumber;
      *vecptr++ = ADMIN_REPORT_WATCH;
      *vecptr++ = rqeptr->ConnectNumber;
      *vecptr++ = rqeptr->ConnectNumber;

      *vecptr++ = UserAtClient(rqeptr);

      *vecptr++ = rqeptr->rqHeader.MethodName;
      *vecptr++ = rqeptr->rqHeader.RequestUriPtr;

      status = FaolToNet (rqptr, WebSocketFao, &FaoVector);
      if (VMSnok (status)) ErrorNoticed (rqptr, status, "FaolToNet()", FI_LI);
   }

   if (!DisplayCount)
   {
      status = FaolToNet (rqptr, NoneFao, NULL);
      if (VMSnok (status)) ErrorNoticed (rqptr, status, "FaolToNet()", FI_LI);
   }

   vecptr = FaoVector;
   *vecptr++ = ADMIN_CONTROL_WEBSOCKET_DISCONNECT;
   *vecptr++ = AdminRefresh (rqptr);

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

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

   AdminEnd (rqptr);
}

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

