/*****************************************************************************/
/*
                                Response.c

HTTP response generation related functions.
Includes NCS character set conversion.


NCS CHARACTER SET CONVERSION
----------------------------
The [CharsetConvert] configuration directive provides the information required
to convert one character set to another based on the "Accept-Charset:" of the
request and the character set associated with the response.  The basic format
of the directive is

  doc-charset accept-charset[,accept-charset..] [NCS-conv-function[=factor]]

At least one 'doc-charset' and one 'accept-charset' must be present.  If only
these two are present (i.e. no 'NCS-conversion-function') it indicates that
the two character sets are aliases (i.e. the same set of characters, different
name) and no conversion is necessary.

If an 'NCS-conversion-function' is supplied it indicates that the document
'doc-charset' can be converted to the request 'Accept-Charset:' preference of
the 'accept-charset' using the NCS conversion function name specified.

A 'factor' parameter can be appended to the conversion function.  Some
conversion functions requires more than one output byte to represent one input
byte for some characters.  The 'factor' is an integer between 1 and 4
indicating how much more buffer space may be required for the converted string. 
It works by allocating that many times more output buffer space than is
occupied by the input buffer.  If not specified it defaults to 1, or an output
buffer the same size as the input buffer.

Multiple comma-separated 'accept-charset's may be included as the second
component for either of the above behaviours, with each being matched
individually. Wildcard '*' and '%' may be used in the 'doc-charset and
'accept-charset' strings.

1) If the document character set matches any client accepted character set
*exactly* no conversion or change of charset is required.

  [CharsetConvert]
  windows-1251 windows-1251,cp-1251
  windows-1251 koi8-r koi8r_to_windows1251_to_koi8r
  
  "Accept-Charset: iso-8859-1, cp-1251, *"

  (document charset: windows-251)
  "Content-Type: text/plain; charset: cp-1251"  (with no conversion)

2) If any document-accepted pair of the directive matches the document and
accepted combination of the request and an NCS conversion function has been
specified then it is set to be converted to that.  The response charset is
changed to that specified by the 'accept-charset' of the directive.  Note the
third conversion function shows a conversion factor of 4, so the output buffer
will be allocated at four times the size of the input buffer.

  [CharsetConvert]
  koi8-r koi8-r,koi8
  koi8-r windows-1251,cp-1251 koi8r_to_windows1251
  koi8-r utf8 koi8-r_to_utf8=4
  
  "Accept-Charset: iso-8859-1, cp-1251, *"

  (document charset: koi8-r)
  "Content-Type: text/plain; charset: cp-1251"   (with conversion)

3) If no document-accepted pairs of the directive match the document and
accepted combination of the request and the 'accept-charset' list of the
request included a full wildcard (e.g. ", *") then no conversion is required
and the document charset is retained for the response.

  [CharsetConvert]
  koi8-r koi8-r,koi8
  koi8-r windows-1251,cp-1251 koi8r_to_windows1251
  
  "Accept-Charset: iso-8859-1, mac-cyr, *"

  (document charset: koi8-r)
  "Content-Type: text/plain; charset: koi8-r"   (with no conversion)

4) If no document-accepted pairs of the directive match the document and
accepted combination of the request and the 'accept-charset' list of the
request contains no wildcard then 406 (not acceptable) error is returned.

  [CharsetConvert]
  koi8-r koi8-r,koi8
  koi8-r windows-1251,cp-1251 koi8r_to_windows1251
  
  "Accept-Charset: iso-8859-1, mac-cyr"

  (document charset: koi8-r)
  "HTTP/1.0 406 Not Acceptable"


Testing the NCS Convert
~~~~~~~~~~~~~~~~~~~~~~~
An $NCS/LIST provides a listing of the available character set conversion
modules.  The following setup should convert all documents accessed with a path
beginning /tolower/ to lower case (e.g. http://the.host.name/tolower/ht_root/)
and similarly for upper case.

  # WASD_CONFIG_GLOBAL
  [CharsetConvert]
  iso-8859-1_lower iso-8859-1 Multi_to_Lower
  iso-8859-1_upper iso-8859-1 Multi_to_Upper

  # WASD_CONFIG_MAP
  set /tolower/* charset=iso-8859-1_lower
  map /tolower/* /*
  set /toupper/* charset=iso-8859-1_upper
  map /toupper/* /*



VERSION HISTORY
---------------

VERSION HISTORY
---------------
28-OCT-2024  MGD  ResponseStream() tweak for C21 (64 bit data)
12-SEP-2022  MGD  ResponseHeader() default "content-security-policy:"
12-NOV-2020  MGD  ResponseHeader() content length now 64 bit
                  ResponseEntityMatch() allow for unquoted entity
12-FEB-2020  MGD  ResponseHeader() provide for "content-security-policy:"
10-OCT-2019  MGD  ResponseHiss() and ResponseStream() use task structure
30-JAN-2019  MGD  SET response=200=203 for request tracking and log analysis
                  ResponseHiss() response status changed from 403 to 203
29-NOV-2017  MGD  ResponseHeader() no chunk header if 204 status
03-DEC-2016  MGD  ResponseHeader() ensure non-printables cannot be injected 
11-AUG-2016  MGD  ResponseHeader() ->rqCgi.ScriptControlHttpStatus will allow
                    an error reporting script to override the original status
18-FEB-2016  MGD  bugfix; ResponseHeader() for HEAD request transfer-encoding
                    chunked suppress actual chunked body (RFC 7230 3.3)
30-DEC-2015  MGD  rework around HTTP/2 integration
22-FEB-2015  MGD  ResponseHeader() Strict-Transport-Security: header
19-JAN-2014  MGD  ResponseStream() and request /stream/
02-JAN-2014  MGD  ResponseCorsProcess() implement CORS processing
                  ResponseHeaderAppend() allow "pre-response" appending
17-JUN-2010  MGD  ResponseWebSocketHeader() draft-ietf-hybi-..-76
10-FEB-2010  MGD  according to http://www.ietf.org/rfc/rfc2145.txt a server
                    should respond with the minor HTTP version reflecting its
                    own compliance rather than the client's provided the
                    response itself is compliant with the client minor version
                    (i.e. HTTP/1.0 requests should get HTTP/1.1 in the response
                    status line - and now implemented by ResponseHeader()) 
24-JAN-2010  MGD  ResponseWebSocketHeader()
08-AUG-2006  MGD  bugfix; ResponseHeader() accomodate 304 (not modified)
24-NOV-2005  MGD  support for the OPAQUE realm
06-OCT-2005  MGD  bugfix; ResponseHeader() ensure a charset= supplied with
                  a text content-type (e.g. from a CGI script) is used
14-JUL-2005  MGD  ResponseOptions() discriminate server and resource
                  requests and respond appropriately using "Allow:"
20-JAN-2005  MGD  ResponseHeader() include 'rqResponse.LocationPtr'
16-DEC-2004  MGD  ResponseHeader() where content-length is unknown
                  attempt to enable chunked transfer-encoding
06-SEP-2004  MGD  allow ResponseHiss() to specify kBytes
20-JUL-2004  MGD  HTTP/1.1 compliance,
                  modification to ResponseHeader() processing,
                  if any NCS conversion factor is one-to-many then any
                  document content-length becomes invalid and is suppressed
21-AUG-2003  MGD  "Accept-Ranges:" response field
12-JUL-2003  MGD  ensure content type and length set in response header data
03-JUL-2002  MGD  move RequestEcho() and RequestWhere() as ResponseEcho()
                  and ResponseWhere(), add ResponseHiss()
30-APR-2002  MGD  "Cache-Control:" field for Mozilla compatibility
23-APR-2002  MGD  bugfix; ResponseCharsetConvert() must be FreeFromHeap()!!
10-NOV-2001  MGD  initial (some functions moved from SUPPORT.C)
*/
/*****************************************************************************/

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

/* VMS related header files */
#include <ncs$routines.h>
#include <ssdef.h>
#include <stsdef.h>

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

#define WASD_MODULE "RESPONSE"

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

int  ResponseCharsetCount;

char  ResponseAllowServer [] =
"Allow: CONNECT, DELETE, GET, HEAD, OPTIONS, POST, PUT, TRACE\r\n";

char  ResponseAllowResource [] =
"Allow: DELETE, GET, HEAD, POST, PUT\r\n";

/* "MS-Author-Via: DAV" see explanation in DAVWEB.C */

char  ResponseAllowWebDavServer [] =
"Allow: CONNECT, COPY, DELETE, GET, HEAD, MKCOL, MOVE, \
OPTIONS, POST, PROPFIND, PROPPATCH, PUT, TRACE\r\n\
MS-Author-Via: DAV\r\n\
DAV: 1\r\n";

char  ResponseAllowWebDavLockServer [] =
"Allow: CONNECT, COPY, DELETE, GET, HEAD, LOCK, MKCOL, MOVE, \
OPTIONS, POST, PROPFIND, PROPPATCH, PUT, TRACE, UNLOCK\r\n\
MS-Author-Via: DAV\r\n\
DAV: 1,2\r\n";

char  ResponseAllowWebDavResource [] =
"Allow: COPY, DELETE, GET, HEAD, MKCOL, MOVE, POST, PROPFIND, \
PROPPATCH, PUT\r\n\
MS-Author-Via: DAV\r\n\
DAV: 1\r\n";

char  ResponseAllowWebDavLockResource [] =
"Allow: COPY, DELETE, GET, HEAD, LOCK, MKCOL, MOVE, POST, PROPFIND, \
PROPPATCH, PUT, UNLOCK\r\n\
MS-Author-Via: DAV\r\n\
DAV: 1,2\r\n";

LIST_HEAD  ResponseCharsetList;

char  ResponseHeader500 [] =
"HTTP/1.0 500 Internal error\r\n\
Content-Type: text/plain\r\n\
\r\n\
A server error occured when generating the response!\n\
Please report to the site administrator.\n\
\n\0";

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

extern BOOL  AuthPromiscuous,
             GzipAccept,
             GzipResponse,
             WebDavEnabled,
             WebDavLockingEnabled;

extern int64  HttpdTime64;

extern int  NetReadBufferSize,
            OutputBufferSize;

extern unsigned long  SysPrvMask[];

extern char  *FaoUrlEncodeTable[];

extern char  ErrorSanityCheck[];

extern char  SoftwareID[];

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

/*****************************************************************************/
/*
Generate the HTTP response header field dictionary entries from where an
HTTP/1.n header or HTTP/2 headers response will be derived.

If no response status code is supplied as a parameter it defaults to whatever
'rqptr->rqResponse.HttpStatus' is set.  If this is not set both default to 200.
UNLESS this header is for a redirected error report in which case both are set
to the status code of the original request and generate any required
authorization challenges against the original realm if a 401 status!

If a content-type has been supplied with the call (and it always should be!)
generate a "content-type:" header line, with "charset" component if set for the
server or request.  A path-set content-type overrides the parameter.

If a modified time is supplied generate a "last-modified:" header line.

If the request is marked as pre-expired then generate an "expires:" header line
containing a distant (but meaningful) past GMT time.

|OtherHeaderPtr| is a catch-all parameter.  The fields in this string are
parsed from it and so should use the HTTP/1.n format.

This function will always generate a header (only failing if it cannot allocate
memory, in which case the server exits).  If an error is detected when doing so
a bogus 500 header is created with an embedded indication of where the problem
occured.  The request will continue but generally when delivered the error
indication will be obvious.
*/

