/*****************************************************************************/
#ifdef COMMENTS_WITH_COMMENTS
/*
                                  DCL.c

*************
** CAUTION **
*************

THIS MODULE IS TASK-ORIENTED, NOT REQUEST-ORIENTED.

That is, most of the functions take a pointer to DCL task rather than a pointer
to request as do other modules. The reason is simple. In this module the
more-permanent data-structures are those associated with the DCL script
processes, which persist for multiple requests. With the requests transient the
DCL script processes must be managed in their absence. Hence requests are
associated with DCL script processes not vice-versa.


OVERVIEW
--------
Provides multi-threaded, concurrent HTTPd script processes executing DCL.

This module never returns a valid status and ALWAYS calls the supplied next
task (AST) function.  This should check for a generated error message to
determine is there were any problems.

The DCL can either be in the form of a command, or a procedure or executable
image file specification. Both should not be supplied, but file specifications
have precedence. If a file specfication is supplied the module verifies its
existance, and if not qualified with an extension, looks for a procedure first
(".COM"), then an executable image (".EXE"), then through any user-defined
list of file types (extensions) and associated scripting executables (e.g.
".PL" associated with the verb "PERL"). Furthermore, the DCL can be executed
either standalone or as a CGI script (indicated by the presence of a script
name in the request data structure). If a CGI script, then the output stream
is parsed for header information, if not a script then the stream is just
checked for correct carriage control (terminated by a newline). CGI variables
are created for both standalone DCL and scripts, although some (e.g.
WWW_SCRIPT_NAME) will be empty, and meaningless, for standalone DCL. 

The AST-driven nature makes the code a little more difficult to follow, but 
creates a powerful, event-driven, multi-threaded server.  All of the 
necessary functions implementing this module are designed to be non-blocking. 

All of these functions are designed to be, and should be, called at AST 
delivery level, which means they cannot be interrupted at the same level (in 
this case USER mode), and so their actions are essentially atomic at that 
level, meaning no additional synchronization is required for such activities 
as thread disposal, etc.

The HTTPd can maintain a number of script processes limited only by its process 
quotas, memory is dynamically allocated and there are no fixed data structures 
related to script process management. 

The use of byte-streams (effectively "pipes") allows even DCL procedures to
output as HTTP servers, without the need for explicit network I/O. 

Four mailboxes are created for each script process' IPC:

  1.  A mailbox connected to its SYS$COMMAND.  This is used to pass DCL
      commands and/or other data to the script process.  It effectively allows
      the HTTPd to control the activities of the script process this way.

  2.  A mailbox connected to its SYS$OUTPUT.  This recieves records from
      the script process, if required appends HTTP-required carriage-control
      (single <LF>), then sends the record to the client via the network.
      This allows even DCL procedures to supply a correct output stream to
      the client (see next paragraph).

      If the first line from a script is an HTTP status line (e.g.
      "HTTP/1.0 200 ok") then HTTPD assumes the script will be supplying
      a complete HTTP data stream, including full header and required
      carriage control (single <LF> terminating each line).  If the first
      line is not a HTTP status line it assumes CGI script output compliance
      and also ensures each record (line) received has correct HTTP
      carriage-control.

      This stream also attempts to maintain compliance with CGI scripting.
      If the first line output by a script is not an HTTP status line it
      creates and sends one to the client before sending the first line.

  3.  A mailbox defined for the script process by the name HTTP$INPUT.
      This may be used to read the request data steam sent by the client.
      Note that from v4.2 this is also the SYS$INPUT <stdin> stream as well,
      which appears to be the more common CGI implementation. As of version
      4.3 the default behaviour is to supply only the request body to the
      script (CGI standard and the more common implmentation).  Defining the 
      environment variable HTTPD_DCL_FULL_REQUEST it is possible to revert
      to the previous behaviour of supplying the header then the body.
      (It's an easy enough modification for most scripts to skip the header by
      reading until the header-separating empty (blank) line is encountered.)

  4.  A mailbox defined by the name CGIPLUSIN.  This allows CGIplus scripts
      to read a stream of CGI variable information.  Each request begins with
      a comment line "!", which can be used for request start synchronisation
      and may always be discarded, and ends with an empty record (blank line),
      with a variable number of records in between.

The script script processes can use the basic CGI variables (VMS CERN-like) and 
behave very much like a CGI script.

That is, if a script wants to be CGI-compliant it provides as the first line a 
"Status:", "Content-type:" or a "Location:" then a blank line.   If the first 
line output by a script is a "Content-Type:" header line an HTTP "200" status 
line is prepended.  If the first line output by a script is a "Location:" 
redirection header line the redirection is processed to ensure CERN HTTPD/CGI 
behaviour.  An HTTP "302" status line is prepended if not a local redirection. 
If none of these, HTTPD creates a complete HTTP header comprising status line, 
"Content-Type: text/plain" and blank line (this is an extension of CERN HTTPD 
behaviour). 

If the first characters are "HTTP/1.0 ..." the script will be considered to be 
supplying the raw HTTP stream and record boundaries, carriage-control, etc., 
are of no further concern to the module.  This is the equivalent of a
"no-parse-header" script.  If CGI-compliant each record should represent a 
line of output.   That is lines should not be buffered together and sent as a 
block unless the script is supplying a raw HTTP data stream. 


CGI VARIABLES
-------------
See CGI.C module.


BUILD-RECORD OUTPUT MODE
------------------------ 
Generally the script's response header output would be issued as records.  A
record is defined as a 'line' of script output that is delimited by a newline
character ('\n', 0x0a), or a carriage-return then newline character ('\r\n',
0x0d 0x0a).  The CGI header processing code of CGI.C can also cope with
non-record header responses because the logical line is delimited by the
newline.  The script body can be issued in any way consistent with the response
MIME content-type and required record carriage control (which the server will
supply if required).

Generally compiled scripts output in record-mode unless explicitly programmed
to output in binary mode.  Some pre-built scripting environments are somewhat
poorly designed or ported to VMS and will provide all the output as single
character 'records'.  Horribly inefficient!!  This server still allows for such
environments by noting the first record.  If a single byte it switches to
'build-record' mode.   In 'build-record' mode each "real" record is assumed to
be any zero or more bytes delimited by a newline character.  A zero-byte record
is transmogrified into a single-byte, newline character record.  In this mode
the single byte I/Os are buffered until the newline is received (and appended
to the buffer) whereupon that built-up record is then processed as if received
as a single record.  (For more detail query Alex Ivanov about the vicicitudes
of GhostScript PostScript RTE programming. :^)


CGI-PLUS
--------
CGI plus lower latency, plus greater efficiency, plus less system impact!

CGIplus attempts to eliminate the overhead associated with creating the script
process and then executing the image of a CGI script.  It does this by allowing
the script process and associated image to continue executing in-between uses,
eliminating the startup overhead.  This both reduces the load on the system and
the request latency where one of these scripts is involved. In this sense these
advantages parallel those offered by commercial HTTP server-integration APIs,
such as Netscape NSAPI and Microsoft ISAPI.  The script interface is still
largely CGI, which means a new API does not need to be learned and that
existing CGI scripts are simple to modify.

The script must read the CGI variables from CGIPLUSIN.

They are supplied either as:

1)  A series of plain-text, records (lines).  The first contains a single "!",
used as a start sentinal.  A series of records then follows, containing the CGI
variable name, an equate symbol and then the variable value.  This format may
be easily parsed and as the value contains no encoded characters may be
directly used.  An empty record (blank line) indicates the end of the request
information.  (This is the default mode, though can be reverted to by a
"CGIPLUS: record" callout - see below.)

2)  Two records.  The first contains a leading sequence of "!!" followed by a
series of ASCII characters forming a number representing in plain-test the size
of the following binary record (e.g. "!!1563").  This binary record has the
structure described in the CGI.C module topic "CGIplus Variable Structure", and
must be parsed by the receiving application.  (This is by far the more
efficient mode and can be selected using a "CGIPLUS: struct" callout - see
below.)  Although the author had already developed a concept similar in
approach it was the independent suggestion and some initial performance
bench-marking by Jean-François Piéronne (jfp@altavista.net) that prompted it's
inclusion in the 7.2 release.

The request may be processed at that stage.

After processing the CGIplus script can loop, waiting to read the details of
the next request from CGIPLUSIN.  The first record read may ALWAYS be discarded
allowing a read to be used as a simple synchronization mechanism.

HTTP output (to the client) is written to SYS$OUTPUT (stdout). End of output
MUST be indicated by writing a special EOF string to the output stream. This is
a KLUDGE, and the least elegant part of CGIplus design, BUT it is also the
simplest implementation and should work in all but the most exceptional
circumstances. The special EOF string has been chosen to be most unlikely to
occur in normal output (a hopefully unique 224 bit sequence), but there is
still a very, very small chance! The CGIplus EOF string is obtained from the
logical name CGIPLUSEOF, defined in the script process's process table, using
the language's equivalent of F$TRNLNM(), SYS$TRNLNM(), or a getenv() call in
the C Language. This string will always contain less than 32 characters and
comprise only common, printable characters. It must be written at the
conclusion of a request's output to the output stream as a single record (line)
but may also contain a <CR><LF> or just <LF> trailing carriage-control (to
allow for programming language constraints). See examples in
HT_ROOT:[SRC.CGIPLUS]

HTTP input (raw request stream, header and any body) is still available to the
CGIplus script.

Multiple CGIplus scripts may be executing in script processes at any one time.
This includes multiple instances of any particular script.  It is the server's
task to track these, distributing appropriate requests to idle script processes,
monitoring those currently processing requests, creating new instances if and
when necessary, and deleting the least-used, idle CGIplus script processes when
configurable thresholds are reached.

A CGIplus script can be terminated by the server at any time (the script
process $FORCEX()ed then $DELPRC()ed) so resources should be largely quiescent
when not actually processing. CGIplus script processes may also be terminated
from the command line using STOP/ID=. The server administration menu provides a
simple mechansim to purge (stop) all CGIplus processes, allowing the server to
be flushed of all script processes. This can be useful if some new compilation
of a CGIplus script executable needs to made available.

CGIplus scripts are differentiated from "normal" CGI scripts in the mapping
rule configuration file using the "script+" and "exec+" directives.  Of course
it would be possible to design a script to simply modify it's behaviour so it
was possible to execute in both environments.  Simply detecting the presence
or absence of one of the "normal" CGI variables (i.e. DCL symbols,
e.g. WWW_PATH_INFO, WWW_CGI_GATEWAY_INTERFACE, etc.) would be sufficient
indication.

See examples in HT_ROOT:[SRC.CGIPLUS]

April 1998 Note:  It has been observed that under rare circumstances a
persistant script process script-serviced request can die unexpectedly.  This
has been isolated to the following scenario.  A request underway results in a
CGIplus script terminating and the script process exiting.  Any output in the
script's C RTL buffers is flushed during exit, including possibly the CGI
output EOF indicator, generating an I/O AST which is serviced indicating the
request is complete and the CGIplus script is ready for reuse.  In fact it
isn't because the process is running-down.  Before the script process
termination AST can be processed another AST containing a request for that same
CGIplus script is serviced.  The DCL task structure is allocated to the new
request but shortly, possibly immediately after, that DCL task receives the
termination AST and is run-down.  The request receives no output and Netscape
Navigator for instance reports "Document contains no data".  This has been
addressed by checking whether the script has begun processing (by reading from
the COMMAND or CGIPLUSIN variable stream.  If this stream has not been read
from it is considered the above has happened and the script request is
resubmitted to DclBegin().  A limit is placed on the number of times this may
happen in succession, to prevent an errant script from producing a runaway
condition in the server.


CGIPLUS RUNTIME
---------------
This is a variation on the CGIplus environment.  It allows for mapping a
request path into *three* components (well sort of).  MAPURL.C allows an EXEC
to do some special mapping, essentially the derivation of a special run-time
file (script), then completely remapping the whole thing again to derive a
script file name (provided as a "parameter" to the executing run-time file) and
a resultant path.  The idea is the run-time environment is some sort of
persistant engine/interpreter operating in a CGIplus environment and getting
its requests via the CGIplus stream.  The actual script to be processed by it
is passed as CGI variables SCRIPT_NAME and SCRIPT_FILENAME which the engine
can then use as source for it's interpreter.  The rest of the environment is
normal CGI/CGIplus.  When finished the engine then runs-down the processing
environment, signals CGIplus-EOF and goes quiescent waiting for the next
request.

These run-time environments are so much like CGIplus scripts (with only a
slightly different handling of the script file name itself) that CGIplus
scripts can behave as run-time environments.  For example the CONAN script.  It
essentially "interprets" the "scripting" input of a VMS Help or text library. 
See the examples in the section immediately below.


SCRIPT RUNTIME ENVIRONMENTS
---------------------------
File types (extensions) and associated scripting languages can be defined in
the configuration file.  The syntax is "type foreign-verb".  For example:

  [DclRunTime]
  .PL  $PERL_EXE:PERL.EXE
  .CGI PERL

Three are predefined, ".COM" for DCL procedures, ".CLD" to define a verb via
command-definition file, and ".EXE" for executables.  There are two further
run-time types, CGIplus and (persitant) Run-Time Environment (RTE) indicated by
enclosing them in parentheses.  For example:

  [DclRunTime]
  .PL  (HT_EXE:PERLRTE.EXE)
  .HLB (CGI-BIN:[000000]CONAN)

When these are encountered against a file type the script processing is
restarted from the current CGI type, to either CGIplus or RTE respectively. 
This incurs a small request processing penalty but the potential efficiencies
of the latter two environments make it well worthwhile.

NOTE: it is assumed the RTE executable/procedure exists.  No check is made by
the server for its existance or access permissions before activating under DCL.


SCRIPT COMMAND PARAMETERS
-------------------------
The mapping rule

  SET * script=command="<string>"

can be used to provide optional command-line qualifiers and parameters during
CGI and CGIplus script activation.  To add such to a script activation the
first character in the string should be an asterisk.  This indicates the verb
created by the DCL modules should be used to activate the script and anything
followed should just be appended to the verb's command-line.  The following
mapping

  SET /cgi-bin/script.exe script=command="* /QUALIFIER1 PARAMETER1"

would result in the script being activated using the following DCL commands

  WASDVERB:=$CGI-BIN:[000000]SCRIPT.EXE
  WASDVERB /QUALIFIER1 PARAMETER1

If the first character is not an asterisk the path SETing completely replaces
the server-generated script activation command allowing a completely different
command to be used to activate the script.  This mapping

  SET /cgi-bin/script.exe script=command="OKEYDOKEY /QUALIFIER1 PARAMETER1"

would result in the following DCL commands being generated

  WASDVERB:=$CGI-BIN:[000000]SCRIPT.EXE
  OKEYDOKEY /QUALIFIER1 PARAMETER1

As can be seen the first command is effectively ignored.


CGI CALLOUT
-----------
The CGIplus input/output streams are used to provide support for the script
process to "escape" from the normal SYS$OUTPUT stream and send records directly
to a server function for interpretation and processing.  In turn this function
can return records to the script via the CGIPLUSIN stream.  This works for
*BOTH* CGIplus *AND* vanilla CGI scripting!

The script indicates it wishes to suspend normal output by providing a record
containing the string found in the script process' CGIPLUSESC logical.  End of
this mode of communication is indicated by a record containing the string from
the CGIPLUSEOT logical (after which output to the client is resumed).  These
sequences are generated and used in much the same way as CGIPLUSEOF.

This functionality is used to supports CGIplus scripts that act not in the
traditional role as a CGI script but as "agents" to perform some required
function transparently to request processing.  An obvious example is an
external authentication/authorization processor.  These agents execute in the
normal CGI environment, with the request's CGI variables available (with some
minor differences depending on authorization state), <stdout> output stream,
etc.  There are some behavioural constraints on agents but this general
approach confers the considerable benefits of being able to write and operate
these agents as if CGI/CGIplus scripts, even as (CG)ISAPI DLLs.

A default callout for a CGIplus script is provided.  This function provides a
number of operations that may be useful to special-purpose scripts.  The
responses provided by the server are always an HTTP-like code, 200 for success,
400 for script request error, etc., with trailing plain-text explanation. 
The provision of and requirement for reading a response may be suppressed by
leading the directive with a '!' or '#'.

CGI "callout" requests (case-insensitive):

  AUTH-FILE:string            authorize/deny SYSPRV access to file specified
  BODY:string                 return the request body, must be "stream"
  CGIPLUS:string              provide CGI variables, "struct" or "record"
  CLIENT-READ:[string]        initiate reads directly from client to script
  CONTENT-TYPE:string         map the file extension to a MIME content-type
  GATEWAY-BEGIN:integer       HTTP response status code (e.g. 200) BG: device
  GATEWAY-END:integer         count of bytes output directly to the BG: device
  ICON-TYPE:string            map the content-type/file extension to icon URL
  LIFETIME:integer            or "do-not-disturb" sets script process lifetime
  MAP-FILE:string             map the supplied file to a path
  MAP-PATH:string             map the supplied path to a file
  NOOP:[string]               do nothing, just return a success status
  TIMEOUT-BIT-BUCKET:integer  or "none" sets script into bit-bucket timeout
  TIMEOUT-NOPROGRESS:integer  or "none" sets request no-progress timeout
  TIMEOUT-OUTPUT:integer      or "none" sets request output timeout


CLIENT-READ: CALLOUT
--------------------
A script can initiate reads direct from the client using the CLIENT-READ:
callout.  Although this has little value for the standard browser, which when
using HTTP will only supply a body with a POSTed request and then only as a
block of request data, a custom application or Java applet could initiate an
"interactive" dialog with a script.  When the CLIENT-READ: callout is received
by the server it queues a network read from the client.  If an when this
completes the record is written to the script via the normal HTTP$INPUT stream. 
The script can write records to the client via it's normal SYS$OUTPUT stream. 
This I/O is asynchronous.  The client records read are transported via the
normal server protocols and so support communication via SSL, providing a
secured stream for such communication.  Any functionality that can be built
into a server-end script and it's associated client-end application should be
able to be supported via this mechanism.  Of course, for extended transactions
some consideration must be given to request and script timeouts.


GATEWAY_BG
----------
The CGI.C module provides a "GATEWAY_BG" CGI variable that contains the BG:
(socket) device connected to the client.  This device is created shareable. 
Opening a channel to it allows a script to directly output to the TCP/IP
socket, bypassing the server completely.  NEEDLESS TO SAY THIS REDUCES OVERHEAD
CONSIDERABLY and for a certain class of services may be appropriate.  Note that
this is a completely RAW stream, the script must supply all carriage-control,
etc.  Also, because it is raw, it is also completely unencrypted and so cannot
be used with an SSL request or WATCHed for trouble-shooting purposes.

The script must supply a full NPH response header to the client, and a
GATEWAY-BEGIN:nnn callout to the server, supplying (for logging, etc.) the HTTP
status code of the response.  When the response body transmission is complete
the script must supply a GATEWAY-END:nnn callout, providing the server with
the data count transfered (again for logging, etc.).  If a channel to the BG:
device is opened it should always be closed when it is finished with.  Failure
to do so could lead to resource starvation for the server.  When complete the
script just concludes as normal.  The following is an example.

  fflush (stdout);
  fprintf (stdout, "%s\n", getenv("CGIPLUSESC"));
  fflush (stdout);
  fprintf (stdout, "GATEWAY-BEGIN: %d\n", 200);
  fflush (stdout);

  byteCount = fprintf (BgOut, "All sorts of rubbish to the raw socket!\n");

  fprintf (stdout, "GATEWAY-END: %d\n", bytesCount);
  fflush (stdout);
  fprintf (stdout, "%s\n", getenv("CGIPLUSEOT"));
  fflush (stdout);


ZOMBIES
-------
The reuse of DCL script processes for CGI scripting provides very significant
performance gains with very little _real_ possibility of undesirable
interaction between uses (where scripts are "well-behaved", which should be all
enviornments). When a non-zero zombie lifetime is specified DCL script
processes implicitly persist between uses for standard CGI and DCL (SSI)
commands as well as explicitly with CGIplus scripts. When not being used to
process a request these script processes are termed "zombies" ;^) they are
neither "alive" (executing a script and processing a request) nor are they
"dead" (script process deleted and task structure free). Instead the script
process is in a LEF state waiting for more input via CGIPLUSIN. A great deal of
care is taken to ensure there is no interaction between uses (all symbols are
deleted, output mailbox is emptied), but there can be no "iron-clad" guarantee.
Use of zombies (persistant DCL processes) is disabled by setting the
appropriate configuration parameter to zero. The same DCL EOF mechansism is
used to signal end-of-output in all process-persistant environments.


SCRIPTING PROCESSES
-------------------
As of WASD 7.1 the creation of scripting processes has been moved from
lib$spawn() to sys$creprc().  This was primarily to support detached processes
executing under a different persona.  There are two modes for scripting now. 

The first exclusively bases scripting on subprocesses (still created using
sys$creprc()) executing using the server account).  This is (should be ;^)
completely compatible with versions prior to WASD 7.1 and can be supported on
all previous VMS versions WASD compiled and executed under.

The second mode uses detached processes.  These are completely autonomous
processes, with full, not pooled quotas, etc.  This may be an advantage in
itself, with resource exhaustion (by the server itself) less likely.  These
processes would usually be created using the same account as the server, but
with the server using the sys$persona...() services (the basics available since
VMS V6.2) can be executing under a different account opening up a whole raft of
possibilities (a la U**x setuid()), see below.

One of the real advantages in using subprocesses is their automatic cleanup
during parent process deletion.  With detached processes there is no such
convenience.  It is very much up to the application author to completely manage
the life-cycle of these processes.  Whilst the author wishes to only employ
user-mode code this becomes an issue under some circumstances.  The server
maintains a list of all processes it manages and so during normal image
run-down the exit handler can sys$delprc() these without any trouble.  This
will probably be 99.9% of the time.  The other 0.1% might be represented by a
site administrator doing a STOP/ID= instead of the more usual and convenient
HTTPD/DO=EXIT on the server process for some reason.  The STOP results in the
exit handler not gaining control and so any scripting processes not being
deleted.

To avoid having potentially a large number of now unmanaged processes left
permanently on the system (or worse still, after a number of these accumulating
on the system), the server during startup scans all candidate processes on the
system and deletes those associated with it's previous incarnation.  How can it
tell processes it created from any others?  Good question!  Well, it may have
created them under a different account so it can't just delete any others
running under it's account besides itself, particularly if there may be
multiple server executing on the one system.  OK, how do we find them?  These
processes have a mailbox 'terminal', so scan for those with 'MBA'.  So do lots
of other processes!  But only those created by the server have a specific ACL
attached to the device, with a special, unique identifier in the first ACE.  If
this ACL is detected the process is deleted.  The rights identifier must be
server-process-unique and by default is generated from the process name.  For
instance "HTTPd:80" would require an identifier "WASD_HTTPD_80".  Not too
complex, especially considering the basics of the code to create such an ACL
must exist anyway, allowing processes under non-server accounts to connect to
them.

Yet another issue!  With detached processes created via LOGINOUT.EXE the full
process life-cycle is undertaken, including SYLOGIN.COM and LOGIN.COM, which
may write to SYS$OUTPUT during execution.  This output is obviously undesirable
;^) and so is absorbed.  A sentinal (similar to those used for script EOF and
callout ESC and EOT) is output when the server supplied DCL commands being read
via the SYS$COMMAND mailbox gain control.  This is detected by the server,
output absorbtion is turned off and normal CGI output processing begun.

Scripting process priorities are set in the following way.  Script processes
created for execution under the server username, or a username specified via a
"SET SCRIPT=AS=" are created one priority lower than the server process itself. 
Processes to be executed under a /~username, that is via a "SET SCRIPT=AS=~"
rule, are created two priorities lower than the server.  The rationale being
that the server process itself should always have a slight edge (it will
probably be I/O bound anyway), and "server" scripts should have a slight edge
over "user" scripts.  This way the server should respond quickly, even if
script processing on a busy system then takes a little time to complete the
request.  For example, if the server executes at 4 then scripts created under
the server account will execute at 3 and /~username scripts at 2.  These may be
changed in DCL.H and via recompilation.

Setting a script to have a maximum CPU consumption (set /path script=CPU=5)
Results in a "watchdog" routine being invoked each time the DCL supervisor
ticks.  This asynchronous $GETJPI compares the current CPU consumption with
that at the beginning of the script execution.  Note it's the *script* not
process, and is not the same as CPULM process quota.  This provides somewhat
more versatility than a CPULM-style (which won't work on LOGINOUT.EXE created
processes anyway).  It does however rely on the DCL supervisor and so is
subject to the timer granularity of that subsystem.  When the CPU is being
controlled in this way the supervisor ticks at a more appropriate period, so
that although not accurate to the second in terminating a excessive-CPU script
it should not be too far off the mark!


"suEXEC"/"SETUID" SCRIPTING
---------------------------
The detached scripting mechanism described above is coupled with the VMS V6.0
and later sys$persona...() system services to allow scripting under user
accounts specified by the system administrator using mapping rules.  This must
be enabled using the command-line qualifier /PERSONA.  As with all scripting
this should be used with caution, although the detached script process,
isolated from the main server by account differences, should not be able to
affect the server directly.  This only interaction with it should be via the
IPC mailboxes, which are still owned by the server process, with the user
script granted access via an ACL on the device.

The /PERSONA qualifier takes an optional rights identifier parameter.  If this
is supplied access to the persona services (as as a consequence all scripting)
is controlled by account possession of the identifier.  Note that this includes
*all* accounts, including the HTTP server account.  The format of the qualifier
use then becomes something like /PERSONA=WASD_SCRIPTING.

By default only non-privileged accounts can be used to script.  If privileged
accounts are required for scripting the /PERSONA=RELAXED keyword must be
supplied.

Persona scripting can be further restricted to authenticated and authorized
requests.  The /PERSONA=AUTHORIZED keyword will enable this.  Unless the
request has been subject to HTTP authorization the request just results in an
error.  A variation on this allows privileged accounts to be used for scripting
only within authorized requests using /PERSONA=RELAXED=AUTHORIZED.

The 'SET /path/* SCRIPT=AS=username' mapping rule allows user names (accounts)
to be specified for (a) script(s) with a particular path.  For instance, the
script "/database/query" could be set up to execute under the user name
DATABASE using rules similar to the following:

  set /database/* script=as=DATABASE
  exec /database/* /database_root/cgi-bin/*

General user scripting (that is, access to accounts via the "/~username" style
syntax) may also be enabled using rules such as the following:

  set /~*/cgi-bin/* script=as=~
  # the following is NOT a typo, the rule is UXEC (User eXEC)
  uxec /~*/cgi-bin/* /*/www/cgi-bin/*
  user /~*/* /*/www/*
  redirect /~* ///~*/

For requests that have been authenticated using the SYSUAF, the username
may provide the scripting account.  Use a SET script=as=$ rule, where the
dollar indicates that before activating the script the server should substitute
the authenticated VMS username ... CAUTION!  If the request was not SYSUAF
authenticated it fails.

  set /cgi-bin/showme* script=as=$

To optionally execute scripts user a SYSUAF authenticated username use the SET
script=as=$? rule.  If not SYSUAF authenticated it is executed under the
default scripting account.

  set /cgi-bin/showme* script=as=$?

It is also possible to direct the server to execute *all* of it's own scripts
under some non-server account by prefixing the entire rule file using something
like the following rule.

  set /* script=as=NOBODY


NOBODY SCRIPTING
----------------
Version 8.1 establishes a new strategy in scripting account - it always
attempts to enable detached scripting with a non-server account to perform the
scripting.  This is the algorithm:

1) If /DEMO subprocess scripting is forced.

2) If /SCRIPT=AS=SUBPROCESS is used subprocess scripting is forced.

3) If /SCRIPT=AS=username is used detached scripting is forced.

4) If the account HTTP$NOBODY exists detached scripting is forced.

5) If /PERSONA is used detached scripting is forced.

6) The scripting process mode is set by [DclDetachProcess].

The advantages of generally scripting under a totally non-server account,
non-user account cannot be overstated.  This /SCRIPT=AS= and HTTP$NOBODY
approach allows this to be available without enabling /PERSONA scripting in
general (and thereby having it not available via mapping rules).  Presto! It
all just happens.  Note that this CANNOT be a username with anything other than
the average Joe privileges.  This may also be used with PERSONA enabled.


SCRIPT RUN-DOWN
---------------
This excellent approach was suggested by Jean-François Piéronne
(jfp@altavista.net).  It makes a significant contribution to improving
performance and reducing overhead.

As of WASD 7.2 a change in behaviour for client connection drops.  Prior to
this version the first network write error caused the termination of the script
and process.  Now [DclBitBucketTimeout] or mapping set rule
SCRIPT=BIT-BUCKET=hh:mm:ss control behaviour.  If this is set (non-zero) the
server now just absorbs any further output from the script until the timeout
expires.  The rationale being that most scripts execute relatively quickly,
most connection drops are client impatience or changing of mind, script process
creation and instantiation is relatively expensive and it is better to try and
preserve these wherever possible, or at least allow them to complete their
processing.  Scripts can also set this timeout on a per-request basis using the
TIMEOUT-BIT-BUCKET: callout.

Do-Not-Disturb scripts, indicated by use of the "LIFETIME: do-not-disturb"
callouts, are never automatically run-down or otherwise touched.  Normal
behaviour can be reverted to using a "LIFETIME: configuration".  They can be
administratively purged or force-deleted of course (i.e. from the Admin Menu
and CLI /DO=DCL=).  Do-Not-Disturb lifetimes may be used during critical
sections of processing (ensuring it will not under any normal circumstances
have it's processing disturbed), at the beginning and ending of entire requests
(putting a critical section around the entire request), or even permanently,
making them effectively immortal and like many gods a potential source of all
sorts of subtle and gross affliction ;^)

Also with WASD 7.2 the script process is now checked for an executing image
(JPI$_IMAGNAME) and if it is a $FORCEX is issued.  The rationale is of course
to allow any image exit handlers a chance to do their job.  Prior to v7.2 a
$DELPRC was simply issued, which can cause some issues with some environments,
for example RDB (and other such-like I should imagine), where database
checkpoint/rollback can be induced.  Generally it will be CGIplus/RTE scripts
that require a $FORCEX on the image.  In these cases when the image exits the
queued SYS$COMMAND DCL will cause the process to perform a STOP/ID=0 deleting
itself and delivering the completion AST.  On rare occasions (and with standard
CGI scripts) this may not happen so every few seconds (under the control of the
DCL supervisor) the process is agains checked for an executing image.  When it
isn't (or one minute passes, which-ever first) the process is $DELPRCed.


HT_SCRATCH
----------
If defined, this logical locates a directory where scripts can place temporary
files.  Although these scripts should clean up after themselves, temporary or
working files placed into this directory are automatically deleted if last
modified earlier than [DclCleanupScratchMinutesOld] before the scan starts. 
The scan that searches for and deletes these files if present occurs either
when there are no more script processes active or not greater than every
[DclCleanupScratchMinutesMax] minutes.

The CGI variable 'WWW_UNIQUE_ID' can be used to generate unique file names.  To
prevent a file being automatically cleaned up make the first character of it's
name a dollar symbol.  The following DCL code fragment creates unique server
and script file names.

  $ NAME = F$PARSE(WWW_SCRIPT_NAME,,,"NAME")
  $ FILENAME = NAME + "." + WWW_UNIQUE_ID
  $ OPEN /WRITE TMPFILE 'FILENAME'


LOGICAL NAMES
-------------
HT_SCRATCH      if defined, directory for working/scratch files used by scripts
                            (cleaned up every [DclZombieLifeTime] minutes max.)
HTTPD$LOGIN     if defined, provides a command procedure executed immediately
                            before the script command/procedure/image
HTTPD$VERIFY    if defined, turns on script/DCL-level verify


VERSION HISTORY
---------------
18-MAY-2004  MGD  provide additional WATCH data when allocating persistent
                  DCL task (after nasty script name parse issue in .ru)
26-FEB-2004  MGD  script processes SET DEFAULT before activation
                  CGI variable SCRIPT_DEFAULT (script=default=<directory>)
14-FEB-2004  MGD  set script process parse extended/traditional if path ODS set
11-JAN-2004  MGD  bugfix; DclAllocateTask() CGIplus with virtual services
18-SEP-2003  MGD  bugfix; suppress output after "Script-Control: x-error..."
10-SEP-2003  MGD  refine MAP-PATH to return 400 response if no reverse,
                  bugfix; MAP-FILE: stripping leading character
19-JUL-2003  MGD  provide network mode detached process creation
                  revise detached process cleanup candidate identification
                  revise script activation code (include .CLD)
                  bugfix; DclScriptProcessPurge()
18-JUN-2003  MGD  bugfix; (potential anyway) correct increment of
                  queued I/O counters around delivery of error ASTs
19-APR-2003  MGD  bugfix; DclSysOutputAst() do not rundown script process 
                  if the error generated came from "Script-Control:",
                  bugfix; allow for '!' from (!$blah) mapping rule
15-MAR-2003  MGD  script=as=$? to indicate optional use of SYSUAF username
                  implement authorization "scriptas" keyword directive
16-FEB-2003  MGD  with RTEs look first for one that was executing the same
                  script name and path then if not found fall back to LRU
                  idle RTE executing same script or just to LRU RTE,
                  make DCL command buffer space dynamic
30-JAN-2003  MGD  build up 'records' from single byte output streams
                  (ask Alex Ivanov about GhostScript output),
                  path set carriage-control on CGIPLUSIN stream
                  (including end of callout stream)
08-OCT-2002  MGD  refine default scripting
23-SEP-2002  MGD  additional persona counters,
                  'CliScriptAs' allows a NOBODY scripting environment
                  without enabling PERSONA in general
15-JUN-2002  MGD  bugfix; BodyRead() QueuedClientRead++ in DclHttpInputAst()
27-APR-2002  MGD  use sys$setprv(),
                  bugfix; DclFindFileEnd() reset result file name
02-FEB-2002  MGD  rework HTTP$INPUT due to request body processing changes
26-JAN-2002  MGD  bugfix; DclTaskRunDown() reset script task type
29-OCT-2001  MGD  PERSONA_MACRO reporting
21-OCT-2001  MGD  kludge work around spawning authorized privs with $CREPRC
29-SEP-2001  MGD  multiple instance support (minor changes)
25-AUG-2001  MGD  bugfix; always generate callout sequences
04-AUG-2001  MGD  support module WATCHing
25-APR-2001  MGD  watchdog on CPU time consumed by scripts, 
                  use HttpdTick() to drive DclSupervisor(),
                  bugfix; SCRIPT_FILENAME with CGIplus
13-APR-2001  MGD  change client write error behaviour for CGIplus
                  (CGIplus script 'bit-bucket' period),
                  changes to script run-down ($FORCEX),
                  DCL supervisor now more granular at fifteen seconds,
                  callout BODY: to return request body on CGIPLUSIN stream,
                  callout CGIPLUS: to support stream variables
06-MAR-2001  MGD  CONTENT-TYPE: callout maps file suffix to MIME content-type
                  ICON-TYPE: callout maps file suffix/content-type to icon URL
05-DEC-2000  MGD  DclCleanupScratch(),
                  modify HTTPD$VERIFY to allow for strict CGI output
19-NOV-2000  MGD  bugfix; for $persona_assume() on VAX (sigh!)
01-OCT-2000  MGD  scripting process creation using sys$creprc(),
                  detached and persona-based scripting
13-SEP-2000  MGD  suppress callout response using leading '!' or '#',
                  APACHE_INPUT changed to APACHE$INPUT (1.3-12)
                  add GATEWAY-BEGIN: and GATEWAY-END: callouts,
                  add CLIENT-READ: callout reads direct from client to script
08-AUG-2000  MGD  limit script output of ENDOFFILE,
24-JUN-2000  MGD  persistant run-time environments,
                  script cache now uses mapped script file name,
                  fixed potential problem when setting 'DclSysOutputSize',
                  bugfix; HEAD requests specifying content-length
27-MAY-2000  MGD  add BYTLM check before creating mailboxes
08-APR-2000  MGD  some (VMS) Apache compatibility,
                  if(!cfptr->cfScript.Enabled)
04-MAR-2000  MGD  use NetWriteFaol(), et.al.
13-JAN-2000  MGD  add OPCOM messages
03-JAN-2000  MGD  support ODS-2 and ODS-5 using ODS module for script find
28-NOV-1999  MGD  provide HTTPD$LOGIN
10-OCT-1999  MGD  make SYS$COMMAND and CGIPLUSIN mailbox sizes configurable,
                  bugfix; DclSysOutputToClientAst()
28-AUG-1999  MGD  callout/agent support,
                  support Purveyor/Cern WWW_IN: and WWW_OUT:,
                  bugfix; sizeof(StopId)-1
12-JUN-1999  MGD  change some WatchData() to WatchDataDump()
12-FEB-1999  MGD  refine WATCH information
07-NOV-1998  MGD  WATCH facility
17-OCT-1998  MGD  script name cache,
                  error report support
19-SEP-1998  MGD  improve granularity of script search,
                  do not search for established CGIplus scripts
                  (this reduces CGIplus script activation time by 50%!!)
15-AUG-1998  MGD  replace per-script process timers with DclSupervisor()
27-MAY-1998  MGD  generate CGI variables only once for any one request
02-APR-1998  MGD  see "April 1998 Note" above,
                  report status 500/501 if script returns no output
28-MAR-1998  MGD  ensure script output is null-terminated (for CGI.C)
16-DEC-1997  MGD  generalized CGI processing unbundled into CGI.c module
06-DEC-1997  MGD  resolving a suspected inconsistent AST delivery situation
                  by requiring all $QIO()s with an AST routine to ensure any
                  queueing errors, etc. are reported via the AST routine
19-OCT-1997  MGD  extensible script run-time environment,
                  HTTP_ACCEPT_CHARSET, HTTP_FORWARDED and HTTP_HOST variables,
                  change in behaviour: CGI "Content-Type:" response bodies now
                  only have carriage-control checked/adjusted if "text/..."
10-SEP-1997  MGD  add "!'F$VERIFY(0)" to start of DCL in case verify on account
09-AUG-1997  MGD  ACCEPT_LANGUAGE variable
01-AUG-1997  MGD  allow supplying request header AS WELL AS body, or only body,
                  added AUTH_REALM, AUTH_GROUP, HTTP_ACCEPT, and 
                  REQUEST_TIME_GMT/LOCAL CGI variables
01-JUN-1997  MGD  Persistant DCL processes, CGIplus, new for HTTPd v4.2,
                  DCL.C completely re-designed!
26-APR-1997  MGD  bugfix; serious flaw POST content handling since v4.0
                  to REQUEST.C, PUT.C in version 4.0 (rewrite of HTTP$INPUT)
01-FEB-1997  MGD  HTTPd version 4
14-NOV-1996  MGD  bugfix; no status was being returned after "DELETE/SYMBOL X"
                  in DclSysCommandStringSymbol()
06-APR-1996  MGD  miscellaneous refinements
26-MAR-1996  MGD  added WWW_HTTP_AUTHENTICATION, scripts can now authenticate
01-DEC-1995  MGD  HTTPd version 3
19-SEP-1995  MGD  changed carriage-control on records from <CR><LF> (the strict
                  HTTP requirement) to single newline (<LF>, de facto standard)
                  This will be slightly more efficient, and "more compliant"!
21-APR-1995  MGD  bugfix; DclSysOutputAst()
03-APR-1995  MGD  added remote user authentication and CGI symbol
20-MAR-1995  MGD  bugfix; DclQioHttpInput()
20-DEC-1994  MGD  initial development as a module for multi-threaded daemon
*/
#endif /* COMMENTS_WITH_COMMENTS */
/*****************************************************************************/

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

