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

  # HTTPD$CONFIG
  [CharsetConvert]
  iso-8859-1_lower iso-8859-1 Multi_to_Lower
  iso-8859-1_upper iso-8859-1 Multi_to_Upper

  # HTTPD$MAP
  set /tolower/* charset=iso-8859-1_lower
  map /tolower/* /*
  set /toupper/* charset=iso-8859-1_upper
  map /toupper/* /*



VERSION HISTORY
---------------
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_V6
#undef _VMS_V6_SOURCE
#define _VMS_V6_SOURCE
#undef __VMS_VER
#define __VMS_VER 60000000
#undef __CRTL_VER
#define __CRTL_VER 60000000
#endif

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

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

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

#define WASD_MODULE "RESPONSE"

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

int  ResponseCharsetCount;

char  HttpProtocol [] = "HTTP/1.0";

LIST_HEAD  ResponseCharsetList;

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

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

extern BOOL  AuthPromiscuous;

extern int  NetReadBufferSize,
            OutputBufferSize;

extern char  SoftwareID[];

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

/*****************************************************************************/
/*
Generate a VmGetHeap()ed string containing an HTTP response header, pointed to
by 'rqptr->rqResponse.HeaderPtr' with 'rqptr->rqResponse.HeaderLength' also set. Will
generate success as well as error response headers, incorporating required
authorization challenges if a 401 status.

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 the current GMT time.

'OtherHeaderPtr' is a catch-all parameter.  This string is directly included as
part of the HTTP header and so should contain correct carriage control, e.g.
"Keep-Alive:\r\n".

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,
int ContentLength,
unsigned long *ModifiedBinTimePtr,
char *OtherHeaderPtr
)
{
   static char  Header500 [] =
"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";

   static char  HeaderFao [] =
"!AZ !UL !AZ\r\n\
!&@\
!&@\
Server: !AZ\r\n\
Date: !AZ\r\n\
Accept-Ranges: bytes\r\n\
!&@\
!&@\
!&@\
!&@\
!&@\
!AZ\
!AZ\
\r\n";

   static $DESCRIPTOR (BufferDsc, "");

   int  status, idx;
   unsigned short  Length;
   unsigned long  FaoVector [32];
   unsigned long  *vecptr;
   char  *cptr, *sptr, *zptr;
   char  *AuthRealmBufferPtr,
         *CharsetPtr,
         *SemiColonPtr;
   char  ContentTypeString [128],
         ModifiedString [32],
         Buffer [8192];

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_RESPONSE))
      WatchThis (rqptr, FI_LI, WATCH_MOD_RESPONSE,
                 "ResponseHeader() !UL !&Z !SL !%D !&Z",
                 HttpStatusCode, ContentTypePtr, ContentLength,
                 ModifiedBinTimePtr ? ModifiedBinTimePtr : 0,
                 OtherHeaderPtr);

   rqptr->rqResponse.HeaderLength = 0;
   rqptr->rqResponse.HeaderPtr = NULL;

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

   if (rqptr->RedirectErrorStatusCode)
   {
      /********************************************/
      /* 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 (ContentTypePtr && strsame (ContentTypePtr, "text/", 5))
   {
      /*********************/
      /* text of some sort */
      /*********************/

      SemiColonPtr = NULL;
      zptr = (sptr = ContentTypeString) + sizeof(ContentTypeString);
      /* as we copy note where any "; charset=" begins */
      for (cptr = ContentTypePtr; *cptr && sptr < zptr; *sptr++ = *cptr++)
         if (*cptr == ';') SemiColonPtr = sptr;

      /* 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 (!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 (SemiColonPtr) sptr = SemiColonPtr;
         for (cptr = "; charset="; *cptr && sptr < zptr; *sptr++ = *cptr++);
         for (cptr = CharsetPtr; *cptr && sptr < zptr; *sptr++ = *cptr++);
      }

      if (sptr >= zptr)
      {
         ErrorNoticed (SS$_BUFFEROVF, "ResponseHeader()", FI_LI);
         rqptr->rqResponse.HeaderPtr = Header500;
         rqptr->rqResponse.HeaderLength = sizeof(Header500)-1;
         return;
      }
      *sptr = '\0';
      ContentTypePtr = ContentTypeString;
   }

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

   vecptr = FaoVector;

   *vecptr++ = HttpProtocol;
   *vecptr++ = rqptr->rqResponse.HttpStatus;
   *vecptr++ = HttpStatusCodeText(rqptr->rqResponse.HttpStatus);

   if (rqptr->rqResponse.HttpStatus == 401 ||
       rqptr->rqResponse.HttpStatus == 407)
   {
      /* requires authorization challenge */
      if (rqptr->rqAuth.BasicChallengePtr[0])
      {
         *vecptr++ = "!AZ\r\n";
         *vecptr++ = rqptr->rqAuth.BasicChallengePtr;
      }
      else
         *vecptr++ = "";
      if (rqptr->rqAuth.DigestChallengePtr[0])
      {
         *vecptr++ = "!AZ\r\n";
         *vecptr++ = rqptr->rqAuth.DigestChallengePtr;
      }
      else
         *vecptr++ = "";
   }
   else
   {
      *vecptr++ = "";
      *vecptr++ = "";
   }

   *vecptr++ = SoftwareID;
   *vecptr++ = rqptr->rqTime.GmDateTime;

   if (!ModifiedBinTimePtr)
      *vecptr++ = "";
   else
   {
      /* last modified */
      if (VMSnok (status =
          HttpGmTimeString (ModifiedString, ModifiedBinTimePtr)))
      {
         ErrorNoticed (status, "ResponseHeader()", FI_LI);
         rqptr->rqResponse.HeaderPtr = Header500;
         rqptr->rqResponse.HeaderLength = sizeof(Header500)-1;
         return;
      }
      *vecptr++ = "Last-Modified: !AZ\r\n";
      *vecptr++ = ModifiedString;
   }

   if (rqptr->rqResponse.PreExpired ||
       rqptr->rqPathSet.Expired)
   {
      /* "Cache-Control:" is an HTTP/1.1 directive for Mozilla compatibility */
      *vecptr++ = "Expires: !AZ\r\nCache-Control: no-cache\r\n";
      if (!ModifiedBinTimePtr)
         *vecptr++ = "Fri, 13 Jan 1978 14:00:00 GMT";
      else
         /* already generated immediately above */
         *vecptr++ = ModifiedString;
   }
   else
      *vecptr++ = "";

   if (ContentTypePtr)
   {
      *vecptr++ = "Content-Type: !AZ\r\n";
      *vecptr++ = ContentTypePtr;
      cptr = VmGetHeap (rqptr, strlen(ContentTypePtr)+1);
      strcpy (cptr, ContentTypePtr);
      rqptr->rqResponse.ContentTypePtr = cptr;
   }
   else
      *vecptr++ = "";

   if (ContentLength >= 0)
   {
      *vecptr++ = "Content-Length: !UL\r\n";
      *vecptr++ = ContentLength;
      rqptr->rqResponse.ContentLength = ContentLength;
   }
   else
      *vecptr++ = "";

   for (idx = 0; idx < RESPONSE_COOKIE_MAX; idx++)
   {
      if (!rqptr->rqResponse.CookiePtr[idx]) continue;
      *vecptr++ = "Set-Cookie: !AZ\r\n!&@";
      *vecptr++ = rqptr->rqResponse.CookiePtr[idx];
   }
   *vecptr++ = "";

   if (rqptr->rqPathSet.ResponseHeaderAddLength)
      *vecptr++ = rqptr->rqPathSet.ResponseHeaderAddPtr;
   else
      *vecptr++ = "";

   if (OtherHeaderPtr)
      *vecptr++ = OtherHeaderPtr;
   else
      *vecptr++ = "";

   BufferDsc.dsc$a_pointer = Buffer;
   BufferDsc.dsc$w_length = sizeof(Buffer)-1;

   status = WriteFaol (Buffer, sizeof(Buffer), &Length, HeaderFao, &FaoVector);
   if (VMSnok (status) || status == SS$_BUFFEROVF)
   {
      ErrorNoticed (status, "ResponseHeader()", FI_LI);
      rqptr->rqResponse.HeaderPtr = Header500;
      rqptr->rqResponse.HeaderLength = sizeof(Header500)-1;
      return;
   }
   Buffer[Length] = '\0';

   cptr = VmGetHeap (rqptr, Length+1);
   memcpy (cptr, Buffer, Length+1);
   rqptr->rqResponse.HeaderLength = Length;
   rqptr->rqResponse.HeaderPtr = cptr;

   if (Debug) fprintf (stdout, "|%s|\n", Buffer);
}

