/*****************************************************************************/
/*
                                 gSOAPrte.c

A WASD Run Time Environment for executing gSOAP applications built as shareable
images.  For convenience, gSOAPrte uses the Apache apache_gsoap.h header file
implementation to create a shareable image activation procedure for the SOAP
application.  The VMS gSOAP Apache build procedures are used to create the
shareable SOAP application, which can then be deployed directly under the WASD
RTE as it would under VMS Apache.  (Actually, the same image can be used under
either!)  Just place the executable into the application's web-space.

Any individual shareable image SOAP application should be able to $EXIT at any
time and have the RTE elegantly run-down.  This might be used to limit the
number of requests any particular SOAP application or RTE handles.  Of course
if any one application exits all cached applications are also gone and will
require reactivation at the next request for each.

One million requests (500k of CALC.C and 500k of ECHO.C) have been made against
a single gSOAPrte process on the test-bench without failure or virtual memory /
working set increase.

RTE activation of the SOAP application can be WATCH [x]script.


CONFIGURATION
-------------
Activation of SOAP applications is just a matter of mapping the RTE into the
application web-space.  For example, if SOAP applications are to be accessed
via the path /soap-bin/ then the following mapping rule would activate .EXE
image file names in the GSOAP$ROOT:[BIN] directory.

  # WASD_CONFIG_MAP
  exec+ /soap-bin/* ($cgi_exe:gsoaprte.exe)/gsoap$root/bin/* map=once

Environment variable (symbol or logical name) GSOAPRTE_APP_MAX can be used to
specify the maximum number of shared image applications cached before the RTE
exits (default is 32).  Variable GSOAPRTE_USAGE_MAX can be used to set a limit
on the total number of requests processed by the RTE before it exits (default
is unlimited).


BUILD DETAILS
-------------
See BUILD_GSOAPRTE.COM procedure.


COPYRIGHT
---------
Copyright (C) 2010-2013 Mark G.Daniel
This program comes with ABSOLUTELY NO WARRANTY.
This is free software, and you are welcome to redistribute it under the
conditions of the GNU GENERAL PUBLIC LICENSE, version 3, or any later version.
http://www.gnu.org/licenses/gpl.txt


VERSION HISTORY (update SOFTWAREVN as well!)
---------------
02-JUN-2013  MGD  v1.0.2, bugfix; different interface versions is now fatal
02-APR-2013  MGD  v1.0.1, bugfix; callout for explicit stream mode
20-MAR-2010  MGD  v1.0.0, initial
*/
/*****************************************************************************/

/* minimum VMS V7.3 */
#undef __VMS_VER
#define __VMS_VER 70300000
#undef __CRTL_VER
#define __CRTL_VER 70300000

#define SOFTWAREVN "1.0.2"
#define SOFTWARENM "GSOAPRTE"
#ifdef __ALPHA
#  define SOFTWAREID SOFTWARENM " AXP-" SOFTWAREVN
#endif
#ifdef __ia64
#  define SOFTWAREID SOFTWARENM " IA64-" SOFTWAREVN
#endif
#ifdef __VAX
#  define SOFTWAREID SOFTWARENM " VAX-" SOFTWAREVN
#endif

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

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

#include "stdsoap2.h"

#define  __NO_HTTPD_H__
#include "apache_gsoap.h"

#define BOOL int
#define TRUE 1
#define FALSE 0

#define FI_LI "GSOAPRTE", __LINE__

#ifndef __VAX
#   pragma nomember_alignment
#endif

#define VMSok(x) ((x) & STS$M_SUCCESS)
#define VMSnok(x) (!((x) & STS$M_SUCCESS))
 
/* mainly to allow easy use of the __unaligned directive */
#define ULONGPTR __unaligned unsigned long*
#define USHORTPTR __unaligned unsigned short*

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

BOOL  RequestMethodPOST,
      WatchScript;

int  RequestContentLength,
     UsageCount,
     UsageMax = 999999999;