ResponseHeader
(
REQUEST_STRUCT *rqptr,
int HttpStatusCode,
char *ContentTypePtr,
int64 ContentLength64,
unsigned long *ModifiedTime64Ptr,
char *OtherHeaderPtr
)
{
   static char  CookieString [32],
                NumberString [32];
   static $DESCRIPTOR (NumberDsc, NumberString);
   static $DESCRIPTOR (NumberFaoDsc, "!UL\0");
   static $DESCRIPTOR (Number64FaoDsc, "!@UQ\0");

   int  idx, status, length;
   char  *cptr, *sptr, *zptr;
   char  *AuthRealmBufferPtr,
         *CharsetPtr,
         *LocationPtr,
         *SuppliedCharsetPtr;
   char  BufferString [512],
         ModifiedString [32];
   DICT_ENTRY_STRUCT  *denptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE,
                 "ResponseHeader() !UL !&Z !@UQ !%D !&Z",
                 HttpStatusCode, ContentTypePtr, &ContentLength64,
                 ModifiedTime64Ptr ? ModifiedTime64Ptr : 0,
                 OtherHeaderPtr);

   rqptr->rqResponse.HeaderGenerated = true;

   if (rqptr->RedirectedXray)
   {
      rqptr->rqResponse.NoGzip = true;
      rqptr->PersistentResponse = false;
   }

   if (rqptr->rqCgi.ScriptControlHttpStatus)
      HttpStatusCode = rqptr->rqCgi.ScriptControlHttpStatus;

   if (!HttpStatusCode) HttpStatusCode = rqptr->rqResponse.HttpStatus;
   if (!HttpStatusCode) HttpStatusCode = 200;

   if (rqptr->rqPathSet.Response200is203 == 203)
      if (HttpStatusCode == 200)
         HttpStatusCode = 203;

   rqptr->rqResponse.HttpStatus = HttpStatusCode;

   if (rqptr->RedirectErrorStatusCode &&
       !rqptr->rqCgi.ScriptControlHttpStatus)
   {
      /********************************************/
      /* special case ... redirected error report */
      /********************************************/

      rqptr->rqResponse.HttpStatus = rqptr->RedirectErrorStatusCode;

      /* if authorization error then generate authentication challenge(s) */
      if (rqptr->rqResponse.HttpStatus == 401)
      {
         /* of course, use the realm of the original request! */
         sptr = rqptr->rqAuth.RealmDescrPtr;
         rqptr->rqAuth.RealmDescrPtr = rqptr->RedirectErrorAuthRealmDescrPtr;
         ResponseHeaderChallenge (rqptr);
         rqptr->rqAuth.RealmDescrPtr = sptr;
      }
   }
   else
   if (rqptr->rqResponse.HttpStatus == 401 ||
       rqptr->rqResponse.HttpStatus == 407)
      ResponseHeaderChallenge (rqptr);

   /* if the path has a content-type SET against it then that overrides */
   if (rqptr->rqPathSet.ContentTypePtr)
      ContentTypePtr = rqptr->rqPathSet.ContentTypePtr;

   if (LocationPtr = rqptr->rqResponse.LocationPtr)
      rqptr->rqResponse.LocationPtr = NULL;

   if (rqptr->rqResponse.HttpStatus == 304)
   {
      /* not-modified can have no content-type or response body */
      ContentTypePtr = NULL;
      /* make the content-length zero so there's no temptation to chunk */
      ContentLength64 = 0;
   }

   if (ContentTypePtr && (MATCH5(ContentTypePtr,"text/") ||
                          MATCH5(ContentTypePtr,"TEXT/")))
   {
      /*********************/
      /* text of some sort */
      /*********************/

      SuppliedCharsetPtr = NULL;
      zptr = (sptr = BufferString) + sizeof(BufferString)-1;
      /* as we copy note where any "; charset=" begins */
      for (cptr = ContentTypePtr; *cptr && sptr < zptr; *sptr++ = *cptr++)
         if (*cptr == ';') SuppliedCharsetPtr = sptr;
      if (SuppliedCharsetPtr)
      {
         cptr = SuppliedCharsetPtr;
         if (*cptr) cptr++;
         while (ISLWS(*cptr)) cptr++;
         if (!strsame (cptr, "charset=", 8)) SuppliedCharsetPtr = NULL;
      }

      /* if the response character set has been specifically set */
      if (!(CharsetPtr = rqptr->rqResponse.MsgCharsetPtr))
         /* if the path has a charset SET against it then that overrides */
         if (CharsetPtr = rqptr->rqPathSet.CharsetPtr)
            if (*CharsetPtr == '(') CharsetPtr = NULL;
      /* otherwise, if the server has a default charset then use that */
      if (!SuppliedCharsetPtr &&
          !CharsetPtr && Config.cfContent.CharsetDefault[0])
         CharsetPtr = Config.cfContent.CharsetDefault;
      /* if response specifies a character set and we're converting them */
      if (CharsetPtr && CharsetPtr[0] && ResponseCharsetCount)
         CharsetPtr = ResponseCharsetConvertBegin (rqptr, CharsetPtr);

      if (CharsetPtr && CharsetPtr[0])
      {
         if (SuppliedCharsetPtr) sptr = SuppliedCharsetPtr;
         for (cptr = "; charset="; *cptr && sptr < zptr; *sptr++ = *cptr++);
         for (cptr = CharsetPtr; *cptr && sptr < zptr; *sptr++ = *cptr++);
      }

      /* if it overflows (!) just chop it off */
      *sptr = '\0';
      ContentTypePtr = BufferString;
   }

   /***************************/
   /* generate header entries */
   /***************************/

   /* note this is an "internal" entry */
   sys$fao (&NumberFaoDsc, 0, &NumberDsc, rqptr->rqResponse.HttpStatus);
   DictInsert (rqptr->rqDictPtr, DICT_TYPE_INTERNAL,
               "response_status", 15, NumberString, -1);

   /* note this is an "internal" entry */
   DictInsert (rqptr->rqDictPtr, DICT_TYPE_INTERNAL,
               "response_reason", 15,
               HttpStatusCodeText(rqptr->rqResponse.HttpStatus), -1);

   DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
               "server", 6, SoftwareID, -1);

   DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
               "date", 4, rqptr->rqTime.GmDateTime, -1);

   DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
               "accept-ranges", 13, "bytes", 5);

   if (GzipAccept)
      DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                  "accept-encoding", 15, "gzip, deflate", 13);

   if (rqptr->ServicePtr->SSLserverPtr)
   {
      char  *aptr;
      SESOLA_CONTEXT  *scptr;
      if (!(aptr = rqptr->rqPathSet.ResponseStrictTransSecPtr))
      {
         scptr = (SESOLA_CONTEXT*)rqptr->ServicePtr->SSLserverPtr;
         aptr = scptr->StrictTransSecPtr;
      }
      /* must begin with a digit (integer seconds) or suppresses */
      if (aptr && isdigit(*aptr))
      {
         denptr = DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                              "strict-transport-security", 25, NULL, 16);
         zptr = (sptr = DICT_GET_VALUE(denptr)) + 16;
         for (cptr = "max-age="; *cptr && sptr < zptr; *sptr++ = *cptr++);
         for (cptr = aptr; *cptr && sptr < zptr; *sptr++ = *cptr++);
         DictValueLength (denptr, (uchar*)sptr - DICT_GET_VALUE(denptr));
      }
   }

   if (LocationPtr)
   {
      cptr = ResponseNonPrint (rqptr, LocationPtr, -1);
      DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                  "location", 8, cptr, -1);
   }

   if (rqptr->rqResponse.HttpStatus == 401 ||
       rqptr->rqResponse.HttpStatus == 407)
   {
      /* requires authorization challenge */
      if (rqptr->rqAuth.BasicChallengePtr)
         ResponseDictFromString (rqptr, rqptr->rqAuth.BasicChallengePtr, -1);
      if (rqptr->rqAuth.DigestChallengePtr)
         ResponseDictFromString (rqptr, rqptr->rqAuth.DigestChallengePtr, -1);
   }

   if (rqptr->rqResponse.EntityTag[0])
      DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                  "etag", 4, rqptr->rqResponse.EntityTag, -1);

   if (ModifiedTime64Ptr)
   {
      status = HttpGmTimeString (ModifiedString, ModifiedTime64Ptr);
      if (VMSnok (status))
      {
         ErrorNoticed (rqptr, status, NULL, FI_LI);
         rqptr->rqResponse.Internal500 = true;
         return;
      }
      DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                  "last-modified", 13, ModifiedString, -1);
   }

   if (rqptr->rqResponse.PreExpired ||
       rqptr->rqPathSet.Expired)
   {
      DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                  "expires", 7, "Fri, 13 Jan 1978 14:00:00 GMT", 29);
      /* trying fairly hard here */
      DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                  "cache-control", 13,