/*****************************************************************************/
/*
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 (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_RESPONSE))
      WatchThis (rqptr, FI_LI, WATCH_MOD_RESPONSE,
                 "ResponseHeaderChallenge()");

   /* without a realm for authentication convert it to forbidden */
   if ((rqptr->rqResponse.HttpStatus == 401 ||
        rqptr->rqResponse.HttpStatus == 407) &&
       (!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.BasicChallengePtr)
      rqptr->rqAuth.BasicChallengePtr = "";

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

/*****************************************************************************/
/*
Append a string onto a HTTP header located in HTTPd heap allocated memory. 
This header string must already exist (created by ResponseHeader200() or
equivalent).  The new string is appended to the current header, just before the
header terminating empty line.  Any string added must contain correct HTTP
header carriage control.
*/

ResponseHeaderAppend
(
REQUEST_STRUCT *rqptr,
char *StringPtr,
int StringLength
)
{
   char  *cptr,
         *HeaderPtr;
   int  HeaderLength;

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_RESPONSE))
      WatchThis (rqptr, FI_LI, WATCH_MOD_RESPONSE,
                 "ResponseHeaderAppend() !&Z", rqptr->rqResponse.HeaderPtr);

   if (!(HeaderPtr = rqptr->rqResponse.HeaderPtr)) return;

   HeaderLength = rqptr->rqResponse.HeaderLength;
   if (StringLength <= 0) StringLength = strlen(StringPtr);

   HeaderPtr = VmReallocHeap (rqptr, HeaderPtr,
                              HeaderLength+StringLength, FI_LI);
   /* point to just before the header terminating empty line */
   cptr = HeaderPtr + HeaderLength - 2;
   memcpy (cptr, StringPtr, StringLength);
   /* add the new header terminating empty line */
   cptr += StringLength;
   *cptr++ = '\r';
   *cptr++ = '\n';
   *cptr = '\0';

   rqptr->rqResponse.HeaderPtr = HeaderPtr;
   rqptr->rqResponse.HeaderLength = HeaderLength + StringLength;

   if (Debug)
      fprintf (stdout, "%d |%s|\n", rqptr->rqResponse.HeaderLength, HeaderPtr);
}