unsigned long  CurrentBinTime [2];

char  *RequestConnectionPtr,
      *RequestContentLengthPtr,
      *RequestContentTypePtr,
      *RequestScriptFileNamePtr,
      *RequestServerSignaturePtr,
      *RequestSoapActionPtr;

char  SoftwareID [] = SOFTWAREID;

#define FILE_NAME_SIZE 256

/* used to cache shareable image data */
struct SoapHolderStruct
{
   int  ScriptFileNameLength,
        UsageCount;
   unsigned long  LastUsedBinTime [2];
   char  ScriptFileName [FILE_NAME_SIZE];
   struct soap  *SoapPtr;
   struct apache_soap_interface  *ApacheSoapIntPtr;
   struct SoapHolderStruct  *NextEntryPtr;
} *SoapHolder;

/* set a maximum on the number of SOAP applications that can be loaded */
#define SOAP_HOLDER_MAX 32
int  ApacheGsoapInterfaceVersion = APACHE_GSOAP_INTERFACE_VERSION,
     SoapHolderCount,
     SoapHolderMax = SOAP_HOLDER_MAX;

/***********************/
/* function prototypes */
/***********************/

int FindImageSymbolHandler ();
struct apache_soap_interface* LoadSoapApp (char*);
int lib$find_image_symbol (__unknown_params);
int sys$faol (__unknown_params);
int lib$get_foreign (__unknown_params);
int sys$gettim (__unknown_params);
BOOL NextRequest (BOOL);
BOOL ProcessRequest ();
void RteErrorReport (char*);
unsigned int RecvHandler (struct soap*, char*, unsigned int);
int SendHandler (struct soap*, const char*, unsigned int);
void CallOut (char*, int, char*, char*, ...);

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

main ()

{
   char  *cptr;

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

   if ((stdin = freopen ("HTTP$INPUT", "r", stdin, "ctx=bin")) == NULL)
      exit (vaxc$errno);

   if ((stdout = freopen ("SYS$OUTPUT", "w", stdout, "ctx=xplct")) == NULL)
      exit (vaxc$errno);

   if (cptr = getenv("GSOAPRTE_USAGE_MAX"))
      if (isdigit(*cptr))
         UsageMax = atoi(cptr);

   if (cptr = getenv("GSOAPRTE_APP_MAX"))
      if (isdigit(*cptr))
         SoapHolderMax = atoi(cptr);

   if (cptr = getenv("GSOAPRTE_INTERFACE_VERSION"))
      if (isdigit(*cptr))
         ApacheGsoapInterfaceVersion = atoi(cptr);

   while (NextRequest(ProcessRequest()));

   exit (SS$_NORMAL);
}

/*****************************************************************************/
/*
Return true to continue, false to run-down the RTE.  If there is an issue with
the SOAP interface of any single shareable image (e.g. no soap_serv vector)
then the entire RTE image must be run-down to clear the
(application-)problematic image (no other published way to remove shareable
image from the process).  This shouldn't happen in production (development
maybe) and so is not a major consideration.
*/

BOOL ProcessRequest ()