"no-cache, no-store, max-age=0, must-revalidate, private", 55);
      DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                  "pragma", 6, "no-cache", 8);
   }

   if (ContentTypePtr)
   {
      cptr = ResponseNonPrint (rqptr, ContentTypePtr, -1);
      denptr = DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                           "content-type", 12, cptr, -1);
      rqptr->rqResponse.ContentTypePtr = DICT_GET_VALUE(denptr);
   }

   if (rqptr->rqResponse.CharsetNcsCfFactor > 1)
   {
      /* if the conversion is one-to-many the content-length is invalid */
      ContentLength64 = -1;
   }

   if (GzipResponse)
      rqptr->rqResponse.ContentEncodeAsGzip =
          GzipShouldDeflate (rqptr, ContentTypePtr, ContentLength64);

   if (rqptr->rqResponse.ContentEncodeAsGzip)
   {
      DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                  "content-encoding", 16, "gzip", 4);
      /* disable the content-length header */
      ContentLength64 = -1;
   }

   if (HTTP2_REQUEST(rqptr))
   {
      /* HTTP/2 write are implicitly "chunked" */
      rqptr->rqResponse.TransferEncodingChunked = false;
   }
   else
   if (rqptr->rqResponse.HttpVersion == HTTP_VERSION_1_1)
   {
      if (rqptr->rqResponse.HttpStatus != 204 &&
          !rqptr->rqResponse.NoChunked &&
          !rqptr->rqPathSet.ResponseNoChunked)
      {
         if (rqptr->rqCgi.TransferEncodingChunked == CGI_OUTPUT_CHUNK)
         {
            /* any script has explicitly requested content chunking */
            if (!rqptr->rqCgi.TransferEncoding)
            {
               rqptr->rqResponse.TransferEncodingChunked = true;
               ContentLength64 = -1;
            }
         }
         else
         if (rqptr->rqCgi.TransferEncodingChunked != CGI_OUTPUT_NO_CHUNK)
         {
            /* any script has NOT explicitly requested NO content chunking */
            if (ContentLength64 < 0 &&
                rqptr->PersistentRequest &&
                !rqptr->rqCgi.TransferEncoding)
            {
               /* there's a chance of connection persistence if it's chunked */
               rqptr->rqResponse.TransferEncodingChunked = true;
            }
         }

         if (rqptr->rqResponse.TransferEncodingChunked)
         {
            DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                        "transfer-encoding", 17, "chunked", 7);
            /* suppress actual chunked body stream (RFC 7230 3.3) */
            if (rqptr->rqHeader.Method == HTTP_METHOD_HEAD)
               rqptr->rqResponse.TransferEncodingChunked = false;
         }

         if (rqptr->rqResponse.HttpStatus != 204 &&
             rqptr->rqPathSet.ResponseChunked)
         {
            DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                        "transfer-encoding", 17, "chunked", 7);
            if (rqptr->rqHeader.Method == HTTP_METHOD_HEAD)
               rqptr->rqResponse.TransferEncodingChunked = false;
            else
               rqptr->rqResponse.TransferEncodingChunked = true;
            ContentLength64 = -1;
         }
      }
   }

   if (ContentLength64 != -1)
   {
      sys$fao (&Number64FaoDsc, 0, &NumberDsc, &ContentLength64);
      DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                  "content-length", 14, NumberString, -1);
      /* any time we've got a content-length this becomes possible */
      rqptr->PersistentResponse = true;
      rqptr->rqResponse.ContentLength64 = ContentLength64;
   }
   else
   if (rqptr->rqResponse.TransferEncodingChunked)
   {
      /* chunking contains it's own implicit content-length */
      rqptr->PersistentResponse = true;
   }
   else
   {
      /* without content-length this is not possible */
      rqptr->PersistentResponse = false;
   }

   for (idx = 0; idx < RESPONSE_COOKIE_MAX; idx++)
      if (rqptr->rqResponse.CookiePtr[idx])
         denptr = DictInsert (rqptr->rqDictPtr,
                              DICT_TYPE_RESPONSE_UNIQUE,
                              "set-cookie", 10,
                              rqptr->rqResponse.CookiePtr[idx], -1);

   if (!HTTP2_REQUEST(rqptr))
   {
      /* HTTP/2 manages it's own connectivity */
      if (rqptr->rqResponse.HttpVersion == HTTP_VERSION_1_1)
      {
         if (!rqptr->PersistentRequest || !rqptr->PersistentResponse)
            DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                        "connection", 10, "close", 5);
      }
      else
      {
         if (rqptr->PersistentRequest && rqptr->PersistentResponse)
         {
            DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                        "connection", 10, "keep-alive", 10);
            DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                        "keep-alive", 10, "", 0);
         }
      }
   }

   /* precedence; CGI script, mapping, default */
   if (rqptr->rqCgi.CspLength)
   {
      if (isalpha(*rqptr->rqCgi.CspPtr))
         DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                     "content-security-policy", 23,
                     rqptr->rqCgi.CspPtr,
                     rqptr->rqCgi.CspLength);
   }
   else
   if (rqptr->rqPathSet.ResponseCspLength)
   {
      if (isalpha(*rqptr->rqPathSet.ResponseCspPtr))
         DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                     "content-security-policy", 23,
                     rqptr->rqPathSet.ResponseCspPtr,
                     rqptr->rqPathSet.ResponseCspLength);
   }
   else
   {
      zptr = (sptr = BufferString) + sizeof(BufferString)-1;
      if (rqptr->CspNonce[0])
      {
         for (cptr = "script-src \'nonce-";
              *cptr && sptr < zptr;
              *sptr++ = *cptr++); 
         for (cptr = rqptr->CspNonce; *cptr && sptr < zptr; *sptr++ = *cptr++);
         for (cptr = "\' \'self\' \'strict-dynamic\'; ";
              *cptr && sptr < zptr;
              *sptr++ = *cptr++);
      }
      for (cptr = "frame-ancestors \'self\'; form-action \'self\';";
           *cptr && sptr < zptr;
           *sptr++ = *cptr++);
      *sptr = '\0';

      DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                  "content-security-policy", 23,
                  BufferString, sptr - BufferString);
   }

   if (rqptr->rqPathSet.ResponseCsproLength &&
       isalpha(*rqptr->rqPathSet.ResponseCsproPtr))
      DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE,
                  "content-security-policy-report-only", 35,
                  rqptr->rqPathSet.ResponseCsproPtr,
                  rqptr->rqPathSet.ResponseCsproLength);

   if (rqptr->rqPathSet.ResponseHeaderAddLength)
      ResponseDictFromString (rqptr, rqptr->rqPathSet.ResponseHeaderAddPtr, -1);

   if (OtherHeaderPtr)
      ResponseDictFromString (rqptr, OtherHeaderPtr, -1);

   if (WATCH_NOT_ONE_SHOT(Watch.Category))
      WatchFilterHttpStatus (rqptr);
}

/*****************************************************************************/
/*
Insert response header entries into the dictionary as parsed from a
null-terminated string.  Format is "<field-name>:[ ]<field-value>[\r\n]" and if
the string does not comply then is ignored.  Field value can be empty.  If the
string appears to begin with a NPH request line then parse and add that to the
dictionary.
*/

void ResponseDictFromString
(
REQUEST_STRUCT *rqptr,
char *string,
int length
)
{
   int  klen, vlen;
   char  *cptr, *kptr, *vptr, *zptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE,
                 "ResponseDictFromString() !#AZ",
                 length >= 0 ? length : strlen(string), string);

   if (length < 0)
      for (zptr = cptr = string; *zptr; zptr++);
   else
      zptr = (cptr = string) + length;

   if (length > 8 && MATCH7 (cptr, "HTTP/1."))
   {
      for (cptr += 7; cptr < zptr && !ISLWS(*cptr) && NOTEOL(*cptr); cptr++);
      while (cptr < zptr && ISLWS(*cptr)) cptr++;
      if (isdigit(*cptr))
      {
         for (vptr = cptr; cptr < zptr && isdigit(*cptr); cptr++);
         vlen = cptr - vptr;
         DictInsert (rqptr->rqDictPtr, DICT_TYPE_INTERNAL,
                     "response_status", 15, vptr, vlen);
         while (cptr < zptr && ISLWS(*cptr)) cptr++;
         if (NOTEOL(*cptr))
         {
            for (vptr = cptr; cptr < zptr && NOTEOL(*cptr); cptr++);
            vlen = cptr - vptr;
            DictInsert (rqptr->rqDictPtr, DICT_TYPE_INTERNAL,
                        "response_reason", 15, vptr, vlen);
         }
      }
      while (cptr < zptr && ISEOL(*cptr)) cptr++;
   }

   while (cptr < zptr)
   {
      for (kptr = cptr; cptr < zptr && *cptr != ':' && NOTEOL(*cptr); cptr++);
      if (*cptr != ':') break;
      klen = cptr - kptr;
      for (cptr++; cptr < zptr && ISLWS(*cptr); cptr++);

      for (vptr = cptr; cptr < zptr && NOTEOL(*cptr); cptr++);
      vlen = cptr - vptr;

      DictInsert (rqptr->rqDictPtr, DICT_TYPE_RESPONSE_UNIQUE,
                  kptr, klen, vptr, vlen);

      while (cptr < zptr && ISEOL(*cptr)) cptr++;
   }
}

/*****************************************************************************/
/*
The HTTP/1.1 compliant "100 Continue" interim response written synchronously.
*/

ResponseHeader100Continue (REQUEST_STRUCT *rqptr)

{
#define STRCAT(string) { \
   for (cptr = string; *cptr && sptr < zptr; *sptr++ = *cptr++); \
}
#define CHRCAT(character) { \
   if (sptr < zptr) *sptr++ = character; \
}
   int  status,
        BufferLength;
   char  *cptr, *sptr, *zptr;
   char  Buffer [256];

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE,
                 "ResponseHeader100Continue() HTTP/2:!&B", rqptr->Http2Ptr);

   if (HTTP2_REQUEST(rqptr)) return;

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

   if (rqptr->rqResponse.HttpVersion == HTTP_VERSION_1_1)
     STRCAT ("HTTP/1.1 100 Continue\r\nServer: ")
   else
     STRCAT ("HTTP/1.0 100 Continue\r\nServer: ")
   STRCAT (SoftwareID)
   STRCAT ("\r\nDate: ")
   STRCAT (rqptr->rqTime.GmDateTime)
   STRCAT ("\r\nAccept-Ranges: bytes\r\n\r\n")

   if (sptr >= zptr)
   {
      ErrorNoticed (rqptr, SS$_RESULTOVF, NULL, FI_LI);
      rqptr->rqResponse.Internal500 = true;
      return;
   }

   *sptr = '\0';
   BufferLength = sptr - Buffer;

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

   InstanceMutexLock (INSTANCE_MUTEX_HTTPD);
   AccountingPtr->ResponseStatusCodeGroup[1]++;
   AccountingPtr->ResponseStatusCodeCount[RequestHttpStatusIndex(100)]++;
   InstanceMutexUnLock (INSTANCE_MUTEX_HTTPD);

#undef STRCAT
#undef CHRCAT
}

/*****************************************************************************/
/*
Generate a 200 header response.  If output has been buffered and a reference to
the descriptor provided then total-up the content length in all the associated
descriptors and provide that.
*/

ResponseHeader200
(
REQUEST_STRUCT *rqptr,
char *ContentType,
STR_DSC *sdptr
)
{
   int64  ContentLength64;

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE,
                 "ResponseHeader200() !AZ !&X", ContentType, sdptr);

   if (sdptr)
   {
      /* total-up the content of all associated descriptors */
      ContentLength64 = 0;
      while (sdptr)
      {
         ContentLength64 += STR_DSC_LEN(sdptr);
         sdptr = STR_DSC_NEXT(sdptr);
      }
   }
   else
      ContentLength64 = -1;

   ResponseHeader (rqptr, 200, ContentType, ContentLength64, NULL, NULL);
}


/*****************************************************************************/
/*
Generate DIGEST and/or BASIC challenges as appropriate.  If the response status
code is 401 (authorization needed) and no realm has been specified change the
code to 403 (forbidden) and just return.
*/

ResponseHeaderChallenge (REQUEST_STRUCT *rqptr)

{
   int  status;

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE,
                 "ResponseHeaderChallenge()");

   if (rqptr->rqResponse.HttpStatus == 401 ||
       rqptr->rqResponse.HttpStatus == 407)
   {
      /* for OPAQUE realm it's all up to the script */
      if (rqptr->rqAuth.SourceRealm == AUTH_SOURCE_OPAQUE) return;

      /* for EXTERNAL realm with a "param=/NO401" it's all up to the script */
      if (rqptr->rqAuth.SourceRealm == AUTH_SOURCE_EXTERNAL &&
          rqptr->rqAuth.PathParameterPtr &&
          strsame (rqptr->rqAuth.PathParameterPtr, "/NO401", 6)) return;

      /* without a realm for authentication convert it to forbidden */
      if (!rqptr->rqAuth.RealmDescrPtr || !rqptr->rqAuth.RealmDescrPtr[0])
      {
         rqptr->rqResponse.HttpStatus = 403;
         return;
      }
   }

   if (!rqptr->rqAuth.ChallengeScheme)
   {
      /* ensure at least a BASIC challenge is generated if promiscuous */
      if (Config.cfAuth.BasicEnabled || AuthPromiscuous)
         rqptr->rqAuth.ChallengeScheme |= AUTH_SCHEME_BASIC;
      if (Config.cfAuth.DigestEnabled)
         rqptr->rqAuth.ChallengeScheme |= AUTH_SCHEME_DIGEST;

      /* if neither scheme enabled don't challenge */
      if (!rqptr->rqAuth.ChallengeScheme) rqptr->rqResponse.HttpStatus = 403;
   }

   if ((rqptr->rqAuth.ChallengeScheme & AUTH_SCHEME_BASIC) &&
       !rqptr->rqAuth.BasicChallengePtr)
      BasicChallenge (rqptr);

   if ((rqptr->rqAuth.ChallengeScheme & AUTH_SCHEME_DIGEST) &&
       !rqptr->rqAuth.DigestChallengePtr)
      DigestChallenge (rqptr, "");
}