/*****************************************************************************/
/*
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 (NULL, FI_LI, 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);
      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  status;
   char  ch;
   char  *aptr, *cptr, *sptr;
   RESPONSE_CHARSET  *csptr;
   LIST_ENTRY  *leptr;

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_RESPONSE))
      WatchThis (rqptr, FI_LI, WATCH_MOD_RESPONSE,
                 "ResponseCharsetConvertBegin() !&Z !&Z",
                 CharsetPtr, rqptr->rqHeader.AcceptCharsetPtr);

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

   if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_RESPONSE_BODY))
      WatchThis (rqptr, FI_LI, 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 (*(unsigned short*)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_CATEGORY(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_CATEGORY(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_CATEGORY(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, strlen(sptr)+1);
         strcpy (CharsetPtr, sptr);
         *cptr = ch;
         return (CharsetPtr);
      }

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

   if (WATCHING(rqptr) && WATCH_CATEGORY(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 (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_RESPONSE))
      WatchThis (rqptr, FI_LI, 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 (SS$_IVBUFLEN, "ncs$convert()", 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 (status, "ncs$convert()", FI_LI);

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

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

   return (status);
}

/*****************************************************************************/
/*
Echo back to the client as a plain-text document the entire request header and
any body content.
*/ 

ResponseEcho (REQUEST_STRUCT *rqptr)