/* VMS related header files */

/* cmbdef.h is not defined for VAXC 3.n */
#define CMB$M_READONLY 0x01
#define CMB$M_WRITEONLY 0x02

/* let's just make sure these are available everywhere */
#define IO$M_NORSWAIT 0x400
#define SS$_MBFULL 0x000008d8

#include <descrip.h>
#include <iodef.h>
#include <jpidef.h>
#include <kgbdef.h>
#include <libdef.h>
#include <libdtdef.h>
#include <prcdef.h>
#include <prvdef.h>
#include <rms.h>
#include <ssdef.h>
#include <stsdef.h>

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

#define WASD_MODULE "DCL"

/* provides code to support vanilla-CGI use of CGIplus callouts */
#define CGIPLUS_CALLOUT_FOR_CGI 1

/* provides APACHE$INPUT: stream for VMS Apache compatibility */
#define STREAMS_FOR_APACHE 1

/* provides WWW_IN: and WWW_OUT: streams for Purveyor/Cern compatibility */
#define STREAMS_FOR_PURVEYOR_AND_CERN 1

/* in seconds */
#define DCL_SUPERVISOR_TICK_MIN  2
#define DCL_SUPERVISOR_TICK_MAX 15

/* just a sentinal used to indicate when the DCL supervisor timer expires */
#define DCL_SUPERVISOR_TICK -1

/* maximum period tryig to force an image to exit */
#define DCL_FORCE_IMAGE_EXIT_SECONDS 60

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

BOOL  DclUseZombies;

int  DclCgiHeaderSize,
     DclCgiPlusLifeTimePurgeCount,
     DclCgiPlusInSize,
     DclCleanupMinutesMax,
     DclCleanupMinutesOld,
     DclDetachProcessPriorityServer,
     DclDetachProcessPriorityUser,
     DclHitHardLimitCount,
     DclMailboxBytLmRequired,
     DclPersonaServicesAvailable,
     DclPurgeCount,
     DclPurgeScriptProcessesCount,
     DclPurgeScriptNameCacheCount,
     DclScriptDetachProcess,
     DclSoftLimitPurgeCount,
     DclScriptProcessCount,
     DclScriptProcessHardLimit,
     DclScriptProcessSoftLimit,
     DclSysCommandSize,
     DclSysOutputSize,
     DclZombieLifeTimePurgeCount;

/* two longwords so it can be used by sys$grantid() */
unsigned long  ProcessRightsIdent [2];

LIST_HEAD  DclTaskList;

LIST_HEAD  DclScriptNameCacheList;

#define DEFAULT_CGI_VARIABLE_PREFIX "WWW_"
char DclCgiVariablePrefix [32] = DEFAULT_CGI_VARIABLE_PREFIX;
int DclCgiVariablePrefixLength = sizeof(DEFAULT_CGI_VARIABLE_PREFIX)-1;

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

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

extern BOOL  CliDemo,
             HttpdNetworkMode,
             OdsExtended,
             OperateWithSysPrv,
             PersonaMacro;

extern int  CliPersonaEnabled,
            EfnWait,
            EfnNoWait,
            HttpdTickSecond,
            NetAcceptBytLmRequired,
            NetListenBytLmRequired,
            NetReadBufferSize,
            OpcomMessages,
            OutputBufferSize,
            ProcessPriority,
            ServerPort;

extern unsigned long  CrePrcMask[],
                      DetachMask[],
                      GrantIdMask[],
                      MailboxMask[],
                      SysPrvMask[],
                      WorldMask[];

extern char  CliScriptAs[],
             ErrorSanityCheck[],
             HttpProtocol[],
             HttpdScriptAsUserName[],
             ProcessIdentName[],
             ServerHostPort[],
             SoftwareID[],
             Utility[];

extern LIST_HEAD  PersonaCacheList;
extern int  PersonaCacheCount,
            PersonaCacheEntries;

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

/*****************************************************************************/
/*
Set and ensure limits are reasonable at server startup.
*/ 

DclInit ()

{
   int  status,
        SetPrvStatus;
   char  *cptr;

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclInit()");

   /* command line overrides configuration, default fallbacks */
   if (!DclSysCommandSize) DclSysCommandSize = Config.cfBuffer.SizeDclCommand;
   if (!DclSysCommandSize) DclSysCommandSize = DEFAULT_DCL_SYSCOMMAND_SIZE;
   if (!DclSysOutputSize) DclSysOutputSize = Config.cfBuffer.SizeDclOutput;
   /* if not specified then make it the same as the network buffer */
   if (!DclSysOutputSize) DclSysOutputSize = OutputBufferSize;
   if (!DclSysOutputSize) DclSysOutputSize = DEFAULT_DCL_SYSOUTPUT_SIZE;
   if (!DclCgiHeaderSize) DclCgiHeaderSize = Config.cfBuffer.SizeDclCgiHeader;
   if (!DclCgiHeaderSize) DclCgiHeaderSize = DEFAULT_DCL_CGI_HEADER_SIZE;
   if (!DclCgiPlusInSize) DclCgiPlusInSize = Config.cfBuffer.SizeDclCgiPlusIn;
   if (!DclCgiPlusInSize) DclCgiPlusInSize = DEFAULT_DCL_CGIPLUSIN_SIZE;
   /* HTTP$INPUT size is determined by network read buffer size! */

   DclScriptProcessSoftLimit = Config.cfScript.ScriptProcessSoftLimit;
   if (DclScriptProcessSoftLimit <= 0 || DclScriptProcessSoftLimit > 99)
      DclScriptProcessSoftLimit = Config.cfServer.BusyLimit;

   DclScriptProcessHardLimit = Config.cfScript.ScriptProcessHardLimit;
   if (DclScriptProcessHardLimit <= DclScriptProcessSoftLimit ||
       DclScriptProcessHardLimit > 99)
      DclScriptProcessHardLimit = DclScriptProcessSoftLimit +
                                  (DclScriptProcessSoftLimit / 4);

   DclCleanupMinutesMax = Config.cfScript.CleanupScratchMinutesMax;
   DclCleanupMinutesOld = Config.cfScript.CleanupScratchMinutesOld;
   if (DclCleanupMinutesOld < DclCleanupMinutesMax)
      DclCleanupMinutesOld = DclCleanupMinutesMax;

   if (Config.cfScript.ZombieLifeTime) DclUseZombies = true;

   if (CliDemo)
      DclScriptDetachProcess = false; 
   else
   if (strsame (CliScriptAs, "SUBPROCESS", -1))
      DclScriptDetachProcess = false;
   else
   if (HttpdScriptAsUserName[0])
      DclScriptDetachProcess = true;
   else
   if (CliPersonaEnabled)
      DclScriptDetachProcess = true;
   else
      DclScriptDetachProcess = Config.cfScript.DetachProcess;

   if (DclScriptDetachProcess)
   {
      WriteFaoStdout ("%!AZ-I-DCL, detached process scripting\n", Utility);

      DclCleanupScriptProcesses ();

      DclPersonaServicesAvailable = CliPersonaEnabled;
      WriteFaoStdout ("%!AZ-I-DCL, persona !&?\rnot \renabled at command line\n",
                      Utility, DclPersonaServicesAvailable);

      if (DclPersonaServicesAvailable || HttpdScriptAsUserName[0])
      {
         status = PersonaInit ();
         if (VMSnok (status))
         {
            WriteFaoStdout ("%!AZ-F-DCL, persona not available\n-!&M\n",
                            Utility, status);
            exit (status);
         }
      }

      if (Config.cfScript.DetachProcessPriority[0])
      {
         /* get at most two integers from this parameter */
         cptr = Config.cfScript.DetachProcessPriority;
         while (*cptr && !isdigit(*cptr)) cptr++;
         if (isdigit(*cptr))
         {
            DclDetachProcessPriorityServer = atoi(cptr);
            while (*cptr && isdigit(*cptr)) cptr++;
         }
         while (*cptr && !isdigit(*cptr)) cptr++;
         if (isdigit(*cptr)) DclDetachProcessPriorityUser = atoi(cptr);
         /* can't set user script priorities above those of the server! */
         if (DclDetachProcessPriorityUser > DclDetachProcessPriorityServer)
            DclDetachProcessPriorityUser = DclDetachProcessPriorityServer;
      }
   }
   else
      WriteFaoStdout ("%!AZ-I-DCL, subprocess scripting\n", Utility);
}

/*****************************************************************************/
/*
This function does not return a status value. If an error occurs the
'NextTaskFunction()' is executed. The calling routine may assume that this
module will always execute the 'NextTaskFunction()' at some stage. No need to
look for an established CGIplus script, we know it's there otherwise it never
would have been allocated. For new CGIplus scripts, as well as for standard
CGI scripts, first find the script file (as well as confirming it does exist!)
Already established CGIplus scripts and DCL commands can begin I/O with the
script process immediately.
*/ 

DclBegin
(
REQUEST_STRUCT *rqptr,
REQUEST_AST NextTaskFunction,
char *DclCommand,
char *ScriptName,
char *CgiScriptFileName,
char *CgiPlusScriptFileName,
char *ScriptRunTime,
REQUEST_AST CalloutFunction
)
{
   BOOL  MappedScriptAs;
   int  len, status,
        BasePriority,
        TaskType;
   char  *ScriptAsPtr;
   DCL_TASK  *tkptr;

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL))
   {
      WatchThis (rqptr, FI_LI, WATCH_MOD_DCL, "DclBegin()");
      WatchDataFormatted (
"DclCommand !&Z\n\
ScriptName !&Z\n\
CgiScriptFileName !&Z\n\
CgiPlusScriptFileName !&Z\n\
ScriptRunTime !&Z\n\
CalloutFunction !&A\n\
Md5HashPath: !16&H\n",
         DclCommand, ScriptName, CgiScriptFileName, CgiPlusScriptFileName,
         ScriptRunTime, CalloutFunction, &rqptr->Md5HashPath);
   }

   if (ERROR_REPORTED (rqptr))
   {
      /* previous error, cause threaded processing to unravel */
      SysDclAst (NextTaskFunction, rqptr);
      return;
   }

   if (!Config.cfScript.Enabled)
   {
      rqptr->rqResponse.HttpStatus = 403;
      ErrorGeneral (rqptr, MsgFor(rqptr,MSG_GENERAL_DISABLED), FI_LI);
      SysDclAst (NextTaskFunction, rqptr);
      return;
   }

   BasePriority = ProcessPriority - DclDetachProcessPriorityServer;
   if (DclScriptDetachProcess)
   {
      if (HttpdScriptAsUserName[0])
         ScriptAsPtr = HttpdScriptAsUserName;
      else
         ScriptAsPtr = HttpdProcess.UserName;
   }
   else
      ScriptAsPtr = "";
   MappedScriptAs = false;

   if (rqptr->rqAuth.VmsUserScriptAs)
   {
      /* authorization rule has precedence over mapping rule */
      if (rqptr->RemoteUser[0] &&
          rqptr->rqAuth.SysUafAuthenticated)
      {
         ScriptAsPtr = rqptr->RemoteUser;
         BasePriority = ProcessPriority - DclDetachProcessPriorityUser;
         MappedScriptAs = true;
      }
      else
      {
         rqptr->rqResponse.HttpStatus = 403;
         ErrorGeneral (rqptr, MsgFor(rqptr,MSG_AUTH_REQUIRED), FI_LI);
         SysDclAst (NextTaskFunction, rqptr);
         return;
      }
   }
   else
   if (rqptr->rqPathSet.ScriptAsPtr)
   {
      if (rqptr->rqPathSet.ScriptAsPtr[0] == '~')
      {
         /* from a user rule mapping */
         ScriptAsPtr = rqptr->rqPathSet.ScriptAsPtr+1;
         BasePriority = ProcessPriority - DclDetachProcessPriorityUser;
         MappedScriptAs = true;
      }
      else
      if (((unsigned short*)rqptr->rqPathSet.ScriptAsPtr)[0] == '$?')
      {
         /* optionally use SYSUAF authenticated username */
         if (rqptr->RemoteUser[0] &&
             rqptr->rqAuth.SysUafAuthenticated)
         {
            ScriptAsPtr = rqptr->RemoteUser;
            BasePriority = ProcessPriority - DclDetachProcessPriorityUser;
            MappedScriptAs = true;
         }
      }
      else
      if (rqptr->rqPathSet.ScriptAsPtr[0] == '$')
      {
         /* must use a SYSUAF authenticated username */
         if (rqptr->RemoteUser[0] &&
             rqptr->rqAuth.SysUafAuthenticated)
         {
            ScriptAsPtr = rqptr->RemoteUser;
            BasePriority = ProcessPriority - DclDetachProcessPriorityUser;
            MappedScriptAs = true;
         }
         else
         {
            rqptr->rqResponse.HttpStatus = 403;
            ErrorGeneral (rqptr, MsgFor(rqptr,MSG_AUTH_REQUIRED), FI_LI);
            SysDclAst (NextTaskFunction, rqptr);
            return;
         }
      }
      else
      {
         /* an explicitly specified username */
         ScriptAsPtr = rqptr->rqPathSet.ScriptAsPtr;
         MappedScriptAs = true;
      }
   }

   if (BasePriority < 0) BasePriority = 0;

   if (ScriptRunTime &&
       ScriptRunTime[0] &&
       ScriptRunTime[0] != '!')
      TaskType = DCL_TASK_TYPE_RTE_SCRIPT;
   else
   if (CgiPlusScriptFileName && CgiPlusScriptFileName[0])
      TaskType = DCL_TASK_TYPE_CGIPLUS_SCRIPT;
   else
   if (CgiScriptFileName && CgiScriptFileName[0])
      TaskType = DCL_TASK_TYPE_CGI_SCRIPT;
   else
   if (DclCommand && DclCommand[0])
      TaskType = DCL_TASK_TYPE_CLI;
   else
      ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);

   if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_RESPONSE))
   {
      switch (TaskType)
      {
         case DCL_TASK_TYPE_CGI_SCRIPT :
            WatchThis (rqptr, FI_LI, WATCH_RESPONSE,
                       "SCRIPT!&@ CGI !AZ !AZ (!AZ)",
                       ScriptAsPtr[0] ? " as !AZ" : "!+", ScriptAsPtr,
                       ScriptName, CgiScriptFileName,
                       ScriptRunTime ? ScriptRunTime+1 : "");
            break;
         case DCL_TASK_TYPE_CGIPLUS_SCRIPT :
            WatchThis (rqptr, FI_LI, WATCH_RESPONSE,
                       "SCRIPT!&@ CGIplus !AZ !AZ (!AZ)",
                       ScriptAsPtr[0] ? " as !AZ" : "!+", ScriptAsPtr,
                       ScriptName, CgiPlusScriptFileName,
                       ScriptRunTime ? ScriptRunTime+1 : "");
            break;
         case DCL_TASK_TYPE_RTE_SCRIPT :
            WatchThis (rqptr, FI_LI, WATCH_RESPONSE,
                       "SCRIPT!&@ RTE !AZ !AZ (!AZ)",
                       ScriptAsPtr[0] ? " as !AZ" : "!+", ScriptAsPtr,
                       ScriptName, CgiScriptFileName, ScriptRunTime);
            break;
         case DCL_TASK_TYPE_CLI :
            WatchThis (rqptr, FI_LI, WATCH_RESPONSE,
                       "CLI!&@ !AZ", 
                       ScriptAsPtr[0] ? " as !AZ" : "!+", ScriptAsPtr,
                       DclCommand);
            break;
         default :
               ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
      }
   }

   if (MappedScriptAs &&
       !DclPersonaServicesAvailable &&
       /* these latter two allow Server Admin process reports */
       ScriptAsPtr != HttpdScriptAsUserName &&
       ScriptAsPtr != HttpdProcess.UserName)
   {
      rqptr->rqResponse.HttpStatus = 403;
      ErrorGeneral (rqptr, MsgFor(rqptr,MSG_GENERAL_DISABLED), FI_LI);
      SysDclAst (NextTaskFunction, rqptr);
      return;
   }

   status = DclAllocateTask (rqptr, TaskType,
                             ScriptAsPtr, BasePriority,
                             ScriptName, CgiPlusScriptFileName,
                             ScriptRunTime);
   if (VMSnok (status))
   {
      SysDclAst (NextTaskFunction, rqptr);
      return;
   }

   /* get a local pointer to the newly allocated DCL task structure */
   tkptr = rqptr->DclTaskPtr;

   tkptr->NextTaskFunction = NextTaskFunction;
   memcpy (&tkptr->LastUsedBinaryTime, &rqptr->rqTime.Vms64bit, 8);
   tkptr->LastUsedSecond = HttpdTickSecond;
   tkptr->WatchItem = rqptr->WatchItem;

   switch (tkptr->TaskType)
   {
      case DCL_TASK_TYPE_CGI_SCRIPT :

         if (CalloutFunction)
            tkptr->CalloutFunction = CalloutFunction;
         else
            tkptr->CalloutFunction = &DclCalloutDefault;

         strcpy (tkptr->ScriptName, ScriptName);
         strcpy (tkptr->ScriptFileName, CgiScriptFileName);
         if (ScriptRunTime)
         {
            strcpy (tkptr->ScriptRunTime, ScriptRunTime);
            tkptr->ScriptRunTimePtr = tkptr->ScriptRunTime;
         }

         /* reset CGI output processing */
         CgiOutput (rqptr, NULL, 0);

         if (!rqptr->AccountingDone++)
            InstanceGblSecIncrLong (&AccountingPtr->DoScriptCount);

         break;

      case DCL_TASK_TYPE_CGIPLUS_SCRIPT :

         if (CalloutFunction)
            tkptr->CalloutFunction = CalloutFunction;
         else
            tkptr->CalloutFunction = &DclCalloutDefault;

         /* reset CGI output processing */
         CgiOutput (rqptr, NULL, 0);

         if (!tkptr->ScriptName[0])
         {
            /* no need to reset these for established CGIplus scripts! */
            strcpy (tkptr->ScriptName, ScriptName);
            strcpy (tkptr->ScriptFileName, CgiPlusScriptFileName);
            if (ScriptRunTime)
            {
               strcpy (tkptr->ScriptRunTime, ScriptRunTime);
               tkptr->ScriptRunTimePtr = tkptr->ScriptRunTime;
            }
         }

         if (!rqptr->AccountingDone++)
         {
            InstanceGblSecIncrLong (&AccountingPtr->DoCgiPlusScriptCount);
            if (tkptr->CgiPlusUsageCount > 1)
               InstanceGblSecIncrLong (&AccountingPtr->DclCgiPlusReusedCount);
         }

         break;

      case DCL_TASK_TYPE_RTE_SCRIPT :

         if (CalloutFunction)
            tkptr->CalloutFunction = CalloutFunction;
         else
            tkptr->CalloutFunction = &DclCalloutDefault;

         /* reset CGI output processing */
         CgiOutput (rqptr, NULL, 0);

         strcpy (tkptr->ScriptName, ScriptName);
         strcpy (tkptr->ScriptFileName, CgiScriptFileName);
         /* RTEs must have a run-time otherwise they're not RTEs */
         strcpy (tkptr->ScriptRunTime, ScriptRunTime);
         tkptr->ScriptRunTimePtr = tkptr->ScriptRunTime;
         memcpy (&tkptr->Md5HashPath,
                 &rqptr->Md5HashPath,
                 sizeof(tkptr->Md5HashPath));

         if (!rqptr->AccountingDone++)
         {
            InstanceGblSecIncrLong (&AccountingPtr->DoRteScriptCount);
            if (tkptr->CgiPlusUsageCount > 1)
               InstanceGblSecIncrLong (&AccountingPtr->DclRteReusedCount);
         }

         break;

      case DCL_TASK_TYPE_CLI :

         tkptr->CalloutFunction = NULL;
         len = strzcpy (tkptr->DclCommandPtr, DclCommand,
                        tkptr->DclCommandSize);
         if (len > tkptr->DclCommandSize)
         {
            len = tkptr->DclCommandLength = strlen(DclCommand);
            len = ((len / DCL_COMMAND_MIN_SIZE) + 1) * DCL_COMMAND_MIN_SIZE;
            if (len > DCL_COMMAND_MAX_SIZE)
            {
               tkptr->DclCommandLength = 0;
               rqptr->rqResponse.HttpStatus = 500;
               ErrorGeneralOverflow (rqptr, FI_LI);
               SysDclAst (NextTaskFunction, rqptr);
               return;
            }
            VmFree (tkptr->DclCommandPtr, FI_LI);
            tkptr->DclCommandPtr = VmGet (len);
            tkptr->DclCommandSize = len;
            strcpy (tkptr->DclCommandPtr, DclCommand);
         }

         /* reset CGI output processing */
         CgiOutput (rqptr, NULL, 0);

         /*
            As CLI commands are always used during some other request
            processing count them independent of any other AccountingPtr->
         */
         rqptr->AccountingDone++;
         InstanceGblSecIncrLong (&AccountingPtr->DoDclCommandCount);

         break;

      default :
            ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
   }

   if (rqptr->rqPathSet.ScriptNoFind &&
       tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT)
   {
      /* the RTE will handle all script locating, error reporting, etc. */
      rqptr->rqCgi.ScriptFileNamePtr = tkptr->ScriptFileName;
      strcpy (tkptr->SearchOds.ResFileName, tkptr->ScriptFileName);
   }
   else
   if (tkptr->TaskType == DCL_TASK_TYPE_CGI_SCRIPT ||
       tkptr->TaskType == DCL_TASK_TYPE_CGIPLUS_SCRIPT ||
       tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT)
   {
      if (tkptr->SearchOds.ResFileName[0])
      {
         rqptr->rqCgi.ScriptFileNamePtr = tkptr->ScriptFileName;
         strcpy (tkptr->SearchOds.ResFileName, tkptr->ScriptFileName);
      }
      else
      {
         if (DclUseZombies) DclSearchScriptNameCache (tkptr, rqptr);

         /* if not found in the name cache then look in the file system! */
         if (!(tkptr->SearchOds.ResFileName[0] &&
               tkptr->ScriptRunTimePtr))
         {
            /* script is being requested, first look for the script file */
            tkptr->FindScriptState = DCL_FIND_SCRIPT_BEGIN;
            DclFindScript (tkptr);
            return;
         }
      }
   }
  
   /* must be an established CGIplus script or DCL command (from SSI module) */
   DclBeginScript (tkptr);
}

/*****************************************************************************/
/*
Allocate a DCL task structure to the request. All task structures are linked
together in a single list, function and state indicated by the various flags
and counters associated with each.

If a CGIplus task script is to be executed then check for an already
established, idle CGIplus task structure executing that particular script. If
none found, or CGIplus script not required, and zombies in use
(persistant-script processes) then look through the list for an idle zombie
script process. If no zombie available (or not enabled) then check if we have
reached the script process creation hard-limit. If not reached look through the
list for an existing but no-script process-executing DCL task structure. If
none found create an additional DCL task structure and add it to the list.

Initialize the task structure (no matter from which scan it originated) and if
necessary create a script process for it. (An obvious improvement to processing
would be to have multiple lists, but that will have to wait for another time
:^) If an error is encountered an error message is generated and the error
status returned. It is up to the calling routine to abort the processing.
*/