/*****************************************************************************/
/*
Build a complete (HTTP/1.n) response header from dictionary entries and insert
that into the dictionary.  Return a pointer to that entry.  This may be
directly used as an HTTP/1.n response header.
*/ 

DICT_ENTRY_STRUCT* ResponseDictHeader (REQUEST_STRUCT *rqptr)

{
   BOOL is1;
   int  size;
   char  *bptr, *cptr, *kptr, *sptr, *zptr,
         *scode, *stext;
   DICT_ENTRY_STRUCT  *denptr, *renptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE, "ResponseDictHeader()");

   is1 = !rqptr->Http2Ptr;

   size = sizeof("HTTP/1.n \r\n\r\n");

   denptr = DictLookup (rqptr->rqDictPtr, DICT_TYPE_INTERNAL,
                        "response_status", 15);
   /* quite possible the header has not been generated yet */
   if (denptr == NULL) return (NULL);
   scode = DICT_GET_VALUE(denptr);
   size += DICT_GET_VALUE_LEN(denptr);

   denptr = DictLookup (rqptr->rqDictPtr, DICT_TYPE_INTERNAL,
                        "response_reason", 15);
   /* if response status is in the dictionary the reason should be too */
   if (denptr == NULL)
      ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
   stext = DICT_GET_VALUE(denptr);
   size += DICT_GET_VALUE_LEN(denptr);

   DictIterate (rqptr->rqDictPtr, NULL);
   while ((denptr = DictIterate (rqptr->rqDictPtr, DICT_TYPE_RESPONSE)) != NULL)
      size += DICT_GET_KEY_LEN(denptr) + DICT_GET_VALUE_LEN(denptr) + 4;

   /* insert the entry reserving space */
   renptr = DictInsert (rqptr->rqDictPtr, DICT_TYPE_INTERNAL,
                        "response_header", 15, NULL, size);
   bptr = DICT_GET_VALUE(renptr);
   zptr = (sptr = bptr) + size;

   /* response line */
   if (rqptr->rqResponse.HttpVersion == HTTP_VERSION_0_9)
      cptr = "HTTP/1.0 ";
   else
   if (rqptr->rqResponse.HttpVersion == HTTP_VERSION_1_0 &&
       rqptr->rqPathSet.ResponseHttpOriginal)
      cptr = "HTTP/1.0 ";
   else
      cptr = "HTTP/1.1 ";
   while (*cptr && sptr < zptr) *sptr++ = *cptr++;
   for (cptr = scode; *cptr && sptr < zptr; *sptr++ = *cptr++);
   if (sptr < zptr) *sptr++ = ' ';     
   for (cptr = stext; *cptr && sptr < zptr; *sptr++ = *cptr++);
   if (sptr < zptr) *sptr++ = '\r';     
   if (sptr < zptr) *sptr++ = '\n';     

   /* request fields */
   DictIterate (rqptr->rqDictPtr, NULL);
   while ((denptr = DictIterate (rqptr->rqDictPtr, DICT_TYPE_RESPONSE)) != NULL)
   {
      /* e.g. |set-cookie| field begins with a number to allow multiples */
      for (cptr = kptr = DICT_GET_KEY(denptr); !isalpha(*cptr); cptr++);
      while (*cptr && sptr < zptr)
      {
         /* make it look more like an HTTP/1.1 response by capitalising */
         if (is1 && (cptr == kptr || *(cptr-1) == '-'))
            *sptr++ = to_upper(*cptr++);
         else
            *sptr++ = *cptr++;
      }
      if (sptr < zptr) *sptr++ = ':';     
      if (sptr < zptr) *sptr++ = ' ';     
      for (cptr = DICT_GET_VALUE(denptr);
           *cptr && sptr < zptr;
           *sptr++ = *cptr++);
      if (sptr < zptr) *sptr++ = '\r';     
      if (sptr < zptr) *sptr++ = '\n';     
   }
   if (sptr < zptr) *sptr++ = '\r';     
   if (sptr < zptr) *sptr++ = '\n';     

   DictValueLength (renptr, sptr - bptr);

   if (sptr > zptr) ErrorNoticed (rqptr, SS$_RESULTOVF, NULL, FI_LI);

   return (renptr);
}

/*****************************************************************************/
/*
Generate a location dictionary entry in preparation for a redirect.
If |string| is NULL then the dictionary entry merely reserves space.
*/

char* ResponseLocation
(
REQUEST_STRUCT *rqptr,
char *string,
int length
)
{
   DICT_ENTRY_STRUCT  *denptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE,
                 "ResponseLocation() !UL !&Z", length, string);

   /* no empty locations! */
   if (string != NULL && !string[0])
      return (rqptr->rqResponse.LocationPtr = NULL);

   denptr = DictInsert (rqptr->rqDictPtr, DICT_TYPE_INTERNAL,
                        "location", 8, string, length);
   rqptr->rqResponse.LocationPtr = DICT_GET_VALUE(denptr);
   return (rqptr->rqResponse.LocationPtr);
}

/*****************************************************************************/
/*
Ensure non-printables (e.g. <CR>, <LF>) cannot be injected, by URL-encoding.
*/

char* ResponseNonPrint
(
REQUEST_STRUCT *rqptr,
char *string,
int length
)
{
   int  nonprint;
   char  *aptr, *cptr, *czptr, *eptr, *sptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE,
                 "ResponseNonPrint() !UL !&Z", length, string);

   if (string == NULL) return (string);

   if (length >= 0)
      czptr = string + length;
   else
      czptr = string + 1048560;
   nonprint = 0;
   for (cptr = string; *cptr && cptr < czptr; cptr++)
      if (*(uchar*)cptr <= 0x1f || *(uchar*)cptr >= 0x7f) nonprint++;

   /* if zero non-printable characters and not a substring */
   if (!nonprint && length < 0) return (string);

   if (length >= 0)
   {
      /* substring copied to intermediate storage */
      aptr = sptr = VmGetHeap (rqptr, length+1);
      for (cptr = string; *cptr && cptr < czptr; *sptr++ = *cptr++);
      string = aptr;
   }
   else
      length = cptr - string;
   if (nonprint) length += nonprint * 2;
   
   /* URL-encode non-printable characters */
   aptr = sptr = VmGetHeap (rqptr, length+1);
   cptr = string;
   while (*cptr)
   {
      if (*(uchar*)cptr > 0x1f && *(uchar*)cptr < 0x7f)
         *sptr++ = *cptr++;
      else
      {
         eptr = FaoUrlEncodeTable[*(uchar*)cptr++];
         while (*eptr) *sptr++ = *eptr++;
      }
   }

   return (aptr);
}

/*****************************************************************************/
/*
Cross-Origin Resource Sharing (CORS) request processing.

This function is called if the request has an "Origin: .." header and the path
has been SET CORS=ORIGIN=..  Performs pre-flight and request checks.  If CORS
authorised adds CORS response headers.  If not authorised adds nothing.

http://www.w3.org/TR/cors/
http://www.html5rocks.com/en/tutorials/cors/
http://en.wikipedia.org/wiki/Cross-origin_resource_sharing
http://developer.mozilla.org/en-US/docs/HTTP/Access_control_CORS
http://www.html5rocks.com/static/images/cors_server_flowchart.png

                                       < Origin:? > --no-------> ( invalid CORS )
                                             |
                                            yes
                                             |
             +--------<------no-- < HTTP method OPTIONS? >
             |                               |
             |                              yes
             |                               |
  [ actual request ] <---no-- < Access-Control-Request-Method:? > --yes--> [ pre-flight request ]
             |                                                                       |
             |                                                                       |
             |                                                              < header valid? > --no-----------> ( invalid request )
             |                                                                       |                                  |
             |                                                                      yes                                no 
             |                                                                       |                                  |
             |                                                     < Access-Control-Request-Header:? >  --yes--> < header valid? >
             |                                                                       |                                  |
             |                                                                      no                                 yes
             |                                                                       |                                  |
             |                                                    [ set Access-Control-Allow-Methods: ] -------<--------+
             |                                                                       |
             |                                                                       |
 < expose response headers? > --no------>-------+                 [ set Access-Control-Allow-Headers: ]
             |                                  |                                    |
            yes                                 |                                    |
             |                                  |                                    |
 [ set Access-Control-Expose-Headers: ]         |               [ set Access-Control-Max-Age: (optional) ]
             |                                  |                                    |
             |                                  |                                    |
             +--------------->------------------+-----------------<------------------+
                                                |
                                                |
                               [ set Access-Control-Allow-Origin: ]
                                                |
                                                |
                                       < cookies allowed? > --yes---> [set Access-Control-Allow-Credentials: ]
                                                |                                    |
                                               no                                    |
                                                |                                    |
                                                +-----------------<------------------+
                                                |
                                                |
                                     < pre-flight request? > --yes---------> ( HTTP 200 no body )
                                                |
                                               no
                                                |
                                     ( process the request )

*/

ResponseCorsProcess (REQUEST_STRUCT *rqptr)