{
   static int  CallCount;

   BOOL  SoapAppIssue = FALSE;
   int  ScriptFileNameLength;
   char  *ScriptFileName;
   struct apache_soap_interface  *asiptr;
   struct soap  *soaptr;
   struct SoapHolderStruct  *shptr,
                            *TailSoapHolder = NULL;

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

   /* while() first call is always ignored */
   if (!CallCount++) return (TRUE);

   UsageCount++;

   if (!RequestMethodPOST)
   {
      RteErrorReport ("only POST allowed for SOAP");
      return (TRUE);
   }

   if (RequestContentTypePtr == NULL ||
       RequestContentLengthPtr == NULL ||
       RequestContentLength <= 0)
   {
      RteErrorReport ("insufficient request data");
      return (TRUE);
   }

   if ((ScriptFileName = RequestScriptFileNamePtr) == NULL)
      exit (SS$_BUGCHECK);
   ScriptFileNameLength = strlen(ScriptFileName);

   if (WatchScript)
      CallOut (FI_LI, NULL, "!UL <= !UL: !AZ !AZ",
               UsageCount, UsageMax, SoftwareID, ScriptFileName);

   sys$gettim (&CurrentBinTime);

   if (WatchScript)
   {
      int  HolderCount = 0;
      for (shptr = SoapHolder; shptr; shptr = shptr->NextEntryPtr)
         CallOut (FI_LI, NULL, "!ZL: !AZ !UL !%D",
                  ++HolderCount,
                  shptr->ScriptFileName,
                  shptr->UsageCount,
                  shptr->LastUsedBinTime);
   }

   /****************/
   /* search cache */
   /****************/

   for (shptr = SoapHolder; shptr; shptr = shptr->NextEntryPtr)
   {
      TailSoapHolder = shptr;
      if (ScriptFileNameLength != shptr->ScriptFileNameLength) continue;
      if (strcasecmp (ScriptFileName, shptr->ScriptFileName)) continue;
      /* hit */
      asiptr = shptr->ApacheSoapIntPtr;
      soaptr = shptr->SoapPtr;
      break;
   }

   if (shptr == NULL)
   {
      /* miss */
      asiptr = LoadSoapApp (ScriptFileName);
      if (!asiptr) return (FALSE);

      /* add to the list */
      SoapHolderCount++;
      shptr = calloc (1, sizeof(struct SoapHolderStruct));
      if (shptr == NULL) exit (vaxc$errno);
      if (SoapHolder == NULL)
         SoapHolder = shptr;
      else
         TailSoapHolder->NextEntryPtr = shptr;
      shptr->ScriptFileNameLength = ScriptFileNameLength;
      strcpy (shptr->ScriptFileName, ScriptFileName);
      shptr->ApacheSoapIntPtr = asiptr;
      soaptr = calloc (1, sizeof(struct soap));
      if (soaptr == NULL) exit (vaxc$errno);
      shptr->SoapPtr = soaptr;

      if (asiptr->interface_version != ApacheGsoapInterfaceVersion)
      {
         char  msg [256];
         sprintf (msg, "interface version RTE:%d script:%d",
                  ApacheGsoapInterfaceVersion,
                  asiptr->interface_version);
         RteErrorReport (msg);
         SoapAppIssue = TRUE;
         return (FALSE);
      }
   }

   /*********************/
   /* execute shareable */
   /*********************/

   shptr->UsageCount++;
   memcpy (&shptr->LastUsedBinTime, &CurrentBinTime, 8);

   RecvHandler (NULL, NULL, 0);
   SendHandler (NULL, NULL, 0);

   if (asiptr->fsoap_init != NULL)
   {
      if (WatchScript) CallOut (FI_LI, NULL, "soap_init()");
      (*asiptr->fsoap_init)(soaptr, NULL);

      /* the KEEPALIVE here should be enough but see SendHandler() */
      soap_set_omode (soaptr, SOAP_IO_BUFFER |
                              SOAP_IO_LENGTH |
                              SOAP_IO_KEEPALIVE);

      soaptr->frecv = &RecvHandler;
      soaptr->fsend = &SendHandler;

      if (asiptr->fsoap_serve != NULL)
      {
         if (WatchScript) CallOut (FI_LI, NULL, "soap_serve()");
         (*asiptr->fsoap_serve)(soaptr, NULL);
      }
      else
      {
         RteErrorReport ("no \'soap_serve\' entry point");
         SoapAppIssue = TRUE;
      }

      if (asiptr->fsoap_destroy != NULL)
      {
         if (WatchScript) CallOut (FI_LI, NULL, "soap_destroy()");
         (*asiptr->fsoap_destroy)(soaptr, NULL);
      }

      if (asiptr->fsoap_end != NULL)
      {
         if (WatchScript) CallOut (FI_LI, NULL, "soap_end()");
         (*asiptr->fsoap_end)(soaptr, NULL);
      }
      else
      {
         RteErrorReport ("no \'soap_end\' entry point");
         SoapAppIssue = TRUE;
      }

      if (asiptr->fsoap_done != NULL)
      {
         if (WatchScript) CallOut (FI_LI, NULL, "soap_done()");
         (*asiptr->fsoap_done)(soaptr, NULL);
      }
      else
      {
         RteErrorReport ("no \'soap_done\' entry point");
         SoapAppIssue = TRUE;
      }
   }
   else
   {
      RteErrorReport ("no \'soap_init\' entry point");
      SoapAppIssue = TRUE;
   }

   /* now run the RTE (and application(s)) down if excessive */
   if (UsageCount >= UsageMax) return (FALSE);
   if (SoapHolderCount > SoapHolderMax) return (FALSE);

   return (!SoapAppIssue);
}