int DclAllocateTask
(
REQUEST_STRUCT *rqptr,
int TaskType,
char *ScriptAsPtr,
int BasePriority,
char *ScriptName,
char *CgiPlusScriptFileName,
char *ScriptRunTime
)
{
   BOOL  WatchThisOne;
   int  status,
        CgiPlusScriptFileNameLength;
   int  LruSecond [2];
   char  *cptr;
   DCL_TASK  *tkptr;
   DCL_TASK  *lrutkptr [2];
   LIST_ENTRY  *leptr;

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (rqptr, FI_LI, WATCH_MOD_DCL,
                 "DclAllocateTask() !UL !&Z !&Z !&Z !&Z",
                 TaskType, ScriptName, CgiPlusScriptFileName,
                 ScriptRunTime, ScriptAsPtr);

   tkptr = NULL;

   if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_DCL))
      WatchThisOne = true;
   else
      WatchThisOne = false;

   if (TaskType == DCL_TASK_TYPE_CGIPLUS_SCRIPT)
   {
      /******************************************************/
      /* look for an unused instance of this CGIplus script */
      /******************************************************/

      for (cptr = CgiPlusScriptFileName; *cptr; cptr++);
      CgiPlusScriptFileNameLength = cptr - CgiPlusScriptFileName;
      /* does it have a trailing file type? */
      while (cptr > CgiPlusScriptFileName && *cptr != ']' && *cptr != '.')
         cptr--;
      if (*cptr == ']') cptr = "."; else cptr = "";
      for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr)
      {
         tkptr = (DCL_TASK*)leptr;

         if (tkptr->TaskType != DCL_TASK_TYPE_CGIPLUS_SCRIPT)
         {
            tkptr = NULL;
            continue;
         }

         if (WatchThisOne)
         {
            if (strsame (ScriptName, tkptr->ScriptName, -1) &&
                !strsame (CgiPlusScriptFileName,
                          tkptr->ScriptFileName,
                          CgiPlusScriptFileNameLength))
               WatchThis (rqptr, FI_LI, WATCH_DCL,
                          "DEVICE-LOGICAL-NAME-ISSUE? !AZ !AZ",
                          CgiPlusScriptFileName, tkptr->ScriptFileName);
         }

         if (!tkptr->ScriptProcessPid ||
             tkptr->QueuedSysCommand > tkptr->QueuedSysCommandAllowed ||
             tkptr->QueuedSysOutput ||
             tkptr->QueuedCgiPlusIn ||
             tkptr->QueuedHttpInput ||
             tkptr->QueuedClientRead ||
             tkptr->RequestPtr ||
             tkptr->FindScript ||
             tkptr->DeleteProcess ||
             !strsame (ScriptName, tkptr->ScriptName, -1) ||
             !strsame (CgiPlusScriptFileName,
                       tkptr->ScriptFileName,
                       CgiPlusScriptFileNameLength) ||
             tkptr->ScriptFileName[CgiPlusScriptFileNameLength] != *cptr ||
             (DclScriptDetachProcess &&
              !strsame (ScriptAsPtr, tkptr->CrePrcUserName, -1)))
         {
            tkptr = NULL;
            continue;
         }

         break;
      }

      if (tkptr && WatchThisOne)
         WatchThis (rqptr, FI_LI, WATCH_DCL,
                    "CGIPLUS idle pid:!8XL!&@", tkptr->ScriptProcessPid,
                    tkptr->CrePrcUserName[0] ? " of !AZ" : "!+",
                    tkptr->CrePrcUserName);
   }

   if (TaskType == DCL_TASK_TYPE_RTE_SCRIPT)
   {
      /************************************************/
      /* look for an unused instance of this run-time */
      /************************************************/

      /* initialize least-recently-used storage */
      lrutkptr[0] = lrutkptr[1] = NULL;
      LruSecond[0] = LruSecond[1] = 0;

      for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr)
      {
         tkptr = (DCL_TASK*)leptr;

         if (!tkptr->ScriptProcessPid ||
             tkptr->TaskType != DCL_TASK_TYPE_RTE_SCRIPT ||
             tkptr->QueuedSysCommand > tkptr->QueuedSysCommandAllowed ||
             tkptr->QueuedSysOutput ||
             tkptr->QueuedCgiPlusIn ||
             tkptr->QueuedHttpInput ||
             tkptr->QueuedClientRead ||
             tkptr->RequestPtr ||
             tkptr->FindScript ||
             tkptr->DeleteProcess ||
             !strsame (ScriptRunTime, tkptr->ScriptRunTime, -1) ||
             (DclScriptDetachProcess &&
              !strsame (ScriptAsPtr, tkptr->CrePrcUserName, -1)))
         {
            tkptr = NULL;
            continue;
         }

         if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL))
            WatchThis (rqptr, FI_LI, WATCH_MOD_DCL,
"RTE !&Z !&Z !&B !16&H !16&H !&B !SL !SL !&B !SL !&B !&X !&X !&X",
                       ScriptName, tkptr->ScriptName,
                       strsame (ScriptName, tkptr->ScriptName, -1),
                       &tkptr->Md5HashPath, &rqptr->Md5HashPath,
                       memcmp (&tkptr->Md5HashPath,
                               &rqptr->Md5HashPath,
                               sizeof(rqptr->Md5HashPath)),
                       tkptr->LastUsedSecond, LruSecond[0],
                       tkptr->LastUsedSecond < LruSecond[0],
                       tkptr->LastUsedSecond, LruSecond[1],
                       tkptr->LastUsedSecond < LruSecond[1],
                       tkptr, lrutkptr[0], lrutkptr[1] /* whew! */);

         if (!strsame (ScriptName, tkptr->ScriptName, -1))
         {
            /* not the same script being executed by the RTE */
            if (tkptr->LastUsedSecond < LruSecond[0] || !LruSecond[0])
            {
               LruSecond[0] = tkptr->LastUsedSecond;
               lrutkptr[0] = tkptr;
            }
            tkptr = NULL;
            continue;
         }
         if (memcmp (&tkptr->Md5HashPath,
                     &rqptr->Md5HashPath,
                     sizeof(rqptr->Md5HashPath)))
         {
            /* not the same path being supplied to the script */
            if (tkptr->LastUsedSecond < LruSecond[1] || !LruSecond[1])
            {
               LruSecond[1] = tkptr->LastUsedSecond;
               lrutkptr[1] = tkptr;
            }
            tkptr = NULL;
            continue;
         }

         break;
      }

      if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL))
         WatchThis (rqptr, FI_LI, WATCH_MOD_DCL, "!&X !SL !&X !SL !&X",
                    tkptr, LruSecond[0], lrutkptr[0],
                           LruSecond[1], lrutkptr[1]);

      if (!tkptr)
      {
         /* none was found having the same script and path */
         if (lrutkptr[1])
            /* use the one with the same script in preference to ... */
            tkptr = lrutkptr[1];
         else
         if (lrutkptr[0])
            /* the one just executing the same RTE */
            tkptr = lrutkptr[0];
      }

      if (tkptr)
      {
         if (WatchThisOne)
            WatchThis (rqptr, FI_LI, WATCH_DCL,
                       "RTE idle pid:!8XL!&@(!AZ)", tkptr->ScriptProcessPid,
                       tkptr->CrePrcUserName[0] ? " of !AZ " : "!+",
                       tkptr->CrePrcUserName, tkptr->ScriptName);

         /* ensure the previous script information is not carried over */
         tkptr->ScriptName[0] =
            tkptr->ScriptFileName[0] =
            tkptr->SearchOds.ResFileName[0] = '\0';
         memset (&tkptr->Md5HashPath, 0, sizeof(tkptr->Md5HashPath));
      }
   }

   if (!tkptr && DclUseZombies)
   {
      /************************/
      /* look for idle zombie */
      /************************/

      for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr)
      {
         tkptr = (DCL_TASK*)leptr;

         if (!tkptr->ScriptProcessPid ||
             tkptr->TaskType == DCL_TASK_TYPE_CGIPLUS_SCRIPT ||
             tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT ||
             tkptr->QueuedSysCommand ||
             tkptr->QueuedSysOutput ||
             tkptr->QueuedCgiPlusIn ||
             tkptr->QueuedHttpInput ||
             tkptr->QueuedClientRead ||
             tkptr->FindScript ||
             tkptr->DeleteProcess ||
             tkptr->RequestPtr ||
             (DclScriptDetachProcess &&
              !strsame (ScriptAsPtr, tkptr->CrePrcUserName, -1)))
         {
            tkptr = NULL;
            continue;
         }

         tkptr->BuildRecords =
            tkptr->CgiPlusVarStruct = false;
         tkptr->DclCommandLength =
            tkptr->CgiPlusUsageCount =
            tkptr->LifeTimeSecond =
            tkptr->SysOutputBuildCount = 0;
         tkptr->DclCommandPtr[0] =
            tkptr->ScriptRunTime[0] =
            tkptr->ScriptName[0] =
            tkptr->ScriptFileName[0] =
            tkptr->SearchOds.ResFileName[0] = '\0';
         tkptr->ScriptRunTimePtr = NULL;
         memset (&tkptr->Md5HashPath, 0, sizeof(tkptr->Md5HashPath));

         break;
      }

      if (tkptr && WatchThisOne)
         WatchThis (rqptr, FI_LI, WATCH_DCL,
                    "ZOMBIE idle pid:!8XL!&@", tkptr->ScriptProcessPid,
                    tkptr->CrePrcUserName[0] ? " of !AZ" : "!+",
                    tkptr->CrePrcUserName);
   }

   if (!tkptr && DclScriptProcessCount >= DclScriptProcessHardLimit)
   {
      if (WatchThisOne)
         WatchThis (rqptr, FI_LI, WATCH_DCL,
                    "SCRIPT-PROCESS hard-limit !UL", DclScriptProcessCount);

      /* let's see if we can do something about it! */
      DclScriptProcessPurge ();

      DclHitHardLimitCount++;
      ErrorGeneral (rqptr, MsgFor(rqptr,MSG_SCRIPT_HARD_LIMIT), FI_LI);
      return (STS$K_ERROR);
   }

   if (!tkptr)
   {
      /********************************/
      /* look for free task structure */
      /********************************/

      for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr)
      {
         tkptr = (DCL_TASK*)leptr;

         if (tkptr->ScriptProcessPid ||
             tkptr->QueuedSysCommand ||
             tkptr->QueuedSysOutput ||
             tkptr->QueuedCgiPlusIn ||
             tkptr->QueuedHttpInput ||
             tkptr->QueuedClientRead ||
             tkptr->FindScript ||
             tkptr->DeleteProcess ||
             tkptr->RequestPtr)
         {
            tkptr = NULL;
            continue;
         }

         tkptr->BuildRecords =
            tkptr->CgiPlusVarStruct = false;
         tkptr->DclCommandLength =
            tkptr->CgiPlusUsageCount =
            tkptr->LifeTimeSecond =
            tkptr->SysOutputBuildCount = 0;
         tkptr->CrePrcUserName[0] =
            tkptr->DclCommandPtr[0] =
            tkptr->ScriptRunTime[0] =
            tkptr->ScriptName[0] =
            tkptr->ScriptFileName[0] =
            tkptr->SearchOds.ResFileName[0] = '\0';
         tkptr->ScriptRunTimePtr = NULL;
         memset (&tkptr->Md5HashPath, 0, sizeof(tkptr->Md5HashPath));
         break;
      }
   }

   if (!tkptr)
   {
      /* if we're getting short of script processes then start purging */
      if (DclScriptProcessCount >= DclScriptProcessSoftLimit)
      {
         if (WatchThisOne)
            WatchThis (rqptr, FI_LI, WATCH_DCL,
                       "SCRIPT-PROCESS soft-limit purge !UL",
                       DclScriptProcessCount);

         DclScriptProcessPurge ();
      }
   }

   if (!tkptr)
   {
      /*********************/
      /* create a new task */
      /*********************/

      tkptr = VmGet (sizeof(DCL_TASK));

      /* allocate an ambit minimum size DCL command buffer */
      tkptr->DclCommandPtr = VmGet (DCL_COMMAND_MIN_SIZE);
      tkptr->DclCommandSize = DCL_COMMAND_MIN_SIZE;
      tkptr->DclCommandLength = 0;
      
      /*
         Allocate memory in the DCL task for SYS$OUTPUT buffer.
         Allow two bytes for carriage control and terminating null.
      */
      tkptr->SysOutputPtr = VmGet (DclSysOutputSize+3);
      tkptr->SysOutputSize = DclSysOutputSize;

      if (VMSnok (status = DclCreateMailboxes (tkptr)))
      {
         VmFree (tkptr->SysOutputPtr, FI_LI);
         VmFree (tkptr, FI_LI);
         rqptr->rqResponse.ErrorTextPtr = MsgFor(rqptr,MSG_SCRIPT_IPC);
         ErrorVmsStatus (rqptr, status, FI_LI);
         return (status);
      }

      ListAddTail (&DclTaskList, tkptr);
   }

   /*******************/
   /* initialize task */
   /*******************/

   /* associate the DCL task and the request */
   rqptr->DclTaskPtr = tkptr;
   tkptr->RequestPtr = rqptr;          

   tkptr->TaskType = TaskType;
   tkptr->TotalUsageCount++;
   tkptr->ForceImageExit = true;
   tkptr->DeleteProcess =
      tkptr->TaskRunDown = false;
   tkptr->ClientWriteErrorCount =
      tkptr->ForceImageExitSecond =
      tkptr->ScriptCpuTimMax =
      tkptr->SysOutputEndOfFileCount = 0;
   if (rqptr->rqPathSet.ScriptBitBucketTimeout)
      tkptr->BitBucketTimeout = rqptr->rqPathSet.ScriptBitBucketTimeout;
   else
      tkptr->BitBucketTimeout = Config.cfScript.BitBucketTimeout;
   tkptr->ScriptCpuMax = rqptr->rqPathSet.ScriptCpuMax;
   memset (&tkptr->Md5HashPath, 0, sizeof(tkptr->Md5HashPath));

   switch (TaskType)
   {
      case DCL_TASK_TYPE_CGI_SCRIPT :

         rqptr->rqCgi.IsCliDcl =
            tkptr->BuildRecords =
            tkptr->CgiPlusVarStruct =
            tkptr->ScriptProcessActivated =
            tkptr->ScriptProcessResponded = false;
         tkptr->CgiPlusUsageCount =
            tkptr->CgiBelLength =
            tkptr->CgiEofLength =
            tkptr->CgiEotLength =
            tkptr->CgiEscLength =
            tkptr->LifeTimeSecond =
            tkptr->SysOutputBuildCount = 0;
         tkptr->CgiBel[0] =
            tkptr->CgiEof[0] =
            tkptr->CgiEot[0] =
            tkptr->CgiEsc[0] = '\0';

         /* limited life in the twilight zone */
         if (DclUseZombies && Config.cfScript.ZombieLifeTime)
         {
            DclSupervisor (0);
            tkptr->LifeTimeSecond = HttpdTickSecond +
                                    Config.cfScript.ZombieLifeTime;
         }

         /* always generate new strings for standard CGI scripts */
         CgiSequenceBel (tkptr->CgiBel, &tkptr->CgiBelLength);
         CgiSequenceEof (tkptr->CgiEof, &tkptr->CgiEofLength);
         CgiSequenceEot (tkptr->CgiEot, &tkptr->CgiEotLength);
         CgiSequenceEsc (tkptr->CgiEsc, &tkptr->CgiEscLength);

         /* note: CgiBel is for DCL module internal use only */
         rqptr->rqCgi.EofPtr = tkptr->CgiEof;
         rqptr->rqCgi.EofLength = tkptr->CgiEofLength;
         rqptr->rqCgi.EotPtr = tkptr->CgiEot;
         rqptr->rqCgi.EotLength = tkptr->CgiEotLength;
         rqptr->rqCgi.EscPtr = tkptr->CgiEsc;
         rqptr->rqCgi.EscLength = tkptr->CgiEscLength;

         break;

      case DCL_TASK_TYPE_CGIPLUS_SCRIPT :
      case DCL_TASK_TYPE_RTE_SCRIPT :

         rqptr->rqCgi.IsCliDcl =
            tkptr->ScriptProcessActivated =
            tkptr->ScriptProcessResponded = false;
         tkptr->CgiPlusUsageCount++;
         tkptr->ZombieCount = 0;

         /* give it three-score years and ten if life-time is specified */
         if (Config.cfScript.CgiPlusLifeTime)
         {
            /* if set do-not-disturb carries across CGIplus requests */
            if (tkptr->LifeTimeSecond != DCL_DO_NOT_DISTURB)
            {
               DclSupervisor (0);
               tkptr->LifeTimeSecond = HttpdTickSecond +
                                       Config.cfScript.CgiPlusLifeTime;
            }
         }

         /* CGIplus MUST retain original EOF/EOT/ESC until process dies */
         if (!tkptr->CgiBelLength)
            CgiSequenceBel (tkptr->CgiBel, &tkptr->CgiBelLength);
         if (!tkptr->CgiEofLength)
            CgiSequenceEof (tkptr->CgiEof, &tkptr->CgiEofLength);
         if (!tkptr->CgiEotLength)
            CgiSequenceEot (tkptr->CgiEot, &tkptr->CgiEotLength);
         if (!tkptr->CgiEscLength)
            CgiSequenceEsc (tkptr->CgiEsc, &tkptr->CgiEscLength);

         /* note: CgiBel is for DCL module internal use only */
         rqptr->rqCgi.EofPtr = tkptr->CgiEof;
         rqptr->rqCgi.EofLength = tkptr->CgiEofLength;
         rqptr->rqCgi.EotPtr = tkptr->CgiEot;
         rqptr->rqCgi.EotLength = tkptr->CgiEotLength;
         rqptr->rqCgi.EscPtr = tkptr->CgiEsc;
         rqptr->rqCgi.EscLength = tkptr->CgiEscLength;

         break;

      case DCL_TASK_TYPE_CLI :

         rqptr->rqCgi.IsCliDcl = true;
         tkptr->BuildRecords =
            tkptr->CgiPlusVarStruct = false;
         tkptr->CgiPlusUsageCount =
            tkptr->CgiEofLength =
            tkptr->CgiEotLength =
            tkptr->CgiEscLength =
            tkptr->LifeTimeSecond =
            tkptr->SysOutputBuildCount = 0;
         tkptr->CgiEof[0] =
            tkptr->CgiEot[0] =
            tkptr->CgiEsc[0] = '\0';
         CgiSequenceBel (tkptr->CgiBel, &tkptr->CgiBelLength);

         /* limited life in the twilight zone */
         if (DclUseZombies && Config.cfScript.ZombieLifeTime)
         {
            DclSupervisor (0);
            tkptr->LifeTimeSecond = HttpdTickSecond +
                                    Config.cfScript.ZombieLifeTime;
         }

         if (DclUseZombies)
         {
            /* always generate a new EOF string for DCL commands */
            CgiSequenceEof (tkptr->CgiEof, &tkptr->CgiEofLength);
            rqptr->rqCgi.EofPtr = tkptr->CgiEof;
            rqptr->rqCgi.EofLength = tkptr->CgiEofLength;
         }

         break;

      default :
            ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
   }

   if (Watch.Category && WatchThisOne)
   {
      WatchThis (rqptr, FI_LI, WATCH_DCL, "MBX SYS$COMMAND !AZ",
                 tkptr->SysCommandDevName);
      WatchThis (rqptr, FI_LI, WATCH_DCL, "MBX SYS$OUTPUT !AZ",
                 tkptr->SysOutputDevName);
      WatchThis (rqptr, FI_LI, WATCH_DCL, "MBX CGIPLUSIN !AZ",
                 tkptr->CgiPlusInDevName);
      WatchThis (rqptr, FI_LI, WATCH_DCL, "MBX HTTP$INPUT !AZ",
                 tkptr->HttpInputDevName);
      WatchThis (rqptr, FI_LI, WATCH_DCL, "MBX termination !AZ",
                 tkptr->CrePrcTermMbxDevName);
   }

   if (tkptr->ScriptProcessPid)
   {
      /******************/
      /* process exists */
      /******************/

      /* kick off the first of the CPU consumption watchdogs */
      if (tkptr->ScriptCpuMax) DclScriptCpuTim (tkptr);

      return (SS$_NORMAL);
   }

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

   status = DclCreateScriptProcess (tkptr, ScriptAsPtr, BasePriority);
   if (VMSok (status))
   {
      tkptr->ZombieCount = 0;
      DclScriptProcessCount++;

      /* in this case we know the CPU consumption is starting at zero ;^) */
      if (tkptr->ScriptCpuMax)
         /* multiply by one hundred turning seconds into 10mS ticks */
         tkptr->ScriptCpuTimMax = tkptr->ScriptCpuMax * 100;

      return (status);
   }
   else
   {
      /* disassociate the DCL task and request structures */
      rqptr->DclTaskPtr = tkptr->RequestPtr = NULL;
      tkptr->WatchItem = 0;
      return (status);
   }
}

/*****************************************************************************/
/*
Search the script name cache using a task structure to get information about
the script's environment.
*/ 

DclSearchScriptNameCache
(
DCL_TASK *tkptr,
REQUEST_STRUCT *rqptr
)
{
   DCL_SCRIPT_NAME_ENTRY  *captr;
   LIST_ENTRY  *leptr;

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (rqptr, FI_LI, WATCH_MOD_DCL,
                 "DclSearchScriptNameCache() !&Z !&Z",
                 tkptr->ScriptFileName, tkptr->ScriptRunTime);

   for (leptr = DclScriptNameCacheList.HeadPtr;
        leptr;
        leptr = leptr->NextPtr)
   {
      captr = (DCL_SCRIPT_NAME_ENTRY*)leptr;

      if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL))
         WatchThis (rqptr, FI_LI, WATCH_MOD_DCL, "!&Z !&Z !&B !&Z",
                    tkptr->ScriptFileName, captr->ScriptFileName,
                    strsame (tkptr->ScriptFileName, captr->ScriptFileName, -1),
                    captr->ResFileName);

      if (!captr->ResFileName[0]) continue;
      if (!strsame (tkptr->ScriptFileName, captr->ScriptFileName, -1)) continue;

      if (!rqptr->PragmaNoCache)
      {
         /* found it */
         if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_DCL))
            WatchThis (rqptr, FI_LI, WATCH_DCL,
                       "SCRIPT name cache !UL hit!%s !AZ as !AZ",
                       captr->HitCount+1, tkptr->ScriptFileName, 
                       captr->ResFileName);

         /* copy the expanded (searched for) file name to the task */
         strcpy (tkptr->SearchOds.ResFileName, captr->ResFileName);
         rqptr->rqCgi.ScriptFileNamePtr = tkptr->SearchOds.ResFileName;
         strcpy (tkptr->SearchOds.ResFileName, captr->ResFileName);
         if (captr->ScriptRunTime[0])
         {
            strcpy (tkptr->ScriptRunTime, captr->ScriptRunTime);
            tkptr->ScriptRunTimePtr = tkptr->ScriptRunTime;
         }
         else
         {
            tkptr->ScriptRunTime[0] = '\0';
            tkptr->ScriptRunTimePtr = NULL;
         }
         captr->HitCount++;
         memcpy (&captr->LastBinaryTime, &rqptr->rqTime.Vms64bit, 8);

         return;
      }

      /* "reload" is used to purge the script name cache entry */
      captr->ResFileName[0] = captr->ScriptRunTime[0] = '\0';
      tkptr->ScriptRunTimePtr = NULL;
      return;
   }

   if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_DCL))
      WatchThis (rqptr, FI_LI, WATCH_DCL,
                 "SCRIPT name cache !AZ not found", tkptr->ScriptFileName); 
}

/*****************************************************************************/
/*
Add the name details of a script to the cache.  First check that no other
request has provided this same entry while this request was finding the script
details.  Then update an empty entry if it can be found in the list, or create
a new entry and add it to the list.
*/ 

DclUpdateScriptNameCache (DCL_TASK *tkptr)

{
   DCL_SCRIPT_NAME_ENTRY  *captr;
   LIST_ENTRY  *leptr;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "DclUpdateScriptNameCache() !&Z !&Z !&Z",
                 tkptr->ScriptFileName, tkptr->SearchOds.ResFileName,
                 tkptr->ScriptRunTime);

   /* check that no one has beaten us to it */
   for (leptr = DclScriptNameCacheList.HeadPtr;
        leptr;
        leptr = leptr->NextPtr)
   {
      captr = (DCL_SCRIPT_NAME_ENTRY*)leptr;
      if (strsame (tkptr->ScriptFileName, captr->ScriptFileName, -1) &&
          captr->ResFileName[0]) return;
   }

   /* now look for an empty entry */
   for (leptr = DclScriptNameCacheList.HeadPtr;
        leptr;
        leptr = leptr->NextPtr)
   {
      captr = (DCL_SCRIPT_NAME_ENTRY*)leptr;
      if (!captr->ResFileName[0]) break;
   }

   if (!leptr)
   {
      /* didn't find an instance of the script create a new entry */
      captr = VmGet (sizeof(DCL_SCRIPT_NAME_ENTRY));
      ListAddTail (&DclScriptNameCacheList, captr);
   }

   /* cache the script name information */
   strcpy (captr->ScriptFileName, tkptr->ScriptFileName);
   strcpy (captr->ResFileName, tkptr->SearchOds.ResFileName);
   if (tkptr->ScriptRunTime[0])
      strcpy (captr->ScriptRunTime, tkptr->ScriptRunTime);
   else
      captr->ScriptRunTime[0] = '\0';
   captr->HitCount = 0;
   memcpy (&captr->LastBinaryTime, tkptr->RequestPtr->rqTime.Vms64bit, 8);

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                 "SCRIPT name cache update !AZ as !AZ",
                 captr->ScriptFileName, captr->ResFileName);
}

/*****************************************************************************/
/*
Set all expanded file name entries in the script name cache to empty.  This
function is called when the DCLSupervisor() determines there are no more
zombies or CGIplus scripts active, and also when script processes are purged.
*/ 

DclPurgeScriptNameCache ()

{
   DCL_SCRIPT_NAME_ENTRY  *captr;
   LIST_ENTRY  *leptr;

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclPurgeScriptNameCache()");

   DclPurgeScriptNameCacheCount++;

   for (leptr = DclScriptNameCacheList.HeadPtr;
        leptr;
        leptr = leptr->NextPtr)
   {
      captr = (DCL_SCRIPT_NAME_ENTRY*)leptr;
      captr->ResFileName[0] = captr->ScriptRunTime[0] = '\0';
   }
}

/*****************************************************************************/
/*
Perform an asynchronous search for the script file specified by
'tkptr->ScriptFileName'.  When found return the actual script file in
'tkptr->SearchOds.ResFileName' and call DclBeginScript().  If not found set to
empty and conclude the task.  The search is performed first by checking for a
file with the file type supplied with the script specification (usually not),
then by defaulting to ".COM", then ".EXE", and finally to any configured
runtime file types, in that order.

The file search uses a DCL task structure but no script process I/O is actually
underway. As the search is AST-driven it is possible for a cancelling client
to disconnect from the task structure via DclTaskRunDown() while the search
is in progress. Each find-script-file function checks for the request pointer
and aborts the search if no longer present. The 'tkptr->FindScript' flag
indicates the structure is in use for this purpose and so will not be
reallocated until reset as the search is finally aborted.
*/ 

DclFindScript (DCL_TASK *tkptr)

{
   int  status, idx;
   REQUEST_STRUCT  *rqptr;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "DclFindScript() !UL !&Z !&Z",
                 tkptr->FindScriptState, tkptr->ScriptFileName,
                 tkptr->ScriptRunTime);

   if (!(rqptr = tkptr->RequestPtr))
   {
      /* request thread has disconnected during file search */
      DclFindScriptEnd (tkptr, false);
      return;
   }

   switch (tkptr->FindScriptState)
   {
      case DCL_FIND_SCRIPT_BEGIN :

         tkptr->FindScript = true;
         tkptr->FindScriptFileNamePtr = tkptr->ScriptFileName;

         /* first look for DCL procedure (overridden if file type supplied) */
         tkptr->FindScriptState = DCL_FIND_SCRIPT_COM;
         OdsParse (&tkptr->SearchOds,
                   tkptr->FindScriptFileNamePtr, 0, ".COM;", 5,
                   0, &DclFindScriptParseAst, tkptr);
         return;

      case DCL_FIND_SCRIPT_COM :

         /* command procedure not found, look for a command definition */
         tkptr->FindScriptState = DCL_FIND_SCRIPT_CLD;
         OdsParse (&tkptr->SearchOds,
                   tkptr->FindScriptFileNamePtr, 0, ".CLD;", 5,
                   0, &DclFindScriptParseAst, tkptr);
         return;

      case DCL_FIND_SCRIPT_CLD :

         /* command procedure not found, look for an executable */
         tkptr->FindScriptState = DCL_FIND_SCRIPT_EXE;
         OdsParse (&tkptr->SearchOds,
                   tkptr->FindScriptFileNamePtr, 0, ".EXE;", 5,
                   0, &DclFindScriptParseAst, tkptr);

         return;

      case DCL_FIND_SCRIPT_EXE :

         /* command definition not found, look for a configured run-time */
         tkptr->FindScriptRunTimeIdx = 0;
         tkptr->FindScriptState = DCL_FIND_SCRIPT_RUNTIME;

      case DCL_FIND_SCRIPT_RUNTIME :

         /* looking through any list of user-defined script file types */
         idx = tkptr->FindScriptRunTimeIdx++;
         if (idx >= Config.cfScript.RunTimeCount)
         {
            /********************/
            /* script not found */
            /********************/

            /* indicate the script was not found */
            tkptr->SearchOds.ResFileName[0] = '\0';

            if (!tkptr->CalloutFunction ||
                (void*)tkptr->CalloutFunction ==
                (void*)&DclCalloutDefault)
            {
               /* standard CGI/CGIplus script */
               rqptr->rqResponse.HttpStatus = 404;
               ErrorGeneral (rqptr, MsgFor(rqptr,MSG_SCRIPT_NOT_FOUND), FI_LI);
            }
            else
            {
               /* not a standard CGIplus script, an agent task */
               rqptr->rqResponse.HttpStatus = 500;
               ErrorGeneral (rqptr, MsgFor(rqptr,MSG_AUTH_AGENT_NOT_FOUND), FI_LI);
            }

            DclFindScriptEnd (tkptr, false);

            return;
         }

         OdsParse (&tkptr->SearchOds,
                   tkptr->FindScriptFileNamePtr, 0,
                   Config.cfScript.RunTime[idx].String,
                   Config.cfScript.RunTime[idx].FileTypeLength,
                   0, &DclFindScriptParseAst, tkptr);

         return;

      default :
            ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
   }
}

/*****************************************************************************/
/*
AST called from DclFindScript() when asynchronous parse completes.  Check for
error status, then perform an asynchronous search with AST to
DclFindScriptSearchAst()
*/

DclFindScriptParseAst (struct FAB *FabPtr)

{
   int  status;
   REQUEST_STRUCT  *rqptr;
   DCL_TASK  *tkptr;

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

   tkptr = FabPtr->fab$l_ctx;

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "DclFindScriptParseAst() !&F sts:!&S stv:!&S",
                 &DclFindScriptParseAst, FabPtr->fab$l_sts, FabPtr->fab$l_stv);

   if (!(rqptr = tkptr->RequestPtr))
   {
      /* request thread has disconnected during file search */
      DclFindScriptEnd (tkptr, false);
      return;
   }

   if (VMSnok (status = FabPtr->fab$l_sts))
   {
      rqptr->rqResponse.ErrorTextPtr = tkptr->ScriptName;
      rqptr->rqResponse.ErrorOtherTextPtr = tkptr->ScriptFileName;
      ErrorVmsStatus (rqptr, status, FI_LI);
      DclFindScriptEnd (tkptr, false);
      return;
   }

   if (tkptr->SearchOds.Nam_fnb & NAM$M_WILDCARD)
   {
      rqptr->rqResponse.HttpStatus = 403;
      rqptr->rqResponse.ErrorTextPtr = tkptr->ScriptName;
      rqptr->rqResponse.ErrorOtherTextPtr = tkptr->ScriptFileName;
      ErrorGeneral (rqptr, MsgFor(rqptr,MSG_GENERAL_NO_WILDCARD), FI_LI);
      DclFindScriptEnd (tkptr, false);
      return;
   }

   OdsSearch (&tkptr->SearchOds, &DclFindScriptSearchAst, tkptr);
}

/*****************************************************************************/
/*
AST called from DclFindScriptParseAst() when asynchronous search completes.
Check for a file-not-found status, if so then call DclFindScript() to search
for the next possibility.  Check for an error status.  If the file has been
found determine the runtime environment and initiate the script process
execution. 
*/

DclFindScriptSearchAst (struct FAB *FabPtr)

{
   int  status, idx;
   char  *cptr, *sptr, *zptr;
   REQUEST_STRUCT  *rqptr;
   DCL_TASK  *tkptr;

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

   tkptr = FabPtr->fab$l_ctx;

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "DclFindScriptSearchAst() !&F sts:!&S stv:!&S",
                 &DclFindScriptSearchAst, FabPtr->fab$l_sts, FabPtr->fab$l_stv);

   if (!(rqptr = tkptr->RequestPtr))
   {
      /* request thread has disconnected during file search */
      DclFindScriptEnd (tkptr, false);
      return;
   }

   if (VMSnok (status = FabPtr->fab$l_sts))
   {
      if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_DCL))
      {
         tkptr->SearchOds.NamVersionPtr[0] = '\0';
         WatchThis (rqptr, FI_LI, WATCH_DCL,
                    "SEARCH !AZ !&S %!-!&M",
                    tkptr->SearchOds.NamDevicePtr, status);
         tkptr->SearchOds.NamVersionPtr[0] = ';';
      }

      if (status == RMS$_FNF)
      {
         /* not found, look for another */
         DclFindScript (tkptr);
         return;
      }

      /* some other error, report it and finish up */
      rqptr->rqResponse.ErrorTextPtr = tkptr->ScriptName;
      rqptr->rqResponse.ErrorOtherTextPtr = tkptr->ScriptFileName;
      ErrorVmsStatus (rqptr, status, FI_LI);
      DclFindScriptEnd (tkptr, false);
      return;
   }

   if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_DCL))
   {
      tkptr->SearchOds.NamVersionPtr[0] = '\0';
      WatchThis (rqptr, FI_LI, WATCH_DCL,
                 "SEARCH found !AZ", tkptr->SearchOds.NamDevicePtr);
      tkptr->SearchOds.NamVersionPtr[0] = ';';
   }

   /*************/
   /* found it! */
   /*************/

   if (tkptr->ScriptRunTime[0])
      tkptr->ScriptRunTimePtr = tkptr->ScriptRunTime;
   else
   if (strsame (tkptr->SearchOds.NamTypePtr, ".COM;", 5))
      tkptr->ScriptRunTimePtr = "@";
   else
   if (strsame (tkptr->SearchOds.NamTypePtr, ".CLD;", 5))
      tkptr->ScriptRunTimePtr = "=";
   else
   if (strsame (tkptr->SearchOds.NamTypePtr, ".EXE;", 5))
      tkptr->ScriptRunTimePtr = "$";
   else
   {
      /* look through the list of user-definable script file types */
      for (idx = 0; idx < Config.cfScript.RunTimeCount; idx++)
      {
         if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
            WatchDataFormatted ("!&Z !&Z\n",
                                tkptr->SearchOds.NamTypePtr,
                                Config.cfScript.RunTime[idx].String);
         if (strsame (tkptr->SearchOds.NamTypePtr,
                      Config.cfScript.RunTime[idx].String,
                      Config.cfScript.RunTime[idx].FileTypeLength))
            break;
      }
      if (idx < Config.cfScript.RunTimeCount)
      {
         /* found the file type (file extension) */
         cptr = Config.cfScript.RunTime[idx].String;
         while (*cptr && *cptr != ' ') cptr++;
         if (*cptr) cptr++;
         tkptr->ScriptRunTimePtr = cptr;
      }
      else
      if (tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT)
         tkptr->ScriptRunTimePtr = NULL;
      else
      {
         /********************************************/
         /* don't know how to execute this file type */
         /********************************************/

         rqptr->rqResponse.HttpStatus = 500;
         tkptr->SearchOds.NamVersionPtr[0] = '\0';
         ErrorGeneral (rqptr,
"Execution of &nbsp;<TT>!AZ</TT>&nbsp; script types not configured.",
                       tkptr->SearchOds.NamTypePtr, FI_LI);
         DclFindScriptEnd (tkptr, false);
         return;
      }
   }

   /**********************/
   /* execute the script */
   /**********************/

   /* terminate the expanded CGI file name */
   tkptr->SearchOds.NamVersionPtr[0] = '\0';

   DclFindScriptEnd (tkptr, true);
}

/*****************************************************************************/
/*
The parse structures only really need to be explicitly released if the script
is actually found, otherwise they are always implicitly released on the
sys$search() file-not-found! Here we'll do it all the time as we are dealing
with possible search abort as well as general search conclusion. When doing so
use scratch expanded file name space so as not to overwrite the CGI file name
if the script file was found.
*/

DclFindScriptEnd
(
DCL_TASK *tkptr,
BOOL FileFound
)
{
   /*********/
   /* begin */
   /*********/

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "DclFindScriptEnd() !&F !&B", &DclFindScriptEnd, FileFound);

   tkptr->FindScript = false;

   /* ensure parse internal data structures are released */
   if (tkptr->SearchOds.ParseInUse) OdsParseRelease (&tkptr->SearchOds);

   if (FileFound)
   {
      /* update the cache */
      DclUpdateScriptNameCache (tkptr);

      /* NOW update the script file name with the one actually resolved */
      strcpy (tkptr->ScriptFileName, tkptr->SearchOds.ResFileName);
      tkptr->RequestPtr->rqCgi.ScriptFileNamePtr = tkptr->ScriptFileName;

      DclBeginScript (tkptr);
      return;
   }

   /* ensure it looks as if it was NOT found */
   tkptr->SearchOds.ResFileName[0] = '\0';
   DclTaskRunDown (tkptr); 
   return;
}

/*****************************************************************************/
/*
Abort current request script processing, freeing the request and DCL task from
each other, then restart DCL processing appropriately.  Is used to restart
processing after CGIplus script failed to start (see "April 1998 Note:" above)
or when a run-time configuration entry indicates either CGIplus or RTE should
be used to handle scripting the file type.  When restarting for RTE two sources
of the RTE executable must be considered.  If from the [DclScriptRunTime]
configuration structure then 'ScriptRunTimePtr' points to a file name,
otherwise 'ScriptRunTimePtr' points to either "$" or "@" to indicate how the
file should be handled.  If the seconad character is a null then it's the
latter and the 'ResFileName' should be used.
*/ 

DclRestartScript (DCL_TASK *tkptr)

{
   int  TaskType;
   char  *ScriptRunTimePtr;
   char  DclCommand [DCL_COMMAND_MAX_SIZE],
         ScriptRunTime [ODS_MAX_FILE_NAME_LENGTH+1],
         ResFileName [ODS_MAX_FILE_NAME_LENGTH+1],
         ScriptFileName [ODS_MAX_FILE_NAME_LENGTH+1],
         ScriptName [SCRIPT_NAME_SIZE];
   REQUEST_AST  NextTaskFunction;
   REQUEST_STRUCT  *rqptr;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclRestartScript()");

   rqptr = tkptr->RequestPtr;

   if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_DCL))
      WatchThis (rqptr, FI_LI, WATCH_DCL, "RESTART script !UL",
                 tkptr->RequestPtr->rqCgi.ScriptRetryCount);

   /* retrieve necessary information from the current DCL task */
   TaskType = tkptr->TaskType;
   NextTaskFunction = tkptr->NextTaskFunction;
   strcpy (ResFileName, tkptr->SearchOds.ResFileName);
   strcpy (ScriptFileName, tkptr->ScriptFileName);
   strcpy (ScriptName, tkptr->ScriptName);
   strcpy (DclCommand, tkptr->DclCommandPtr);
   if (tkptr->ScriptRunTime[0])
   {
      strcpy (ScriptRunTime, tkptr->ScriptRunTime);
      ScriptRunTimePtr = ScriptRunTime;
   }
   else
      ScriptRunTimePtr = NULL;

   /* disassociate the DCL task and request structures, then conclude */
   tkptr->RequestPtr->DclTaskPtr = NULL;
   tkptr->RequestPtr = tkptr->NextTaskFunction = NULL;
   tkptr->WatchItem = 0;
   DclTaskRunDown (tkptr); 

   /* restart using a new DCL task */
   switch (TaskType)
   {
      case DCL_TASK_TYPE_CGIPLUS_SCRIPT :

         DclBegin (rqptr, NextTaskFunction, NULL, ScriptName, NULL,
                   ScriptFileName, ScriptRunTimePtr, NULL);
         return;

      case DCL_TASK_TYPE_CGI_SCRIPT :

         DclBegin (rqptr, NextTaskFunction, NULL, ScriptName, ScriptFileName,
                   NULL, ScriptRunTimePtr, NULL);
         return;

      case DCL_TASK_TYPE_RTE_SCRIPT :

         DclBegin (rqptr, NextTaskFunction, NULL, ScriptName, ScriptFileName,
                   NULL, ScriptRunTime, NULL);
         return;

      case DCL_TASK_TYPE_CLI :

         DclBegin (rqptr, NextTaskFunction, DclCommand, NULL, NULL,
                   NULL, NULL, NULL);
         return;

      default :

         ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
   }
}

/*****************************************************************************/
/*
Called with an already-established CGIplus script, a DCL command, or when a
new CGIplus or CGI script file name has been searched for and found.  Begin
the I/O with the script process.
*/ 

DclBeginScript (DCL_TASK *tkptr)

{
   int  status,
        Length;
   char  *ContentPtr;
   REQUEST_STRUCT  *rqptr;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclBeginScript()");

   if (!(rqptr = tkptr->RequestPtr))
   {
      /* request thread has disconnected during file search */
      DclTaskRunDown (tkptr);
      return;
   }

   if (tkptr->TaskType == DCL_TASK_TYPE_CGI_SCRIPT ||
       tkptr->TaskType == DCL_TASK_TYPE_CGIPLUS_SCRIPT ||
       tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT)
   {
      /* provide request stream (HTTP$INPUT) to script process */
      if (Config.cfScript.FullRequest)
      {
         ErrorGeneral (rqptr, "[DclFullRequest] no longer supported!", FI_LI);
         DclTaskRunDown (tkptr);
         return;
      }

      BodyReadBegin (rqptr, &DclHttpInput, NULL);
      tkptr->QueuedClientRead++;
   }

   /* queue the initial read of the script process' SYS$OUTPUT */
   DclQioSysOutput (tkptr);

   switch (tkptr->TaskType)
   {
      case DCL_TASK_TYPE_CGI_SCRIPT :

         tkptr->QueuedSysCommandAllowed = 0;
         rqptr->rqResponse.ErrorTextPtr =
            MsgFor(rqptr,MSG_SCRIPT_DCL_ENVIRONMENT);
         if (VMSnok (DclCgiScriptSysCommand (tkptr)))
         {
            tkptr->DeleteProcess = true;
            DclTaskRunDown (tkptr);
            return;
         }

         break;

      case DCL_TASK_TYPE_CGIPLUS_SCRIPT :
      case DCL_TASK_TYPE_RTE_SCRIPT :

         /* allow for the outstanding queued "STOP/ID=0" and EOF */
         tkptr->QueuedSysCommandAllowed = 2;
         if (tkptr->QueuedSysCommand < tkptr->QueuedSysCommandAllowed)
            DclCgiPlusScriptSysCommand (tkptr);

         /* here comes the CGI variable stream */
         if (VMSnok (DclCgiPlusScriptCgiPlusIn (tkptr)))
         {
            tkptr->DeleteProcess = true;
            DclTaskRunDown (tkptr);
            return;
         }

         break;

      case DCL_TASK_TYPE_CLI :

         tkptr->QueuedSysCommandAllowed = 0;
         if (VMSnok (DclCgiScriptSysCommand (tkptr)))
         {
            tkptr->DeleteProcess = true;
            DclTaskRunDown (tkptr);
            return;
         }

         break;

      default :
            ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
   }

   /* remove default error message */
   rqptr->rqResponse.ErrorTextPtr = NULL;
}