{
#define STRCAT(string) \
   for (cptr = string; *cptr && sptr < zptr; *sptr++ = *cptr++);

   static char  SimpleMethods [] = "$GET,HEAD,POST",
                /* plus a pragmatic few */
                SimpleHeaders [] = "$Accept,Accept-Encoding,Accept-Language,\
Connection,Content-Language,Content-Type,DNT,Host,Origin,Referer,User-Agent",
                SimpleTypes [] = "$application/x-www-form-urlencoded,\
multipart/form-data,text/plain";

   BOOL  AllowedCORS,
         NonSimpleHeader,
         NonSimpleMethod,
         SimpleHeader,
         SimpleMethod,
         SimpleRequest;
   int  cnt;
   char  *cptr, *sptr, *zptr;
   char  buf [2048];
   DICT_ENTRY_STRUCT  *denptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE, "ResponseCorsProcess()");

   if (WATCHING (rqptr, WATCH_REQUEST))
   {
       WatchThis (WATCHITM(rqptr), WATCH_REQUEST, "CORS: !AZ",
                  rqptr->rqPathSet.CorsAllowOriginPtr);
       WatchDataFormatted ("methods: !AZ\nheaders: !AZ\n\
expose: !AZ\ncredentials: !&B\nmax-age: !UL\n",
                           rqptr->rqPathSet.CorsAllowMethodsPtr ?
                              rqptr->rqPathSet.CorsAllowMethodsPtr : "n/a",
                           rqptr->rqPathSet.CorsAllowHeadersPtr ?
                              rqptr->rqPathSet.CorsAllowHeadersPtr : "n/a",
                           rqptr->rqPathSet.CorsExposeHeadersPtr ?
                              rqptr->rqPathSet.CorsExposeHeadersPtr : "n/a",
                           rqptr->rqPathSet.CorsAllowCredentials,
                           rqptr->rqPathSet.CorsMaxAge);
   }

   /****************/
   /* check origin */
   /****************/

   if (!ResponseCorsOrigin (rqptr))
   {
      if (WATCHING (rqptr, WATCH_RESPONSE))
          WatchThis (WATCHITM(rqptr), WATCH_RESPONSE,
                     "CORS: fail \"!AZ\"", rqptr->rqHeader.OriginPtr);
      return;
   }

   AllowedCORS = SimpleRequest = true;
   NonSimpleHeader = NonSimpleMethod = SimpleHeader = SimpleMethod = false;

   if (rqptr->rqHeader.Method == HTTP_METHOD_OPTIONS &&
       rqptr->rqHeader.AccConRequestMethodPtr)
   {
      /********************/
      /* pre-flight check */
      /********************/

      /* check allowed methods */
      if (cptr = rqptr->rqHeader.AccConRequestMethodPtr)
      {
         NonSimpleMethod = false;
         if (!(SimpleMethod = ResponseCorsToken (rqptr, cptr, SimpleMethods)))
            NonSimpleMethod = ResponseCorsToken (rqptr, cptr,
                                          rqptr->rqPathSet.CorsAllowMethodsPtr);
         if (!(SimpleMethod || NonSimpleMethod))
            AllowedCORS = false;
         else
         if (NonSimpleMethod)
            SimpleRequest = false;
      }

      /* check allowed headers */
      if (cptr = rqptr->rqHeader.AccConRequestHeadersPtr)
      {
         NonSimpleHeader = false;
         if (!(SimpleHeader = ResponseCorsToken (rqptr, cptr, SimpleHeaders)))
            NonSimpleHeader = ResponseCorsToken (rqptr, cptr,
                                          rqptr->rqPathSet.CorsAllowHeadersPtr);
         if (!(SimpleHeader || NonSimpleHeader))
            AllowedCORS = false;
         else
         if (NonSimpleHeader)
            SimpleRequest = false;
      }

      /* for simple requests check any content type */
      if (AllowedCORS && SimpleRequest)
         if (cptr = rqptr->rqHeader.ContentTypePtr)
            if (!ResponseCorsToken (rqptr, cptr, SimpleTypes))
               AllowedCORS = false;

      if (!AllowedCORS) return;

      /**********************/
      /* pre-flight headers */
      /**********************/

      if (WATCHING (rqptr, WATCH_RESPONSE))
         WatchThis (WATCHITM(rqptr), WATCH_RESPONSE,
                    "CORS: !AZsimple pre-flight OK",
                    SimpleRequest ? "" : "non-");

      zptr = (sptr = buf) + sizeof(buf)-1;
      STRCAT ("Access-Control-Allow-Origin: ")
      if (*rqptr->rqPathSet.CorsAllowMethodsPtr == '*')
         STRCAT ("*")
      else
         STRCAT (rqptr->rqHeader.OriginPtr)
      STRCAT ("\r\n")
      if (NonSimpleMethod && rqptr->rqPathSet.CorsAllowMethodsPtr)
      {
         STRCAT ("Access-Control-Allow-Methods: ")
         STRCAT (rqptr->rqPathSet.CorsAllowMethodsPtr)
         STRCAT ("\r\n")
      }
      if (NonSimpleHeader)
      {
         STRCAT ("Access-Control-Allow-Headers: Content-Type")
         if (rqptr->rqPathSet.CorsAllowHeadersPtr)
         {
            STRCAT (",")
            STRCAT (rqptr->rqPathSet.CorsAllowHeadersPtr)
         }
         STRCAT ("\r\n")
      }
      if (rqptr->rqPathSet.CorsAllowCredentials)
         STRCAT ("Access-Control-Allow-Credentials: true\r\n");
      if (rqptr->rqPathSet.CorsMaxAge)
         if (sptr+48 < zptr)
            sptr += sprintf (sptr, "Access-Control-Max-Age: %d\r\n",
                             rqptr->rqPathSet.CorsMaxAge);
      *sptr = '\0';
      if (sptr >= zptr) ErrorNoticed (rqptr, SS$_RESULTOVF, NULL, FI_LI);

      ResponseDictFromString (rqptr, buf, sptr - buf);

      return;
   }

   /*****************/
   /* request check */
   /*****************/

   /* request method */
   cptr = rqptr->rqHeader.MethodName;
   NonSimpleMethod = false;
   if (!(SimpleMethod = ResponseCorsToken (rqptr, cptr, SimpleMethods)))
      NonSimpleMethod = ResponseCorsToken (rqptr, cptr,
                                    rqptr->rqPathSet.CorsAllowMethodsPtr);
   if (!(SimpleMethod || NonSimpleMethod))
      AllowedCORS = false;
   else
   if (NonSimpleMethod)
      SimpleRequest = false;

   /* request headers */
   DictIterate (rqptr->rqDictPtr, NULL);
   while (denptr = DictIterate (rqptr->rqDictPtr, DICT_TYPE_REQUEST))
   {
      cptr = DICT_GET_KEY(denptr);

      NonSimpleHeader = false;
      if (!(SimpleHeader = ResponseCorsToken (rqptr, cptr, SimpleHeaders)))
         NonSimpleHeader = ResponseCorsToken (rqptr, cptr,
                                       rqptr->rqPathSet.CorsAllowHeadersPtr);
      if (!(SimpleHeader || NonSimpleHeader))
         AllowedCORS = false;
      else
      if (NonSimpleHeader)
         SimpleRequest = false;

      /* only check *all* headers if currently WATCHing */
      if (!AllowedCORS)
         if (!(WATCHING (rqptr, WATCH_RESPONSE)))
            break;
   }

   /* for simple requests check any content type */
   if (AllowedCORS && SimpleRequest)
      if (cptr = rqptr->rqHeader.ContentTypePtr)
         if (!ResponseCorsToken (rqptr, cptr, SimpleTypes))
            AllowedCORS = false;

   if (!AllowedCORS) return;

   /**************/
   /* request OK */
   /**************/

   if (WATCHING (rqptr, WATCH_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_RESPONSE,
                 "CORS: !AZsimple request OK", SimpleRequest ? "" : "non-");

   zptr = (sptr = buf) + sizeof(buf)-1;
   STRCAT ("Access-Control-Allow-Origin: ")
   STRCAT (rqptr->rqHeader.OriginPtr)
   if (rqptr->rqPathSet.CorsAllowCredentials)
      STRCAT ("\r\nAccess-Control-Allow-Credentials: true\r\n")
   else
      STRCAT ("\r\n")
   if (rqptr->rqPathSet.CorsExposeHeadersPtr)
   {
      STRCAT ("Access-Control-Expose-Headers: ")
      STRCAT (rqptr->rqPathSet.CorsExposeHeadersPtr)
      STRCAT ("\r\n")
   }
   *sptr = '\0';
   if (sptr >= zptr) ErrorNoticed (rqptr, SS$_RESULTOVF, NULL, FI_LI);

   ResponseDictFromString (rqptr, buf, sptr - buf);

#undef STRCAT
}

/*****************************************************************************/
/*
Match a comma/white-space separated list of possible origins to the supplied
origin.  List origin of '*' matches all.  Host portion and port can contain
'*' wildcard allowing the likes of "http://*.example.com" and
"https://example.com:*".  Return true or false on match.
*/

BOOL ResponseCorsOrigin (REQUEST_STRUCT *rqptr)

{
   BOOL  http, match;
   int  port1, port2;
   char  ch;
   char  *c1ptr, *s1ptr, *c2ptr, *s2ptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE,
                 "ResponseCorsOrigin() \"!&Z\" in \"!&Z\"",
                 rqptr->rqHeader.OriginPtr,
                 rqptr->rqPathSet.CorsAllowOriginPtr);

   if (!(c2ptr = rqptr->rqPathSet.CorsAllowOriginPtr)) return (false);
   if (*c2ptr == '*') return (true);
   if (!(s1ptr = rqptr->rqHeader.OriginPtr)) return (false);
   if (!(http = MATCH7(s1ptr,"http://")) &&
       !MATCH8(s1ptr,"https://")) return (false);

   match = false;
   while (*c2ptr)
   {
      while (ISLWS(*c2ptr) || *c2ptr == ',') c2ptr++;
      if (!*(s2ptr = c2ptr)) break;
      c1ptr = s1ptr;

      /* match "http://" or "https:/" */
      if (MATCH7(c1ptr,c2ptr))
      {
         if (http)
         {
            c1ptr += 7;
            c2ptr += 7;
            port1 = port2 = 80;
         }
         else
         {
            c1ptr += 8;
            c2ptr += 8;
            port1 = port2 = 443;
         }

         /* match host portion up to (possible) port */
         while (*c1ptr && *c1ptr != ':' &&
                *c2ptr && *c2ptr != ':' && !ISLWS(*c2ptr) && *c2ptr != ',')
         {
            if (*c2ptr == '*')
            {
               /* e.g. "http://*.example.com" */
               c2ptr++;
               if (*c2ptr && *c2ptr != ':' && !ISLWS(*c2ptr) && *c2ptr != ',')
                  while (*c1ptr && *c1ptr != *c2ptr) c1ptr++;
            }
            else
            {
               if (to_lower(*c1ptr) != to_lower(*c2ptr)) break;
               c1ptr++;
               c2ptr++;
            }
         }

         if ((!*c1ptr || *c1ptr == ':') &&
             (!*c2ptr || *c2ptr == ':' || ISLWS(*c2ptr) || *c2ptr == ','))
         {
            /* host portion matched, check ports */
            if (*c2ptr == ':' && *(c2ptr+1) == '*')
               match = true;
            else
            {
               if (*c1ptr == ':' && isdigit(*(c1ptr+1))) port1 = atoi(c1ptr+1);
               if (*c2ptr == ':' && isdigit(*(c2ptr+1))) port2 = atoi(c2ptr+1);
               if (port1 == port2) match = true;
            }
        }

         if (match) break;
      }

      while (*c2ptr && !ISLWS(*c2ptr) && *c2ptr != ',') c2ptr++;
   }

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE, "match !&B", match);

   return (match);
}

/*****************************************************************************/
/*
Processes two lists of tokens (e.g. "one, Two, Three-four") looking for any one
of the first list being in the second list.  Return true if hit, otherwise
false.  If the second list begins with a dollar symbol it's considered a simple
list and not reported.
*/