{
   int  status;

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_REQUEST))
      WatchThis (rqptr, FI_LI, WATCH_MOD_REQUEST, 
                 "ResponseEcho() !&F", &ResponseEcho);

   if (!rqptr->rqResponse.PreExpired)
   {
      /* detected that this is the setup call from RequestScript() */
      rqptr->rqResponse.PreExpired = true;
      /* pre-expired set also means this if() won't be executed again! */
      RESPONSE_HEADER_200_PLAIN (rqptr);
   }

   if (rqptr->rqHeader.RequestHeaderPtr)
   {
      /* AST from writing echo header, write response header */
      NetWrite (rqptr, &ResponseEchoBody,
                rqptr->rqHeader.RequestHeaderPtr,
                rqptr->rqHeader.RequestHeaderLength);
      return;
   }
}

/*****************************************************************************/
/*
Echo the request body chunk-by-chunk.
Called as an AST by the network write in ResponseEcho().
*/ 

ResponseEchoBody (REQUEST_STRUCT *rqptr)

{
   int  status;

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_REQUEST))
      WatchThis (rqptr, FI_LI, WATCH_MOD_REQUEST, 
                 "ResponseEchoBody() !&F", &ResponseEchoBody);

   if (!rqptr->rqBody.DataPtr)
   {
      /* first call */
      BodyReadBegin (rqptr, &ResponseEchoBody, NULL);
      return;
   }

   if (VMSnok (rqptr->rqBody.DataStatus))
   {
      /* error or end-of-file (body) */
      RequestEnd (rqptr);
      return;
   }

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

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

ResponseHiss (REQUEST_STRUCT *rqptr)

{
   char  *cptr, *zptr;

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_REQUEST))
      WatchThis (rqptr, FI_LI, WATCH_MOD_REQUEST, 
                 "ResponseHiss() !&F", &ResponseHiss);

   if (!rqptr->rqOutput.BufferPtr)
   {
      /* first call, initialize */
      rqptr->rqResponse.HttpStatus = 403;
      rqptr->rqResponse.HeaderSent = true;
      rqptr->rqOutput.BufferPtr = cptr = VmGetHeap (rqptr, NetReadBufferSize);
      zptr = cptr + NetReadBufferSize - sizeof(long);
      *(unsigned long*)cptr = rqptr->rqTime.Vms64bit[1];
      while (cptr < zptr)
      {
         *((unsigned long*)cptr+1) = *(unsigned long*)cptr * 1103515245 + 12345;
         if (!isalnum(*cptr))
         {
            *(unsigned long*)cptr = *((unsigned long*)cptr+1);
            continue;
         }
         cptr++;
      }
      *cptr++ = rqptr->rqOutput.BufferPtr[1];
      *cptr++ = rqptr->rqOutput.BufferPtr[2];
      *cptr++ = rqptr->rqOutput.BufferPtr[4];
      *cptr++ = rqptr->rqOutput.BufferPtr[8];
      /* before any real network write just fudge the status */
      rqptr->rqNet.WriteIOsb.Status = SS$_NORMAL;
   }

   if (VMSnok (rqptr->rqNet.WriteIOsb.Status) ||
       rqptr->BytesRawTx >= ADMIN_SCRIPT_HISS_MAX_BYTES)
   {
      RequestEnd (rqptr);
      return;
   }

   NetWriteRaw (rqptr, &ResponseHiss,
                rqptr->rqOutput.BufferPtr, NetReadBufferSize);
}

/*****************************************************************************/
/*
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 (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_REQUEST))
      WatchThis (rqptr, FI_LI, WATCH_MOD_REQUEST, "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 (status, "OdsParseTerminate()", FI_LI);
         RequestEnd (rqptr);
         return;
      }
      rqptr->rqResponse.PreExpired = true;
      RESPONSE_HEADER_200_PLAIN (rqptr);
      /* 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;
   }
}

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