/*****************************************************************************/
/*
Delete any script (sub)processes. 
Called by the image user-mode exit handler.
*/

DclExit ()

{
   int  status,
        SetPrvStatus;
   DCL_TASK  *tkptr;
   LIST_ENTRY  *leptr;

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclExit()");

   for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr)
   {
      tkptr = (DCL_TASK*)leptr;
      if (!tkptr->ScriptProcessPid) continue;

      /* need WORLD privilege if process created under another username */
      if (tkptr->CrePrcUserName[0])
         if (VMSnok (SetPrvStatus = sys$setprv (1, &WorldMask, 0, 0)))
            ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);

      status = sys$delprc (&tkptr->ScriptProcessPid, 0);

      if (tkptr->CrePrcUserName[0])
         if (VMSnok (SetPrvStatus = sys$setprv (0, &WorldMask, 0, 0)))
            ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);

      if (VMSnok (status)) ErrorNoticed (status, "sys$delprc()", FI_LI); 
   }
}

/*****************************************************************************/
/*
The maximum number of concurrent script processes has been reached. Look
through the DCL task structure for a CGIplus script process not currently in
use. Find the least used script process and delete it.  A lifetime count of -1
or if it set as do-not-disturb indicates the script process has requested that
it be immune to supervisor purging.
*/

DclScriptProcessPurge ()

{
   int  status,
        MinUsageCount;
   DCL_TASK  *mintkptr;
   DCL_TASK  *tkptr;
   LIST_ENTRY  *leptr;

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclScriptProcessPurge() !UL !UL",
                 DclScriptProcessCount, DclScriptProcessSoftLimit);

   DclPurgeCount++;
   MinUsageCount = 999999999;
   mintkptr = NULL;

   for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr)
   {
      tkptr = (DCL_TASK*)leptr;

      if (!tkptr->ScriptProcessPid ||
          tkptr->QueuedSysOutput ||
          tkptr->QueuedCgiPlusIn ||
          tkptr->QueuedHttpInput ||
          tkptr->QueuedClientRead ||
          (tkptr->TaskType != DCL_TASK_TYPE_CGIPLUS_SCRIPT &&
           tkptr->TaskType != DCL_TASK_TYPE_RTE_SCRIPT) ||
          tkptr->LifeTimeSecond == DCL_DO_NOT_DISTURB ||
          tkptr->RequestPtr ||
          tkptr->FindScript ||
          tkptr->DeleteProcess)
         continue;

      if (tkptr->CgiPlusUsageCount < MinUsageCount)
         MinUsageCount = (mintkptr = tkptr)->CgiPlusUsageCount;
   }

   if (!mintkptr) return;

   mintkptr->DeleteProcess = true;
   DclTaskRunDown (mintkptr);
   DclSoftLimitPurgeCount++;
}

/*****************************************************************************/
/*
This function may be called at any stage to rundown or abort a DCL task,
including during the search for the script file (see note in DclFindScript()).
If there is still outstanding I/O this is cancelled as appropriate to task
rundown or abort. If no outstanding I/O then if there is an associated request
that request's next task function is called.
*/

DclTaskRunDown (DCL_TASK *tkptr)

{
   int  status,
        SetPrvStatus;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
         "DclTaskRundown() !&X !UL !UL !UL !UL !UL !UL !UL !UL !8XL",
         tkptr->RequestPtr, tkptr->DeleteProcess,
         tkptr->ForceImageExit, tkptr->ForceImageExitSecond,
         tkptr->QueuedSysCommand,
         tkptr->QueuedSysOutput, tkptr->QueuedCgiPlusIn,
         tkptr->QueuedHttpInput, tkptr->QueuedClientRead,
         tkptr->ScriptProcessPid);

   if (tkptr->RequestPtr)
      if (tkptr->RequestPtr->rqTmr.TerminatedCount)
         tkptr->DeleteProcess = true;

   tkptr->TaskRunDown = true;

   if (tkptr->DeleteProcess) tkptr->QueuedSysCommandAllowed = 0;

   if (tkptr->QueuedSysCommand > tkptr->QueuedSysCommandAllowed ||
       tkptr->QueuedSysOutput ||
       tkptr->QueuedCgiPlusIn ||
       tkptr->QueuedHttpInput || 
       tkptr->QueuedClientRead)
   {
      /****************/
      /* rundown task */
      /****************/

      if (tkptr->DeleteProcess && tkptr->ForceImageExit)
      {
         DclForceImageExit (tkptr);
         return;
      }

      if (tkptr->DeleteProcess)
      {
         /* cancel ALL outstanding I/O */
         sys$cancel (tkptr->SysCommandChannel);
         sys$cancel (tkptr->SysOutputChannel);
         sys$cancel (tkptr->CgiPlusInChannel);
         sys$cancel (tkptr->HttpInputChannel);
         if (tkptr->QueuedClientRead && tkptr->RequestPtr)
            NetCloseSocket (tkptr->RequestPtr);
         return;
      }

      /* cancel any outstanding I/O on input channels */
      if (tkptr->QueuedCgiPlusIn) sys$cancel (tkptr->CgiPlusInChannel);
      if (tkptr->QueuedHttpInput) sys$cancel (tkptr->HttpInputChannel);
      if (tkptr->QueuedSysCommand > tkptr->QueuedSysCommandAllowed)
         sys$cancel (tkptr->SysCommandChannel);
      /* if reading directly from the client just close the socket */
      if (tkptr->QueuedClientRead && tkptr->RequestPtr)
         NetCloseSocket (tkptr->RequestPtr);
      return;
   }

   /* if there's still an outstanding CPU watchdog $GETJPI wait for it */
   if (tkptr->ScriptCpuTimGetJpi) return;

   /*********************/
   /* task has finished */
   /*********************/

   if (tkptr->ScriptName[0] && !tkptr->SearchOds.ResFileName[0])
   {
      /* search for script file was unsuccessful */
      if (tkptr->RequestPtr)
      {
         /* still has an associated request, declare the next task */
         SysDclAst (tkptr->NextTaskFunction, tkptr->RequestPtr);

         /* disassociate the DCL task and request structures */
         tkptr->RequestPtr->DclTaskPtr = NULL;
         tkptr->RequestPtr = tkptr->NextTaskFunction = NULL;
         tkptr->WatchItem = 0;
      }

      if (tkptr->TaskType == DCL_TASK_TYPE_CGIPLUS_SCRIPT ||
          tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT)
         tkptr->DeleteProcess = true;
   }
   else
   if (tkptr->RequestPtr)
   {
      if (!tkptr->ScriptProcessActivated &&
          tkptr->RequestPtr->rqCgi.ScriptRetryCount++ < DCL_MAX_SCRIPT_RETRY &&
          !tkptr->RequestPtr->rqResponse.ErrorReportPtr)
      {
         /* looks like the script exited before actually starting! */
         tkptr->DeleteProcess = true;
         DclRestartScript (tkptr);
      }
      else
      {
         if (tkptr->TaskType != DCL_TASK_TYPE_CLI &&
             (!tkptr->ScriptProcessResponded ||
              !tkptr->ScriptProcessActivated) &&
             !tkptr->RequestPtr->rqResponse.ErrorReportPtr)
         {
            /* hmmm, script has not provided any output! */
            if (tkptr->RequestPtr->rqHeader.Method == HTTP_METHOD_GET)
            {
               /* blame script for general GET method failures */
               tkptr->RequestPtr->rqResponse.HttpStatus = 502;
               ErrorGeneral (tkptr->RequestPtr,
                  MsgFor(tkptr->RequestPtr,MSG_SCRIPT_RESPONSE_ERROR), FI_LI);
            }
            else
            {
               /* other methods are probably not implemented by the script */
               tkptr->RequestPtr->rqResponse.HttpStatus = 501;
               ErrorGeneral (tkptr->RequestPtr,
                  MsgFor(tkptr->RequestPtr,MSG_REQUEST_METHOD), FI_LI);
            }
         }

         /* still has an associated request, declare the next task */
         SysDclAst (tkptr->NextTaskFunction, tkptr->RequestPtr);

         /* disassociate the DCL task and request structures */
         tkptr->RequestPtr->DclTaskPtr = NULL;
         tkptr->RequestPtr = tkptr->NextTaskFunction = NULL;
         tkptr->WatchItem = 0;
      }
   }

   if (DclUseZombies ||
       tkptr->TaskType == DCL_TASK_TYPE_CGIPLUS_SCRIPT ||
       tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT)
   {
      /* empty any remains in sys$output! */
      DclEmptySysOutput (tkptr);
   }

   /* if marked for process deletion */
   if (tkptr->DeleteProcess)
   {
      if (tkptr->ScriptProcessPid)
      {
         /* need WORLD privilege if process created under another username */
         if (tkptr->CrePrcUserName[0])
            if (VMSnok (SetPrvStatus = sys$setprv (1, &WorldMask, 0, 0)))
               ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);

         status = sys$delprc (&tkptr->ScriptProcessPid, 0);
         if (VMSnok (status)) ErrorNoticed (status, "sys$delprc()", FI_LI); 
         InstanceGblSecIncrLong (&AccountingPtr->DclDelPrcCount);

         if (tkptr->CrePrcUserName[0])
            if (VMSnok (SetPrvStatus = sys$setprv (0, &WorldMask, 0, 0)))
               ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);

         if WATCH_CATEGORY(WATCH_DCL)
            WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                       "DELPRC pid:!8XL", tkptr->ScriptProcessPid);
      }
      else
      {
         tkptr->DeleteProcess = false;
         tkptr->TaskType = DCL_TASK_TYPE_NONE;
      }
   }

   if (DclUseZombies &&
       tkptr->TaskType != DCL_TASK_TYPE_CGIPLUS_SCRIPT &&
       tkptr->TaskType != DCL_TASK_TYPE_RTE_SCRIPT)
      tkptr->ZombieCount++;
}

/*****************************************************************************/
/*
$FORCEX is painful to use - It should have an AST like process deletion for
when it concludes.  You cannot issue a $DELPRC for the same process  until you
are sure the image has run-down.  Hence, if a $FORCEX is issued for the target
process this function (and it's associated AST routine) must be called again to
determine if the image has exited.  If it hasn't then the check must be
performed again until it has (or until you are out of patience ;^).  Once the
image exits the $DELPRC can be issued.

This function is called to check if a script is executing an image.  An
asynchronous $GETJPI delivers to DclForceImageExitAst() where the decisions
are made.
*/

DclForceImageExit (DCL_TASK *tkptr)

{
   static unsigned long  GetJpiControlFlags = JPI$M_IGNORE_TARGET_STATUS;

   int  status,
        SetPrvStatus;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "DclForceImageExit() !8XL", tkptr->ScriptProcessPid);

   /* if there's still an outstanding $GETJPI */
   if (tkptr->ForceImageExitGetJpi) return;

   if (!tkptr->ForceImageExitSecond)
   {
      /* set the timer to control how long the force image is waited for */
      tkptr->ForceImageExitSecond = HttpdTickSecond +
                                    DCL_FORCE_IMAGE_EXIT_SECONDS;
      tkptr->ForceImageExitIssued = tkptr->ForceImageExitGetJpi = false;
   }
   else
   if (HttpdTickSecond >= tkptr->ForceImageExitSecond)
   {
      /* exceeded maximum period trying to force the image to exit */
      tkptr->ForceImageExit = false;
      tkptr->ForceImageExitSecond = 0;
      DclTaskRunDown (tkptr);
      return;
   }

   /* using an asynchronous sys$getjpi() get (any) process image name */
   tkptr->JpiImagNameItem[0].buf_len = sizeof(GetJpiControlFlags);
   tkptr->JpiImagNameItem[0].item = JPI$_GETJPI_CONTROL_FLAGS;
   tkptr->JpiImagNameItem[0].buf_addr = &GetJpiControlFlags;
   tkptr->JpiImagNameItem[0].short_ret_len = 0;
   tkptr->JpiImagNameItem[1].buf_len = sizeof(tkptr->JpiImagName)-1;
   tkptr->JpiImagNameItem[1].item = JPI$_IMAGNAME;
   tkptr->JpiImagNameItem[1].buf_addr = tkptr->JpiImagName;
   tkptr->JpiImagNameItem[1].short_ret_len = &tkptr->JpiImagNameLength;
   tkptr->JpiImagNameItem[2].buf_len =
      tkptr->JpiImagNameItem[2].item =
      tkptr->JpiImagNameItem[2].buf_addr =
      tkptr->JpiImagNameItem[2].short_ret_len = 0;

   /* need WORLD privilege if process created under another username */
   if (tkptr->CrePrcUserName[0])
      if (VMSnok (SetPrvStatus = sys$setprv (1, &WorldMask, 0, 0)))
         ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);

   status = sys$getjpi (0, &tkptr->ScriptProcessPid, 0,
                        &tkptr->JpiImagNameItem, &tkptr->JpiImagNameIOsb,
                        &DclForceImageExitAst, tkptr);

   if (tkptr->CrePrcUserName[0])
      if (VMSnok (SetPrvStatus = sys$setprv (0, &WorldMask, 0, 0)))
         ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);

   if (VMSok (status))
   {
      tkptr->ForceImageExitGetJpi = true;
      /* if it's anything other than a CGIplus/RTE script look at it ASAP */
      if (!(tkptr->TaskType == DCL_TASK_TYPE_CGIPLUS_SCRIPT ||
            tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT))
         DclSupervisor (DCL_SUPERVISOR_TICK_MIN);
      return;
   }

   tkptr->ForceImageExit = false;
   tkptr->ForceImageExitSecond = 0;

   /* commonly it can be gone but with termination AST not yet processed */
   if (status == SS$_NONEXPR) return;

   ErrorNoticed (status, "sys$getjpi()", FI_LI); 

   DclTaskRunDown (tkptr);
}

/*****************************************************************************/
/*
Called as an AST routine by the asynchronous $GETJPI in DclForceImageExit(). 
If the $GETJPI was successful and an image is running issue a $FORCEX to run
the image down.  If not just call DclTaskRunDown() again to begin running the
script process down.
*/

DclForceImageExitAst (DCL_TASK *tkptr)

{
   int  status,
        SetPrvStatus;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "DclForceImageExitAst() !&F !8XL !&S {!UL}!-!#AZ",
                 &DclForceImageExitAst,
                 tkptr->ScriptProcessPid, tkptr->JpiImagNameIOsb.Status,
                 tkptr->JpiImagNameLength, tkptr->JpiImagName);

   tkptr->ForceImageExitGetJpi = false;

   if (VMSnok (tkptr->JpiImagNameIOsb.Status) || !tkptr->JpiImagNameLength)
   {
      /* sys$getjpi() unsuccessful or image not currently executing */
      tkptr->ForceImageExit = false;
      tkptr->ForceImageExitSecond = 0;
      DclTaskRunDown (tkptr);
      return;
   }

   /* if not the first check then return rather than using another $FORCEX */
   if (tkptr->ForceImageExitIssued) return;

   if WATCH_CATEGORY(WATCH_DCL)
      WatchThis (NULL, FI_LI, WATCH_DCL, "FORCEX pid:!8XL !#AZ",
                 tkptr->ScriptProcessPid,
                 tkptr->JpiImagNameLength, tkptr->JpiImagName);

   /* need WORLD privilege if process created under another username */
   if (tkptr->CrePrcUserName[0])
      if (VMSnok (SetPrvStatus = sys$setprv (1, &WorldMask, 0, 0)))
         ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);

   status = sys$forcex (&tkptr->ScriptProcessPid, 0, SS$_NORMAL);
   InstanceGblSecIncrLong (&AccountingPtr->DclForceXCount);

   if (tkptr->CrePrcUserName[0])
      if (VMSnok (SetPrvStatus = sys$setprv (0, &WorldMask, 0, 0)))
         ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);

   if (VMSok (status))
   {
      tkptr->ForceImageExitIssued = true;
      return;
   }

   tkptr->ForceImageExit = false;
   tkptr->ForceImageExitSecond = 0;

   /* commonly it can be gone but with termination AST not yet processed */
   if (status == SS$_NONEXPR) return;

   ErrorNoticed (status, "sys$forcex()", FI_LI); 

   DclTaskRunDown (tkptr);
}

/*****************************************************************************/
/*
Queue a $GETJPI to discover the CPU time consumed since start of script
processing.
*/

DclScriptCpuTim (DCL_TASK *tkptr)

{
   static unsigned long  GetJpiControlFlags = JPI$M_IGNORE_TARGET_STATUS;

   int  status,
        SetPrvStatus;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "DclScriptCpuTim() !8XL", tkptr->ScriptProcessPid);

   /* if there's still an outstanding $GETJPI */
   if (tkptr->ScriptCpuTimGetJpi) return;

   /* using an asynchronous sys$getjpi() get (any) process image name */
   tkptr->JpiCpuTimItem[0].buf_len = sizeof(GetJpiControlFlags);
   tkptr->JpiCpuTimItem[0].item = JPI$_GETJPI_CONTROL_FLAGS;
   tkptr->JpiCpuTimItem[0].buf_addr = &GetJpiControlFlags;
   tkptr->JpiCpuTimItem[0].short_ret_len = 0;
   tkptr->JpiCpuTimItem[1].buf_len = sizeof(tkptr->JpiCpuTim);
   tkptr->JpiCpuTimItem[1].item = JPI$_CPUTIM;
   tkptr->JpiCpuTimItem[1].buf_addr = &tkptr->JpiCpuTim;
   tkptr->JpiCpuTimItem[1].short_ret_len = 0;
   tkptr->JpiCpuTimItem[2].buf_len =
      tkptr->JpiCpuTimItem[2].item =
      tkptr->JpiCpuTimItem[2].buf_addr =
      tkptr->JpiCpuTimItem[2].short_ret_len = 0;

   /* need WORLD privilege if process created under another username */
   if (tkptr->CrePrcUserName[0])
      if (VMSnok (SetPrvStatus = sys$setprv (1, &WorldMask, 0, 0)))
         ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);

   status = sys$getjpi (0, &tkptr->ScriptProcessPid, 0,
                        &tkptr->JpiCpuTimItem, &tkptr->JpiCpuTimIOsb,
                        &DclScriptCpuTimAst, tkptr);

   if (tkptr->CrePrcUserName[0])
      if (VMSnok (SetPrvStatus = sys$setprv (0, &WorldMask, 0, 0)))
         ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);

   if (VMSok (status))
   {
      tkptr->ScriptCpuTimGetJpi = true;
      return;
   }

   /* commonly it can be gone but with termination AST not yet processed */
   if (status == SS$_NONEXPR) return;
   ErrorNoticed (status, "sys$getjpi()", FI_LI); 
}

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

DclScriptCpuTimAst (DCL_TASK *tkptr)

{
   int  status,
        SetPrvStatus;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "DclScriptCpuTimAst() !&F !8XL !&S !UL !UL",
                 &DclScriptCpuTimAst,
                 tkptr->ScriptProcessPid, tkptr->JpiCpuTimIOsb.Status,
                 tkptr->JpiCpuTim, tkptr->ScriptCpuTimMax);
 
   tkptr->ScriptCpuTimGetJpi = false;

   if (tkptr->TaskRunDown)
   {
      /* task began run-down during asynchronous $GETJPI */
      DclTaskRunDown (tkptr);
      return;
   }

   /* sys$getjpi() unsuccessful (perhaps suspended), do nothing */
   if (VMSnok (tkptr->JpiCpuTimIOsb.Status)) return;

   /* if first time through with zombie then set the maximum allowed */
   if (!tkptr->ScriptCpuTimMax)
      /* multiply by one hundred turning seconds into 10mS ticks */
      tkptr->ScriptCpuTimMax = tkptr->JpiCpuTim + tkptr->ScriptCpuMax * 100;

   /* return if what's consumed is less that what's allowed */
   if (tkptr->JpiCpuTim < tkptr->ScriptCpuTimMax) return;

   if WATCH_CATEGORY(WATCH_DCL)
      WatchThis (NULL, FI_LI, WATCH_DCL, "CPUMAX pid:!8XL cputim:!UL max:!UL",
                 tkptr->ScriptProcessPid, tkptr->JpiCpuTim,
                 tkptr->ScriptCpuTimMax);

   tkptr->ScriptCpuMax = tkptr->ScriptCpuTimMax = 0;
   tkptr->DeleteProcess = true;
   DclTaskRunDown (tkptr);
}

/*****************************************************************************/
/*
If an error is encountered an error message is generated and the error status
returned.  It is up to the calling routine to abort the processing.  Queue a
writer-wait I/O to the SYS$OUTPUT channel to stall I/O until the script process
has started.
*/ 

DclCreateScriptProcess
(
DCL_TASK *tkptr,
char *ScriptAsPtr,
int BasePriority
)
{
#if OPERATE_WITH_SYSPRV
   /* this mask does not get the SYSPRV bit reset during startup */
   static unsigned long  OperateSysPrvMask [2]  = { PRV$M_SYSPRV, 0 };
#endif

   static int  ScriptProcessNumber;
   static unsigned long  JpiAuthPriv [2],
                         PrevPrivMask [2];
   static char  CommandDevName [64],
                ScriptProcessName [16];
   static $DESCRIPTOR (CommandDevNameDsc, CommandDevName);
   static $DESCRIPTOR (LoginOutDsc, "SYS$SYSTEM:LOGINOUT.EXE");
   static $DESCRIPTOR (ScriptProcessNameFaoDsc, "!AZ-!UL");
   static $DESCRIPTOR (ScriptProcessNameDsc, ScriptProcessName);

   static struct
   {
      short  flag;
      char  data [1+UAF$S_USERNAME + 1+UAF$S_USERNAME +
                  1+UAF$S_PASSWORD + 1+UAF$S_ACCOUNT];
   } LgiData;
   static $DESCRIPTOR (LgiDataDsc,"");

   static struct
   {
      unsigned short  buf_len;
      unsigned short  item;
      unsigned char   *buf_addr;
      unsigned short  *short_ret_len;
   }
      JpiItems [] =
   {
      { sizeof(JpiAuthPriv), JPI$_AUTHPRIV, &JpiAuthPriv, 0 },
      { 0,0,0,0 }
   };

   int  idx, status,
        Count,
        BecomeStatus,
        SetPrvStatus;
   unsigned short  Length;
   unsigned long  CrePrcFlags;
   char  *cptr, *sptr, *zptr,
         *ProcessTypePtr;
   IO_SB  IOsb;
   REQUEST_STRUCT  *rqptr;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "DclCreateScriptProcess() !&Z !UL", ScriptAsPtr, BasePriority);

   rqptr = tkptr->RequestPtr;

   /* start with a known quantity (yep, got caught ;^) */
   status = SS$_NORMAL;

   /* sanity check */
   if (BasePriority > 5) BasePriority = 5;

#if OPERATE_WITH_SYSPRV
   /* if normally operating with SYSPRV *ensure* it's off before spawning */
   if (OperateWithSysPrv) 
      if (VMSnok (SetPrvStatus = sys$setprv (0, &OperateSysPrvMask, 0, 0)))
         ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);
#endif

   if (DclScriptDetachProcess)
   {
      if (HttpdNetworkMode)
         ProcessTypePtr = "network";
      else
         ProcessTypePtr = "detached";

      InstanceGblSecIncrLong (&AccountingPtr->DclCrePrcDetachCount);
      CrePrcFlags = PRC$M_DETACH;
      tkptr->CrePrcDetachProcess = tkptr->CrePrcDetachStarting = true;

      if (VMSnok (SetPrvStatus = sys$setprv (1, &CrePrcMask, 0, 0)))
         ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);

      /* check if this task is for the same user as is required */
      if (strcmp (ScriptAsPtr, tkptr->CrePrcUserName)) 
      {
         /* nope, need to change the identity */
         zptr = (sptr=tkptr->CrePrcUserName) + sizeof(tkptr->CrePrcUserName)-1;
         for (cptr = ScriptAsPtr; *cptr && sptr < zptr; *sptr++ = *cptr++);
         *sptr = '\0';

         if (tkptr->CrePrcUserName[0] == '!')
         {
            /* used to disable default scripting account for some reason */
            status = SS$_INVUSER;
         }
         else
            status = SS$_NORMAL;

         /* set mailbox ACLs to "tag" the mailbox, and allow user access */
         if (VMSok (status))
            status = DclMailboxAcl (tkptr->SysCommandDevName,
                                    tkptr->CrePrcUserName);
         if (VMSok (status))
            status = DclMailboxAcl (tkptr->SysOutputDevName,
                                    tkptr->CrePrcUserName);
         if (VMSok (status))
            status = DclMailboxAcl (tkptr->HttpInputDevName,
                                    tkptr->CrePrcUserName);
         if (VMSok (status))
            status = DclMailboxAcl (tkptr->CgiPlusInDevName,
                                    tkptr->CrePrcUserName);
         if (VMSok (status))
            status = DclMailboxAcl (tkptr->CrePrcTermMbxDevName,
                                    tkptr->CrePrcUserName);

         /* no such id is generated by DclMailboxAcl() if username unknown */
         if (status == SS$_NOSUCHID) status = SS$_INVUSER;

         if (VMSok (status) &&
             (DclPersonaServicesAvailable ||
              ScriptAsPtr == HttpdScriptAsUserName))
         {
            status = PersonaAssume (tkptr->CrePrcUserName);
            if (VMSok (status) &&
                ScriptAsPtr != HttpdScriptAsUserName)
            {
               status = PersonaAllowed (rqptr, tkptr->CrePrcUserName);
               if (status == SS$_CREATED)
               {
                  /* bogus success message indicates privileged account */
                  InstanceGblSecIncrLong (&AccountingPtr->
                                          DclCrePrcPersonaPrvUserCount);
                  WriteFaoStdout ("%!AZ-W-PERSONA, !20%D, privileged !AZ\n",
                                  Utility, 0, tkptr->CrePrcUserName);
                  /* report this message whenever any OPCOM is in use */
                  if (Config.cfOpcom.Messages)
                     WriteFaoOpcom ("%!AZ-W-PERSONA, privileged !AZ",
                                    Utility, tkptr->CrePrcUserName);
               }
            }
            if (VMSok (status))
            {
               InstanceGblSecIncrLong (&AccountingPtr->DclCrePrcPersonaCount);
               if (ScriptAsPtr == HttpdProcess.UserName ||
                   ScriptAsPtr == HttpdScriptAsUserName)
                  InstanceGblSecIncrLong (&AccountingPtr->
                                          DclCrePrcPersonaDefaultCount);
            }
         }

         if WATCH_CATEGORY(WATCH_DCL)
         {
            if (VMSok (status))
               WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                  "USERNAME !AZ", tkptr->CrePrcUserName);
            else
               WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                  "USERNAME !AZ !&S %!-!&M", tkptr->CrePrcUserName, status);
         }

         if (status == SS$_INVUSER)
         {
            InstanceGblSecIncrLong (&AccountingPtr->
                                    DclCrePrcPersonaInvUserCount);
            WriteFaoStdout ("%!AZ-W-PERSONA, !20%D, invalid user !AZ\n",
                            Utility, 0, tkptr->CrePrcUserName);
            /* report this message whenever any OPCOM is in use */
            if (Config.cfOpcom.Messages)
               WriteFaoOpcom ("%!AZ-W-PERSONA, invalid user !AZ",
                              Utility, tkptr->CrePrcUserName);
            /* report invalid user as "forbidden" */
            rqptr->rqResponse.HttpStatus = 403;
         }
      }
   }
   else
   {
      ProcessTypePtr = "subprocess";
      InstanceGblSecIncrLong (&AccountingPtr->DclCrePrcSubprocessCount);
      CrePrcFlags = 0;
      if (Config.cfScript.SpawnAuthPriv)
      {
         /* enable persona's authorized privileges prior to spawning */
         status = sys$getjpiw (EfnWait, 0, 0, &JpiItems, &IOsb, 0, 0);
         if (VMSok (status)) status = IOsb.Status;
         if (VMSnok (status))
            ErrorExitVmsStatus (status, "sys$getjpiw()", FI_LI);
         if (VMSnok (SetPrvStatus =
             sys$setprv (1, &JpiAuthPriv, 0, &PrevPrivMask)))
            ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);
      }
   }

   if (VMSok (status))
   {                                
      for (Count = 100; Count; Count--)
      {
         /* script processes are consecutively numbered from 1..999 */
         ScriptProcessNameDsc.dsc$w_length = sizeof(ScriptProcessName)-1;
         sys$fao (&ScriptProcessNameFaoDsc, &Length, &ScriptProcessNameDsc, 
                  HttpdProcess.PrcNam, ScriptProcessNumber++ % 1000 + 1);
         ScriptProcessName[ScriptProcessNameDsc.dsc$w_length = Length] = '\0';

         if (HttpdNetworkMode)
         {
            /*********************************/
            /* create "network" mode process */
            /*********************************/

            memset (&LgiData, 0, sizeof(LgiData));
            LgiData.flag = LGI$M_NET_PROXY;
            idx = 0;
            cptr = tkptr->CrePrcUserName;
            LgiData.data[idx] = strlen(cptr);
            memcpy (&LgiData.data[idx+1], cptr, LgiData.data[idx]);
            idx += LgiData.data[idx] + 1;
            LgiData.data[idx++] = 0;
            LgiData.data[idx++] = 0;
            LgiData.data[idx++] = 0;
            LgiDataDsc.dsc$a_pointer = &LgiData;
            LgiDataDsc.dsc$w_length = sizeof(LgiData.flag) + idx;
            CrePrcFlags = PRC$M_DETACH | PRC$M_NETWRK | PRC$M_NOPASSWORD;

            /* create network log file name (e.g. "_MBX1234:NET$WASD.LOG") */
            zptr = (sptr = CommandDevName) + sizeof(CommandDevName)-1;
            for (cptr = tkptr->SysCommandDevName;
                 *cptr && sptr < zptr; 
                 *sptr++ = *cptr++);
            for (cptr = NETWORK_MODE_LOG_NAME;
                 *cptr && sptr < zptr; 
                 *sptr++ = *cptr++);
            *sptr = '\0';
            CommandDevNameDsc.dsc$w_length = sptr - CommandDevName;

            status = sys$creprc (&tkptr->ScriptProcessPid,
                                 &LoginOutDsc,
                                 /* composite SYS$INPUT and log file name */
                                 &CommandDevNameDsc,
                                 /* proxy login data structure */
                                 &LgiDataDsc,
                                 /* SYS$NET, which must be redirected to */
                                 &tkptr->SysOutputDevNameDsc,
                                 0, 0,
                                 &ScriptProcessNameDsc,
                                 BasePriority,
                                 0,
                                 tkptr->CrePrcTermMbxUnit,
                                 CrePrcFlags,
                                 0, 0);
         }
         else
         {
            /**************************************/
            /* create "other" mode or sub process */
            /**************************************/

            status = sys$creprc (&tkptr->ScriptProcessPid,
                                 &LoginOutDsc,
                                 &tkptr->SysCommandDevNameDsc,
                                 &tkptr->SysOutputDevNameDsc,
                                 0, 0, 0,
                                 &ScriptProcessNameDsc,
                                 BasePriority,
                                 0,
                                 tkptr->CrePrcTermMbxUnit,
                                 CrePrcFlags,
                                 0, 0);
         }

         if WATCH_CATEGORY(WATCH_DCL)
         {
            if (VMSok (status))
               WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                  "CREATE !AZ pid:!8XL priority !UL",
                  ProcessTypePtr, tkptr->ScriptProcessPid, BasePriority);
            else
               WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                  "CREATE !AZ !&S %!-!&M", ProcessTypePtr, status);
         }

         if (status != SS$_DUPLNAM) break;
      }
   }

   if (DclScriptDetachProcess)
   {
      tkptr->DetachedGrantId = true;
      if (DclPersonaServicesAvailable ||
          ScriptAsPtr == HttpdScriptAsUserName)
      {
         /* return to the "natural" persona of the server account */
         BecomeStatus = PersonaAssume (NULL);
         if (VMSnok (BecomeStatus)) status = BecomeStatus;
      }
      if (VMSnok (SetPrvStatus = sys$setprv (0, &CrePrcMask, 0, 0)))
         ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);
   }
   else
   if (Config.cfScript.SpawnAuthPriv)
   {
      /* spawned with authorized privileges, restore previous ones */
      if (VMSnok (SetPrvStatus = sys$setprv (0, &JpiAuthPriv, 0, 0)))
         ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);
      if (VMSnok (SetPrvStatus = sys$setprv (1, &PrevPrivMask, 0, 0)))
         ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);
   }

#if OPERATE_WITH_SYSPRV
   /* if normally operating with SYSPRV turn it back on */
   if (OperateWithSysPrv) 
      if (VMSnok (SetPrvStatus = sys$setprv (1, &OperateSysPrvMask, 0, 0)))
         ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);
#endif

   if (VMSok (status))
   {
      /* queue a read from the process termination mailbox */
      status = sys$qio (EfnNoWait, tkptr->CrePrcTermMbxChannel, IO$_READLBLK,
                        &tkptr->CrePrcTermMbxIOsb,
                        &DclScriptProcessCompletionAST, tkptr,
                        &tkptr->CrePrcTermRecord,
                        sizeof(tkptr->CrePrcTermRecord),
                        0, 0, 0, 0);

      if (VMSnok (status))
      {
         /* need WORLD privilege if process created under another username */
         if (tkptr->CrePrcUserName[0])
            if (VMSnok (SetPrvStatus = sys$setprv (1, &WorldMask, 0, 0)))
               ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);
         status = sys$delprc (&tkptr->ScriptProcessPid, 0);
         if (VMSnok (status)) ErrorNoticed (status, "sys$delprc()", FI_LI); 
         if (tkptr->CrePrcUserName[0])
            if (VMSnok (SetPrvStatus = sys$setprv (0, &WorldMask, 0, 0)))
               ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);
      }
   }

   if (VMSok (status))
   {
      InstanceGblSecIncrLong (&AccountingPtr->DclCrePrcCount);
      return (status);
   }

   rqptr->rqResponse.ErrorTextPtr = MsgFor(rqptr,MSG_SCRIPT_SPAWN);
   ErrorVmsStatus (rqptr, status, FI_LI);
   return (status);
}

/*****************************************************************************/
/*
This AST is called when the script processes exits.
*/

DclScriptProcessCompletionAST (DCL_TASK *tkptr)