/*****************************************************************************/
/*
Load the SOAP application shareable image (script file name) and find the
APACHE_INIT_SOAP_INTERFACE procedure (function) to activate.  If successful
allocate an Apache interface structure, execute the interface procedure to
populate it, then return a pointer to the allocated strucure.  If unsuccessful
return a NULL pointer.
*/

struct apache_soap_interface* LoadSoapApp (char *ScriptFileName)

{
   static $DESCRIPTOR (InitSoapInterfaceDsc, "apache_init_soap_interface");

   int  status,
        MajorVersion,
        MinorVersion;
   char  *cptr, *sptr, *zptr;
   char  FileName [FILE_NAME_SIZE],
         ImageName [FILE_NAME_SIZE],
         StatusMsg [256];
   struct apache_soap_interface  *asiptr;
   void (*InitSoapInterface)(struct apache_soap_interface*);
   $DESCRIPTOR (FileNameDsc, FileName);
   $DESCRIPTOR (ImageNameDsc, ImageName);

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

   cptr = ScriptFileName;

   /* device and directory */
   zptr = (sptr = ImageName) + sizeof(ImageName)-1;
   while (*cptr && *cptr != ']' && sptr < zptr) *sptr++ = *cptr++;
   if (cptr[1] == '[')
   {
      if (sptr < zptr) *sptr++ = *cptr++;
      while (*cptr && *cptr != ']' && sptr < zptr) *sptr++ = *cptr++;
   }
   if (*cptr && sptr < zptr) *sptr++ = *cptr++;
   ImageNameDsc.dsc$a_pointer = sptr;

   /* file name (without type) */
   zptr = (sptr = FileName) + sizeof(FileName)-1;
   while (*cptr && *cptr != '.' && sptr < zptr) *sptr++ = *cptr++;
   if (sptr >= zptr)
   {
      RteErrorReport ("string overflow");
      return (NULL);
   }
   *sptr = '\0';

   FileNameDsc.dsc$w_length = sptr - FileName;

   /* append the file type to the device and directory */
   sptr = ImageNameDsc.dsc$a_pointer;
   zptr = ImageName + sizeof(ImageName)-1;
   while (*cptr && *cptr != ';' && sptr < zptr) *sptr++ = *cptr++;
   if (sptr >= zptr)
   {
      RteErrorReport ("string overflow");
      return (NULL);
   }
   *sptr = '\0';

   ImageNameDsc.dsc$a_pointer = ImageName;
   ImageNameDsc.dsc$w_length = sptr - ImageName;

   lib$establish (FindImageSymbolHandler);

   status = lib$find_image_symbol (&FileNameDsc, &InitSoapInterfaceDsc,
                                   &InitSoapInterface, &ImageNameDsc);
   if (WatchScript)
      CallOut (FI_LI, NULL, "lib$find_image_symbol() !AZ !AZ %X!8XL",
               ImageName, FileName, status);

   lib$revert ();