BOOL ResponseCorsToken
(
REQUEST_STRUCT *rqptr,
char *List1Ptr,
char *List2Ptr
)
{
#define ISTOK(c) (isalnum(c) || c == '-' || c == '_' || c == '/')

   BOOL  hit, simple;
   int  HitCount,
        TokenCount;
   char  *c1ptr, *c2ptr, *s1ptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHALL, WATCH_MOD_RESPONSE,
                 "ResponseCorsToken() \"!&Z\" in \"!&Z\"",
                 List1Ptr, List2Ptr);

   hit = false;
   if (!(c1ptr = List1Ptr) || !List2Ptr) return (false);
   if (simple = (*List2Ptr == '$')) List2Ptr++;
   /* always matching is acceptable */
   if (*List2Ptr == '*') return (true);
   HitCount = TokenCount = 0;
   while (*c1ptr)
   {
      while (*c1ptr && !ISTOK(*c1ptr)) c1ptr++;
      if (!*(s1ptr = c1ptr)) break;
      TokenCount++;
      c2ptr = List2Ptr;
      while (*c2ptr)
      {
         while (*c2ptr && !ISTOK(*c2ptr)) c2ptr++;
         if (!*c2ptr) break;
         c1ptr = s1ptr;
         while (ISTOK(*c1ptr) && ISTOK(*c2ptr) &&
                to_lower(*c1ptr) == to_lower(*c2ptr))
         {
            c1ptr++;
            c2ptr++;
         }
         if (hit = !ISTOK(*c1ptr) && !ISTOK(*c2ptr))
         {
            HitCount++;
            break;
         }
         while (ISTOK(*c2ptr)) c2ptr++;
      }
      while (ISTOK(*c1ptr)) c1ptr++;

      if (!hit)
      {
         /* only check *all* tokens if currently WATCHing */
         if (!simple && WATCHING (rqptr, WATCH_RESPONSE))
             WatchThis (WATCHITM(rqptr), WATCH_RESPONSE,
                        "CORS: fail \"!#AZ\"", c1ptr-s1ptr, s1ptr);
         else
             break;
      }
   }

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHALL, WATCH_MOD_RESPONSE, "hit !&B", hit);

   return (HitCount == TokenCount);

#undef ISTOK
}

/*****************************************************************************/
/*
CONFIG.C module calls this function with a string list of all/any
[CharsetConvert] directive entries.   Enter the required parameters into a
charset NCS conversion structure and places this at the end of a linked list.
The conversion information is stored as a series of null-terminated strings
addressed by the three pointers.  The first, the 'DocCharsetPtr', may itself
be one or more null-terminated strings, terminated by a null-string.  Then the
'AccCharsetPtr' and 'NcsCfNamePtr' strings. 
*/

ResponseCharsetConfig (META_CONFIG *mcptr)

{
   static char  ProblemParam [] =
"NCS conversion parameter problem\n\\!AZ\\",
                ProblemNcsCf [] =
"NCS conversion function !AZ\n%!&M";

   int  status;
   char  *aptr, *cptr, *sptr;
   $DESCRIPTOR (CsNameDsc, "");
   RESPONSE_CHARSET  *csptr;

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

   if (WATCH_MODULE(WATCH_MOD_CONFIG))
      WatchThis (WATCHALL, WATCH_MOD_CONFIG,
                 "ResponseCharsetConfig()\n!&Z",
                 Config.cfContent.CharsetConvertPtr);

   cptr = Config.cfContent.CharsetConvertPtr;
   while (*cptr)
   {
      /* scan to get maximum possible length of this string */
      for (aptr = sptr = cptr; *sptr && *sptr != STRING_LIST_CHAR; sptr++);

      /* allocate sufficient storage */
      csptr = (RESPONSE_CHARSET*)
         VmGet (sizeof(RESPONSE_CHARSET)+((sptr-cptr)*2)+4);
      /* this first, literal string is used only for WATCH purposes */
      for (sptr = csptr->Storage;
           *cptr && *cptr != STRING_LIST_CHAR;
           *sptr++ = *cptr++);
      *sptr++ = '\0';

      /* back to start, skip leading white space */
      for (cptr = aptr; *cptr && ISLWS(*cptr); cptr++);

      /* parse 'doc-charset' string */
      csptr->DocCharsetPtr = sptr;
      while (*cptr && !ISLWS(*cptr) && *cptr != STRING_LIST_CHAR)
         *sptr++ = *cptr++;
      *sptr++ = '\0';
      while (*cptr && ISLWS(*cptr)) cptr++;

      /* parse 'accept-charset' string */
      csptr->AccCharsetPtr = sptr;
      while (*cptr)
      {
         /* parse out comma/white-space delimited string(s) */
         while (*cptr && !ISLWS(*cptr) && *cptr != ',' &&
                *cptr != STRING_LIST_CHAR) *sptr++ = *cptr++;
         *sptr++ = '\0';
         while (*cptr && ISLWS(*cptr)) cptr++;
         if (*cptr != ',') break;
         cptr++;
         while (*cptr && ISLWS(*cptr)) cptr++;
      }

      /* empty string terminate (possible set of) 'accept-charset' string(s) */
      *sptr++ = '\0';
      while (*cptr && ISLWS(*cptr)) cptr++;

      /* parse 'NCS-conversion function' string */
      csptr->NcsCfFactor = 1;
      csptr->NcsCfNamePtr = sptr;
      while (*cptr && !ISLWS(*cptr) &&
             *cptr != '=' && *cptr != STRING_LIST_CHAR)
         *sptr++ = *cptr++;
      *sptr++ = '\0';
      if (*cptr == '=')
      {
         cptr++;
         csptr->NcsCfFactor = atoi(cptr);
         if (csptr->NcsCfFactor < 1) csptr->NcsCfFactor = 1;
         if (csptr->NcsCfFactor > 4) csptr->NcsCfFactor = 4;
         while (*cptr && !ISLWS(*cptr) && *cptr != STRING_LIST_CHAR) cptr++;
      }

      /* scan over any trailing white-space */
      while (*cptr && *cptr != STRING_LIST_CHAR) cptr++;
      if (*cptr) cptr++;

      if (!*csptr->DocCharsetPtr ||
          !*csptr->AccCharsetPtr)
      {
         MetaConReport (mcptr, METACON_REPORT_ERROR, ProblemParam, aptr);
         VmFree (csptr, FI_LI);
         continue;
      }

      if (*csptr->NcsCfNamePtr)
      {
         CsNameDsc.dsc$a_pointer = csptr->NcsCfNamePtr;
         CsNameDsc.dsc$w_length = strlen(csptr->NcsCfNamePtr);
         status = ncs$get_cf (&csptr->NcsCf, &CsNameDsc, NULL);
         if (VMSnok (status))
         {
            MetaConReport (mcptr, METACON_REPORT_ERROR, ProblemNcsCf, csptr->NcsCfNamePtr, status);
            VmFree (csptr, FI_LI);
            continue;
         }
      }
      else
         csptr->NcsCf = 0;

      ListAddTail (&ResponseCharsetList, csptr, LIST_ENTRY_TYPE_CHARSET);
      ResponseCharsetCount++;
   }
}

/*****************************************************************************/
/*
Accepts a character set name string.  Compares this to the request's accepted
character sets, one by one.  The comparison algorithm is described in this
module's preamble.  Returns a pointer to the response character set.  Modifies
the '->rqResponse.CharsetNcsCf' longword to contain the NCS character set
conversion function.  This will be used to indicate a conversion should be
performed before writing a network buffer.
*/

char* ResponseCharsetConvertBegin
(
REQUEST_STRUCT *rqptr,
char *CharsetPtr
)
{
   BOOL  MatchAllWildcard;
   int  size, status;
   char  ch;
   char  *aptr, *cptr, *sptr;
   RESPONSE_CHARSET  *csptr;
   LIST_ENTRY  *leptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE,
                 "ResponseCharsetConvertBegin() !&Z !&Z",
                 CharsetPtr, rqptr->rqHeader.AcceptCharsetPtr);

   if (!(cptr = rqptr->rqHeader.AcceptCharsetPtr))
   {
      if (WATCHING (rqptr, WATCH_RESPONSE_BODY))
         WatchThis (WATCHITM(rqptr), WATCH_RESPONSE_BODY,
                    "NCS$CONVERT no request charset");
      return (CharsetPtr);
   }

   if (WATCHING (rqptr, WATCH_RESPONSE_BODY))
      WatchThis (WATCHITM(rqptr), WATCH_RESPONSE_BODY, "NCS$CONVERT !AZ to !AZ",
                 CharsetPtr, cptr);

   InstanceGblSecIncrLong (&AccountingPtr->NcsCount);

   /* attempt to match character set with one accepted by the request header */
   while (*cptr)
   {
      while (*cptr && ISLWS(*cptr)) cptr++;
      sptr = cptr;
      while (*cptr && *cptr != ';' && *cptr != ',' && !ISLWS(*cptr))
         cptr++;
      ch = *cptr;
      *cptr = '\0';

      if (SAME2(sptr,'*\0'))
      {
         /* note the presence of a match-all wildcard */
         MatchAllWildcard = true;
         if (*cptr = ch) cptr++;
         while (*cptr && *cptr != ',') cptr++;
         while (*cptr == ',') cptr++;
         continue;
      }

      if (strsame (CharsetPtr, sptr, -1))
      {
         /* exact match, no conversion necessary */
         if (WATCHING (rqptr, WATCH_RESPONSE_BODY))
            WatchDataFormatted ("\"!AZ\" match, no conversion\n", sptr);
         *cptr = ch;
         return (CharsetPtr);
      }

      /* look through the list of sets of convertable character sets */
      for (leptr = ResponseCharsetList.HeadPtr; leptr; leptr = leptr->NextPtr)
      {
         csptr = (RESPONSE_CHARSET*)leptr;
         if (WATCHING (rqptr, WATCH_RESPONSE_BODY))
            WatchDataFormatted ("\"!AZ\" with \"!AZ\"\n", sptr, csptr->Storage);
         /* if the 'doc-charset' does not match the 'document' charset */
         if (!StringMatch (rqptr, CharsetPtr, csptr->DocCharsetPtr)) continue;
         /* if (one of) 'acc-charset' does not match 'Accept-Charset:' */
         aptr = csptr->AccCharsetPtr;
         while (*aptr)
         {
            if (StringMatch (rqptr, sptr, aptr)) break;
            while (*aptr) aptr++;
            aptr++;
         }
         if (!*aptr) continue;
         /* matches both charset strings */
         rqptr->rqResponse.CharsetNcsCf = csptr->NcsCf;
         rqptr->rqResponse.CharsetNcsCfFactor = csptr->NcsCfFactor;

         if (WATCHING (rqptr, WATCH_RESPONSE_BODY))
            if (rqptr->rqResponse.CharsetNcsCf)
               WatchDataFormatted ("\"!AZ\" conversion using \"!AZ\"\n",
                                   sptr, csptr->NcsCfNamePtr);
            else
               WatchDataFormatted ("\"!AZ\" alias, no conversion\n", sptr);

         if (rqptr->rqResponse.CharsetNcsCf)
            InstanceGblSecIncrLong (&AccountingPtr->NcsConvertCount);

         CharsetPtr = VmGetHeap (rqptr, size = strlen(sptr)+1);
         strzcpy (CharsetPtr, sptr, size);
         *cptr = ch;
         return (CharsetPtr);
      }

      if (*cptr = ch) cptr++;
      while (*cptr && *cptr != ',') cptr++;
      while (*cptr == ',') cptr++;
   }

   if (WATCHING (rqptr, WATCH_RESPONSE_BODY))
      if (MatchAllWildcard)
         WatchDataFormatted ("\"*\" wildcard, no conversion\n");
      else
         WatchDataFormatted ("no match, no conversion\n");

   return (CharsetPtr);
}