{
   int  status;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
"DclScriptProcessCompletionAST() !&F !&S !8XL !4XL \'!12AZ\' !&S",
         &DclScriptProcessCompletionAST,
         tkptr->CrePrcTermMbxIOsb.Status,
         tkptr->ScriptProcessPid,
         tkptr->CrePrcTermRecord.acc$w_msgtyp,
         tkptr->CrePrcTermRecord.acc$t_username,
         tkptr->CrePrcTermRecord.acc$l_finalsts);

   if (VMSnok (tkptr->CrePrcTermMbxIOsb.Status))
   {
      if WATCH_CATEGORY(WATCH_DCL)
         WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                    "TERMINATION-MBX !8XL !&S %!-!&M",
                    tkptr->ScriptProcessPid,
                    tkptr->CrePrcTermMbxIOsb.Status);
      ErrorNoticed (tkptr->CrePrcTermMbxIOsb.Status,
                    "DclScriptProcessCompletionAST", FI_LI);
   }

   if WATCH_CATEGORY(WATCH_DCL)
   {
      if (VMSok (tkptr->CrePrcTermRecord.acc$l_finalsts))
         WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                    "!AZ completion pid:!8XL",
                    DclScriptDetachProcess ? "DETACHED" : "SUBPROCESS",
                    tkptr->ScriptProcessPid);
      else
         WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                    "!AZ completion pid:!8XL !&S %!-!&M",
                    DclScriptDetachProcess ? "DETACHED" : "SUBPROCESS",
                    tkptr->ScriptProcessPid,
                    tkptr->CrePrcTermRecord.acc$l_finalsts);
   }

   /* ensure SYS$COMMAND gets emptied! */
   tkptr->QueuedSysCommandAllowed = 0;

   /* won't be getting anymore output from this process! */
   status = sys$qio (EfnNoWait, tkptr->SysOutputChannel,
                     IO$_WRITEOF | IO$M_NORSWAIT, 0, 0, 0,
                     0, 0, 0, 0, 0, 0);

   /* no longer marked for delete (if it was), set PID and lifetime to zero */
   tkptr->BuildRecords =
      tkptr->ScriptCpuTimGetJpi =
      tkptr->DeleteProcess =
      tkptr->ForceImageExit =
      tkptr->ForceImageExitGetJpi =
      tkptr->ForceImageExitIssued =
      tkptr->TaskRunDown = false;
   tkptr->ForceImageExitSecond =
      tkptr->JpiCpuTimIOsb.Status =
      tkptr->JpiImagNameIOsb.Status =
      tkptr->JpiImagNameLength =
      tkptr->LifeTimeSecond =
      tkptr->ScriptCpuMax =
      tkptr->ScriptCpuTimMax =
      tkptr->ScriptProcessPid = 
      tkptr->SysOutputBuildCount = 0;
   tkptr->CrePrcUserName[0] = '\0';

   /* keep track of how many script processes are executing */
   if (DclScriptProcessCount) DclScriptProcessCount--;

   /* ensure any old sequence strings are not reused */
   tkptr->CgiBel[0] =
      tkptr->CgiEof[0] =
      tkptr->CgiEot[0] =
      tkptr->CgiEsc[0] = '\0';
   tkptr->CgiBelLength =
      tkptr->CgiEofLength =
      tkptr->CgiEotLength =
      tkptr->CgiEscLength = 0;

   DclTaskRunDown (tkptr);
}

/*****************************************************************************/
/*
If a script application writes any output before it was/is terminated that
output will still be laying unread in the mailbox.  Clear any such noise lest
it be read by the next script process to use the mailbox.  Does this
synchronously (i.e. with QIO waits).
*/

DclEmptySysOutput (DCL_TASK *tkptr)

{
   int  status,
        LastMessageCount;
   struct MbxSenseIOsb  SenseIOsb;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "DclEmptySysOutput()");

   LastMessageCount = 999999999;
   SenseIOsb.MessageCount = 0;

   for (;;)
   {
      status = sys$qiow (EfnWait, tkptr->SysOutputChannel,
                         IO$_SENSEMODE, &SenseIOsb, 0, 0, 0, 0, 0, 0, 0, 0);
      if (VMSok (status)) status = SenseIOsb.Status;
      if (VMSnok (status)) ErrorExitVmsStatus (status, "sys$qiow()", FI_LI);

      if (!SenseIOsb.MessageCount) break;
      /* potential infinite loop, check message count is decreasing! */
      if (LastMessageCount <= SenseIOsb.MessageCount) break;
      LastMessageCount = SenseIOsb.MessageCount;

      sys$qiow (EfnWait, tkptr->SysOutputChannel,
                IO$_READLBLK, &tkptr->SysOutputIOsb, 0, 0,
                tkptr->SysOutputPtr, tkptr->SysOutputSize, 0, 0, 0, 0);
   }
}

/*****************************************************************************/
/*
If an error is encountered an error message is generated and the error status
returned.  It is up to the calling routine to abort the processing.  Create
four mailboxes that will be associated with the script process I/O streams. If
an error occurs any mailbox created up to that point is deleted and the
channel set back to zero.
*/ 

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

DclCreateMailboxes (DCL_TASK *tkptr)

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

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

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

   BytLmBefore = GetJpiBytLm ();

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "DclCreateMailboxes() !UL !UL",
                 BytLmBefore, DclMailboxBytLmRequired);

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

   tkptr->CgiPlusInChannel =
      tkptr->CrePrcTermMbxChannel =
      tkptr->HttpInputChannel =
      tkptr->SysCommandChannel =
      tkptr->SysOutputChannel = 0;

   /***********************/
   /* SYS$COMMAND mailbox */
   /***********************/

   if (VMSnok (status =
       sys$crembx (0,
                   &tkptr->SysCommandChannel,
                   DclSysCommandSize, DclSysCommandSize,
                   DCL_SUBPROCESS_MBX_PROT_MASK,
                   0, 0, CMB$M_WRITEONLY)))
      goto DclCreateMailBoxesError;

   dscptr = &tkptr->SysCommandDevNameDsc;
   dscptr->dsc$w_length = sizeof(tkptr->SysCommandDevName);
   dscptr->dsc$a_pointer = tkptr->SysCommandDevName;
   dscptr->dsc$b_class = DSC$K_CLASS_S;
   dscptr->dsc$b_dtype = DSC$K_DTYPE_T;

   if (VMSnok (status =
       lib$getdvi (&DevNamItem, &tkptr->SysCommandChannel,
                   0, 0, &tkptr->SysCommandDevNameDsc, &Length)))
      goto DclCreateMailBoxesError;
   tkptr->SysCommandDevName[dscptr->dsc$w_length = Length] = '\0';

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "$CREMBX() SYS$COMMAND !AZ !UL",
                 tkptr->SysCommandDevName, DclSysCommandSize);

   /**********************/
   /* SYS$OUTPUT mailbox */
   /**********************/

   if (VMSnok (status =
       sys$crembx (0,
                   &tkptr->SysOutputChannel,
                   DclSysOutputSize, DclSysOutputSize,
                   DCL_SUBPROCESS_MBX_PROT_MASK,
                   0, 0, 0)))
      goto DclCreateMailBoxesError;

   dscptr = &tkptr->SysOutputDevNameDsc;
   dscptr->dsc$w_length = sizeof(tkptr->SysOutputDevName);
   dscptr->dsc$a_pointer = tkptr->SysOutputDevName;
   dscptr->dsc$b_class = DSC$K_CLASS_S;
   dscptr->dsc$b_dtype = DSC$K_DTYPE_T;

   if (VMSnok (status =
       lib$getdvi (&DevNamItem, &tkptr->SysOutputChannel,
                   0, 0, &tkptr->SysOutputDevNameDsc, &Length)))
      goto DclCreateMailBoxesError;
   tkptr->SysOutputDevName [dscptr->dsc$w_length = Length] = '\0';

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "$CREMBX() SYS$OUTPUT !AZ !UL",
                 tkptr->SysOutputDevName, DclSysOutputSize);

   /*********************/
   /* CGIPLUSIN mailbox */
   /*********************/

   if (VMSnok (status =
       sys$crembx (0,
                   &tkptr->CgiPlusInChannel,
                   DclCgiPlusInSize, DclCgiPlusInSize,
                   DCL_SUBPROCESS_MBX_PROT_MASK,
                   0, 0, CMB$M_WRITEONLY)))
      goto DclCreateMailBoxesError;

   dscptr = &tkptr->CgiPlusInDevNameDsc;
   dscptr->dsc$w_length = sizeof(tkptr->CgiPlusInDevName);
   dscptr->dsc$a_pointer = tkptr->CgiPlusInDevName;
   dscptr->dsc$b_class = DSC$K_CLASS_S;
   dscptr->dsc$b_dtype = DSC$K_DTYPE_T;

   if (VMSnok (status =
       lib$getdvi (&DevNamItem, &tkptr->CgiPlusInChannel,
                   0, 0, &tkptr->CgiPlusInDevNameDsc, &Length)))
      goto DclCreateMailBoxesError;
   tkptr->CgiPlusInDevName[dscptr->dsc$w_length = Length] = '\0';

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "$CREMBX() CGIPLUSIN !AZ !UL",
                 tkptr->CgiPlusInDevName, DclCgiPlusInSize);

   /**********************/
   /* HTTP$INPUT mailbox */
   /**********************/

   if (VMSnok (status =
       sys$crembx (0,
                   &tkptr->HttpInputChannel,
                   NetReadBufferSize, NetReadBufferSize,
                   DCL_SUBPROCESS_MBX_PROT_MASK,
                   0, 0, CMB$M_WRITEONLY)))
      goto DclCreateMailBoxesError;

   dscptr = &tkptr->HttpInputDevNameDsc;
   dscptr->dsc$w_length = sizeof(tkptr->HttpInputDevName);
   dscptr->dsc$a_pointer = tkptr->HttpInputDevName;
   dscptr->dsc$b_class = DSC$K_CLASS_S;
   dscptr->dsc$b_dtype = DSC$K_DTYPE_T;

   if (VMSnok (status =
       lib$getdvi (&DevNamItem, &tkptr->HttpInputChannel,
                   0, 0, &tkptr->HttpInputDevNameDsc, &Length)))
      goto DclCreateMailBoxesError;
   tkptr->HttpInputDevName[dscptr->dsc$w_length = Length] = '\0';

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "$CREMBX() HTTP$INPUT !AZ !UL",
                 tkptr->HttpInputDevName, NetReadBufferSize);

   /************************************/
   /* SYS$CREPRC() termination mailbox */
   /************************************/

   if (VMSnok (status =
       sys$crembx (0,
                   &tkptr->CrePrcTermMbxChannel,
                   sizeof(DCL_CREPRC_TERM),
                   sizeof(DCL_CREPRC_TERM),
                   DCL_SUBPROCESS_MBX_PROT_MASK,
                   0, 0, CMB$M_READONLY)))
      goto DclCreateMailBoxesError;

   dscptr = &tkptr->CrePrcTermMbxDevNameDsc;
   dscptr->dsc$w_length = sizeof(tkptr->CrePrcTermMbxDevName);
   dscptr->dsc$a_pointer = tkptr->CrePrcTermMbxDevName;
   dscptr->dsc$b_class = DSC$K_CLASS_S;
   dscptr->dsc$b_dtype = DSC$K_DTYPE_T;

   status = lib$getdvi (&DevNamItem, &tkptr->CrePrcTermMbxChannel,
                        0, 0, &tkptr->CrePrcTermMbxDevNameDsc, &Length);
   if (VMSok (status))
      status = lib$getdvi (&UnitItem, &tkptr->CrePrcTermMbxChannel,
                           0, &LongUnit, 0, 0);
   if (VMSnok (status)) goto DclCreateMailBoxesError;

   /* lib$getdvi() requires 32 bit longs, the mailbox unit is only 16 bits */
   tkptr->CrePrcTermMbxUnit = (unsigned short)LongUnit;
   tkptr->CrePrcTermMbxDevName[dscptr->dsc$w_length = Length] = '\0';

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "$CREMBX() TERMINATION !AZ unit:!UL",
                 tkptr->CrePrcTermMbxDevName, tkptr->CrePrcTermMbxUnit);

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

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

   return (SS$_NORMAL);

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

DclCreateMailBoxesError:

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "$CREMBX() !&S", status);

   if (tkptr->CgiPlusInChannel) sys$dassgn (tkptr->CgiPlusInChannel);
   if (tkptr->CrePrcTermMbxChannel) sys$dassgn (tkptr->CrePrcTermMbxChannel);
   if (tkptr->HttpInputChannel) sys$dassgn (tkptr->HttpInputChannel);
   if (tkptr->SysCommandChannel) sys$dassgn (tkptr->SysCommandChannel);
   if (tkptr->SysOutputChannel) sys$dassgn (tkptr->SysOutputChannel);
   tkptr->CrePrcTermMbxChannel =
      tkptr->CgiPlusInChannel =
      tkptr->HttpInputChannel =
      tkptr->SysCommandChannel =
      tkptr->SysOutputChannel = 0;

   return (status);
}

/*****************************************************************************/
/*
Queue up a read from the script process "SYS$OUTPUT" mailbox.  When the read 
completes call function DclSysOutputAst(), do any post-processing required and
write the data to the client over the network.  The next read from the script
process via the mailbox will be queued by the network write completion AST
function.
*/ 

DclQioSysOutput (DCL_TASK *tkptr)

{
   int  status,
        DclAstStatus;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "DclSysOutput() !8XL", tkptr->ScriptProcessPid);

   tkptr->QueuedSysOutput++;
   status = sys$qio (EfnNoWait, tkptr->SysOutputChannel,
                     IO$_READLBLK, &tkptr->SysOutputIOsb,
                     &DclSysOutputAst, tkptr,
                     tkptr->SysOutputPtr, tkptr->SysOutputSize, 0, 0, 0, 0);
   if (VMSok (status)) return;
   /* report error via the AST */
   tkptr->SysOutputIOsb.Status = status;
   SysDclAst (&DclSysOutputAst, tkptr);
}

/*****************************************************************************/
/*
A queued asynchronous read from the script process "SYS$OUTPUT" mailbox has 
completed.  For 'build-records' mode see description in module prologue.
*/ 

DclSysOutputAst (DCL_TASK *tkptr)

{
   int  cnt, status, value;
   char  *cptr;
   REQUEST_STRUCT  *rqptr;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
         "DclSysOutputAst() !&F !8XL !UL !UL !UL !UL !UL !UL !&S",
         &DclSysOutputAst, tkptr->ScriptProcessPid, tkptr->QueuedSysCommand,
         tkptr->QueuedSysOutput, tkptr->QueuedCgiPlusIn,
         tkptr->QueuedHttpInput, tkptr->QueuedClientRead,
         tkptr->SysOutputIOsb.Count, tkptr->SysOutputIOsb.Status);

   if (tkptr->QueuedSysOutput) tkptr->QueuedSysOutput--;

   rqptr = tkptr->RequestPtr;

   if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL))
   {
      if (VMSnok (tkptr->SysOutputIOsb.Status))
         WatchThis (rqptr, FI_LI, WATCH_DCL,
                    "READ SYS$OUTPUT !&S %!-!&M",
                    tkptr->SysOutputIOsb.Status);
      else
      {
         WatchThis (rqptr, FI_LI, WATCH_DCL,
                    "READ SYS$OUTPUT !&S !UL byte!%s",
                    tkptr->SysOutputIOsb.Status,
                    tkptr->SysOutputIOsb.Count);
         if (tkptr->SysOutputIOsb.Count)
         {
            if (tkptr->BuildRecords)
               WatchDataDump (tkptr->SysOutputPtr+tkptr->SysOutputBuildCount,
                              tkptr->SysOutputIOsb.Count);
            else
               WatchDataDump (tkptr->SysOutputPtr,
                              tkptr->SysOutputIOsb.Count);
         }
      }
   }

   if (ERROR_REPORTED(rqptr) && !ERROR_REPORTED_BY_SCRIPT(rqptr))
   {
      /* this is an opportune point to report any error generated elsewhere */
      tkptr->DeleteProcess = true;
      DclTaskRunDown (tkptr);
      return;
   }

   if (tkptr->SysOutputIOsb.Status == SS$_ENDOFFILE)
   {
      if (!tkptr->ScriptProcessPid)
      {
         /* script process has already concluded, must be the last gasp! */
         DclTaskRunDown (tkptr);
         return;
      }

      /* 
          If a script spawns multiple script processes each will
          terminate by queueing an end-of-file.  Ignore these.
          Queue the next read of the script process' SYS$OUTPUT.
          The CRTL outputs an end-of-file for a zero-length record.
          Put a count on the maximum number of these before the
          script is considered to be misbehaving.
      */
      if (tkptr->SysOutputEndOfFileCount++ > DCL_SCRIPT_MAX_ENDOFFILE)
      {
         tkptr->RequestPtr->rqResponse.HttpStatus = 502;
         ErrorGeneral (tkptr->RequestPtr,
            MsgFor(tkptr->RequestPtr,MSG_SCRIPT_RESPONSE_ERROR), FI_LI);
         tkptr->DeleteProcess = true;
         DclTaskRunDown (tkptr);
         return;
      }

      DclQioSysOutput (tkptr);
      return;
   }

   if (tkptr->ViaSysOutputStatus)
      tkptr->SysOutputIOsb.Status = tkptr->ViaSysOutputStatus;

   if (VMSnok (tkptr->SysOutputIOsb.Status))
   {
      if (tkptr->SysOutputIOsb.Status == SS$_ABORT ||
          tkptr->SysOutputIOsb.Status == SS$_CANCEL)
      {
         tkptr->DeleteProcess = true;
         DclTaskRunDown (tkptr);
         return;
      }

      rqptr->rqResponse.ErrorTextPtr = MsgFor(rqptr,MSG_SCRIPT_IPC);
      ErrorVmsStatus (rqptr, tkptr->SysOutputIOsb.Status, FI_LI);
      tkptr->DeleteProcess = true;
      DclTaskRunDown (tkptr);
      return;
   }

   /*************/
   /* status OK */
   /*************/

   if (tkptr->CrePrcDetachStarting)
   {
      cptr = tkptr->SysOutputPtr;
      cnt = tkptr->SysOutputIOsb.Count;
      cptr[cnt] = '\0';

      if (cnt >= tkptr->CgiBelLength &&
          cnt <= tkptr->CgiBelLength+2 &&
          !memcmp (cptr, tkptr->CgiBel, tkptr->CgiBelLength))
      {
         tkptr->CrePrcDetachStarting = false;
         /* reset CGI output processing */
         CgiOutput (rqptr, NULL, 0);

         if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL))
            WatchThis (rqptr, FI_LI, WATCH_DCL, "DETACHED process ready");
      }

      /* absorb this, just queue the next read */
      DclQioSysOutput (tkptr);
      return;
   }

   if (!tkptr->ScriptProcessResponded)
   {
      /*********************/
      /* finally it's true */
      /*********************/

      tkptr->ScriptProcessResponded = true;
      if (tkptr->SysOutputIOsb.Count == 1)
      {
         /* hmmm, one byte only - start 'building records'! */
         tkptr->BuildRecords = true;
         if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL))
            WatchThis (rqptr, FI_LI, WATCH_DCL, "BUILD records");
      }
   }

   if (tkptr->BuildRecords)
   {
      /*****************************************/
      /* building 'records' from single bytes! */
      /*****************************************/

      cptr = tkptr->SysOutputPtr + tkptr->SysOutputBuildCount;

      if (tkptr->SysOutputIOsb.Count)
      {
         tkptr->SysOutputBuildCount += tkptr->SysOutputIOsb.Count; 
         cnt = tkptr->SysOutputSize - tkptr->SysOutputBuildCount;

         if (tkptr->SysOutputIOsb.Count == 1 &&
             *cptr != '\n' && cnt > 0)
         {
            /* not a newline and still space in the buffer */
            tkptr->QueuedSysOutput++;
            status = sys$qio (EfnNoWait, tkptr->SysOutputChannel,
                              IO$_READLBLK, &tkptr->SysOutputIOsb,
                              &DclSysOutputAst, tkptr, cptr+1, cnt,
                              0, 0, 0, 0);
            if (VMSok (status)) return;
            /* report error via the AST */
            tkptr->SysOutputIOsb.Status = status;
            SysDclAst (&DclSysOutputAst, tkptr);
            return;
         }
      }
      else
      {
         *cptr = '\n';
         tkptr->SysOutputBuildCount++;
      }

      /* newline, zero bytes, multiple bytes, or out of buffer space */
      tkptr->SysOutputIOsb.Count = tkptr->SysOutputBuildCount;
      tkptr->SysOutputBuildCount = 0;

      if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL))
      {
         WatchThis (rqptr, FI_LI, WATCH_DCL,
                    "BUILT record !UL byte!%s", tkptr->SysOutputIOsb.Count);
         WatchDataDump (tkptr->SysOutputPtr, tkptr->SysOutputIOsb.Count);
      }
   }

   /******************/
   /* process record */
   /******************/

   cptr = tkptr->SysOutputPtr;
   cnt = tkptr->SysOutputIOsb.Count;
   cptr[cnt] = '\0';

   value = CgiOutput (rqptr, tkptr->SysOutputPtr, tkptr->SysOutputIOsb.Count);
   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "!SL", value);

   switch (value)
   {
      case CGI_OUTPUT_END :

         /* terminate processing */
         DclTaskRunDown (tkptr);

         if (rqptr->rqCgi.CalloutInProgress)
         {
            if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL))
               WatchThis (rqptr, FI_LI, WATCH_DCL, "CALLOUT end");

            /* script didn't send an EOT, let callable function know now! */
            rqptr->rqCgi.CalloutInProgress = false;

            /* the NULL and zero bytes indicates transaction end */
            rqptr->rqCgi.CalloutOutputPtr = NULL;
            rqptr->rqCgi.CalloutOutputCount = 0;

            /* execute the callout function */
            (*tkptr->CalloutFunction)(rqptr);
         }

         if ((void*)tkptr->CalloutFunction !=
             (void*)&DclCalloutDefault)
         {
            /* agent task */
            if (rqptr->rqCgi.BufferLength)
            {
               /* release the CGI variables used for this task */
               if (rqptr->rqCgi.BufferPtr)
                  VmFreeFromHeap (rqptr, rqptr->rqCgi.BufferPtr, FI_LI); 
               rqptr->rqCgi.BufferLength = 0;
               rqptr->rqCgi.BufferPtr = rqptr->rqCgi.BufferCurrentPtr = NULL;
            }
         }

         return;

      case CGI_OUTPUT_NOT_STRICT :

         /* not strictly CGI compliant, report and terminate processing */
         tkptr->RequestPtr->rqResponse.HttpStatus = 502;
         ErrorGeneral (tkptr->RequestPtr,
            MsgFor(tkptr->RequestPtr,MSG_SCRIPT_RESPONSE_ERROR), FI_LI);
         tkptr->DeleteProcess = true;
         DclTaskRunDown (tkptr);
         return;

      case CGI_OUTPUT_ESCAPE_BEGIN :

         /* start talking direct to the server */
         if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL))
            WatchThis (rqptr, FI_LI, WATCH_DCL, "CALLOUT begin");

         rqptr->rqCgi.CalloutInProgress = true;

         /* the NULL and minus one bytes indicates transaction begin */
         rqptr->rqCgi.CalloutOutputPtr = NULL;
         rqptr->rqCgi.CalloutOutputCount = -1;

         /* execute the callout function */
         (*tkptr->CalloutFunction)(rqptr);

         DclQioSysOutput (tkptr);
         return;

      case CGI_OUTPUT_ESCAPE :

         /* the script is talking direct to the server */
         rqptr->rqCgi.CalloutOutputPtr = tkptr->SysOutputPtr;
         rqptr->rqCgi.CalloutOutputCount = tkptr->SysOutputIOsb.Count;

         if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL))
         {
            WatchThis (rqptr, FI_LI, WATCH_DCL,
                       "CALLOUT !UL bytes",
                       rqptr->rqCgi.CalloutOutputCount);
            if (rqptr->rqCgi.CalloutOutputCount)
               WatchDataDump (rqptr->rqCgi.CalloutOutputPtr,
                              rqptr->rqCgi.CalloutOutputCount);
         }

         /* execute the callout function */
         (*tkptr->CalloutFunction)(rqptr);

         DclQioSysOutput (tkptr);
         return;

      case CGI_OUTPUT_ESCAPE_END :

         if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL))
            WatchThis (rqptr, FI_LI, WATCH_DCL, "CALLOUT end");

         /* end talking direct to the server */
         rqptr->rqCgi.CalloutInProgress = false;

         /* the NULL and zero bytes indicates transaction end */
         rqptr->rqCgi.CalloutOutputPtr = NULL;
         rqptr->rqCgi.CalloutOutputCount = 0;

         /* execute the callout function */
         (*tkptr->CalloutFunction)(rqptr);

         if (rqptr->rqPathSet.CgiPlusInWriteof)
            DclQioCgiPlusIn (tkptr, NULL, 0);

         DclQioSysOutput (tkptr);
         return;

      default :

         /* if "Script-Control: x-error..." reported do not output anything */
         if (ERROR_REPORTED_BY_SCRIPT(rqptr)) value = 0;

         if (!value)
         {
            /* output all absorbed, just queue the next read */
            DclQioSysOutput (tkptr);
            return;
         }

         if (rqptr->rqCgi.BufferRecords || rqptr->rqCgi.IsCliDcl)
         {
            /* buffer the record */
            if (tkptr->ClientWriteErrorCount)
            {
               /* no need to REALLY write it if there's been an error! */
               rqptr->rqNet.WriteIOsb.Status = rqptr->rqNet.WriteErrorStatus;
               SysDclAst (&DclSysOutputToClientAst, rqptr);
            }
            else
               NetWriteBuffered (rqptr, &DclSysOutputToClientAst, cptr, value);
            tkptr->QueuedSysOutput++;
            return;
         }

         /* write the record */
         if (tkptr->ClientWriteErrorCount)
         {
            /* no need to REALLY write it if there's been an error! */
            rqptr->rqNet.WriteIOsb.Status = rqptr->rqNet.WriteErrorStatus;
            SysDclAst (&DclSysOutputToClientAst, rqptr);
         }
         else
            NetWrite (rqptr, &DclSysOutputToClientAst, cptr, value);
         tkptr->QueuedSysOutput++;
         return;
   }
}

/*****************************************************************************/
/*
************
*** NOTE ***  This function takes a pointer to a request!!!
************  Due to is being an AST from a general network write function.

A queued asynchronous write of script process SYS$OUTPUT (mailbox) to the
client over the network has completed.  When the bit-bucket timeout is set or
do-not-disturb is set this is ignored (at least for the present) and the script
is allowed to continue.  For others just abort the script.
*/ 

DclSysOutputToClientAst (REQUEST_STRUCT *rqptr)

{
   int  status;
   DCL_TASK  *tkptr;

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

   /* get a pointer to the DCL task from the request structure */
   tkptr = rqptr->DclTaskPtr;

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
"DclSysOutputToClientAst() !&F !8XL !UL !UL !UL !UL !UL !&S !&S",
         &DclSysOutputToClientAst,
         tkptr->ScriptProcessPid, tkptr->QueuedSysCommand,
         tkptr->QueuedSysOutput, tkptr->QueuedCgiPlusIn,
         tkptr->QueuedHttpInput, tkptr->QueuedClientRead,
         tkptr->SysOutputIOsb.Status, rqptr->rqNet.WriteIOsb.Status);

   if (tkptr->QueuedSysOutput) tkptr->QueuedSysOutput--;

   if (VMSnok (rqptr->rqNet.WriteIOsb.Status))
   {
      /* NETWORK ERROR when writing TO CLIENT */
      if (tkptr->LifeTimeSecond == DCL_DO_NOT_DISTURB)
      {
         /* do not disturb script means DO NOT DISTURB SCRIPT!! */
         if (!tkptr->ClientWriteErrorCount)
            if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL))
               WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                          "DO-NOT-DISTURB in effect");
      }
      else
      if (tkptr->BitBucketTimeout)
      {
         if (!tkptr->ClientWriteErrorCount)
         {
            if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL))
               WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                          "BIT-BUCKET !UL seconds", tkptr->BitBucketTimeout);

            /* ignore client error, give the script just a little longer */
            HttpdTimerSet (rqptr, TIMER_OUTPUT, tkptr->BitBucketTimeout);
         }
      }
      else
      {
         /* otherwise OK to abort on client issues */
         tkptr->DeleteProcess = true;
         DclTaskRunDown (tkptr);
         return;
      }

      tkptr->ClientWriteErrorCount++;
   }

   /* queue the next read of the script process' SYS$OUTPUT */
   DclQioSysOutput (tkptr);
}

/*****************************************************************************/
/*
Queue up a write of data to the script process "SYS$COMMAND" mailbox.  This is
the  script processes' "SYS$COMMAND", supplying the DCL commands to execute,
CGI information, etc.
*/ 

DclQioSysCommand 
(
DCL_TASK *tkptr,
char *DataPtr,
int DataLength
)
{
   int  status,
        DclAstStatus;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "DclQioSysCommand() !8XL", tkptr->ScriptProcessPid);

   if (!DataPtr)
   {
      /* NULL pointer means write an end-of-file to the channel */

      if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL))
         WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                    "WRITE SYS$COMMAND EOF");

      tkptr->QueuedSysCommand++;
      status = sys$qio (EfnNoWait, tkptr->SysCommandChannel,
                        IO$_WRITEOF | IO$M_NORSWAIT,
                        &tkptr->SysCommandIOsb, &DclSysCommandAst, tkptr,
                        0, 0, 0, 0, 0, 0);
      if (VMSok (status)) return;
   }
   else
   {
      if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL))
      {
         WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                    "WRITE SYS$COMMAND !UL", DataLength);
         if (DataLength) WatchData (DataPtr, DataLength);
      }

      tkptr->QueuedSysCommand++;
      status = sys$qio (EfnNoWait, tkptr->SysCommandChannel,
                        IO$_WRITELBLK | IO$M_NORSWAIT,
                        &tkptr->SysCommandIOsb, &DclSysCommandAst, tkptr,
                        DataPtr, DataLength, 0, 0, 0, 0);
      if (VMSok (status)) return;
   }

   /* report error via the AST */
   if (status == SS$_MBFULL)
   {
      tkptr->RequestPtr->rqResponse.ErrorTextPtr = "SYS$COMMAND";
      ErrorVmsStatus (tkptr->RequestPtr, status, FI_LI);
   }
   tkptr->SysCommandIOsb.Status = status;
   SysDclAst (&DclSysCommandAst, tkptr);
}

/*****************************************************************************/
/*
A queued write to the script process "SYS$COMMAND" mailbox has completed.  This
is the script processes' "SYS$COMMAND", supplying the DCL commands to execute. 

The first read of the process' CLI command stream indicates it has completed
the full process creation and login cycle.  We can now add the identifier that
marks it as a WASD detached scripting process.  Adding it too early in the
process life cycle can result in LOGINOUT.EXE overriding it with it's own set
of rights identifiers.
*/ 

DclSysCommandAst (DCL_TASK *tkptr)

{
   int  status,
        SetPrvStatus;
   unsigned long  ScriptProcessPid;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
         "DclSysCommandAst() !&F !8XL !UL !UL !UL !UL !UL !&S",
         &DclSysCommandAst, tkptr->ScriptProcessPid, tkptr->QueuedSysCommand,
         tkptr->QueuedSysOutput, tkptr->QueuedCgiPlusIn,
         tkptr->QueuedHttpInput, tkptr->QueuedClientRead,
         tkptr->SysCommandIOsb.Status);

   if (tkptr->QueuedSysCommand) tkptr->QueuedSysCommand--;

   /* first AST is delivered %x00000000, make %X00000001 */
   if (!tkptr->SysCommandIOsb.Status) tkptr->SysCommandIOsb.Status = 1;

   if (tkptr->DetachedGrantId)
   {
      /****************************************/
      /* grant the detached script process ID */
      /****************************************/

      tkptr->DetachedGrantId = false;

      if (VMSnok (SetPrvStatus = sys$setprv (1, &GrantIdMask, 0, 0)))
         ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);

      /* PID needs to be in some sort of scratch space? (most peculiar!) */
      ScriptProcessPid = tkptr->ScriptProcessPid;
      /* note: not sure of what the sixth parameter is - 'segment'? */
      status = sys$grantid (&ScriptProcessPid, 0, &ProcessRightsIdent,
                            0, 0, 0);

      if (VMSnok (SetPrvStatus = sys$setprv (0, &GrantIdMask, 0, 0)))
         ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);

      if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
         WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                    "sys$grantid() !AZ !&X !&S %!-!&M",
                    ProcessIdentName, ProcessRightsIdent[0], status);

      if (VMSnok (status))
      {
         /* make it a little more obvious */
         if (status == SS$_NOPRIV) status = SS$_NOCMKRNL;
         tkptr->RequestPtr->rqResponse.ErrorTextPtr =
            MsgFor(tkptr->RequestPtr,MSG_SCRIPT_DCL_ENVIRONMENT);
         ErrorVmsStatus (tkptr->RequestPtr, status, FI_LI);
         tkptr->DeleteProcess = true;
         DclTaskRunDown (tkptr);
         return;
      }
   }

   if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL))
   {
      if (VMSnok (tkptr->SysCommandIOsb.Status))
         WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                    "WRITE SYS$COMMAND !&S %!-!&M",
                    tkptr->SysCommandIOsb.Status);
      else
         WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                    "WRITE SYS$COMMAND !&S",
                    tkptr->SysCommandIOsb.Status);
   }

   /* if (effectively) no outstanding I/O then conclude the DCL task */
   if (tkptr->QueuedSysCommand <= tkptr->QueuedSysCommandAllowed &&
       !tkptr->QueuedSysOutput &&
       !tkptr->QueuedCgiPlusIn &&
       !tkptr->QueuedHttpInput &&
       !tkptr->QueuedClientRead)
   {
      DclTaskRunDown (tkptr);
      return;
   }

   /* if I/O cancelled then just return */
   if (tkptr->SysCommandIOsb.Status == SS$_ABORT ||
       tkptr->SysCommandIOsb.Status == SS$_CANCEL)
      return;

   /* abort if an error writing SYS$COMMAND stream to script process */
   if (VMSnok (tkptr->SysCommandIOsb.Status))
   {
      tkptr->RequestPtr->rqResponse.ErrorTextPtr =
         MsgFor(tkptr->RequestPtr,MSG_SCRIPT_IPC);
      ErrorVmsStatus (tkptr->RequestPtr, tkptr->SysCommandIOsb.Status, FI_LI);
      tkptr->DeleteProcess = true;
      DclTaskRunDown (tkptr);
      return;
   }

   /* at least one DCL command was read indicating script activation */
   tkptr->ScriptProcessActivated = true;
}

/*****************************************************************************/
/*
Queue up a write of data to the script process "CGIPLUSIN" mailbox.  This is a
CGIplus script processes' CGI variable stream mailbox.             
*/ 

DclQioCgiPlusIn 
(
DCL_TASK *tkptr,
char *DataPtr,
int DataLength
)
{
   int  status,
        DclAstStatus;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclQioCgiPlusIn()");

   if (!DataPtr)
   {
      /* NULL pointer means write an end-of-file to the channel */

      if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL))
         WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                    "WRITE CGIPLUSIN EOF");

      tkptr->QueuedCgiPlusIn++;
      status = sys$qio (EfnNoWait, tkptr->CgiPlusInChannel,
                        IO$_WRITEOF | IO$M_NORSWAIT, &tkptr->CgiPlusInIOsb,
                        &DclCgiPlusInAst, tkptr,
                        0, 0, 0, 0, 0, 0);
      if (VMSok (status)) return;
   }
   else
   {
      if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL))
      {
         WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                    "WRITE CGIPLUSIN !UL bytes", DataLength);
         if (DataLength) WatchDataDump (DataPtr, DataLength);
      }

      tkptr->QueuedCgiPlusIn++;
      status = sys$qio (EfnNoWait, tkptr->CgiPlusInChannel,
                        IO$_WRITELBLK | IO$M_NORSWAIT, &tkptr->CgiPlusInIOsb,
                        &DclCgiPlusInAst, tkptr,
                        DataPtr, DataLength, 0, 0, 0, 0);
      if (VMSok (status)) return;
   }

   /* report error via the AST */
   if (status == SS$_MBFULL)
   {
      tkptr->RequestPtr->rqResponse.ErrorTextPtr = "CGIPLUSIN";
      ErrorVmsStatus (tkptr->RequestPtr, status, FI_LI);
   }
   tkptr->CgiPlusInIOsb.Status = status;
   SysDclAst (&DclCgiPlusInAst, tkptr);
}