   if (VMSnok (status))
   {
      if (status == LIB$_KEYNOTFOU)
         RteErrorReport ("\'APACHE_INIT_SOAP_INTERFACE\' not found");
      else
      {
         sprintf (StatusMsg, "status %%X%08.08X", status);
         RteErrorReport (StatusMsg);
      }
      return (NULL);
   }
   asiptr = calloc (1, sizeof(struct apache_soap_interface));
   if (asiptr == NULL) exit (vaxc$errno);

   (*InitSoapInterface)(asiptr);

   return (asiptr);
}

/*****************************************************************************/
/*
Just continue, to report an error if the image couldn't be activated or the
required symbol not found.
*/

int FindImageSymbolHandler ()

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

   return (SS$_CONTINUE);
}

/*****************************************************************************/
/*
gSOAP gets all request data using this function.  Supply some basic header
fields (captured by NextRequest()) and then the request body.
*/

unsigned int RecvHandler
(
struct soap *soaptr,
char *bufptr,
unsigned int bufsiz
)
{
   static BOOL  SupplyHeader = TRUE;

   int  rlen;
   char  *cptr, *czptr, *sptr;

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

   if (bufptr == NULL)
   {
      /* initialisation */
      SupplyHeader = TRUE;
      return (SOAP_OK);
   }

   if (SupplyHeader)
   {
      if (RequestContentTypePtr != NULL)
         soaptr->fparsehdr (soaptr, "Content-Type", RequestContentTypePtr);
      if (RequestContentLengthPtr != NULL)
         soaptr->fparsehdr (soaptr, "Content-Length", RequestContentLengthPtr);
      if (RequestSoapActionPtr != NULL)
         soaptr->fparsehdr (soaptr, "SOAPAction", RequestSoapActionPtr);
      SupplyHeader = FALSE;
   }

   rlen = fread (bufptr, 1, bufsiz, stdin);

   return (rlen);
}

/*****************************************************************************/
/*
gSOAP sends response output to the client via this function.  This works-around
an apparent issue with VMS gSOAP 2.7.9 not correctly handling keep-alive in
non-networked contexts.  Connection persistence is valuable enough to go to
this trouble.  Just suppress the "Connection: close" header and let the WASD
server itself do its thing.
*/

int SendHandler
(
struct soap *soaptr,
const char *bufptr,
unsigned int buflen
)
{
   static BOOL  CheckConnection = TRUE;

   char  *cptr, *czptr, *sptr;

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

   if (bufptr == NULL)
   {
      /* initialisation */
      CheckConnection = TRUE;
      return (SOAP_OK);
   }

   if (CheckConnection)
      if (RequestConnectionPtr)
         if (strstr (RequestConnectionPtr, "keep-alive") == NULL)
            CheckConnection = FALSE;

   if (CheckConnection)
   {
      czptr = (cptr = (char*)bufptr) + buflen;
      while (cptr < czptr)
      {
         sptr = cptr;
         while (cptr < czptr && *(USHORTPTR)cptr != '\r\n') cptr++;
         if (cptr >= czptr) break;
         cptr += 2;
         if (!strncasecmp (sptr, "Connection:", 11))
         {
            /* suppress the connection field - leave it up to the server */
            fwrite (bufptr, sptr-bufptr, 1, stdout);
            fwrite ("Connection: keep-alive\r\n", 24, 1, stdout);
            bufptr = cptr;
            buflen = czptr - cptr;
            CheckConnection = FALSE;
            break;
         }
         if (*(USHORTPTR)cptr == '\r\n')
         {
            /* end of response header */
            CheckConnection = FALSE;
            break;
         }
      }
   }

   if (buflen) fwrite (bufptr, buflen, 1, stdout);

   return (SOAP_OK);
}

/*****************************************************************************/
/*
Looks like the WASD error status reports (no worse than mod_apache anyway :-)
*/

void RteErrorReport (char *msg)