/*****************************************************************************/
/*
When 'rqResponse.CharsetNcsCf' is non-zero NetWrite() calls this function
immediately before writing the buffer specified by 'DataPtr' and 'DataLength'
passed as the addresses of these two parameters by 'DataPtrPtr' and
'DataLengthPtr'.  This function uses ncs$convert() to transliterate each
character into the target character set.  It allocates specific buffer space
(which may vary in size depending on whether it coming from cache, file or
other modules), the conversion is performed into that, and the data pointer and
size originally passed as parameters are adjusted to point to this.  Returns a
VMS status which NetWrite() should report and abort the write if an error.
*/

int ResponseCharsetConvert
(
REQUEST_STRUCT *rqptr,
char **DataPtrPtr,
int *DataLengthPtr
)
{
   static $DESCRIPTOR (SrcDsc, "");
   static $DESCRIPTOR (DstDsc, "");

   int  status,
        BufferSize;
   unsigned short  CvtLen, NotCvtLen;

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE,
                 "ResponseCharsetConvert() !&X !UL !UL !UL",
                 *DataPtrPtr, *DataLengthPtr,
                 rqptr->rqResponse.CharsetNcsBufferSize,
                 rqptr->rqResponse.CharsetNcsCfFactor);

   if (rqptr->rqResponse.CharsetNcsBufferSize <
       *DataLengthPtr * rqptr->rqResponse.CharsetNcsCfFactor)
   {
      if (*DataLengthPtr < OutputBufferSize)
         BufferSize = OutputBufferSize;
      else
         BufferSize = *DataLengthPtr;
      BufferSize *= rqptr->rqResponse.CharsetNcsCfFactor;
      if (BufferSize > 65535)
      {
         ErrorNoticed (rqptr, SS$_IVBUFLEN, NULL, FI_LI);
         return (SS$_IVBUFLEN);
      }
      if (rqptr->rqResponse.CharsetNcsBufferPtr)
         VmFreeFromHeap (rqptr, rqptr->rqResponse.CharsetNcsBufferPtr, FI_LI);
      rqptr->rqResponse.CharsetNcsBufferPtr = VmGetHeap (rqptr, BufferSize);
      rqptr->rqResponse.CharsetNcsBufferSize = BufferSize;
   }

   SrcDsc.dsc$a_pointer = *DataPtrPtr;
   SrcDsc.dsc$w_length = *DataLengthPtr;
   DstDsc.dsc$a_pointer = rqptr->rqResponse.CharsetNcsBufferPtr;
   DstDsc.dsc$w_length = rqptr->rqResponse.CharsetNcsBufferSize;
   status = ncs$convert (&rqptr->rqResponse.CharsetNcsCf, &SrcDsc, &DstDsc,
                         &CvtLen, &NotCvtLen);
   if (VMSok (status) && NotCvtLen) status = SS$_BUGCHECK;
   if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI);

   if (WATCHING (rqptr, WATCH_RESPONSE_BODY))
      WatchThis (WATCHITM(rqptr), WATCH_RESPONSE_BODY,
                 "NCS$CONVERT src:!UL dst:!UL cvt:!UL not:!UL !&S",
                 *DataLengthPtr, rqptr->rqResponse.CharsetNcsBufferSize,
                 CvtLen, NotCvtLen, status);

   *DataPtrPtr = rqptr->rqResponse.CharsetNcsBufferPtr;
   *DataLengthPtr = CvtLen;

   return (status);
}

/*****************************************************************************/
/*
Implements the HTTP/1.1 OPTIONS method by returning an appropriate response
header.  Discriminate between per-server ('*') and per-resource (path) requests
and respond using "Allow:".
*/ 

ResponseOptions (REQUEST_STRUCT *rqptr)

{
   BOOL  WebDavLockingOptions,
         WebDavOptions;

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE, 
                 "ResponseOptions() !&F", &ResponseOptions);

   if (!rqptr->rqHeader.RequestUriPtr ||
       rqptr->rqHeader.RequestUriPtr[0] == '*')
   {
      if (WebDavLockingEnabled)
         ResponseHeader (rqptr, 200, NULL, 0, NULL,
                         ResponseAllowWebDavLockServer);
      else
      if (WebDavEnabled)
         ResponseHeader (rqptr, 200, NULL, 0, NULL,
                         ResponseAllowWebDavServer);
      else
         ResponseHeader (rqptr, 200, NULL, 0, NULL,
                         ResponseAllowServer);
   }
   else
   {
      WebDavOptions = WebDavEnabled &&
                      (rqptr->rqPathSet.WebDavProfile ||
                       rqptr->rqPathSet.WebDavRead || 
                       rqptr->rqPathSet.WebDavServer ||
                       rqptr->rqPathSet.WebDavWrite);

      WebDavLockingOptions = WebDavOptions &&
                             WebDavLockingEnabled &&
                             !rqptr->rqPathSet.WebDavNoLock;

      if (WebDavLockingOptions)
         ResponseHeader (rqptr, 200, NULL, 0, NULL,
                         ResponseAllowWebDavLockResource);
      else
      if (WebDavOptions)
         ResponseHeader (rqptr, 200, NULL, 0, NULL,
                         ResponseAllowWebDavResource);
      else
         ResponseHeader (rqptr, 200, NULL, 0, NULL,
                         ResponseAllowResource);
   }

   RequestEnd (rqptr);
}

/*****************************************************************************/
/*
Echo back to the client as a "message/http" response the entire request header
and any body content.  This implements the HTTP/1.1 TRACE method and the WASD
/echo/ 'script'.
*/ 

ResponseTrace (REQUEST_STRUCT *rqptr)

{
   DICT_ENTRY_STRUCT  *denptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE, 
                 "ResponseTrace() !&F", &ResponseTrace);

   if (!rqptr->TraceTaskPtr)
   {
      /* first call, initialize */
      rqptr->TraceTaskPtr = VmGetHeap (rqptr, sizeof(TRACE_TASK));
      if (RequestDictHeader (rqptr))
         BodyReadBegin (rqptr, &ResponseTrace, NULL);
      else
         RequestEnd (rqptr);
      return;
   }

   if (!rqptr->rqResponse.PreExpired)
   {
      /* second call (from BodyReadBegin()) */
      rqptr->rqResponse.PreExpired = rqptr->rqResponse.NoGzip = true;
      if (rqptr->rqHeader.Method == HTTP_METHOD_TRACE)
         ResponseHeader (rqptr, 200, "message/http", -1, NULL, NULL);
      else
         ResponseHeader (rqptr, 200, "text/plain", -1, NULL, NULL);

      denptr = RequestDictHeader (rqptr);
      NetWrite (rqptr, &ResponseTrace, DICT_GET_VALUE(denptr),
                                       DICT_GET_VALUE_LEN(denptr));
      return;
   }

   /* third and subsequent calls */
   if (VMSnok (rqptr->rqBody.DataStatus) ||
       rqptr->RequestState >= REQUEST_STATE_ABORT)
   {
      /* error or end-of-file (body) */
      rqptr->TraceTaskPtr = NULL;
      RequestEnd (rqptr);
      return;
   }

   NetWrite (rqptr, &BodyRead, rqptr->rqBody.DataPtr, rqptr->rqBody.DataCount);
}

/*****************************************************************************/
/*
Return a stream of pseudo-random alpha-numeric noise.  Designed to return
low-cost 'discouraging' responses to clients that may be sourcing attacks.
This function is called directly to initiate and thereafter as an AST.
Output stops after the client disconnects or when the path specified (e.g.
"/hiss/30" kilobytes) or ADMIN_SCRIPT_HISS_MAX_BYTES number of bytes is
reached.
*/ 

ResponseHiss (REQUEST_STRUCT *rqptr)

{
   int  cnt;
   char  *cptr, *sptr, *zptr;
   HISS_TASK  *tkptr;
   int64  RandomNumber;

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE,
                 "ResponseHiss() !&F !AZ", &ResponseHiss,
                 rqptr->MappedPathPtr);

   if (!(tkptr = rqptr->HissTaskPtr))
   {
      /* first call, initialize */
      rqptr->HissTaskPtr = tkptr = VmGetHeap (rqptr, sizeof(HISS_TASK));

      rqptr->rqResponse.HttpStatus = 203;
      rqptr->rqResponse.HeaderSent = true;
      StrDscIfNotBegin (rqptr, &rqptr->NetWriteBufferDsc,
                        rqptr->NetIoPtr->TcpMaxQio);
      zptr = (sptr = STR_DSC_PTR(&rqptr->NetWriteBufferDsc)) +
                     STR_DSC_SIZE(&rqptr->NetWriteBufferDsc);
      RandomNumber = HttpdTime64;
      while (sptr < zptr)
      {
         /* cheap (no subroutine call) MTH$RANDOM() */
         RandomNumber = RandomNumber * 69069 + 1;
         cptr = (char*)&RandomNumber;
         for (cnt = sizeof(RandomNumber); cnt && sptr < zptr; cnt--)
         {
            if (isalnum(*cptr)) *sptr++ = *cptr;
            cptr++;
         }
      }
      /* get value optionally following path */
      if (*(cptr = rqptr->MappedPathPtr) == '/') cptr++;
      tkptr->HissBytesMax = atoi(cptr) * 1024;
      if (!tkptr->HissBytesMax ||
          tkptr->HissBytesMax > ADMIN_SCRIPT_HISS_MAX_BYTES)
         tkptr->HissBytesMax = ADMIN_SCRIPT_HISS_MAX_BYTES;

      /* before any real network write just fudge the status */
      rqptr->NetIoPtr->WriteStatus = SS$_NORMAL;
   }

   if (VMSnok (rqptr->NetIoPtr->WriteStatus) ||
       rqptr->NetIoPtr->BytesRawTx64 >= tkptr->HissBytesMax ||
       rqptr->RequestState >= REQUEST_STATE_ABORT)
   {
      StrDscNoContent(&rqptr->NetWriteBufferDsc);
      rqptr->HissTaskPtr = NULL;
      RequestEnd (rqptr);
      return;
   }

   NetWriteRaw (rqptr, &ResponseHiss,
                STR_DSC_PTR(&rqptr->NetWriteBufferDsc),
                STR_DSC_SIZE(&rqptr->NetWriteBufferDsc));
}

/*****************************************************************************/
/*
By default returns a stream of pseudo-random "lines" of 8 bit printable
characters.  Very light-weight test stream at maximum throughput.  URI is
/stream/ with optional trailing type of stream ("binary", "octet", "text") and
further optional trailing integer (of kbytes) followed by an optional 'm' or
'g' to indicate mega and gigabytes (these days system capacity is significantly
greater that the VAX this originated on :-) 

Examples: /stream/              8 bit printables until client disconnects
          /stream/100/          100kB of 8 bit printables and then quit
          /stream/binary:250/   250kB of random octets and then quit
          /stream/binary:250m/  250MB of random octets and then quit
          /stream/text/         unlimited lines of 80 column 7 bit text
          /stream/text:10/      10kB of 80 column 7 bit text then quit
          /stream/text:10g/     10GB of 80 column 7 bit text then quit
          /stream/octet/        unlimited octets cycling thru 0x00..0xff
          /stream/qio/          lowest cost content generator

Example use (macOS command line):

$ curl -vo /dev/null http://192.168.1.3/stream/qio/
*/ 