/*****************************************************************************/
/*
A queued write to the script process "CGIPLUSIN" mailbox has completed.  This
is a CGIplus script processes' CGI variable stream mailbox.             
*/ 

DclCgiPlusInAst (DCL_TASK *tkptr)

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
         "DclCgiPlusInAst() !&F !8XL !UL !UL !UL !UL !UL !&S",
         &DclCgiPlusInAst, tkptr->ScriptProcessPid, tkptr->QueuedSysCommand,
         tkptr->QueuedSysOutput, tkptr->QueuedCgiPlusIn,
         tkptr->QueuedHttpInput, tkptr->QueuedClientRead,
         tkptr->CgiPlusInIOsb.Status);

   if (tkptr->QueuedCgiPlusIn) tkptr->QueuedCgiPlusIn--;

   /* first AST is delivered %x00000000, make %X00000001 */
   if (!tkptr->CgiPlusInIOsb.Status) tkptr->CgiPlusInIOsb.Status = 1;

   if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL))
   {
      if (VMSnok (tkptr->CgiPlusInIOsb.Status))
         WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                    "WRITE CGIPLUSIN !&S %!-!&M",
                    tkptr->CgiPlusInIOsb.Status);
      else
         WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                    "WRITE CGIPLUSIN !&S",
                    tkptr->CgiPlusInIOsb.Status);
   }

   /* if (effectively) no outstanding I/O then conclude the DCL task */
   if (tkptr->QueuedSysCommand <= tkptr->QueuedSysCommandAllowed &&
       !tkptr->QueuedSysOutput &&
       !tkptr->QueuedCgiPlusIn &&
       !tkptr->QueuedHttpInput &&
       !tkptr->QueuedClientRead)
   {
      DclTaskRunDown (tkptr);
      return;
   }

   /* if I/O cancelled then just return */
   if (tkptr->CgiPlusInIOsb.Status == SS$_ABORT ||
       tkptr->CgiPlusInIOsb.Status == SS$_CANCEL)
      return;

   /* abort if an error writing CGIPLUSIN stream to script process */
   if (VMSnok (tkptr->CgiPlusInIOsb.Status))
   {
      tkptr->RequestPtr->rqResponse.ErrorTextPtr =
         MsgFor(tkptr->RequestPtr,MSG_SCRIPT_IPC);
      ErrorVmsStatus (tkptr->RequestPtr, tkptr->CgiPlusInIOsb.Status, FI_LI);
      tkptr->DeleteProcess = true;
      DclTaskRunDown (tkptr);
      return;
   }

   /* at least one CGIPLUSIN variable was read indicating script activation */
   tkptr->ScriptProcessActivated = true;
}

/*****************************************************************************/
/*
A network read of the request body has completed and BodyReadAst() has called
this function as an AST.  Write it to HTTP$INPUT with a completion AST to
DclHttpInputAst().
*/ 

DclHttpInput (REQUEST_STRUCT *rqptr)

{
   int  status;
   DCL_TASK  *tkptr;

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

   tkptr = rqptr->DclTaskPtr;

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (rqptr, FI_LI, WATCH_MOD_DCL,
         "DclHttpInput() !&F !8XL !UL !UL !UL !UL !UL !&S !&X !UL",
         &DclHttpInput,
         tkptr->ScriptProcessPid, tkptr->QueuedSysCommand,
         tkptr->QueuedSysOutput, tkptr->QueuedCgiPlusIn,
         tkptr->QueuedHttpInput, tkptr->QueuedClientRead,
         rqptr->rqBody.DataStatus, rqptr->rqBody.DataPtr,
         rqptr->rqBody.DataCount);

   if (tkptr->QueuedClientRead) tkptr->QueuedClientRead--;

   /* if (effectively) no outstanding I/O then conclude the DCL task */
   if (tkptr->QueuedSysCommand <= tkptr->QueuedSysCommandAllowed &&
       !tkptr->QueuedSysOutput &&
       !tkptr->QueuedCgiPlusIn &&
       !tkptr->QueuedHttpInput &&
       !tkptr->QueuedClientRead)
   {
      DclTaskRunDown (tkptr);
      return;
   }

   /* if I/O cancelled then just return */
   if (rqptr->rqBody.DataStatus == SS$_ABORT ||
       rqptr->rqBody.DataStatus == SS$_CANCEL)
      return;

   if (rqptr->rqBody.DataStatus == SS$_ENDOFFILE)
   {
      /* end of body */
      tkptr->QueuedHttpInput++;
      status = sys$qio (EfnNoWait, tkptr->HttpInputChannel,
                        IO$_WRITEOF, &tkptr->HttpInputIOsb,
                        &DclHttpInputAst, tkptr, 0, 0, 0, 0, 0, 0);
      if (VMSok (status)) return;
      /* report error via the AST */
      tkptr->HttpInputIOsb.Status = status;
      SysDclAst (&DclHttpInputAst, tkptr);
      return;
   }

   if (VMSnok (rqptr->rqBody.DataStatus))
   {
      DclTaskRunDown (tkptr);
      return;
   }

   tkptr->QueuedHttpInput++;
   status = sys$qio (EfnNoWait, tkptr->HttpInputChannel,
                     IO$_WRITELBLK, &tkptr->HttpInputIOsb,
                     &DclHttpInputAst, tkptr,
                     rqptr->rqBody.DataPtr, rqptr->rqBody.DataCount,
                     0, 0, 0, 0);
   if (VMSok (status)) return;
   /* report error via the AST */
   tkptr->HttpInputIOsb.Status = status;
   SysDclAst (&DclHttpInputAst, tkptr);
}

/*****************************************************************************/
/*
A queued write to the script process "HTTP$INPUT" mailbox has completed.
Provide more (possibly first) of the request body, or EOF.
*/ 

DclHttpInputAst (DCL_TASK *tkptr)

{
   int  status,
        DclAstStatus,
        Length;
   char  *ContentPtr;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
         "DclHttpInputAst() !&F !8XL !UL !UL !UL !UL !UL !&S !UL",
         &DclHttpInputAst, tkptr->ScriptProcessPid, tkptr->QueuedSysCommand,
         tkptr->QueuedSysOutput, tkptr->QueuedCgiPlusIn,
         tkptr->QueuedHttpInput, tkptr->QueuedClientRead,
         tkptr->HttpInputIOsb.Status, tkptr->HttpInputIOsb.Count);

   if (tkptr->QueuedHttpInput) tkptr->QueuedHttpInput--;

   if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL))
   {
      if (VMSnok (tkptr->HttpInputIOsb.Status))
         WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                    "WRITE HTTP$INPUT !&S %!-!&M",
                    tkptr->HttpInputIOsb.Status);
      else
         WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                    "WRITE HTTP$INPUT !&S",
                    tkptr->HttpInputIOsb.Status);
   }

   /* if (effectively) no outstanding I/O then conclude the DCL task */
   if (tkptr->QueuedSysCommand <= tkptr->QueuedSysCommandAllowed &&
       !tkptr->QueuedSysOutput &&
       !tkptr->QueuedCgiPlusIn &&
       !tkptr->QueuedHttpInput &&
       !tkptr->QueuedClientRead)
   {
      DclTaskRunDown (tkptr);
      return;
   }

   /* if I/O cancelled then just return */
   if (tkptr->HttpInputIOsb.Status == SS$_ABORT ||
       tkptr->HttpInputIOsb.Status == SS$_CANCEL)
      return;

   /* abort if an error writing HTTP stream to script process */
   if (VMSnok (tkptr->HttpInputIOsb.Status))
   {
      tkptr->RequestPtr->rqResponse.ErrorTextPtr =
         MsgFor(tkptr->RequestPtr,MSG_SCRIPT_IPC);
      ErrorVmsStatus (tkptr->RequestPtr, tkptr->HttpInputIOsb.Status, FI_LI);
      tkptr->DeleteProcess = true;
      DclTaskRunDown (tkptr);
      return;
   }

   /* get more from the client */
   BodyRead (tkptr->RequestPtr);
   tkptr->QueuedClientRead++;
}

/*****************************************************************************/
/*
A CLIENT-READ: callout network read from the client has concluded.  If an error
then just conclude the task.  If OK then queue it to the HTTP$INPUT device so
the script can read it.
*/ 
 
DclClientReadAst (REQUEST_STRUCT *rqptr)

{
   int  status;
   DCL_TASK  *tkptr;

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

   /* get a pointer to the DCL task from the request structure */
   tkptr = rqptr->DclTaskPtr;

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (rqptr, FI_LI, WATCH_MOD_DCL,
         "DclClientReadAst() !&F !8XL !UL !UL !UL !UL !UL !&S !UL",
         &DclClientReadAst, tkptr->ScriptProcessPid, tkptr->QueuedSysCommand,
         tkptr->QueuedSysOutput, tkptr->QueuedCgiPlusIn,
         tkptr->QueuedHttpInput, tkptr->QueuedClientRead,
         rqptr->rqNet.ReadIOsb.Status, rqptr->rqNet.ReadIOsb.Count);

   if (tkptr->QueuedClientRead) tkptr->QueuedClientRead--;

   /* if (effectively) no outstanding I/O then conclude the DCL task */
   if (tkptr->QueuedSysCommand <= tkptr->QueuedSysCommandAllowed &&
       !tkptr->QueuedSysOutput &&
       !tkptr->QueuedCgiPlusIn &&
       !tkptr->QueuedHttpInput &&
       !tkptr->QueuedClientRead)
   {
      DclTaskRunDown (tkptr);
      return;
   }

   if (VMSnok (rqptr->rqNet.ReadIOsb.Status))
   {
      DclTaskRunDown (tkptr);
      return;
   }

   if (tkptr->ClientReadStripCrLf)
   {
      if (rqptr->rqNet.ReadIOsb.Count >= 2 &&
          tkptr->ClientReadBufferPtr[rqptr->rqNet.ReadIOsb.Count-2] == '\r' &&
          tkptr->ClientReadBufferPtr[rqptr->rqNet.ReadIOsb.Count-1] == '\n')
         rqptr->rqNet.ReadIOsb.Count -= 2;
      else
      if (rqptr->rqNet.ReadIOsb.Count >= 1 &&
          tkptr->ClientReadBufferPtr[rqptr->rqNet.ReadIOsb.Count-1] == '\n')
         rqptr->rqNet.ReadIOsb.Count--;
   }

   tkptr->QueuedHttpInput++;
   status = sys$qio (EfnNoWait, tkptr->HttpInputChannel,
                     IO$_WRITELBLK, &tkptr->HttpInputIOsb,
                     &DclClientReadHttpInputAst, tkptr,
                     tkptr->ClientReadBufferPtr, rqptr->rqNet.ReadIOsb.Count,
                     0, 0, 0, 0);
   if (VMSok (status)) return;
   /* report error via the AST */
   tkptr->HttpInputIOsb.Status = status;
   SysDclAst (&DclClientReadAst, tkptr);
}

/*****************************************************************************/
/*
A CLIENT-READ: callout write of client data to the HTTP$DEVICE has concluded. 
If there was an error writing this to the script then just conclude the task. 
If OK then queue another network read from the client.
*/ 

DclClientReadHttpInputAst (DCL_TASK *tkptr)

{
   int  status,
        DclAstStatus,
        Length;
   char  *ContentPtr;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
         "DclClientReadHttpInputAst() !8XL !8XL !UL !UL !UL !UL !UL !&S",
         &DclClientReadHttpInputAst,
         tkptr->ScriptProcessPid, tkptr->QueuedSysCommand,
         tkptr->QueuedSysOutput, tkptr->QueuedCgiPlusIn,
         tkptr->QueuedHttpInput, tkptr->QueuedClientRead,
         tkptr->HttpInputIOsb.Status);

   if (tkptr->QueuedHttpInput) tkptr->QueuedHttpInput--;

   if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL))
   {
      if (VMSnok (tkptr->HttpInputIOsb.Status))
         WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                    "CLIENT-READ !&S %!-!&M",
                    tkptr->HttpInputIOsb.Status);
      else
         WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL,
                    "CLIENT-READ !&S",
                    tkptr->HttpInputIOsb.Status);
   }

   /* if (effectively) no outstanding I/O then conclude the DCL task */
   if (tkptr->QueuedSysCommand <= tkptr->QueuedSysCommandAllowed &&
       !tkptr->QueuedSysOutput &&
       !tkptr->QueuedCgiPlusIn &&
       !tkptr->QueuedHttpInput &&
       !tkptr->QueuedClientRead)
   {
      DclTaskRunDown (tkptr);
      return;
   }

   /* if I/O cancelled then just return */
   if (tkptr->HttpInputIOsb.Status == SS$_ABORT ||
       tkptr->HttpInputIOsb.Status == SS$_CANCEL)
      return;

   /* abort if an error writing HTTP stream to script process */
   if (VMSnok (tkptr->HttpInputIOsb.Status))
   {
      tkptr->RequestPtr->rqResponse.ErrorTextPtr =
         MsgFor(tkptr->RequestPtr,MSG_SCRIPT_IPC);
      ErrorVmsStatus (tkptr->RequestPtr, tkptr->HttpInputIOsb.Status, FI_LI);
      tkptr->DeleteProcess = true;
      DclTaskRunDown (tkptr);
      return;
   }

   /* asynchronous read another record from the client */
   NetRead (tkptr->RequestPtr, &DclClientReadAst,
            tkptr->ClientReadBufferPtr, tkptr->ClientReadBufferSize);
   tkptr->QueuedClientRead++;
}

/*****************************************************************************/
/*
Send DCL commands to the CGI script or DCL command script process' SYS$COMMAND.
This sets up the DCL environment (defines logical names, assigns symbols)
executes the procedure or image.
*/ 

int DclCgiScriptSysCommand (DCL_TASK *tkptr)

{
   static char  DefSysErrNl [] = "DEFINE/USER SYS$ERROR NL:";
   static char  DefSysOutNl [] = "DEFINE/USER SYS$OUTPUT NL:";
   static char  DelSymAll [] = "DELSYMALL=\"DELETE/SYMBOL/ALL\"";
   static char  DelSymAllGlobal[] = "DELSYMALL/GLOBAL";
   static char  DelSymAllLocal[] = "DELSYMALL/LOCAL";
   static char  HttpdLogin [] =
"IF F$TRNLNM(\"HTTPD$LOGIN\").NES.\"\" THEN @HTTPD$LOGIN";
   static char  HttpdVerify1 [] =
"IF F$TRNLNM(\"HTTPD$VERIFY\") THEN \
WRITE SYS$OUTPUT \"Content-Type: text/plain\015\012\015\012\"";
   static char  HttpdVerify2 [] = "!\'F$VERIFY(F$TRNLNM(\"HTTPD$VERIFY\"))";
   static char  NetDefSysOut [] = "DEFINE SYS$OUTPUT SYS$NET";
   static char  NetPurgeLog [] = "PURGE/NOLOG/KEEP=3 SYS$LOGIN:"
                                 NETWORK_MODE_LOG_NAME;
   static char  NoVerify [] = "!\'F$VERIFY(0)";
   static char  SetNoOn[] = "SET NOON";
#ifdef ODS_EXTENDED
   static char  SetProcParseExt [] = "SET PROCESS/PARSE=EXTENDED";
   static char  SetProcParseTrad [] = "SET PROCESS/PARSE=TRADITIONAL";
#endif /* ODS_EXTENDED */
   static char  SetProcPriv[] = "SET PROCESS/PRIVILEGE=(NOALL,NETMBX,TMPMBX)";
   static char  StopId [] = "STOP/ID=0";
   static char  WriteIsWrite [] = "WRITE=\"WRITE\"";

   static $DESCRIPTOR (WriteDclQuoteFaoDsc, "WRITE SYS$OUTPUT \"!AZ\"");

   static $DESCRIPTOR (DefineHttpInputFaoDsc,
                       "DEFINE/NOLOG/SUPER HTTP$INPUT !AZ");
   static $DESCRIPTOR (DefineSysInputFaoDsc,
                       "DEFINE/NOLOG/SUPER SYS$INPUT !AZ");

#if CGIPLUS_CALLOUT_FOR_CGI

   static $DESCRIPTOR (DefineCgiPlusInFaoDsc,
                       "DEFINE/NOLOG/SUPER CGIPLUSIN !AZ");
   static $DESCRIPTOR (DefineCgiPlusEotFaoDsc,
                       "DEFINE/NOLOG/SUPER CGIPLUSEOT \"!AZ\"");
   static $DESCRIPTOR (DefineCgiPlusEscFaoDsc,
                       "DEFINE/NOLOG/SUPER CGIPLUSESC \"!AZ\"");

#endif /* CGIPLUS_CALLOUT_FOR_CGI */

#if STREAMS_FOR_APACHE

   static $DESCRIPTOR (DefineApacheInputFaoDsc,
                       "DEFINE/NOLOG/SUPER APACHE$INPUT !AZ");

#endif /* STREAMS_FOR_APACHE */

#if STREAMS_FOR_PURVEYOR_AND_CERN

   static $DESCRIPTOR (DefineWwwInFaoDsc,
                       "DEFINE/NOLOG/SUPER WWW_IN !AZ");
   static char  DefineWwwOut[] = "DEFINE/NOLOG/SUPER WWW_OUT SYS$OUTPUT:";

#endif /* STREAMS_FOR_PURVEYOR_AND_CERN */

   int  status,
        Count;
   unsigned short  Length;
   char  c;
   char  *cptr, *sptr, *zptr,
         *StringPtr;
   char  DclLine [256],
         String [256];
   REQUEST_STRUCT *rqptr;
   $DESCRIPTOR (DclLineDsc, DclLine);

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "DclCgiScriptSysCommand() !&Z !&Z !&Z",
                 tkptr->DclCommandPtr, tkptr->ScriptFileName,
                 tkptr->ScriptRunTimePtr);

   /* get the pointer to the request structure */
   rqptr = tkptr->RequestPtr;

   DclQioSysCommand (tkptr, NoVerify, sizeof(NoVerify)-1);

   DclQioSysCommand (tkptr, DelSymAll, sizeof(DelSymAll)-1);
   DclQioSysCommand (tkptr, DelSymAllGlobal, sizeof(DelSymAllGlobal)-1);
   DclQioSysCommand (tkptr, DelSymAllLocal, sizeof(DelSymAllLocal)-1);
   DclQioSysCommand (tkptr, SetNoOn, sizeof(SetNoOn)-1);

   if (HttpdNetworkMode)
   {
      DclQioSysCommand (tkptr, NetDefSysOut, sizeof(NetDefSysOut)-1);
      DclQioSysCommand (tkptr, DefSysOutNl, sizeof(DefSysOutNl)-1);
      DclQioSysCommand (tkptr, DefSysErrNl, sizeof(DefSysErrNl)-1);
      DclQioSysCommand (tkptr, NetPurgeLog, sizeof(NetPurgeLog)-1);
   }

   if (tkptr->CrePrcDetachStarting)
   {
      /* indicate any login message, etc. are finished, process is ready */
      sys$fao (&WriteDclQuoteFaoDsc, &Length, &DclLineDsc, tkptr->CgiBel);
      DclLine[Length] = '\0';
      DclQioSysCommand (tkptr, DclLine, Length);
   }

   DclQioSysCommand (tkptr, HttpdVerify1, sizeof(HttpdVerify1)-1);
   DclQioSysCommand (tkptr, HttpdVerify2, sizeof(HttpdVerify2)-1);

   if (!DclScriptDetachProcess && Config.cfScript.SpawnAuthPriv)
      /* kludge to work around spawning authorized privileges with $CREPRC */
      DclQioSysCommand (tkptr, SetProcPriv, sizeof(SetProcPriv)-1);

   if (tkptr->TaskType == DCL_TASK_TYPE_CGI_SCRIPT)
   {
      sys$fao (&DefineSysInputFaoDsc, &Length, &DclLineDsc,
               tkptr->HttpInputDevName);
      DclLine[Length] = '\0';
      DclQioSysCommand (tkptr, DclLine, Length);

      /* for backward compatibility */
      sys$fao (&DefineHttpInputFaoDsc, &Length, &DclLineDsc,
               tkptr->HttpInputDevName);
      DclLine[Length] = '\0';
      DclQioSysCommand (tkptr, DclLine, Length);

#if STREAMS_FOR_PURVEYOR_AND_CERN

      /* for Purveyor, Cern backward compatibility */
      sys$fao (&DefineWwwInFaoDsc, &Length, &DclLineDsc,
               tkptr->HttpInputDevName);
      DclLine[Length] = '\0';
      DclQioSysCommand (tkptr, DclLine, Length);
      DclQioSysCommand (tkptr, DefineWwwOut, sizeof(DefineWwwOut)-1);

#endif /* STREAMS_FOR_PURVEYOR_AND_CERN */

#if STREAMS_FOR_APACHE

      /* for VMS Apache forward compatibility :^) */
      sys$fao (&DefineApacheInputFaoDsc, &Length, &DclLineDsc,
               tkptr->HttpInputDevName);
      DclLine[Length] = '\0';
      DclQioSysCommand (tkptr, DclLine, Length);

#endif /* STREAMS_FOR_APACHE */

#if CGIPLUS_CALLOUT_FOR_CGI

      sys$fao (&DefineCgiPlusInFaoDsc, &Length, &DclLineDsc,
               tkptr->CgiPlusInDevName);
      DclLine[Length] = '\0';
      status = DclQioSysCommand (tkptr, DclLine, Length);

      sys$fao (&DefineCgiPlusEotFaoDsc, &Length, &DclLineDsc,
               tkptr->CgiEot);
      DclLine[Length] = '\0';
      status = DclQioSysCommand (tkptr, DclLine, Length);

      sys$fao (&DefineCgiPlusEscFaoDsc, &Length, &DclLineDsc,
               tkptr->CgiEsc);
      DclLine[Length] = '\0';
      status = DclQioSysCommand (tkptr, DclLine, Length);

#endif /* CGIPLUS_CALLOUT_FOR_CGI */
   }

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

   /*
      CGI script requests can only call this once.
      DCL commands from SSI documents can call this multiple times.
      Once the CGI information is generated is is essentially static
      for the life of the request ... so only generate it the once!
   */
   if (!rqptr->rqCgi.BufferPtr)
      if (VMSnok (status = CgiGenerateVariables (rqptr, CGI_VARIABLE_DCL)))
         return (status);

   cptr = rqptr->rqCgi.BufferPtr;
   for (;;)
   {
      if (!(Length = *(short*)cptr)) break;
      DclQioSysCommand (tkptr, cptr+sizeof(short), Length-1);
      cptr += Length + sizeof(short);
   }

#ifdef ODS_EXTENDED
   if (OdsExtended)
   {
      if (rqptr->PathOds == MAPURL_PATH_ODS_5)
      {
         DclQioSysCommand (tkptr, SetProcParseExt, sizeof(SetProcParseExt)-1);
         /* note that for this script activation the parse has been extended */
         tkptr->ProcessParseExtended = true;
      }
      else
      if (rqptr->PathOds == MAPURL_PATH_ODS_2)
         DclQioSysCommand (tkptr, SetProcParseTrad, sizeof(SetProcParseTrad)-1);
      else
      if (tkptr->ProcessParseExtended)
      {
         /* restore previously extended parse */
         DclQioSysCommand (tkptr, SetProcParseTrad, sizeof(SetProcParseTrad)-1);
         tkptr->ProcessParseExtended = false;
      }
   }
#endif /* ODS_EXTENDED */

   DclQioSysCommand (tkptr, HttpdLogin, sizeof(HttpdLogin)-1);

   /* set default to the script location */
   zptr = (sptr = DclLine) + sizeof(DclLine)-1;
   for (cptr = "SET DEFAULT "; *cptr; *sptr++ = *cptr++);
   if (rqptr->rqPathSet.ScriptDefaultPtr)
   {
      if (rqptr->rqPathSet.ScriptDefaultPtr[0] == '#' ||
          rqptr->rqPathSet.ScriptDefaultPtr[0] == '/')
      {
         /* backward compatible or U**x syntax, do not set default */
         Length = 0;
      }
      else
      {
         /* specified by the mapping rules */
         for (cptr = rqptr->rqPathSet.ScriptDefaultPtr;
              *cptr && sptr < zptr;
              *sptr++ = *cptr++);
         *sptr = '\0';
         Length = sptr - DclLine;
      }
   }
   else
   {
      /* whichever directory the script is located in */
      for (cptr = tkptr->SearchOds.ResFileName;
           *cptr && sptr < zptr;
           *sptr++ = *cptr++);
      sptr--;
      while (sptr > DclLine && *sptr != ']') sptr--;
      if (*sptr == ']') sptr++;
      *sptr = '\0';
      Length = sptr - DclLine;
   }
   if (Length) DclQioSysCommand (tkptr, DclLine, Length);

   /*******************************/
   /* DCL command/procedure/image */
   /*******************************/

   if (tkptr->ScriptFileName[0])
   {
      /**************/
      /* CGI script */
      /**************/

      zptr = (sptr = DclLine) + sizeof(DclLine)-1;
      cptr = tkptr->ScriptRunTimePtr;
      /* this exclamation symbols can be used within RTE-style syntax */
      if (*cptr == '!') cptr++;
      if (*(unsigned short*)cptr == '@\0')
      {
         /* searched-for DCL procedure */
         *sptr++ = '@';
         cptr = tkptr->SearchOds.ResFileName;
         while (*cptr && sptr < zptr) *sptr++ = *cptr++;
         *sptr = '\0';
      }
      else
      if (*(unsigned short*)cptr == '=\0')
      {
         /* searched-for command definition */
         memcpy (sptr, "SET COMMAND ", 12);
         sptr += 12;
         cptr = tkptr->SearchOds.ResFileName;
         while (*cptr && sptr < zptr) *sptr++ = *cptr++;
         *sptr = '\0';
         DclQioSysCommand (tkptr, DclLine, sptr-DclLine);

         /* now use the command defintion file name as the verb */
         while (sptr > DclLine && *sptr != ']') sptr--;
         if (*sptr == ']') sptr++;
         cptr = sptr;
         zptr = (sptr = DclLine) + sizeof(DclLine)-1;
         while (*cptr && *cptr != '.' && sptr < zptr) *sptr++ = *cptr++;
         *sptr = '\0';
      }
      else
      if (*(unsigned short*)cptr == '$\0')
      {
         /* searched-for executable */
         memcpy (sptr, "WASDVERB:=$", 11);
         sptr += 11;
         cptr = tkptr->SearchOds.ResFileName;
         while (*cptr && sptr < zptr) *sptr++ = *cptr++;
         *sptr = '\0';
         DclQioSysCommand (tkptr, DclLine, sptr-DclLine);

         /* now use it as a foreign-command */
         zptr = (sptr = DclLine) + sizeof(DclLine)-1;
         memcpy (sptr, "WASDVERB", 8);
         sptr += 8;
         *sptr = '\0';
      }
      else
      if (*cptr == '@' ||
          *cptr == '$')
      {
         /* configured run-time string */
         memcpy (sptr, "WASDVERB:=", 10);
         sptr += 10;
         while (*cptr && sptr < zptr) *sptr++ = *cptr++;
         *sptr = '\0';
         DclQioSysCommand (tkptr, DclLine, sptr-DclLine);

         /* now place it as the verb before the script file */
         zptr = (sptr = DclLine) + sizeof(DclLine)-1;
         memcpy (sptr, "WASDVERB ", 9);
         sptr += 9;
         cptr = tkptr->SearchOds.ResFileName;
         while (*cptr && sptr < zptr) *sptr++ = *cptr++;
         *sptr = '\0';
      }
      else
      {
         /* verb must already exist on site, place before the script file */
         while (*cptr && sptr < zptr) *sptr++ = *cptr++;
         if (sptr < zptr) *sptr++ = ' ';
         cptr = tkptr->SearchOds.ResFileName;
         while (*cptr && sptr < zptr) *sptr++ = *cptr++;
         *sptr = '\0';
      }

      if (rqptr->rqPathSet.ScriptCommandPtr)
      {
         /* add script activation command elements from path SETing */
         StringPtr = rqptr->rqPathSet.ScriptCommandPtr;
         for (;;)
         {
            status = StringParseValue (&StringPtr, String, sizeof(String));
            if (VMSnok (status)) break;
            cptr = String;
            if (*cptr != '*') zptr = (sptr = DclLine) + sizeof(DclLine)-1;
            while (*cptr == '*') cptr++;
            while (*cptr && sptr < zptr) *sptr++ = *cptr++;
            *sptr = '\0';
            DclQioSysCommand (tkptr, DclLine, sptr-DclLine);
         }
         if (status != SS$_ENDOFFILE) ErrorVmsStatus (rqptr, status, FI_LI);
         DclLine[0] = '\0';
      }

      if (DclLine[0]) DclQioSysCommand (tkptr, DclLine, sptr-DclLine);
   }
   else
   {
      /*******/
      /* CLI */
      /*******/

      /* multiple commands may be separated by newlines */
      sptr = tkptr->DclCommandPtr;
      while (*sptr)
      {
         cptr = sptr;
         while (*sptr && *sptr != '\n') sptr++;
         Length = sptr - cptr;
         if (*sptr == '\n')
         {
            zptr = sptr;
            *sptr++ = '\0';
         }
         else
            zptr = NULL;
         DclQioSysCommand (tkptr, cptr, Length);
         if (zptr) *zptr = '\n';
      }
   }

   /*********************/
   /* after script runs */
   /*********************/

   if (DclUseZombies && !rqptr->rqPathSet.ScriptCpuMax)
   {
      DclQioSysCommand (tkptr, NoVerify, sizeof(NoVerify)-1);
      DclQioSysCommand (tkptr, WriteIsWrite, sizeof(WriteIsWrite)-1);

      sys$fao (&WriteDclQuoteFaoDsc, &Length, &DclLineDsc, tkptr->CgiEof);
      DclLine[Length] = '\0';
      DclQioSysCommand (tkptr, DclLine, Length);

      /* do not send an end-of-file! */
      return (SS$_NORMAL);
   }
   else
   {
      /* ensure script process terminates! */
      DclQioSysCommand (tkptr, StopId, sizeof(StopId)-1);

      /* send end-of-file */
      DclQioSysCommand (tkptr, NULL, 0);
   }

   return (SS$_NORMAL);
}

/*****************************************************************************/
/*
Send DCL commands to the CGIplus script process' SYS$COMMAND. This sets up the
DCL environment (defines logical names, assigns symbols) executes the procedure
or image.
*/ 

DclCgiPlusScriptSysCommand (DCL_TASK *tkptr)

{
   static char  DefSysErrNl [] = "DEFINE/USER SYS$ERROR NL:";
   static char  DefSysOutNl [] = "DEFINE/USER SYS$OUTPUT NL:";
   static char  DelSymAll [] = "DELSYMALL=\"DELETE/SYMBOL/ALL\"";
   static char  DelSymAllGlobal[] = "DELSYMALL/GLOBAL";
   static char  DelSymAllLocal[] = "DELSYMALL/LOCAL";
   static char  HttpdLogin [] =
"IF F$TRNLNM(\"HTTPD$LOGIN\").NES.\"\" THEN @HTTPD$LOGIN";
   static char  HttpdVerify1 [] =
"IF F$TRNLNM(\"HTTPD$VERIFY\") THEN \
WRITE SYS$OUTPUT \"Content-Type: text/plain\015\012\015\012\"";
   static char  HttpdVerify2 [] = "!\'F$VERIFY(F$TRNLNM(\"HTTPD$VERIFY\"))";
   static char  NetDefSysOut [] = "DEFINE SYS$OUTPUT SYS$NET";
   static char  NetPurgeLog [] = "PURGE/NOLOG/KEEP=3 SYS$LOGIN:"
                                 NETWORK_MODE_LOG_NAME;
   static char  NoVerify [] = "!\'F$VERIFY(0)";
   static char  SetNoOn [] = "SET NOON";
#ifdef ODS_EXTENDED
   static char  SetProcParseExt [] = "SET PROCESS/PARSE=EXTENDED";
   static char  SetProcParseTrad [] = "SET PROCESS/PARSE=TRADITIONAL";
#endif /* ODS_EXTENDED */
   static char  SetProcPriv[] = "SET PROCESS/PRIVILEGE=(NOALL,NETMBX,TMPMBX)";
   static char  StopId [] = "STOP/ID=0";

   static $DESCRIPTOR (DefineCgiPlusInFaoDsc,
                       "DEFINE/NOLOG/SUPER CGIPLUSIN !AZ");
   static $DESCRIPTOR (DefineCgiPlusEofFaoDsc,
                       "DEFINE/NOLOG/SUPER CGIPLUSEOF \"!AZ\"");
   static $DESCRIPTOR (DefineCgiPlusEotFaoDsc,
                       "DEFINE/NOLOG/SUPER CGIPLUSEOT \"!AZ\"");
   static $DESCRIPTOR (DefineCgiPlusEscFaoDsc,
                       "DEFINE/NOLOG/SUPER CGIPLUSESC \"!AZ\"");
   static $DESCRIPTOR (DefineHttpInputFaoDsc,
                       "DEFINE/NOLOG/SUPER HTTP$INPUT !AZ");
   static $DESCRIPTOR (DefineSysInputFaoDsc,
                       "DEFINE/NOLOG/SUPER SYS$INPUT !AZ");

   static $DESCRIPTOR (WriteDclQuoteFaoDsc, "WRITE SYS$OUTPUT \"!AZ\"");

   int  status;
   unsigned short  Length;
   char  *cptr, *sptr, *zptr,
         *StringPtr;
   char  DclLine [256],
         String [256];
   REQUEST_STRUCT *rqptr;
   $DESCRIPTOR (DclLineDsc, DclLine);

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "DclCgiPlusScriptSysCommand() !&Z", tkptr->ScriptRunTimePtr);

   /* get the pointer to the request structure */
   rqptr = tkptr->RequestPtr;

   DclQioSysCommand (tkptr, NoVerify, sizeof(NoVerify)-1);

   DclQioSysCommand (tkptr, DelSymAll, sizeof(DelSymAll)-1);
   DclQioSysCommand (tkptr, DelSymAllGlobal, sizeof(DelSymAllGlobal)-1);
   DclQioSysCommand (tkptr, DelSymAllLocal, sizeof(DelSymAllLocal)-1);
   DclQioSysCommand (tkptr, SetNoOn, sizeof(SetNoOn)-1);

   if (HttpdNetworkMode)
   {
      DclQioSysCommand (tkptr, NetDefSysOut, sizeof(NetDefSysOut)-1);
      DclQioSysCommand (tkptr, DefSysOutNl, sizeof(DefSysOutNl)-1);
      DclQioSysCommand (tkptr, DefSysErrNl, sizeof(DefSysErrNl)-1);
      DclQioSysCommand (tkptr, NetPurgeLog, sizeof(NetPurgeLog)-1);
   }

   if (tkptr->CrePrcDetachStarting)
   {
      /* indicate any login message, etc. are finished, process is ready */
      sys$fao (&WriteDclQuoteFaoDsc, &Length, &DclLineDsc, tkptr->CgiBel);
      DclLine[Length] = '\0';
      DclQioSysCommand (tkptr, DclLine, Length);
   }

   DclQioSysCommand (tkptr, HttpdVerify1, sizeof(HttpdVerify1)-1);
   DclQioSysCommand (tkptr, HttpdVerify2, sizeof(HttpdVerify2)-1);

   if (!DclScriptDetachProcess && Config.cfScript.SpawnAuthPriv)
      /* kludge to work around spawning authorized privileges with $CREPRC */
      DclQioSysCommand (tkptr, SetProcPriv, sizeof(SetProcPriv)-1);

   sys$fao (&DefineSysInputFaoDsc, &Length, &DclLineDsc,
            tkptr->HttpInputDevName);
   DclLine[Length] = '\0';
   DclQioSysCommand (tkptr, DclLine, Length);

   /* for backward compatibility */
   sys$fao (&DefineHttpInputFaoDsc, &Length, &DclLineDsc,
            tkptr->HttpInputDevName);
   DclLine[Length] = '\0';
   DclQioSysCommand (tkptr, DclLine, Length);

   sys$fao (&DefineCgiPlusInFaoDsc, &Length, &DclLineDsc,
            tkptr->CgiPlusInDevName);
   DclLine[Length] = '\0';
   status = DclQioSysCommand (tkptr, DclLine, Length);

   sys$fao (&DefineCgiPlusEofFaoDsc, &Length, &DclLineDsc,
            tkptr->CgiEof);
   DclLine[Length] = '\0';
   status = DclQioSysCommand (tkptr, DclLine, Length);

   sys$fao (&DefineCgiPlusEotFaoDsc, &Length, &DclLineDsc,
            tkptr->CgiEot);
   DclLine[Length] = '\0';
   status = DclQioSysCommand (tkptr, DclLine, Length);

   sys$fao (&DefineCgiPlusEscFaoDsc, &Length, &DclLineDsc,
            tkptr->CgiEsc);
   DclLine[Length] = '\0';
   status = DclQioSysCommand (tkptr, DclLine, Length);