{
   char  *sptr;

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

   if (WatchScript) CallOut (FI_LI, NULL, "!AZ", msg);

   fprintf (stdout,
"Status: 502\r\n\
Content-Type: text/html\r\n\
\r\n\
<HTML>\n\
<HEAD>\n\
<TITLE>SOAP Handler</TITLE>\n\
</HEAD>\n\
<BODY>\n\
<FONT SIZE=\"+1\">\n\
<B>SOAP Handler Error</B> &nbsp;-&nbsp; %s\n\
</FONT>\n",
            msg);

   if (RequestServerSignaturePtr)
      fprintf (stdout,
"<P><HR WIDTH=\"85%%\" ALIGN=\"left\" SIZE=\"2\" NOSHADE>\n\
%s\n",
               RequestServerSignaturePtr);

   fputs ("</BODY>\n</HTML>\n", stdout);
}

/*****************************************************************************/
/*
If a previous request has been processed then output the CGIplus end-of-stream
sentinal on behalf of that request.  If the 'GetNext' parameter indicates that
it shouldn't then just return.  Otherwise, reset each of the previous request
header field required for gSOAP processing.  Wait for the next (or just begin
at the first) request's CGI variable stream.  Capture gSOAP required request
header fields (from the CGI variables) and return.
*/

BOOL NextRequest (BOOL GetNext)