ResponseStream (REQUEST_STRUCT *rqptr)

{
   int  status;
   int64  bytes, cnt, RandomNumber;
   unsigned char  octet;
   unsigned char  *aptr, *cptr, *sptr, *zptr;
   STREAM_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE,
                 "ResponseStream() !&F !AZ", &ResponseStream,
                 rqptr->rqHeader.RequestUriPtr);

   if (!(tkptr = rqptr->StreamTaskPtr))
   {
      /* first call, initialize */
      rqptr->StreamTaskPtr = tkptr = VmGetHeap (rqptr, sizeof(STREAM_TASK));

      if (*(cptr = rqptr->rqHeader.RequestUriPtr) == '/') cptr++;
      while (*cptr && *cptr != '/') cptr++;
      if (*cptr == '/') cptr++;
      if (!(tkptr->StreamTypeFlag = to_lower(*cptr)))
         tkptr->StreamTypeFlag = 's';
      while (*cptr && !isdigit(*cptr)) cptr++;
      tkptr->StreamBytesMax = atoi(cptr) * 1024;
      while (*cptr && isdigit(*cptr)) cptr++;
      /* default is kilobytes, optionally megabytes and gigabytes */
      if (*cptr && to_lower(*cptr) == 'm')
         tkptr->StreamBytesMax *= 1024;
      else
      if (*cptr && to_lower(*cptr) == 'g')
         tkptr->StreamBytesMax *= (1024 * 1024);
      if (!tkptr->StreamBytesMax) tkptr->StreamBytesMax = -1;
      tkptr->StreamOctetBuffer = 0;

      rqptr->rqResponse.NoChunked = rqptr->rqResponse.NoGzip =
         rqptr->rqResponse.PreExpired = true;
      if (tkptr->StreamTypeFlag == 'b' ||
          tkptr->StreamTypeFlag == 'q' ||
          tkptr->StreamTypeFlag == 'o')
         ResponseHeader (rqptr, 200, "application/binary",
            tkptr->StreamBytesMax > 0 ? tkptr->StreamBytesMax : 0, NULL, NULL);
      else
         ResponseHeader (rqptr, 200, "text/plain",
            tkptr->StreamBytesMax > 0 ? tkptr->StreamBytesMax : 0, NULL, NULL);
      if (tkptr->StreamTypeFlag != 'q')
         StrDscIfNotBegin (rqptr, &rqptr->NetWriteBufferDsc,
                           rqptr->NetIoPtr->TcpMaxQio);

      /* before any real network write just fudge the status */
      rqptr->NetIoPtr->WriteStatus = SS$_NORMAL;
   }

   if (!tkptr->StreamBytesMax ||
       VMSnok (rqptr->NetIoPtr->WriteStatus) ||
       rqptr->RequestState >= REQUEST_STATE_ABORT)
   {
      StrDscNoContent(&rqptr->NetWriteBufferDsc);
      rqptr->StreamTaskPtr = NULL;
      RequestEnd (rqptr);
      return;
   }

   aptr = sptr = STR_DSC_PTR(&rqptr->NetWriteBufferDsc);
   zptr = sptr + STR_DSC_SIZE(&rqptr->NetWriteBufferDsc);

   switch (tkptr->StreamTypeFlag)
   {
      case 'b' :

         /* binary - random 8 bit octets */
         sys$gettim (&RandomNumber);
         while (sptr < zptr)
         {
            /* cheap (no subroutine call) MTH$RANDOM() */
            RandomNumber = RandomNumber * 69069 + 1;
            cptr = (unsigned char*)&RandomNumber;
            for (cnt = sizeof(RandomNumber); cnt && sptr < zptr; cnt--)
               *sptr++ = *cptr++;
         }
         break;

      case 'o' :

         /* octets - continuously cycle 0x00..0xff */
         octet = (unsigned char)tkptr->StreamOctetBuffer;
         while (sptr < zptr) *sptr++ = (char)octet++;
         tkptr->StreamOctetBuffer = (int)octet;
         break;

      case 'q' :

         /* a file - driven by $QIOs - is the lowest cost content generator */
         FileBegin (rqptr, &ResponseStream, &RequestEnd, NULL,
                    "SYS$SHARE:HYPERSORT.EXE", "application/binary");
         return;

      case 't' :

         /* text - repeated lines of 7 bit characters */
         while (sptr < zptr)
         {
            for (cnt = ('z'-80+1); cnt <= 'z'; cnt++) *sptr++ = (char)cnt;
            *sptr++ = '\n';
            /* only complete lines of 80 characters */
            if (sptr + 81 >= zptr) zptr = sptr;
         }
         break;

      default :

         /* stream of 8 bit printables */
         sys$gettim (&RandomNumber);
         while (sptr < zptr)
         {
            /* cheap (no subroutine call) MTH$RANDOM() */
            RandomNumber = RandomNumber * 69069 + 1;
            cptr = (unsigned char*)&RandomNumber;
            for (cnt = sizeof(RandomNumber); cnt && sptr < zptr; cnt--)
               if (isprint(*cptr) || *cptr == '\n')
                  *sptr++ = *cptr++;
               else
                  cptr++;
         }
   }

   if (tkptr->StreamBytesMax != -1)
   {
      /* not unlimited stream */
      bytes = tkptr->StreamBytesMax;
      if (bytes < sptr - aptr) sptr = aptr + bytes;
      tkptr->StreamBytesMax -= sptr - aptr;
   }

   NetWrite (rqptr, &ResponseStream, aptr, sptr - aptr);
}

/*****************************************************************************/
/*
After the mapping the path, etc., parse it again (in case of error,
RequestScript() ignores errors) and return the VMS file name as a plain text
document.  This function merely translates any logicals, etc., and reports the
resulting name, it does not demonstrate the directory or file actually exists. 
The call is set up in RequestScript().
*/ 

ResponseWhere
(
REQUEST_STRUCT *rqptr,
char *MappedFile
)
{
   int  status;

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE, "ResponseWhere()");

   OdsParse (&rqptr->ParseOds,
             MappedFile, 0, NULL, 0,
             NAM$M_SYNCHK, NULL, rqptr);

   if (VMSok (status = rqptr->ParseOds.Fab.fab$l_sts))
   {
      if (VMSnok (status = OdsParseTerminate (&rqptr->ParseOds)))
      {
         ErrorNoticed (rqptr, status, NULL, FI_LI);
         RequestEnd (rqptr);
         return;
      }
      rqptr->rqResponse.PreExpired = true;
      ResponseHeader200 (rqptr, "text/plain", NULL);
      /* queue a network write to the client, AST to end processing */
      NetWrite (rqptr, &RequestEnd,
                rqptr->ParseOds.ExpFileName, rqptr->ParseOds.ExpFileNameLength);
      return;
   }
   else
   {
      rqptr->rqResponse.ErrorTextPtr = rqptr->rqHeader.PathInfoPtr;
      ErrorVmsStatus (rqptr, status, FI_LI);
      RequestEnd (rqptr);
      return;
   }
}

/*****************************************************************************/
/*
Match any request match conditionals to any entity present.  Generate a 412
HTTP response (precondition failed) and return false to halt continued request
processing if the conditional(s) requires, otherwise return true to continue
processing the request.
*/ 

BOOL ResponseEntityMatch
(
REQUEST_STRUCT *rqptr,
char *EntityTag
)
{
   BOOL  DoesMatch;
   char  ch;
   char  *cptr, *sptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE, "ResponseEntityMatch()");

   if (rqptr->rqHeader.IfMatchPtr)
   {
      /***********************/
      /* if match entity tag */
      /***********************/

      if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
         WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE,
                    "if-match !&Z !&Z",
                    rqptr->rqHeader.IfMatchPtr,
                    EntityTag && *EntityTag ? EntityTag : "(none)");

      if (!(EntityTag && *EntityTag))
         DoesMatch = false;
      else
      if (rqptr->rqHeader.IfMatchPtr[0] == '*')
         DoesMatch = true;
      else
      {
         DoesMatch = false;
         cptr = rqptr->rqHeader.IfMatchPtr;
         while (*cptr)
         {
            ch = ',';
            while (*cptr && *cptr == ' ') cptr++;
            if (*cptr == '\"') ch = *cptr++;
            for (sptr = cptr; *sptr && *sptr != ch; sptr++);
            ch = *sptr;
            *sptr = '\0';
            DoesMatch = !strcmp (cptr, EntityTag);
            if (WATCHING (rqptr, WATCH_RESPONSE))
               WatchThis (WATCHITM(rqptr), WATCH_RESPONSE,
                          "IF match !AZ !AZ !&B",
                          EntityTag, cptr, DoesMatch);
            *(cptr = sptr) = ch;
            if (DoesMatch) break;
            if (*cptr == '\"') cptr++;
            if (*cptr == ',') cptr++;
         }
      }

      if (!DoesMatch)
      {
         /* precondition failed */
         if (rqptr->WebDavTaskPtr)
            DavWebResponse (rqptr, 412, 0, "If-Match:", FI_LI);
         else
            ResponseHeader (rqptr, 412, NULL, 0, NULL, NULL);
         return (false);
      }
   }

   if (rqptr->rqHeader.IfNoneMatchPtr)
   {
      /****************************/
      /* if none-match entity tag */
      /****************************/

      if (WATCHMOD (rqptr, WATCH_MOD_RESPONSE))
         WatchThis (WATCHITM(rqptr), WATCH_MOD_RESPONSE,
                    "if-none-match !&Z !&Z",
                    rqptr->rqHeader.IfNoneMatchPtr,
                    EntityTag && *EntityTag ? EntityTag : "(none)");

      DoesMatch = false;
      if (!EntityTag || !*EntityTag)
         DoesMatch = false;
      else
      if (rqptr->rqHeader.IfNoneMatchPtr[0] == '*')
         DoesMatch = true;
      else
      {
         cptr = rqptr->rqHeader.IfNoneMatchPtr;
         while (*cptr)
         {
            while (*cptr && *cptr != '\"') cptr++;
            if (*cptr) cptr++;
            for (sptr = cptr; *sptr && *sptr != '\"'; sptr++);
            if (*sptr)
            {
               *sptr = '\0';
               DoesMatch = !strcmp (cptr, EntityTag);
               if (WATCHING (rqptr, WATCH_RESPONSE))
                  WatchThis (WATCHITM(rqptr), WATCH_RESPONSE,
                             "IF none-match !AZ !AZ !&B",
                             EntityTag, cptr, DoesMatch);
               *sptr = '\"';
               if (DoesMatch) break; 
               cptr = sptr + 1;
            } 
         }
      }

      if (DoesMatch &&
          rqptr->rqHeader.Method != HTTP_METHOD_GET &&
          rqptr->rqHeader.Method != HTTP_METHOD_HEAD)
      {
         /* precondition failed */
         if (rqptr->WebDavTaskPtr)
            DavWebResponse (rqptr, 412, 0, "If-None-Match:", FI_LI);
         else
            ResponseHeader (rqptr, 412, NULL, 0, NULL, NULL);
         return (false);
      }
   }

   return (true);
}

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