#ifdef ODS_EXTENDED
   /* no need to keep track of the parse style, only activated once! */
   if (rqptr->PathOds == MAPURL_PATH_ODS_5)
      DclQioSysCommand (tkptr, SetProcParseExt, sizeof(SetProcParseExt)-1);
   else
   if (rqptr->PathOds == MAPURL_PATH_ODS_2)
      DclQioSysCommand (tkptr, SetProcParseTrad, sizeof(SetProcParseTrad)-1);
#endif /* ODS_EXTENDED */

   DclQioSysCommand (tkptr, HttpdLogin, sizeof(HttpdLogin)-1);

   /* set default to the script location */
   zptr = (sptr = DclLine) + sizeof(DclLine)-1;
   for (cptr = "SET DEFAULT "; *cptr; *sptr++ = *cptr++);
   if (rqptr->rqPathSet.ScriptDefaultPtr)
   {
      if (rqptr->rqPathSet.ScriptDefaultPtr[0] == '#' ||
          rqptr->rqPathSet.ScriptDefaultPtr[0] == '/')
      {
         /* backward compatible or U**x syntax, do not set default */
         Length = 0;
      }
      else
      {
         /* specified by the mapping rules */
         for (cptr = rqptr->rqPathSet.ScriptDefaultPtr;
              *cptr && sptr < zptr;
              *sptr++ = *cptr++);
         *sptr = '\0';
         Length = sptr - DclLine;
      }
   }
   else
   {
      /* whichever directory the script is located in */
      for (cptr = tkptr->SearchOds.ResFileName;
           *cptr && sptr < zptr;
           *sptr++ = *cptr++);
      sptr--;
      while (sptr > DclLine && *sptr != ']') sptr--;
      if (*sptr == ']') sptr++;
      *sptr = '\0';
      Length = sptr - DclLine;
   }
   if (Length) DclQioSysCommand (tkptr, DclLine, Length);

   /***********************/
   /* DCL procedure/image */
   /***********************/

   if (tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT)
   {
      /*******/
      /* RTE */
      /*******/

      zptr = (sptr = DclLine) + sizeof(DclLine)-1;
      cptr = tkptr->ScriptRunTimePtr;
      if (*cptr != '@')
      {
         if (*cptr == '$') cptr++;
         memcpy (sptr, "RUN ", 4);
         sptr += 4;
      }
      while (*cptr && sptr < zptr) *sptr++ = *cptr++;
      *sptr = '\0';
   }
   else
   {
      /******************/
      /* CGIplus script */
      /******************/

      zptr = (sptr = DclLine) + sizeof(DclLine)-1;
      cptr = tkptr->ScriptRunTimePtr;
      if (*(unsigned short*)cptr == '@\0')
      {
         /* searched-for DCL procedure */
         *sptr++ = '@';
         cptr = tkptr->SearchOds.ResFileName;
         while (*cptr && sptr < zptr) *sptr++ = *cptr++;
         *sptr = '\0';
      }
      else
      if (*(unsigned short*)cptr == '=\0')
      {
         /* searched-for command definition */
         memcpy (sptr, "SET COMMAND ", 12);
         sptr += 12;
         cptr = tkptr->SearchOds.ResFileName;
         while (*cptr && sptr < zptr) *sptr++ = *cptr++;
         *sptr = '\0';
         DclQioSysCommand (tkptr, DclLine, sptr-DclLine);

         /* now use the command defintion file name as the verb */
         while (sptr > DclLine && *sptr != ']') sptr--;
         if (*sptr == ']') sptr++;
         cptr = sptr;
         zptr = (sptr = DclLine) + sizeof(DclLine)-1;
         while (*cptr && *cptr != '.' && sptr < zptr) *sptr++ = *cptr++;
         *sptr = '\0';
      }
      else
      if (*(unsigned short*)cptr == '$\0')
      {
         /* searched-for executable */
         memcpy (sptr, "WASDVERB:=$", 11);
         sptr += 11;
         cptr = tkptr->SearchOds.ResFileName;
         while (*cptr && sptr < zptr) *sptr++ = *cptr++;
         *sptr = '\0';
         DclQioSysCommand (tkptr, DclLine, sptr-DclLine);

         /* now use it as a foreign-command */
         zptr = (sptr = DclLine) + sizeof(DclLine)-1;
         memcpy (sptr, "WASDVERB", 8);
         sptr += 8;
         *sptr = '\0';
      }
      else
      if (*cptr == '@' ||
          *cptr == '$')
      {
         /* configured run-time string */
         memcpy (sptr, "WASDVERB:=", 10);
         sptr += 10;
         while (*cptr && sptr < zptr) *sptr++ = *cptr++;
         *sptr = '\0';
         DclQioSysCommand (tkptr, DclLine, sptr-DclLine);

         /* now place it as the verb before the script file */
         zptr = (sptr = DclLine) + sizeof(DclLine)-1;
         memcpy (sptr, "WASDVERB ", 9);
         sptr += 9;
         cptr = tkptr->SearchOds.ResFileName;
         while (*cptr && sptr < zptr) *sptr++ = *cptr++;
         *sptr = '\0';
      }
      else
      {
         /* verb must already exist on site, place before the script file */
         while (*cptr && sptr < zptr) *sptr++ = *cptr++;
         if (sptr < zptr) *sptr++ = ' ';
         cptr = tkptr->SearchOds.ResFileName;
         while (*cptr && sptr < zptr) *sptr++ = *cptr++;
         *sptr = '\0';
      }

      if (rqptr->rqPathSet.ScriptCommandPtr)
      {
         /* add script activation command elements from path SETing */
         StringPtr = rqptr->rqPathSet.ScriptCommandPtr;
         for (;;)
         {
            status = StringParseValue (&StringPtr, String, sizeof(String));
            if (VMSnok (status)) break;
            cptr = String;
            if (*cptr != '*') zptr = (sptr = DclLine) + sizeof(DclLine)-1;
            while (*cptr == '*') cptr++;
            while (*cptr && sptr < zptr) *sptr++ = *cptr++;
            *sptr = '\0';
            DclQioSysCommand (tkptr, DclLine, sptr-DclLine);
         }
         if (status != SS$_ENDOFFILE) ErrorVmsStatus (rqptr, status, FI_LI);
         DclLine[0] = '\0';
      }
   }

   if (DclLine[0]) DclQioSysCommand (tkptr, DclLine, sptr-DclLine);

   /* ensure script process terminates! */
   DclQioSysCommand (tkptr, StopId, sizeof(StopId)-1);

   /* send end-of-file */
   DclQioSysCommand (tkptr, NULL, 0);
}

/*****************************************************************************/
/*
Send CGI variables to the script process' CGIPLUSIN input stream.  This is
either done with each CGI variable "name=value" as an individual record, or
with the entire CGI variable being provided in a single I/O.  See CGI.C for an
explanation on the structure of this data.

Transfering the CGIplus variables as a single structure (rather than as
per-variable records) can double the throughput!!  Demonstrated using the
[SRC.CGIPLUS]CGIPLUSTEST.C program.  This indicates that there is much less
than half the overhead for performing this using the 'struct' method!
*/ 

int DclCgiPlusScriptCgiPlusIn (DCL_TASK *tkptr)

{
   static char  CCString [] = "!\0\0";
   static char  StructString [32];
   static $DESCRIPTOR (StructFaoDsc, "!!!!!UL!AZ");
   static $DESCRIPTOR (StructStringDsc, StructString);

   int  status,
        StructLength;
   unsigned short  Length;
   char  *cptr;
   REQUEST_STRUCT *rqptr;

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

   if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL,
                 "DclCgiPlusScriptCgiPlusIn()");

   /* get the pointer to the request structure */
   rqptr = tkptr->RequestPtr;

   if (VMSnok (status = CgiGenerateVariables (rqptr, CGI_VARIABLE_STREAM)))
      return (status);

   if (tkptr->CgiPlusVarStruct)
   {
      StructLength = rqptr->rqCgi.BufferCurrentPtr - rqptr->rqCgi.BufferPtr;
      sys$fao (&StructFaoDsc, &Length, &StructStringDsc,
               StructLength, rqptr->rqPathSet.CgiPlusInCC);
      StructString[Length] = '\0';

      /* just a line for "start-of-request" that can always be discarded */
      DclQioCgiPlusIn (tkptr, StructString, Length);

      /* provide all the CGI variables in one structure and I/O */
      DclQioCgiPlusIn (tkptr, rqptr->rqCgi.BufferPtr, StructLength);
   }
   else
   {
      /* just a line for "start-of-request" that can always be discarded */
      if (rqptr->rqPathSet.CgiPlusInCC[0])
      {
         CCString[1] = rqptr->rqPathSet.CgiPlusInCC[0];
         if (rqptr->rqPathSet.CgiPlusInCC[1])
         {
            CCString[2] = rqptr->rqPathSet.CgiPlusInCC[1];
            DclQioCgiPlusIn (tkptr, CCString, 3);
         }
         else
            DclQioCgiPlusIn (tkptr, CCString, 2);
      }
      else
         DclQioCgiPlusIn (tkptr, CCString, 1);

      /* provide each variable as a separate record */
      cptr = rqptr->rqCgi.BufferPtr;
      for (;;)
      {
         if (!(Length = *(short*)cptr)) break;        
         DclQioCgiPlusIn (tkptr, cptr+sizeof(short), Length-1);
         cptr += Length + sizeof(short);
      }
      /* empty record/line terminates CGI variables */
      if (rqptr->rqPathSet.CgiPlusInCC[0])
         if (rqptr->rqPathSet.CgiPlusInCC[1])
            DclQioCgiPlusIn (tkptr, rqptr->rqPathSet.CgiPlusInCC, 2);
         else
            DclQioCgiPlusIn (tkptr, rqptr->rqPathSet.CgiPlusInCC, 1);
      else
         DclQioCgiPlusIn (tkptr, "", 0);
   }

   if (rqptr->rqPathSet.CgiPlusInWriteof) DclQioCgiPlusIn (tkptr, NULL, 0);

   return (SS$_NORMAL);
}

/*****************************************************************************/
/*
This function is available for an agent callout to write output to the agent's
CGIplus input mailbox.  It may be called one or more times from a single
callout (the only thing to be mindful of is BYTLM and the capacity of the
CGIPLUSIN mailbox.
*/ 

DclCalloutQio
(
REQUEST_STRUCT *rqptr,
char *DataPtr,
int DataLength
)
{
   /*********/
   /* begin */
   /*********/

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (rqptr, FI_LI, WATCH_MOD_DCL, "DclCalloutQio() !&Z", DataPtr);

   if (!rqptr->DclTaskPtr)
      ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);

   DclQioCgiPlusIn (rqptr->DclTaskPtr, DataPtr, DataLength);
}

/*****************************************************************************/
/*
Default callout for CGIplus scripting.  In other words; ask the the server to
do something for a CGIplus script.  See prologue to this module for description
of currently support functionality.
*/ 

DclCalloutDefault (REQUEST_STRUCT *rqptr)

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

   BOOL  ProvideResponse;
   int  status,
        Length,
        Number;
   char  *cptr, *sptr, *zptr, 
         *ContentPtr,
         *FileNamePtr,
         *OutputPtr;
   char  Scratch [1024+4];
   DCL_TASK  *tkptr;

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (rqptr, FI_LI, WATCH_MOD_DCL, "DclCalloutDefault() !&Z",
                 rqptr->rqCgi.CalloutOutputPtr);

   /* get a local pointer to the DCL task structure */
   tkptr = rqptr->DclTaskPtr;

   if (!(OutputPtr = rqptr->rqCgi.CalloutOutputPtr) &&
       (rqptr->rqCgi.CalloutOutputCount == 0 ||
        rqptr->rqCgi.CalloutOutputCount == -1))
   {
      /* indicates the script has sent a begin or end escape sequence */
      return;
   }

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

   /* make sure there are no potential nasties lurking in the string */
   for (cptr = OutputPtr; *cptr && !iscntrl(*cptr); cptr++);
   *cptr = '\0';

   if (toupper(OutputPtr[0]) == 'A' &&
       strsame (OutputPtr, "AUTH-FILE:", 10))
   {
      /**************/
      /* AUTH-FILE: */
      /**************/

      /* authorize access to a particular file */
      for (cptr = OutputPtr+10; *cptr && isspace(*cptr); cptr++);
      if (!*cptr)
      {
         if (ProvideResponse)
            DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1);
         return;
      }
      FileNamePtr = cptr;
      while (*cptr && !isspace(*cptr)) cptr++;
      if (rqptr->rqAuth.VmsUserProfileLength)
      {
         status = AuthVmsCheckUserAccess (rqptr, FileNamePtr, cptr-FileNamePtr);
         if (ProvideResponse)
         {
            if (status == SS$_NOPRIV)
               DclCalloutQio (rqptr, RspForbidden, sizeof(RspForbidden)-1);
            else
            if (VMSok (status))
               DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1);
            else
            {
               /* error reported by access check */
               WriteFao (Scratch, sizeof(Scratch), NULL, "400 %!&M", status);
               DclCalloutQio (rqptr, Scratch, strlen(Scratch));
            }
         }
      }
      else
      if (ProvideResponse)
      {
         /* i.e. request does not have a VMS profile associated */
         DclCalloutQio (rqptr, RspUnauthorized, sizeof(RspUnauthorized)-1);
      }
      return;
   }

   if (toupper(OutputPtr[0]) == 'B' &&
       strsame (OutputPtr, "BODY:", 5))
   {
      /*********/
      /* BODY: */
      /*********/

      for (cptr = OutputPtr+5; *cptr && isspace(*cptr); cptr++);
      while (*cptr)
      {
         while (*cptr && (isspace(*cptr) || *cptr == ';')) cptr++;
         if (!*cptr) break;
         if (strsame (cptr, "STREAM", 6))
            cptr += 6;
         else
         {
            if (ProvideResponse)
               DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1);
            return;
         }
      }

      if (tkptr->ContentLength)
      {
         /* supply only the body of the request (standard CGI behaviour) */
         if (tkptr->ContentLength > DclCgiPlusInSize)
            Length = DclCgiPlusInSize;
         else
            Length = tkptr->ContentLength;
         ContentPtr = tkptr->ContentPtr;
         tkptr->ContentPtr += Length;
         tkptr->ContentLength -= Length;

         if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_DCL))
         {
            WatchThis (rqptr, FI_LI, WATCH_DCL,
                       "WRITE body CGIPLUSIN !UL bytes", Length);
            if (Length) WatchData (ContentPtr, Length);
         }

         status = sys$qio (EfnNoWait, tkptr->CgiPlusInChannel,
                           IO$_WRITELBLK, &tkptr->CgiPlusInIOsb,
                           &DclHttpInputAst, tkptr,
                           ContentPtr, Length, 0, 0, 0, 0);
         if (VMSnok (status))
         {
            /* report error via the AST */
            tkptr->CgiPlusInIOsb.Status = status;
            SysDclAst (&DclHttpInputAst, tkptr);
         }
      }

      if (ProvideResponse)
         DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1);

      return;
   }

   if (toupper(OutputPtr[0]) == 'C' &&
       toupper(OutputPtr[3]) == 'P' && 
       strsame (OutputPtr, "CGIPLUS:", 8))
   {
      /************/
      /* CGIPLUS: */
      /************/

      for (cptr = OutputPtr+8; *cptr && isspace(*cptr); cptr++);
      if (strsame (cptr, "STRUCT", 6))
         tkptr->CgiPlusVarStruct = true;
      else
      if (strsame (cptr, "RECORD", 6))
         tkptr->CgiPlusVarStruct = false;
      else
      {
         if (ProvideResponse)
            DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1);
         return;
      }

      if (ProvideResponse)
         DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1);

      return;
   }

   if (toupper(OutputPtr[0]) == 'C' &&
       toupper(OutputPtr[8]) == 'R' && 
       strsame (OutputPtr, "CLIENT-READ:", 12))
   {
      /***************/
      /* CLIENT-READ */
      /***************/

      tkptr->ClientReadStripCrLf = false;
      for (cptr = OutputPtr+12; *cptr && isspace(*cptr); cptr++);
      if (strsame (cptr, "STRIPCRLF", 9))
         tkptr->ClientReadStripCrLf = true;
      else
      {
         if (ProvideResponse)
            DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1);
         return;
      }

      /* first cancel the normal end-of-request-body EOF on the channel */
      sys$cancel (tkptr->HttpInputChannel);

      /* allocate some storage for buffering this I/O */
      tkptr->ClientReadBufferPtr =
         VmGetHeap (rqptr, tkptr->ClientReadBufferSize = NetReadBufferSize);

      /* queue the first read from the client */
      NetRead (rqptr, &DclClientReadAst,
               tkptr->ClientReadBufferPtr, tkptr->ClientReadBufferSize);
      tkptr->QueuedClientRead++;

      if (ProvideResponse)
         DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1);

      return;
   }

   if (toupper(OutputPtr[0]) == 'C' &&
       toupper(OutputPtr[8]) == 'T' && 
       strsame (OutputPtr, "CONTENT-TYPE:", 13))
   {
      /*****************/
      /* CONTENT-TYPE: */
      /*****************/

      for (cptr = OutputPtr+13; *cptr && isspace(*cptr); cptr++);
      if (!*cptr)
      {
         if (ProvideResponse)
            DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1);
         return;
      }
      while (*cptr) cptr++;
      while (cptr > OutputPtr+13 && *cptr != '.' && *cptr != ']') cptr--;
      cptr = ConfigContentType (NULL, cptr);
      zptr = (sptr = Scratch) + sizeof(Scratch)-1;
      memcpy (sptr, "200 ", 4);
      sptr += 4;
      while (*cptr && sptr < zptr) *sptr++ = *cptr++;
      *sptr = '\0';
      if (ProvideResponse) DclCalloutQio (rqptr, Scratch, sptr - Scratch);
      return;
   }

   if (Config.cfScript.GatewayBg)
   {
      if (toupper(OutputPtr[0]) == 'G' &&
          strsame (OutputPtr, "GATEWAY-BEGIN:", 14))
      {
         /* HTTP status code of response directly to the BG (socket) device */
         for (cptr = OutputPtr+14; *cptr && isspace(*cptr); cptr++);
         if (isdigit(*cptr))
         {
            Number = atoi(cptr);
            rqptr->rqResponse.HttpStatus = Number;
            if (ProvideResponse)
               DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1);
         }               
         else
         if (ProvideResponse)
            DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1);
         return;
      }
      else
      if (toupper(OutputPtr[0]) == 'G' &&
          strsame (OutputPtr, "GATEWAY-END:", 12))
      {
         /* count of bytes output directly to the BG (socket) device */
         for (cptr = OutputPtr+12; *cptr && isspace(*cptr); cptr++);
         if (isdigit(*cptr))
         {
            Number = atoi(cptr);
            rqptr->BytesRawTx += Number;
            if (ProvideResponse)
               DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1);
         }               
         else
         if (ProvideResponse)
            DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1);
         return;
      }
   }

   if (toupper(OutputPtr[0]) == 'I' &&
       strsame (OutputPtr, "ICON-TYPE:", 10))
   {
      /**************/
      /* ICON-TYPE: */
      /**************/

      for (cptr = OutputPtr+10; *cptr && isspace(*cptr); cptr++);
      if (!*cptr)
      {
         if (ProvideResponse)
            DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1);
         return;
      }
      sptr = cptr;
      while (*cptr) cptr++;
      while (cptr > OutputPtr+10 && *cptr != '.' &&
             *cptr != ']' && *cptr != '/') cptr--;
      if (*cptr == '.')
         cptr = ConfigContentType (NULL, cptr);
      else
         cptr = sptr;
      cptr = ConfigIconFor (cptr, NULL, NULL);
      zptr = (sptr = Scratch) + sizeof(Scratch)-1;
      memcpy (sptr, "200 ", 4);
      sptr += 4;
      while (*cptr && sptr < zptr) *sptr++ = *cptr++;
      *sptr = '\0';
      if (ProvideResponse) DclCalloutQio (rqptr, Scratch, sptr - Scratch);
      return;
   }

   if (toupper(OutputPtr[0]) == 'L' &&
       strsame (OutputPtr, "LIFETIME:", 9))
   {
      /*************/
      /* LIFETIME: */
      /*************/

      /* let a CGIplus script set/reset its own lifetime */
      for (cptr = OutputPtr+9; *cptr && isspace(*cptr); cptr++);
      if ((toupper(*cptr) == 'D' && strsame (cptr, "DO-NOT-DISTURB", 4)) ||
          (toupper(*cptr) == 'N' && strsame (cptr, "NONE", 4)))
         Number = DCL_DO_NOT_DISTURB;
      else
      if (!(Number = atoi(cptr)))
      {
         /* anything other than a valid number reverts to config values */
         if (tkptr->TaskType == DCL_TASK_TYPE_CGI_SCRIPT)
            Number = Config.cfScript.ZombieLifeTime;
         else
            Number = Config.cfScript.CgiPlusLifeTime;
      }
      tkptr->LifeTimeSecond = HttpdTickSecond + Number;
      if (ProvideResponse)
         DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1);
      return;
   }

   if (toupper(OutputPtr[0]) == 'M' &&
       toupper(OutputPtr[4]) == 'F' && 
       strsame (OutputPtr, "MAP-FILE:", 9))
   {
      /*************/
      /* MAP-FILE: */
      /*************/

      Scratch[4] = '\0';
      for (cptr = OutputPtr+9; *cptr && isspace(*cptr); cptr++);
      if (!*cptr)
      {
         if (ProvideResponse)
            DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1);
         return;
      }
      cptr = MapUrl_Map (Scratch+4, sizeof(Scratch)-4, cptr, 0,
                         NULL, 0, NULL, 0, NULL, 0, NULL, rqptr);
      if (!cptr[0] && cptr[1])
      {
         memcpy (Scratch, "400 ", 4);
         strcpy (Scratch+4, cptr+1);
         if (ProvideResponse)
            DclCalloutQio (rqptr, Scratch, strlen(Scratch));
      }
      else
      {
         memcpy (Scratch, "200 ", 4);
         /* for backward comptibility (pre8.1) URL-encode the supplied path */
         Length = StringUrlEncode (cptr, Scratch+4, sizeof(Scratch)-4);
         if (ProvideResponse)
            DclCalloutQio (rqptr, Scratch, Length+4);
      }
      return;
   }

   if (toupper(OutputPtr[0]) == 'M' &&
       toupper(OutputPtr[4]) == 'P' && 
       strsame (OutputPtr, "MAP-PATH:", 9))
   {
      /*************/
      /* MAP-PATH: */
      /*************/

      Scratch[4] = '\0';
      for (cptr = OutputPtr+9; *cptr && isspace(*cptr); cptr++);
      if (!*cptr)
      {
         if (ProvideResponse)
            DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1);
         return;
      }
      cptr = MapUrl_Map (cptr, 0, Scratch+4, sizeof(Scratch)-4,
                         NULL, 0, NULL, 0, NULL, 0, NULL, rqptr);
      if (!cptr[0] && cptr[1])
      {
         memcpy (Scratch, "400 ", 4);
         strcpy (Scratch+4, cptr+1);
         if (ProvideResponse)
            DclCalloutQio (rqptr, Scratch, strlen(Scratch));
      }
      else
      {
         if (strsame (Scratch+4, MAPURL_NO_REVERSE_PATH, -1))
            memcpy (Scratch, "400 ", 4);
         else
            memcpy (Scratch, "200 ", 4);
         if (ProvideResponse)
            DclCalloutQio (rqptr, Scratch, strlen(Scratch));
      }
      return;
   }

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

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

   if (toupper(OutputPtr[0]) == 'T' &&
       toupper(OutputPtr[8]) == 'B' && 
       strsame (OutputPtr, "TIMEOUT-BIT-BUCKET:", 19))
   {
      /***********************/
      /* TIMEOUT-BIT-BUCKET: */
      /***********************/

      /* let a script SPECIFY it's own per-task bit-bucket timeout */
      for (cptr = OutputPtr+19; *cptr && isspace(*cptr); cptr++);
      if (isdigit(*cptr))
      {
         if (strsame (cptr, "none", 4))
            Number = 0;
         else
            Number = atoi(cptr);
         tkptr->BitBucketTimeout = Number;
         if (ProvideResponse)
            DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1);
      }               
      else
      if (ProvideResponse)
         DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1);
      return;
   }

   if (toupper(OutputPtr[0]) == 'T' &&
       toupper(OutputPtr[8]) == 'N' && 
       strsame (OutputPtr, "TIMEOUT-NOPROGRESS:", 19))
   {
      /***********************/
      /* TIMEOUT-NOPROGRESS: */
      /***********************/

      /* let a script set/reset it's own per-request no-progress timeout */
      for (cptr = OutputPtr+19; *cptr && isspace(*cptr); cptr++);
      if (isdigit(*cptr))
      {
         if (strsame (cptr, "none", 4))
            Number = -1;
         else
            Number = atoi(cptr);
         HttpdTimerSet (rqptr, TIMER_NOPROGRESS, Number);
         if (ProvideResponse)
            DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1);
      }               
      else
      if (ProvideResponse)
         DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1);
      return;
   }

   if (toupper(OutputPtr[0]) == 'T' &&
       toupper(OutputPtr[8]) == 'O' && 
       strsame (OutputPtr, "TIMEOUT-OUTPUT:", 15))
   {
      /*******************/
      /* TIMEOUT-OUTPUT: */
      /*******************/

      /* let a script set/reset its own per-request output timeout */
      for (cptr = OutputPtr+15; *cptr && isspace(*cptr); cptr++);
      if (isdigit(*cptr))
      {
         if (strsame (cptr, "none", 4))
            Number = -1;
         else
            Number = atoi(cptr);
         HttpdTimerSet (rqptr, TIMER_OUTPUT, Number);
         if (ProvideResponse)
            DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1);
      }               
      else
         if (ProvideResponse)
            DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1);
      return;
   }

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

/*****************************************************************************/
/*
Whenever there is an active script process (not necessarily processing a
request) this function is called every second by HttpdTick().  It only scans
the list of script tasks every so-many seconds.  This can be varied to provide
greater or lesser granularity depending on requirements (some events benfit
from closer observation).  Periodically scan the list of DCL script processes
looking for those whose lifetimes have expired.  Run those script processes
down!  A lifetime count of DCL_DO_NOT_DISTURB (-1) indicates the script process
has requested that it be immune to supervisor purging (and some other other
proactive administration).  Return true to indicate that the HTTPd should
continue to tick.
*/

BOOL DclSupervisor (int PeriodSeconds)

{
   static int  CleanupSecond = 0,
               TaskScanSeconds = 0;

   BOOL  ContinueTicking;
   int  status,
        MinSeconds;
   LIST_ENTRY  *leptr;
   DCL_TASK  *tkptr;

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

   if (WATCH_MODULE(WATCH_MOD_DCL) && PeriodSeconds != -1)
      WatchThis (NULL, FI_LI, WATCH_MOD_DCL,
                 "DclSupervisor() !SL !UL", PeriodSeconds, HttpdTickSecond);

   if (PeriodSeconds >= 0)
   {
      /* initiate or reset the task supervisor ticking */
      if (PeriodSeconds)
      {
         if (HttpdTickSecond + PeriodSeconds < TaskScanSeconds &&
             PeriodSeconds >= DCL_SUPERVISOR_TICK_MIN &&
             PeriodSeconds <= DCL_SUPERVISOR_TICK_MAX)
            TaskScanSeconds = HttpdTickSecond + PeriodSeconds;
      }
      else
      if (!TaskScanSeconds)
         TaskScanSeconds = HttpdTickSecond + DCL_SUPERVISOR_TICK_MAX;

      return (false);
   }

   /*******************/
   /* task supervisor */
   /*******************/

   /* no script process is currently executing */
   if (!TaskScanSeconds) return (false);

   /* no need to do a scan just yet */
   if (TaskScanSeconds > HttpdTickSecond) return (true);

   /* if there is no cleanup expiry set then generate one */
   if (DclCleanupMinutesMax && !CleanupSecond)
      CleanupSecond = HttpdTickSecond + DclCleanupMinutesMax * 60;

   ContinueTicking = false;
   MinSeconds = DCL_SUPERVISOR_TICK_MAX;

   for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr)
   {
      tkptr = (DCL_TASK*)leptr;
 
      if (!tkptr->ScriptProcessPid) continue;

      ContinueTicking = true;

      if ((tkptr->RequestPtr ||
           tkptr->LifeTimeSecond > HttpdTickSecond ||
           tkptr->LifeTimeSecond == DCL_DO_NOT_DISTURB) &&
          !(tkptr->ForceImageExitGetJpi ||
            tkptr->ForceImageExitIssued))
      {
         if (tkptr->ScriptCpuMax)
         {
            /* we're keeping an eye on CPU consumption */
            DclScriptCpuTim (tkptr);
            if (tkptr->ScriptCpuMax < MinSeconds)
               MinSeconds = tkptr->ScriptCpuMax;
         }
         else
         if (tkptr->LifeTimeSecond - HttpdTickSecond < MinSeconds)
            MinSeconds = tkptr->LifeTimeSecond - HttpdTickSecond;

         continue;
      }

      /* process timer has expired, exterminate ... exxterrminnaattte */
      tkptr->LifeTimeSecond = 0;
      tkptr->DeleteProcess = true;
      DclTaskRunDown (tkptr);

      /* if we're still waiting for image exit then it's not over yet */
      if (tkptr->ForceImageExit) continue;

      if (tkptr->TaskType == DCL_TASK_TYPE_CGIPLUS_SCRIPT ||
          tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT)
         DclCgiPlusLifeTimePurgeCount++;
      else
         DclZombieLifeTimePurgeCount++;
   }

   if (CleanupSecond && (CleanupSecond <= HttpdTickSecond || !ContinueTicking))
   {
      /* either the cleanup timer expired or no more scripts */
      if (WATCH_MODULE(WATCH_MOD_DCL))
         WatchThis (NULL, FI_LI, WATCH_MOD_DCL,
                    "CLEANUP !AZ", DCL_HTTPD_SCRATCH);
      /* kick off an independent thread of cleanup I/O */
      SysDclAst (&DclCleanupScratch, NULL);
      CleanupSecond = 0;
   }

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (NULL, FI_LI, WATCH_MOD_DCL,
                 "SUPERVISOR !&B !UL", ContinueTicking, MinSeconds);

   if (ContinueTicking)
   {
      /* at least one item in the connect list is still counting down */
      if (MinSeconds < 0) MinSeconds = 0;
      TaskScanSeconds = HttpdTickSecond + MinSeconds;
      return (true);
   }

   /* purge the script name cache when there are no more zombies/CGIplus */
   DclPurgeScriptNameCache ();

   /* reinitialize the supervisor timings */
   CleanupSecond = TaskScanSeconds = 0;

   return (false);
}

/*****************************************************************************/
/*
In an independent thread of execution search the script working/scratch
directory (HT_SCRATCH) checking for files that are older than the limit (based
on their RDT).  This thread is initiated by being called with a NULL as the
parameter.  This initializes the RMS structures and begins an AST-driven
search, calling this function for each search call with the search FAB as the
parameter.  Files found have the revision date/time compared to a date/time the
required number of minutes earlier than the current time.  Those exceeding that
are deleted.  File names beginning with a dollar are never deleted in this way.
*/

void DclCleanupScratch (struct FAB *FabPtr)

{
   static unsigned long  OneMinuteDelta [2] = { -600000000, -1 };

   BOOL  CleanupUnderway = false;
   static int  FileCount,
               FileDeletedCount,
               FileDollarCount,
               FileHiddenCount;
   static unsigned long  CurrentBinTime [2],
                         OlderThanBinTime [2],
                         ScratchBinTime [2];
   static ODS_STRUCT  SearchOds;

   int  status;

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (NULL, FI_LI, WATCH_MOD_DCL,
                 "DclCleanupScratch() !&F", &DclCleanupScratch);

   if (!FabPtr)
   {
      if (CleanupUnderway) return;
      CleanupUnderway = true;

      FileCount = FileDeletedCount = FileDollarCount = FileHiddenCount = 0;

      memcpy (&ScratchBinTime, &OneMinuteDelta, sizeof(ScratchBinTime));
      status = lib$mult_delta_time (&DclCleanupMinutesOld, &ScratchBinTime);
      if (VMSnok (status))
      {
         ErrorNoticed (status, "lib$mult_delta_time()", FI_LI);
         CleanupUnderway = false;
         return;
      }
      /* add the (negative) delta to the current getting an earlier time */
      sys$gettim (&CurrentBinTime);
      status = lib$sub_times (&CurrentBinTime,
                              &ScratchBinTime,
                              &OlderThanBinTime);
      if (VMSnok (status))
      {
         ErrorNoticed (status, "lib$add_times()", FI_LI);
         CleanupUnderway = false;
         return;
      }

      status = OdsParse (&SearchOds,
                         DCL_HTTPD_SCRATCH, sizeof(DCL_HTTPD_SCRATCH)-1,
                         "[...]*.*;*", 10, 0, NULL, 0);
      if (VMSnok (status))
      {
         ErrorNoticed (status, "sys$parse()", FI_LI);
         CleanupUnderway = false;
         return;
      }
   }
   else
   {
      if (VMSnok (status = SearchOds.Fab.fab$l_sts))
      {
         if (status == RMS$_FNF || status == RMS$_NMF)
         {
            if (FileDeletedCount)
               WriteFaoStdout (
"%!AZ-I-DCL, !20%D, cleanup !AZ, !UL file!%s, !UL deleted ($!UL/.!UL)\n",
                  Utility, 0, DCL_HTTPD_SCRATCH,
                  FileCount, FileDeletedCount,
                  FileDollarCount, FileHiddenCount);
         }
         else
            ErrorNoticed (status, "OdsSearch()", FI_LI);
         CleanupUnderway = false;
         if (SearchOds.ParseInUse) OdsParseRelease (&SearchOds);
         return;
      }

      FileCount++;
      if (SearchOds.NamNamePtr[0] == '$')
         FileDollarCount++;
      else
      if (SearchOds.NamNamePtr[0] == '.')
         FileHiddenCount++;
      else
      {
         status = OdsFileAcpInfo (&SearchOds, NULL, 0); 
         if (VMSnok (status))
         {
            ErrorNoticed (status, "OdsFileAcpInfo()", FI_LI);
            CleanupUnderway = false;
            if (SearchOds.ParseInUse) OdsParseRelease (&SearchOds);
            return;
         }
         /* if a negative time the file is older than the specified period */
         status = lib$sub_times (&SearchOds.FileQio.RdtBinTime,
                                 &OlderThanBinTime,
                                 &ScratchBinTime);
         if (status == LIB$_NEGTIM)
         {
            /* use SYSPRV to ensure the file is deleted */
            sys$setprv (1, &SysPrvMask, 0, 0);
            SearchOds.Fab.fab$l_fop = FAB$M_NAM;
            status = sys$erase (&SearchOds.Fab, 0, 0);
            sys$setprv (0, &SysPrvMask, 0, 0);
            if (VMSok (status)) FileDeletedCount++;
         }
         else
         if (VMSnok (status))
         {
            ErrorNoticed (status, "lib$sub_times()", FI_LI);
            CleanupUnderway = false;
            if (SearchOds.ParseInUse) OdsParseRelease (&SearchOds);
            return;
         }
      }
   }

   OdsSearch (&SearchOds, &DclCleanupScratch, NULL);
}