{
#  ifndef CGIVAR_STRUCT_SIZE
#     define CGIVAR_STRUCT_SIZE 8192
#  endif
#  ifndef CGIVAR_NONE
#     define CGIVAR_NONE NULL
#  endif
#  define SOUS sizeof(unsigned short)

   static int  CgiPlusCheck,
               CalloutDone,
               WwwPrefix;
   static char  *CgiPlusEof = NULL;
   static char  StructBuffer [CGIVAR_STRUCT_SIZE];
   static FILE  *CgiPlusIn;

   int  ServerSoftware = FALSE;
   int  len;
   char  *bptr, *cptr, *sptr;

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

   /* detect the CGIplus environment (once) */
   if (!CgiPlusCheck)
   {
      CgiPlusCheck = 1;
      if ((CgiPlusEof = getenv ("CGIPLUSEOF")) == NULL) return (TRUE);
   }

   /* if vanilla CGI then allow just one invocation */
   if (CgiPlusEof == NULL) return (FALSE);

   /* the CGIPLUSIN stream will be left open */
   if (CgiPlusIn == NULL)
      if ((CgiPlusIn = fopen (getenv("CGIPLUSIN"), "r")) == NULL)
         exit (vaxc$errno);

   if (StructBuffer[0])
   {
      /****************/
      /* end previous */
      /****************/

      fflush (stdout);
      fputs (CgiPlusEof, stdout);
      fflush (stdout);

      /*************/
      /* get next? */
      /*************/

      if (!GetNext) return (FALSE);

      RequestConnectionPtr =
         RequestContentLengthPtr =
         RequestContentTypePtr =
         RequestScriptFileNamePtr =
         RequestServerSignaturePtr =
         RequestSoapActionPtr = NULL;
      RequestContentLength = -1;
      RequestMethodPOST = WatchScript = FALSE;
   }

   /*************************/
   /* get CGIplus variables */
   /*************************/

   /* get the starting record (the essentially discardable one) */
   for (;;)
   {
      cptr = fgets (StructBuffer, sizeof(StructBuffer), CgiPlusIn);
      if (cptr == NULL) exit (vaxc$errno);
      /* if the starting sentinal is detected then break */
      if (*(USHORTPTR)cptr == '!\0' ||
          *(USHORTPTR)cptr == '!\n' ||
          (*(USHORTPTR)cptr == '!!' && isdigit(*(cptr+2)))) break;
   }

   if (*(USHORTPTR)cptr == '!!')
   {
      /********************/
      /* CGIplus 'struct' */
      /********************/

      /* get the size of the binary structure */
      len = atoi(cptr+2);
      if (len <= 0 || len > sizeof(StructBuffer))
         exit (SS$_BUGCHECK);

      if (!fread (StructBuffer, 1, len, CgiPlusIn))
         exit (vaxc$errno);
   }
   else
   {
      /*********************/
      /* CGIplus 'records' */
      /*********************/

      /* reconstructs the original 'struct'ure from the records */
      sptr = (bptr = StructBuffer) + sizeof(StructBuffer);
      while (fgets (bptr+SOUS, sptr-(bptr+SOUS), CgiPlusIn) != NULL)
      {
         /* first empty record (line) terminates variables */
         if (bptr[SOUS] == '\n') break;
         /* note the location of the length word */
         cptr = bptr;
         for (bptr += SOUS; *bptr && *bptr != '\n'; bptr++);
         if (*bptr != '\n') exit (SS$_BUGCHECK);
         *bptr++ = '\0';
         if (bptr >= sptr) exit (SS$_BUGCHECK);
         /* update the length word */
         *(USHORTPTR)cptr = bptr - (cptr + SOUS);
      }
      if (bptr >= sptr) exit (SS$_BUGCHECK);
      /* terminate with a zero-length entry */
      *(USHORTPTR)bptr = 0;
      len = (bptr + SOUS) - StructBuffer;
   }

   if (!CalloutDone)
   {
      /*****************/
      /* 'struct' mode */
      /*****************/

      /* provide the CGI callout to set CGIplus into 'struct' mode */
      fflush (stdout);
      fputs (getenv("CGIPLUSESC"), stdout);
      fflush (stdout);
      /* the leading '!' indicates we're not going to read the response */
      fputs ("!CGIPLUS: struct", stdout);
      fflush (stdout);
      fputs (getenv("CGIPLUSEOT"), stdout);
      fflush (stdout);
      /* don't need to do this again (the '!!' tells us what mode) */
      CalloutDone = 1;
   }

   /***********/
   /* capture */
   /***********/

   sptr = StructBuffer + SOUS;
   if (*(ULONGPTR)sptr == 'WWW_') WwwPrefix = 1;

   for (bptr = StructBuffer; len = *(USHORTPTR)bptr; bptr += len)
   {
      cptr = (bptr += SOUS);
      if (WwwPrefix) cptr += 4;
      if (RequestContentLengthPtr == NULL &&
          !strncmp (cptr, "CONTENT_LENGTH=" , 15))
      {
         RequestContentLengthPtr = cptr + 15;
         RequestContentLength = atoi(RequestContentLengthPtr);
      }
      else
      if (RequestContentTypePtr == NULL &&
          !strncmp (cptr, "CONTENT_TYPE=" , 13))
         RequestContentTypePtr = cptr + 13;
      else
      if (RequestConnectionPtr == NULL &&
          !strncmp (cptr, "HTTP_CONNECTION=" , 16))
         RequestConnectionPtr = cptr + 16;
      else
      if (RequestSoapActionPtr == NULL &&
          !strncmp (cptr, "HTTP_SOAPACTION=" , 16))
         RequestSoapActionPtr = cptr + 16;
      else
      if (RequestScriptFileNamePtr == NULL &&
          !strncmp (cptr, "SCRIPT_FILENAME=" , 16))
         RequestScriptFileNamePtr = cptr + 16;
      else
      if (RequestServerSignaturePtr == NULL &&
          !strncmp (cptr, "SERVER_SIGNATURE=" , 17))
         RequestServerSignaturePtr = cptr + 17;
      else
      if (!RequestMethodPOST &&
          !strncmp (cptr, "REQUEST_METHOD=" , 15))
         RequestMethodPOST = (strcmp(cptr+15,"POST") == 0);
      else
      if (!ServerSoftware &&
          !strncmp (cptr, "SERVER_SOFTWARE=" , 16))
         ServerSoftware = TRUE;
      else
      if (!WatchScript &&
          !strncmp (cptr, "WATCH_SCRIPT=" , 13))
         WatchScript = TRUE;
   }

   /* things are seriously amiss if this doesn't exist */
   if (!ServerSoftware) exit (SS$_BUGCHECK);

   if (WatchScript)
   {
      CallOut (FI_LI, NULL, "CONNECTION=!AZ",
               RequestConnectionPtr ? RequestConnectionPtr : "(null)");
      CallOut (FI_LI, NULL, "CONTENT_LENGTH=!AZ",
               RequestContentLengthPtr ? RequestContentLengthPtr : "(null)");
      CallOut (FI_LI, NULL, "CONTENT_TYPE=!AZ",
               RequestContentTypePtr ? RequestContentTypePtr : "(null)");
      CallOut (FI_LI, NULL, "SCRIPT_FILENAME=!AZ",
               RequestScriptFileNamePtr ? RequestScriptFileNamePtr : "(null)");
      CallOut (FI_LI, NULL, "SOAP_ACTION=!AZ",
               RequestSoapActionPtr ? RequestSoapActionPtr : "(null)");
   }

   /* generate a callout to ensure output is treated stream not record mode */
   fflush (stdout);
   fputs (getenv("CGIPLUSESC"), stdout);
   fflush (stdout);
   /* the leading '!' indicates we're not going to read the response */
   fputs ("!SCRIPT-CONTROL: X-stream-mode", stdout);
   fflush (stdout);
   fputs (getenv("CGIPLUSEOT"), stdout);
   fflush (stdout);

   return (TRUE);

#  undef SOUS
}