/*****************************************************************************/
/*
Scan all detached processes on the system looking for those with a mailbox
'terminal' with the server's 'special' identifier in an ACL.  Delete these
processes. This function is called to clean-up detached script processes that
may have been left on the system if a server is sys$delprc()ed in some way
(e.g. STOP/ID=).  Normally the image exit handler will delete these during
user-mode image rundown.  This function obviously must be called during server
startup prior to actually beginning to process requests.
*/

/* seems a lot but I recall some site having a HUGE number of IDs */
#define JPI_PROCESS_RIGHTS_MAX 1024

#define PSCAN$_GETJPI_BUFFER_SIZE 24
#define PSCAN$_TERMINAL 21 
#define PSCAN$M_PREFIX_MATCH 0x80
#define PSCAN$M_EQL 0x400

DclCleanupScriptProcesses ()

{
   static $DESCRIPTOR (ProcessIdentNameDsc, "");
   static unsigned long  GetJpiControlFlags = JPI$M_IGNORE_TARGET_STATUS;

   static unsigned long  JpiPid,
                         JpiRightsSize;
   static char  JpiPrcNam [16],
                JpiUserName [13];

   static struct
   {
      unsigned short  buf_len;
      unsigned short  item;
      unsigned char   *buf_addr;
      unsigned long   *short_ret_len;
   }
      JpiItems [] =
   {
      { sizeof(GetJpiControlFlags), JPI$_GETJPI_CONTROL_FLAGS,
        &GetJpiControlFlags, 0 },
      { sizeof(JpiPid), JPI$_PID, &JpiPid, 0 },
      { sizeof(JpiPrcNam), JPI$_PRCNAM, &JpiPrcNam, 0 },
      { sizeof(JpiUserName), JPI$_USERNAME, &JpiUserName, 0 },
      { sizeof(JpiRightsSize), JPI$_RIGHTS_SIZE, &JpiRightsSize, 0 },
#define JPI_PROCESS_RIGHTS_ITEM 5
      { 0, JPI$_PROCESS_RIGHTS, 0, 0 },
      { 0,0,0,0 }
   },
      ScanItems [] =
   {
      { 0, PSCAN$_GETJPI_BUFFER_SIZE, 2048, 0 },
      { 0,0,0,0 }
   };

   int  idx, status,
        Context,
        IdentCount,
        ProcessCount,
        SetPrvStatus;
   unsigned long  ProcessContext;
   unsigned long  JpiProcessRights [JPI_PROCESS_RIGHTS_MAX*2];
   char  *cptr;
   IO_SB  IOsb;

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclCleanupScriptProcesses()");

   /* create the identifier if it does not already exist */
   ProcessIdentNameDsc.dsc$a_pointer = ProcessIdentName;
   ProcessIdentNameDsc.dsc$w_length = strlen(ProcessIdentName);
   status = sys$asctoid (&ProcessIdentNameDsc, &ProcessRightsIdent, 0);
   if (VMSnok (status))
   {
      /* use SYSPRV to allow access to the rights database */
      sys$setprv (1, &SysPrvMask, 0, 0);
      status = sys$add_ident (&ProcessIdentNameDsc, 0, 0,
                              &ProcessRightsIdent);
      sys$setprv (0, &SysPrvMask, 0, 0);
      if (VMSok (status))
         WriteFaoStdout (
"%!AZ-I-RDBADDMSG, identifier !AZ value !&S added to rights database\n",
               Utility, ProcessIdentName, ProcessRightsIdent[0]);
      else
      {
         WriteFaoStdout (
"%!AZ-W-RDBADDERRU, unable to add !AZ to rights database\n-!&M\n",
            Utility, ProcessIdentName, status);
         ErrorExitVmsStatus (status, "sys$add_ident", FI_LI);
      }
   }
   ProcessRightsIdent[1] = KGB$M_NOACCESS;

   JpiItems[JPI_PROCESS_RIGHTS_ITEM].buf_len = sizeof(JpiProcessRights);
   JpiItems[JPI_PROCESS_RIGHTS_ITEM].buf_addr = &JpiProcessRights;

   ProcessContext = 0;
   status = sys$process_scan (&ProcessContext, &ScanItems);
   if (VMSnok (status))
   {
      ErrorNoticed (status, "sys$process_scan()", FI_LI);
      return;
   }

   /* enable WORLD so we can access at *all* processes */
   if (VMSnok (SetPrvStatus = sys$setprv (1, &MailboxMask, 0, 0)))
      ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);

   ProcessCount = 0;
   for (;;)
   {
      status = sys$getjpiw (EfnWait, &ProcessContext, 0,  &JpiItems,
                            &IOsb, 0, 0);
      if (VMSok (status)) status = IOsb.Status;
      if (VMSnok (status)) break;

      ProcessCount++;

      JpiUserName[12] = '\0';
      for (cptr = JpiUserName; *cptr && *cptr != ' '; cptr++);
      *cptr = '\0';

      JpiPrcNam[15] = '\0';
      for (cptr = JpiPrcNam; *cptr && *cptr != ' '; cptr++);
      *cptr = '\0';

      if (WATCH_MODULE(WATCH_MOD_DCL))
         WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "!8XL !&Z !&Z !UL",
                    JpiPid, JpiUserName, JpiPrcNam, JpiRightsSize);

      if (JpiRightsSize > sizeof(JpiProcessRights))
      {
         char  Buffer [32];
         sprintf (Buffer, "sys$getjpiw() %08.08X", JpiPid);
         ErrorNoticed (SS$_BUFFEROVF, Buffer, FI_LI);
      }

      /* look through each of the identifiers in the list */
      idx = 0;
      for (IdentCount = JpiRightsSize / 8;
           IdentCount && JpiProcessRights[idx] != ProcessRightsIdent[0];
           IdentCount--) idx += 2;

      /* if we didn't find the identifier then continue */
      if (!IdentCount) continue;

      /* I've seen this happen once and couldn't work out why!! */
      if (JpiPid == HttpdProcess.Pid) continue;

      WriteFaoStdout (
"%!AZ-I-DCL, cleanup detached script process; !8XL !AZ \'!AZ\'\n",
         Utility, JpiPid, JpiUserName, JpiPrcNam);
      status = sys$delprc (&JpiPid, 0);
      if (VMSnok (status)) ErrorNoticed (status, "sys$delprc()", FI_LI); 
   }

   if (VMSnok (SetPrvStatus = sys$setprv (0, &MailboxMask, 0, 0)))
      ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI);

   if (status != SS$_NOMOREPROC)
   {
      ErrorNoticed (status, "sys$getjpiw()", FI_LI);
      return;
   }
}

/*****************************************************************************/
/*
Create an ACL comprising two ACEs and apply it to the specified mailbox device.
The first ACE is a special 'HTTPd...' one, used to distinguish between those
mailboxes and the associated processes created by the server from any other
process with a mailbox 'terminal' (used during DclCleanupScriptProcesses()). 
The second allows read and write access to the 'AllowName' identifier. 
Function must be initialized by calling with 'MailboxName' NULL.  If called
with 'AllowName' NULL the mailbox ACL is read and checked for the special
'HTTPd...' identifying ACE.
*/

#define OSS$M_RELCTX 0x2
#define OSS$_ACL_ADD_ENTRY 3
#define OSS$_ACL_POSITION_TOP 14
#define OSS$_ACL_READ_ENTRY 16
#define PSL$C_USER 3

#ifdef GET_SET_SECURITY_STUB

int DclMailboxAcl
(
char *MailboxName,
char *AllowName
)
{
   /* sys$get/set_security() not supported for this VMS version */
   ErrorNoticed (0, "feature not supported on this platform", FI_LI);
   return (SS$_ABORT);
}

#else /* GET_SET_SECURITY_STUB */

int DclMailboxAcl
(
char *MailboxName,
char *AllowName
)
{
   static $DESCRIPTOR (AclAllowFaoDsc, "(IDENT=!AZ,ACCESS=R+W+E+D)");
   static $DESCRIPTOR (ClassNameDsc, "DEVICE");

   static unsigned long  AccessMode = PSL$C_USER,
                         SecFlags = OSS$M_RELCTX;
   static unsigned short  Length;
   static unsigned char  AclAllowEntry [32],
                         AclReadEntry [32];
   static char  AclString [64],
                PrevAllowName [32];
   static $DESCRIPTOR (AclAllowEntryDsc, AclAllowEntry);
   static $DESCRIPTOR (AclStringDsc, AclString);
   static $DESCRIPTOR (MailboxNameDsc, "");
   static struct {
      unsigned short  buf_len;
      unsigned short  item;
      unsigned char   *buf_addr;
      unsigned long  *long_ret_len;
   }
   SetSecItems [] =
   {
      { 0, OSS$_ACL_ADD_ENTRY, AclAllowEntry, 0 },
      {0,0,0,0}
   },
   GetSecItems [] =
   {
      { 0, OSS$_ACL_POSITION_TOP, 0, 0 },
      { sizeof(AclReadEntry), OSS$_ACL_READ_ENTRY, AclReadEntry, &Length },
      {0,0,0,0}
   };

   int  status;
   unsigned long  Context;
   unsigned short  ErrorPos;

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclMailboxAcl() !&Z !&Z !&Z",
                 MailboxName, AllowName, PrevAllowName);

   MailboxNameDsc.dsc$a_pointer = MailboxName;
   MailboxNameDsc.dsc$w_length = strlen(MailboxName);

   if (strcmp (AllowName, PrevAllowName))
   {
      /****************************************/
      /* first/different name to allow access */
      /****************************************/

      status = sys$fao (&AclAllowFaoDsc, &Length, &AclStringDsc, AllowName);
      if (VMSnok (status)) return (status);
      AclString[Length] = '\0';

      /* parse the ACE */
      AclStringDsc.dsc$a_pointer = AclString;
      AclStringDsc.dsc$w_length = strlen(AclString);
      status = sys$parse_acl (&AclStringDsc, &AclAllowEntryDsc,
                              &ErrorPos, 0, 0);
      AclStringDsc.dsc$w_length = sizeof(AclString)-1;
      if (VMSnok (status)) return (status);

      strncpy (PrevAllowName, AllowName, sizeof(PrevAllowName));
      PrevAllowName[sizeof(PrevAllowName)-1] = '\0';
   }

   /***************************************/
   /* apply the ACL to the mailbox device */
   /***************************************/

   SetSecItems[0].buf_len = AclAllowEntry[0];
   Context = 0;
   status = sys$set_security (&ClassNameDsc, &MailboxNameDsc, 0, SecFlags,
                              &SetSecItems, &Context, &AccessMode);
   return (status);
}

#endif /* GET_SET_SECURITY_STUB */

/*****************************************************************************/
/*
************
*** NOTE ***  This function takes a pointer to a request!!!
************  Due to it being a general report processing function.

Return a report on the DCL task structure.  This function blocks while
executing.
*/ 

DclScriptingReport
(
REQUEST_STRUCT *rqptr,
REQUEST_AST NextTaskFunction
)
{
   static char  PageBeginFao [] =
"<P><TABLE CELLPADDING=3 CELLSPACING=0 BORDER=1>\n\
<TR>\
<TH>Statistics</TH>\
<TH>Processes</TH>\
<TH>Limits</TH>\
</TR>\n\
\
<TR><TD VALIGN=top>\n\
\
<TABLE CELLPADDING=3 CELLSPACING=0 BORDER=0>\n\
<TR><TD>\n\
<TABLE CELLPADDING=0 CELLSPACING=5 BORDER=0>\n\
<TR><TH ALIGN=right>CGI:</TH><TD ALIGN=left>!UL</TD></TR>\n\
<TR><TH ALIGN=right>CGIplus&nbsp;&nbsp;/All:</TH><TD ALIGN=left>!UL</TD></TR>\n\
<TR><TH ALIGN=right>/Reused:</TH><TD ALIGN=left>!UL</TD></TR>\n\
<TR><TH ALIGN=right>RTE&nbsp;&nbsp;/All:</TH><TD ALIGN=left>!UL</TD></TR>\n\
<TR><TH ALIGN=right>/Reused:</TH><TD ALIGN=left>!UL</TD></TR>\n\
<TR><TH ALIGN=right>Autoscripted:</TH><TD ALIGN=left>!UL</TD></TR>\n\
<TR><TH ALIGN=right>CLI:</TH><TD ALIGN=left>!UL</TD></TR>\n\
</TABLE>\n\
</TD></TR>\n\
</TABLE>\n\
\
</TD><TD VALIGN=top>\n\
\
<TABLE CELLPADDING=3 CELLSPACING=0 BORDER=0>\n\
<TR><TD>\n\
<TABLE CELLPADDING=0 CELLSPACING=5 BORDER=0>\n\
<TH ALIGN=right COLSPAN=2>Default:</TH><TD ALIGN=left>!AZ</TD></TR>\n\
<TH ALIGN=right COLSPAN=2>Current:</TH><TD ALIGN=left>!UL</TD></TR>\n\
<TH ALIGN=right COLSPAN=2>$CREPRC:</TH><TD ALIGN=left>!UL</TD></TR>\n\
<TH ALIGN=right COLSPAN=2>$PERSONA!&?_MACRO\r\r\
&nbsp;&nbsp;/All:</TH>\
<TD ALIGN=left>!UL</TD></TR>\n\
<TH ALIGN=right COLSPAN=2>/Default:</TH>\
<TD ALIGN=left>!UL</TD></TR>\n\
<TH ALIGN=right COLSPAN=2>/Invalid:</TH>\
<TD ALIGN=left>!UL</TD></TR>\n\
<TH ALIGN=right COLSPAN=2>/Privileged:</TH>\
<TD ALIGN=left>!UL</TD></TR>\n\
<TH ALIGN=right COLSPAN=2>$FORCEX:</TH><TD ALIGN=left>!UL</TD></TR>\n\
<TH ALIGN=right COLSPAN=2>$DELPRC:</TH><TD ALIGN=left>!UL</TD></TR>\n\
</TABLE>\n\
</TD></TR>\n\
</TABLE>\n\
\
</TD><TD VALIGN=top>\n\
\
<TABLE CELLPADDING=3 CELLSPACING=0 BORDER=0>\n\
<TR><TD>\n\
<TABLE CELLPADDING=0 CELLSPACING=5 BORDER=0>\n\
<TH ALIGN=right>Soft&nbsp;&nbsp;\
/Value:</TH><TD ALIGN=left>!UL</TD></TR>\n\
<TH ALIGN=right>/Purged-at:</TH><TD ALIGN=left>!UL</TD></TR>\n\
<TH ALIGN=right>Hard&nbsp;&nbsp;\
/Value:</TH><TD ALIGN=left>!UL</TD></TR>\n\
<TH ALIGN=right>/Purged-at:</TH><TD ALIGN=left>!UL</TD></TR>\n\
<TH ALIGN=right>Purged&nbsp;&nbsp;\
/Soft-Limit:</TH><TD ALIGN=left>!UL</TD></TR>\n\
<TH ALIGN=right>/Explicit:</TH><TD ALIGN=left>!UL</TD></TR>\n\
<TH ALIGN=right>Zombie&nbsp;&nbsp;\
/Lifetime:</TH><TD ALIGN=left>!&@</TD></TR>\n\
<TH ALIGN=right>/Purged-at:</TH><TD ALIGN=left>!UL</TD></TR>\n\
<TH ALIGN=left>CGIplus&nbsp;&nbsp;\
/Lifetime:</TH><TD ALIGN=left>!&@</TD></TR>\n\
<TH ALIGN=right>/Purged-at:</TH><TD ALIGN=left>!UL</TD></TR>\n\
</TABLE>\n\
</TD></TR>\n\
</TABLE>\n\
\
</TD></TR>\n\
</TABLE>\n\
\
<P><H3><U>DCL Task List</U></H3>\n\
<P><TABLE CELLPADDING=1 CELLSPACING=0 BORDER=0>\n\
<TR>\
<TH></TH>\n\
<TH ALIGN=left><U>Script&nbsp;/&nbsp;Client</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=left><U>PID&nbsp;/&nbsp;Request</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=left><U>User</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=left><U>Type</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=right><U>Lifetime</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=right><U>Zombie</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=right><U>CGIplus</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=right><U>RTE</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=right><U>Total</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=left><U>Last</U></TH>\
<TH>&nbsp;&nbsp;</TH>\
</TR>\n\
<TR HEIGHT=5></TR>\n";

   /* the empty 99% column just forces the rest left with long request URIs */
   static char  TaskFao [] =
"<TR><TD ALIGN=right VALIGN=top><B>!&@</B>&nbsp;&nbsp;</TD>\
!&@\
<TD ALIGN=left VALIGN=top>!8XL&nbsp;&nbsp;</TD>\
<TD ALIGN=left VALIGN=top>!AZ&nbsp;&nbsp;</TD>\
<TD ALIGN=left VALIGN=top>!AZ&nbsp;&nbsp;</TD>\
<TD ALIGN=right VALIGN=top>!UL&nbsp;&nbsp;</TD>\
<TD ALIGN=right VALIGN=top>!&@&nbsp;&nbsp;</TD>\
<TD ALIGN=right VALIGN=top>!&@&nbsp;&nbsp;</TD>\
<TD ALIGN=right VALIGN=top>!&@&nbsp;&nbsp;</TD>\
<TD ALIGN=right VALIGN=top>!UL&nbsp;&nbsp;</TD>\
<TD ALIGN=left VALIGN=top><NOBR>!20%D</NOBR></TD>\
!AZ\
</TR>\n\
!&@";

   static char EmptyTaskListFao [] =
"<TR><TH><B>000</B>&nbsp;&nbsp;</TH>\
<TD COLSPAN=10 BGCOLOR=\"#eeeeee\"><I>empty</I></TD><TR>\n";

   static char  ScriptNameCacheFao [] =
"</TABLE>\n\
<P><H3><U>Script Name Cache</U></H3>\n\
<P><TABLE CELLPADDING=1 CELLSPACING=0 BORDER=0>\n\
<TR>\
<TH></TH>\
<TH ALIGN=left><U>Mapped&nbsp;File</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=left><U>File&nbsp;Name</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=right><U>Hits</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=left><U>Last</U></TH>\
<TH>&nbsp;&nbsp;</TH>\
</TR>\n\
<TR HEIGHT=5></TR>\n";

   static char  NameCacheFao [] =
"<TR><TH ALIGN=right>!3ZL&nbsp;&nbsp;</TH>\
<TD ALIGN=left!AZ><NOBR><TT>!AZ</TT>&nbsp;&nbsp;</NOBR></TD>\
<TD ALIGN=left!AZ><NOBR><TT>!AZ</TT>&nbsp;&nbsp;</NOBR></TD>\
<TD ALIGN=right!AZ>!UL&nbsp;&nbsp;</TD>\
<TD ALIGN=left!AZ><NOBR>!20%D</NOBR></TD>\
!AZ\
</TR>\n";

   static char EmptyScriptNameCacheFao [] =
"<TR><TH><B>000</B>&nbsp;&nbsp;</TH>\
<TD COLSPAN=4 BGCOLOR=\"#eeeeee\"><I>empty</I></TD><TR>\n";

   static char  PersonaCacheFao [] =
"</TABLE>\n\
<P><H3><U>Persona Cache</U></H3>\n\
<P><TABLE CELLPADDING=1 CELLSPACING=0 BORDER=0>\n\
<TR>\
<TH></TH>\
<TH ALIGN=left><U>User</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=right><U>Hits</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=left><U>Last</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=right><U>Reuse</U></TH>\n\
<TH>&nbsp;&nbsp;</TH>\
</TR>\n\
<TR HEIGHT=5></TR>\n";

   static char  PersonaEntryFao [] =
"<TR><\
TD ALIGN=right><B>!3ZL</B>&nbsp;&nbsp;</TD>\
<TD ALIGN=left!AZ><NOBR>!AZ&nbsp;&nbsp;</NOBR></TD>\
<TD ALIGN=right!AZ>!UL&nbsp;&nbsp;</TD>\
<TD ALIGN=left!AZ><NOBR>!20%D&nbsp;&nbsp;</NOBR></TD>\
<TD ALIGN=right!AZ>!UL</TD>\n\
!AZ\
</TR>\n";

   static char EmptyPersonaCacheFao [] =
"<TR><TH><B>000</B>&nbsp;&nbsp;</TH>\
<TD COLSPAN=4 BGCOLOR=\"#eeeeee\"><I>empty</I></TD><TR>\n";

   static char  ButtonsFao [] =
"</TABLE>\n\
<HR SIZE=1 NOSHADE WIDTH=60% ALIGN=left>\n\
<TABLE CELLPADDING=3 CELLSPACING=0 BORDER=0>\n\
<TR><TD>\n\
<FORM METHOD=GET ACTION=\"!AZ\">\n\
<INPUT TYPE=submit VALUE=\" Purge \">\n\
</FORM>\n\
</TD><TD>&nbsp;</TD><TD>\n\
<FORM METHOD=GET ACTION=\"!AZ\">\n\
<INPUT TYPE=submit VALUE=\" Force Delete \">\n\
</FORM>\n\
</TD></TR>\n\
</TABLE>\n\
</BODY>\n\
</HTML>\n";

   int  status,
        Count;
   unsigned long  FaoVector [64];
   unsigned long  *vecptr;
   char  *cptr;
   DCL_SCRIPT_NAME_ENTRY  *captr;
   DCL_TASK  *tkptr;
   LIST_ENTRY  *leptr;
   PERSONA_ENTRY  *pcptr;

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (NULL, FI_LI, WATCH_MOD_DCL,
                 "DclScriptingReport() !&A", NextTaskFunction);

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   RESPONSE_HEADER_200_HTML (rqptr);
   if (DclScriptDetachProcess)
      AdminPageTitle (rqptr, "Detached Process CGI/DCL Scripting");
   else
      AdminPageTitle (rqptr, "Subprocess CGI/DCL Scripting");

   vecptr = FaoVector;

   InstanceMutexLock (INSTANCE_MUTEX_HTTPD);

   *vecptr++ = AccountingPtr->DoScriptCount;
   *vecptr++ = AccountingPtr->DoCgiPlusScriptCount;
   *vecptr++ = AccountingPtr->DclCgiPlusReusedCount;
   *vecptr++ = AccountingPtr->DoRteScriptCount;
   *vecptr++ = AccountingPtr->DclRteReusedCount;
   *vecptr++ = AccountingPtr->DoAutoScriptCount;
   *vecptr++ = AccountingPtr->DoDclCommandCount;

   if (HttpdScriptAsUserName[0])
      *vecptr++ = HttpdScriptAsUserName;
   else
      *vecptr++ = HttpdProcess.UserName;
   *vecptr++ = DclScriptProcessCount;
   *vecptr++ = AccountingPtr->DclCrePrcCount;
   *vecptr++ = PersonaMacro;
   *vecptr++ = AccountingPtr->DclCrePrcPersonaCount;
   *vecptr++ = AccountingPtr->DclCrePrcPersonaDefaultCount;
   *vecptr++ = AccountingPtr->DclCrePrcPersonaInvUserCount;
   *vecptr++ = AccountingPtr->DclCrePrcPersonaPrvUserCount;
   *vecptr++ = AccountingPtr->DclForceXCount;
   *vecptr++ = AccountingPtr->DclDelPrcCount;
   *vecptr++ = DclScriptProcessSoftLimit;
   *vecptr++ = DclSoftLimitPurgeCount;
   *vecptr++ = DclScriptProcessHardLimit;
   *vecptr++ = DclHitHardLimitCount;
   *vecptr++ = DclPurgeCount;
   *vecptr++ = DclPurgeScriptProcessesCount;
   if (DclUseZombies && Config.cfScript.ZombieLifeTime)
   {
      *vecptr++ = "!UL";
      *vecptr++ = Config.cfScript.ZombieLifeTime;
   }
   else
      *vecptr++ = "[disabled]";
   *vecptr++ = DclZombieLifeTimePurgeCount;
   if (Config.cfScript.CgiPlusLifeTime)
   {
      *vecptr++ = "!UL";
      *vecptr++ = Config.cfScript.CgiPlusLifeTime;
   }
   else
      *vecptr++ = "<I>none</I>";
   *vecptr++ = DclCgiPlusLifeTimePurgeCount;

   InstanceMutexUnLock (INSTANCE_MUTEX_HTTPD);

   status = NetWriteFaol (rqptr, PageBeginFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);

   /* task list entries */
   Count = 0;
   for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr)
   {
      tkptr = (DCL_TASK*)leptr;

      vecptr = FaoVector;

      if (tkptr->ScriptProcessPid)
      {
         *vecptr++ = "<A HREF=\"!AZ?pid=!8XL&puser=!AZ\">!3ZL</A>";
         *vecptr++ = ADMIN_REPORT_SHOW_PROCESS;
         *vecptr++ = tkptr->ScriptProcessPid;
         *vecptr++ = tkptr->CrePrcUserName;
         *vecptr++ = ++Count;
      }
      else
      {
         *vecptr++ = "!3ZL"; 
         *vecptr++ = ++Count;
      }

      if (tkptr->TaskType == DCL_TASK_TYPE_CLI)
      {
         for (cptr = tkptr->DclCommandPtr; *cptr && *cptr != '\n'; cptr++);
         if (*cptr)
            *vecptr++ =
"<TD ALIGN=left VALIGN=top BGCOLOR=\"#ffffee\"><PRE>!AZ</PRE></TD>";
         else
            *vecptr++ =
"<TD ALIGN=left VALIGN=top><NOBR><TT>!AZ</TT>&nbsp;&nbsp;</NOBR></TD>";
         *vecptr++ = tkptr->DclCommandPtr;
      }
      else
      {
         if (tkptr->ScriptRunTime[0])
         {
            *vecptr++ =
"<TD ALIGN=left VALIGN=top><NOBR>(!AZ)!AZ&nbsp;&nbsp;</NOBR></TD>";
            *vecptr++ = tkptr->ScriptRunTime;
         }
         else
            *vecptr++ =
"<TD ALIGN=left VALIGN=top><NOBR>!AZ&nbsp;&nbsp;</NOBR></TD>";
         *vecptr++ = tkptr->ScriptName;
      }

      *vecptr++ = tkptr->ScriptProcessPid;
      if (tkptr->CrePrcUserName[0])
         *vecptr++ = tkptr->CrePrcUserName;
      else
         *vecptr++ = "<I>none</I>";

      switch (tkptr->TaskType)
      {
         case DCL_TASK_TYPE_CGI_SCRIPT :     *vecptr++ = "CGI"; break;
         case DCL_TASK_TYPE_CGIPLUS_SCRIPT : *vecptr++ = "CGIplus"; break;
         case DCL_TASK_TYPE_RTE_SCRIPT :     *vecptr++ = "RTE"; break;
         case DCL_TASK_TYPE_CLI :            *vecptr++ = "CLI"; break;
         default :                           *vecptr++ = "?";
      }

      if (HttpdTickSecond > tkptr->LifeTimeSecond)
         *vecptr++ = 0;
      else
         *vecptr++ = tkptr->LifeTimeSecond - HttpdTickSecond;

      if (tkptr->ZombieCount)
      {
         *vecptr++ = "!UL";
         *vecptr++ = tkptr->ZombieCount;
      }
      else
         *vecptr++ = "";

      if (tkptr->TaskType == DCL_TASK_TYPE_CGIPLUS_SCRIPT)
      {
         *vecptr++ = "!UL";
         *vecptr++ = tkptr->CgiPlusUsageCount;
      }
      else
         *vecptr++ = "";

      if (tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT)
      {
         *vecptr++ = "!UL";
         *vecptr++ = tkptr->CgiPlusUsageCount;
      }
      else
         *vecptr++ = "";

      *vecptr++ = tkptr->TotalUsageCount;
      *vecptr++ = &tkptr->LastUsedBinaryTime;

      if (rqptr->rqHeader.AdminNetscapeGold)
         *vecptr++ = "<TD></TD>";
      else
         *vecptr++ = "<TD WIDTH=99%></TD>";

      if (tkptr->RequestPtr)
      {
         *vecptr++ =
"<TR><TD></TD>\
<TD ALIGN=left BGCOLOR=\"#eeeeee\">!&@!AZ</TD>\
<TD ALIGN=left COLSPAN=9 BGCOLOR=\"#eeeeee\"><TT>!&;AZ</TT></TD>\
</TR>\n";

         if (tkptr->RequestPtr->RemoteUser[0])
         {
            *vecptr++ = "!&;AZ@";
            *vecptr++ = tkptr->RequestPtr->RemoteUser;
         }
         else
            *vecptr++ = "";
         *vecptr++ = tkptr->RequestPtr->rqClient.Lookup.HostName;
         *vecptr++ = tkptr->RequestPtr->rqHeader.RequestUriPtr;
      }
      else
      if (tkptr->ScriptProcessPid)
         *vecptr++ =
"<TR><TD></TD><TD COLSPAN=10 BGCOLOR=\"#eeeeee\"><I>idle</I></TD>";
      else
         *vecptr++ =
"<TR><TD></TD><TD COLSPAN=10 BGCOLOR=\"#eeeeee\"><I>none</I></TD>";

      status = NetWriteFaol (rqptr, TaskFao, &FaoVector);
      if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);
   }
   if (!DclTaskList.HeadPtr)
   {
      status = NetWriteFaol (rqptr, EmptyTaskListFao, NULL);
      if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);
   }

   /* script name cache entries */
   status = NetWriteFaol (rqptr, ScriptNameCacheFao, NULL);
   if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);

   Count = 0;
   for (leptr = DclScriptNameCacheList.HeadPtr;
        leptr;
        leptr = leptr->NextPtr)
   {
      captr = (DCL_SCRIPT_NAME_ENTRY*)leptr;

      if (Count++ % 2)
         cptr = " BGCOLOR=\"#eeeeee\"";
      else
         cptr = "";

      vecptr = FaoVector;
      *vecptr++ = Count;
      *vecptr++ = cptr;
      *vecptr++ = captr->ScriptFileName;
      *vecptr++ = cptr;
      *vecptr++ = captr->ResFileName;
      *vecptr++ = cptr;
      *vecptr++ = captr->HitCount;
      *vecptr++ = cptr;
      *vecptr++ = &captr->LastBinaryTime;

      if (rqptr->rqHeader.AdminNetscapeGold)
         *vecptr++ = "<TD></TD>";
      else
         *vecptr++ = "<TD WIDTH=99%></TD>";

      status = NetWriteFaol (rqptr, NameCacheFao, &FaoVector);
      if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);
   }
   if (!DclScriptNameCacheList.HeadPtr)
   {
      status = NetWriteFaol (rqptr, EmptyScriptNameCacheFao, NULL);
      if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);
   }

   /* persona cache entries */
   status = NetWriteFao (rqptr, PersonaCacheFao, PersonaCacheEntries);
   if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);

   Count = 0;
   for (leptr = PersonaCacheList.HeadPtr;
        leptr;
        leptr = leptr->NextPtr)
   {
      pcptr = (PERSONA_ENTRY*)leptr;

      if (Count++ % 2)
         cptr = " BGCOLOR=\"#eeeeee\"";
      else
         cptr = "";

      vecptr = FaoVector;
      *vecptr++ = Count;
      *vecptr++ = cptr;
      *vecptr++ = pcptr->UserName;
      *vecptr++ = cptr;
      *vecptr++ = pcptr->HitCount;
      *vecptr++ = cptr;
      *vecptr++ = &pcptr->LastBinaryTime;
      *vecptr++ = cptr;
      *vecptr++ = pcptr->ReuseCount;

      if (rqptr->rqHeader.AdminNetscapeGold)
         *vecptr++ = "<TD></TD>";
      else
         *vecptr++ = "<TD WIDTH=99%></TD>";

      status = NetWriteFaol (rqptr, PersonaEntryFao, &FaoVector);
      if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);
   }
   if (!PersonaCacheList.HeadPtr)
   {
      status = NetWriteFaol (rqptr, EmptyPersonaCacheFao, NULL);
      if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);
   }

   vecptr = FaoVector;
   *vecptr++ = ADMIN_CONTROL_DCL_PURGE;
   *vecptr++ = ADMIN_CONTROL_DCL_DELETE;

   status = NetWriteFaol (rqptr, ButtonsFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);

   SysDclAst (NextTaskFunction, rqptr);
}

/*****************************************************************************/
/*
Same as for DclPurgeScriptProcesses() except called from control module from
command line!
*/

char* DclControlPurgeScriptProcesses (BOOL WithExtremePrejudice)

{
   static char  Response [64];
   static $DESCRIPTOR (ResponseFaoDsc, "!UL deleted, !UL marked for delete");
   static $DESCRIPTOR (ResponseDsc, Response);

   int  status,
        DeletedCount,
        MarkedCount;
   unsigned short  Length;
   LIST_ENTRY  *leptr;
   DCL_TASK  *tkptr;

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (NULL, FI_LI, WATCH_MOD_DCL,
                 "DclControlPurgeScriptProcesses() !UL", WithExtremePrejudice);

   PersonaCache (NULL, 0);

   DclPurgeScriptNameCache ();

   DclPurgeScriptProcessesCount++;

   DeletedCount = MarkedCount = 0;

   for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr)
   {
      tkptr = (DCL_TASK*)leptr;

      if (!tkptr->ScriptProcessPid) continue;

      if (WithExtremePrejudice ||
          (tkptr->QueuedSysCommand <= tkptr->QueuedSysCommandAllowed &&
           !tkptr->QueuedSysOutput &&
           !tkptr->QueuedCgiPlusIn &&
           !tkptr->QueuedHttpInput &&
           !tkptr->QueuedClientRead &&
           !tkptr->FindScript &&
           !tkptr->RequestPtr))
      {
         /* forced delete or script process not currently active, abort task */
         tkptr->DeleteProcess = true;
         /* don't bother running down any image if it's a delete */
         if (WithExtremePrejudice) tkptr->ForceImageExit = false;
         DclTaskRunDown (tkptr);
         DeletedCount++;
      }
      else
      {
         /* script process is currently active, just leave marked for delete */
         tkptr->DeleteProcess = true;
         MarkedCount++;
      }
   }

   sys$fao (&ResponseFaoDsc, &Length, &ResponseDsc,
            DeletedCount, MarkedCount);
   Response[Length] = '\0';

   return (Response);
}

/*****************************************************************************/
/*
A mapping rule reload is a particularly "dangerous" time for scripting as
confusion could ensure about which CGIplus script is which and which script
name in the cache is which.  Hence at a mapping rule reload purge DCL suprocess
tasks and the script name cache.
*/

DclLoadedMappingRules ()

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

   if (WATCH_MODULE(WATCH_MOD_DCL))
      WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclLoadedMappingRules()");

   DclPurgeScriptNameCache ();

   DclControlPurgeScriptProcesses (false);
}

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