/*****************************************************************************/
/*
Generate a server call-out (e.g. WATCH: or NOTICED:).
*/

void CallOut
(
char *SourceModule,
int SourceLine,
char *CallOutType,
char *FaoString,
...
)
{
   static char  *CgiPlusEsc = NULL,
                *CgiPlusEot = NULL;

   int  argcnt, status;
   char  *cptr, *sptr, *zptr;
   char  Buffer [16384],
         FaoBuffer [256],
         WhereAt [64];
   unsigned long  *vecptr;
   $DESCRIPTOR (BufferDsc, Buffer);
   $DESCRIPTOR (FaoBufferDsc, FaoBuffer);
   unsigned long  FaoVector [32];
   va_list  argptr;

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

   va_count (argcnt);

   sprintf (WhereAt, "%s:%d", SourceModule, SourceLine);

   vecptr = FaoVector;
   if (CallOutType == NULL) *vecptr++ = (unsigned long)WhereAt;
   va_start (argptr, FaoString);
   for (argcnt -= 1; argcnt; argcnt--)
      *vecptr++ = (unsigned long)va_arg (argptr, unsigned long);
   va_end (argptr);

   zptr = (sptr = FaoBuffer) + sizeof(FaoBuffer)-3;
   if (CallOutType == NULL) for (cptr = "|!12AZ|"; *cptr; *sptr++ = *cptr++);
   for (cptr = FaoString; *cptr && sptr < zptr; *sptr++ = *cptr++);
   *sptr++ = '\0';
   FaoBufferDsc.dsc$a_pointer = FaoBuffer;
   FaoBufferDsc.dsc$w_length = sptr - FaoBuffer;
   status = sys$faol (&FaoBufferDsc, 0, &BufferDsc,
                      (ULONGPTR)&FaoVector);
   if (VMSnok(status)) sprintf (Buffer, "$FAO() %%X%08.08X", status);

   if (!CgiPlusEsc) CgiPlusEsc = getenv("CGIPLUSESC");
   if (!CgiPlusEot) CgiPlusEot = getenv("CGIPLUSEOT");

   fflush (stdout);
   fputs (CgiPlusEsc, stdout);
   fflush (stdout);
   /* the leading '!' indicates we're not going to read the response */
   fprintf (stdout, "!%s: %s", CallOutType ? CallOutType : "WATCH", Buffer);
   fflush (stdout);
   fputs (CgiPlusEot, stdout);
   fflush (stdout);
}

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