/*****************************************************************************/
/*
                                 CGIutl.c

A CLI utility to assist at the DCL level with generating HTTP responses,
returning content and with the handling of POSTed requests.  Intended to be
used within DCL procedures to manipulate the CGI environment.

Assign a foreign verb,

  $ CGIUTL = "$HT_EXE:CGIUTL"

All DCL symbols created by or supplied to this utility MUST be global symbols. 
It does not deal with local symbols at all.


HAVING DCL PROBLEMS WITH SYMBOL SIZE?
-------------------------------------
Although CLI symbols may have maximum capacities of 1023 (earlier than VMS
V7.3-2) or 8191 (V7.3-2 and later) it can often be problematic accessing this
full capacity from the DCL command line.  If this is an issue try using the
/MAXSYM=<integer> qualifier to set the maximum number of characters CGIUTL
places into a single symbol.  Perhaps /MAXSYM=900 (as ~980 seems to be a
'magic' number for DCL), or even /MAXSYM=255.

Needless-to-say, there are also SYSGEN parameters controlling memory
allocations to such purposes.  CLISYMTBL is a dynamic parameter directly
related to the symbol table size.  CTLPAGES controls the number of pages
allocated to the P1 (process') pool.

See note against %LIB-F-INVARG described in main()!


DECODING A REQUEST BODY TO DCL SYMBOLS
--------------------------------------
The /URLDECODE qualifier results in a form-URL-encoded POSTed request body
being decoded and the contents of each field being placed into DCL symbols
named using that field.  HTML form field names may contain characters not
allowed within DCL symbol names, therefore when constructing the symbol name
non-alpha-numeric characters in the field name have underscores substituted in
the symbol name.  Once the request body has been decoded the DCL procedure can
manipulate the contents quite simply.  Here's the command line:

  $ CGIUTL /URLDECODE [/SYMBOL|/OUTPUT]

For example the following form input field

  <INPUT TYPE=text NAME=text_input_one SIZE=40>

would have the corresponding DCL symbol name assigned

  CGIUTL_TEXT_INPUT_ONE == "blah-blah-blah-blah"

Field contents greater than the capacity of a single DCL symbol (255 on <=6.n
and 1023 on >=7.n) have the contents distributed across multiple symbol names.
Each of these fields comprises the basic name with a dollar symbol and an
ascending integer.  A symbol with the integer zero contains the total count of
the contents of all of the symbols.  For example, the following text-area field
may have had 900 characters entered.

  <TEXTAREA NAME=text_area_input ROWS=14 COLS=80>
  </TEXTAREA>

Assuming a maximum symbol capacity of 255 characters the contents would be
distributed across 4 symbols, with the additional count symbol, as follows:

  CGIUTL_TEXT_AREA_INPUT$0 == "900"
  CGIUTL_TEXT_AREA_INPUT$1 == "blah-blah-blah-blah...blah-blah"
  CGIUTL_TEXT_AREA_INPUT$2 == "blah-blah-blah-blah...blah-blah"
  CGIUTL_TEXT_AREA_INPUT$3 == "blah-blah-blah-blah...blah-blah"
  CGIUTL_TEXT_AREA_INPUT$4 == "blah-blah-blah"

NOTE:  There was a bug prior to version 1.5 which resulted in the $1, $2, etc.
~~~~~  symbol names being created as _1, _2, etc.  This has been rectified with
       backward compatibility supplied via adding the /BUGSYM qualifier to
       scripts that require it.  Apologies for any inconvenience.

Where form field names are duplicated, as can be done with checkboxes, etc.,
CGUTL attempts to create multiple symbols representing these.  For fields
containing less than the maximum symbol value contents (255 or 1023 depending
on the VMS version) this is quite successful, but can get complex to interpret
where multiple symbols must be created to represent a single field name and
should be avoided.

The naming schema for such duplicate field names is as follows:

For backward compatibility with pre-v1.5 CGIUTL a symbol corresponding to the
field name always contains the value of the LAST such encountered field name.

The symbol CGIUTL_<field_name>$$0 contains the number of symbols representing a
duplicate field name.  If this does not exist then there is only one instance
of this field name in the request body and that value can be obtained from
symbol CGIUTL_<field_name>.  If it exists it will always have a value of at
least 2 ... you need at least two for it to be duplicated!!

The first instance of the field name will then be found in a symbol named
CGIUTL_<field_name>$$1, the second in CGIUTL_<field_name>$$2, etc.  This also
applies to multi-symbol value representations (see above), but can get quite
complex and having duplicate field names for large field values should be
avoided when using CGIUTL.

For example.  The following form fields,

  <INPUT TYPE=checkbox NAME=example VALUE="one"> 1
  <INPUT TYPE=checkbox NAME=example VALUE="two"> 2
  <INPUT TYPE=checkbox NAME=example VALUE="three"> 3
  <INPUT TYPE=checkbox NAME=example VALUE="four"> 4

if all checked, would result in the following symbols being generated

  CGIUTL_EXAMPLE == "four"
  CGIUTL_EXAMPLE$$0 == "4"
  CGIUTL_EXAMPLE$$1 == "one"
  CGIUTL_EXAMPLE$$2 == "two"
  CGIUTL_EXAMPLE$$3 == "three"
  CGIUTL_EXAMPLE$$4 == "four"

When using the /DELIMITER qualifier the first character of the supplied string
is used to split the data in the form fields.  The delimiter character is
discarded.  An example form field datum of

  This contains, some simple comma-separated, values.

and CGIUTL usage of

  $ CGIUTL /URLDECODE /SYMBOL /MAXSYM=20 /DELIMITER=","

would result in symbols of

  CGIUTL_EXAMPLE$0 == "49"
  CGIUTL_EXAMPLE$0$ == "2"
  CGIUTL_EXAMPLE$1 == "This contains"
  CGIUTL_EXAMPLE$1$ == ","
  CGIUTL_EXAMPLE$2 == " some simple comma-s"
  CGIUTL_EXAMPLE$3 == "eparated"
  CGIUTL_EXAMPLE$3$ == ","
  CGIUTL_EXAMPLE$4 == " values."

Note the symbols with names ending in the dollar symbol.  These contain the
delimiter character when it terminated the value parse (i.e. the symbol exists
if the symbol value was delimited).  In the case of symbol value overflow this
dollar-delimited symbol does not exist and indicates the symbol number (and
hence name) should be incremented for the remainder of the value (up until the
dollar-delimited name is encounted).  Of course delimited values can be empty
(and will be with trailing delimiter characters).  The symbol name plus dollar
plus zero plus trailing dollar contains the count of the number of times the
delimiter was hit (so the number of resulting symbols should be that plus one).

Avoid having duplicate field names as it becomes very complex very quickly.

The /SPLIT qualifier performs the same operation on an existing symbol.

  $ EXAMPLE == "one and two and three"
  $ CGIUTL EXAMPLE /SPLIT=" "
  $ SHOW SYMBOL EXAMPLE*
  EXAMPLE == "one and two and three"
  EXAMPLE$0 == "17"
  EXAMPLE$0$ == "4"
  EXAMPLE$1 == "one"
  EXAMPLE$1$ == " "
  EXAMPLE$2 == "and"
  EXAMPLE$2$ == " "
  EXAMPLE$3 == "two"
  EXAMPLE$3$ == " "
  EXAMPLE$4 == "and"
  EXAMPLE$4$ == " "
  EXAMPLE$5 == "three"

This facility overwrites any existing symbol(s) of the same name(s)!

In addition to all field-name related symbols produced during URL-decoding the
following four special-purpose symbol provide some information about those DCL
symbols created.

  CGIUTL$FIELDS .... the number of fields in the body (and hence <FORM>)

  CGIUTL$FIELDS_DUPLICATE .... the number of field names having multiple
                               instances in the request body

  CGIUTL$MAXSYM .... the maximum number of characters possible in each symbol

  CGIUTL$SYMBOLS ... the number of field symbols created by the utility
                     (this excludes these four special-purpose symbols)
                     if a simple comparision between this and CGIUTL$FIELDS
                     show a different count then at least one field had to
                     be distributed across multiple symbols due to size


DECODING A REQUEST BODY TO DCL SYMBOLS *PER LINE*
-------------------------------------------------
Where a request field may have multiple lines (as with <TEXTAREA>s) the body
may optionally have fields placed into symbols on a per-line basis.  That is,
each newline-delimited string in the field (i.e. a %0A occurs in the encoded
data) has a DCL symbol created for it.  If this string is larger than the CGI
symbol value capacity (255 or 1023 characters) it "overflows" into the next
symbol without warning.  A <CR> (carriage-return) is always ignored.  To enable
this behaviour use the /SYMBOLS=LINES qualfiier and keyword.

  $ CGIUTL /URLDECODE /SYMBOLS=LINES

For example if the following form field:

  <TEXTAREA NAME=text_area_input ROWS=14 COLS=80>
  </TEXTAREA>

Had the following text entered into it:

  This is an example of a line.
  This is the next line.
  This is another line.
  ... and this is the last line!

This text would be distributed across 4 symbols, with the additional count
symbol, as follows:

  CGIUTL_TEXT_AREA_INPUT$0 == "102"
  CGIUTL_TEXT_AREA_INPUT$1 == "This is an example of a line."
  CGIUTL_TEXT_AREA_INPUT$2 == "This is the next line."
  CGIUTL_TEXT_AREA_INPUT$3 == "This is another line."
  CGIUTL_TEXT_AREA_INPUT$4 == "... and this is the last line!"

The additional keyword NOCONTROL, removes all <HT> (tabs), <VT> (vertical-tabs)
and <FF> (form-feeds), leaving only space characters.

  $ CGIUTL /URLDECODE /SYMBOLS=(LINES,NOCONTROL)


SYMBOL NAME PREFIX
------------------
By default symbols names are created prefixed with the string "CGIUTL_".  That
is if there is a field name FREDDO in the request body the equivalent symbol is
named "CGIUTL_FREDDO".
                                                            
This prefix may be user-specified with the /PREFIX qualifier.  As an example;
to make the symbol names much the same as those created by the server for GET
requests use /PREFIX=WWW_FORM, which would result in the above form field
having the symbol name "WWW_FORM_FREDDO".

This could be made the default for a given script by making it part of the
foreign verb assignment.

  $ CGIUTL = "$HT_EXE:CGIUTL/PREFIX=WWW_FORM"


DECODING A REQUEST BODY TO A FILE
---------------------------------
The /URLDECODE used with the /OUTPUT=filename qualifier results in a
form-URL-encoded POSTed request body being written to the specified file.  Two
formats are possible controlled using the /FORMAT=NAMES (default) and
/FORMAT=HEADINGS qualifier and keywords.  When NAMES are used each field name
of the format is followed by a colon, space and then the field value.  With
HEADINGS the field name is on a line by itself, underlined with hyphens and
then in a block the field values (more suited to <TEXTAREA> input).  The last
possibility is /FORMAT=NONE which suppresses the output of field names
completely.  To write to an output file as well as create DCL symbols add the
/SYMBOLS qualifier.  The following examples show some of the variations.

  $ CGIUTL /URLDECODE /OUTPUT=WASD_ROOT:[LOG.SERVER]CGIUTL_FORM.TMP
  $ CGIUTL /URLDECODE /OUTPUT=WASD_ROOT:[LOG.SERVER]CGIUTL.TMP /FORMAT=HEADINGS
  $ CGIUTL /URLDECODE /OUTPUT=WASD_ROOT:[LOG.SERVER]CGIUTL_FORM.TMP /SYMBOLS


WRITING A REQUEST BODY TO A FILE
--------------------------------
Using the /BODY qualifier any POSTed request body (form-URL-encoded, text or
other content) can simply be written to the specified /OUTPUT= file.  It will
be created in STREAM-LF format.  For form-URL-encoded and text/.. bodies the
file is written as text.  For other content-type the file is written as binary.


WRITING AN UPLOADED FILE TO A FILE
----------------------------------
The <INPUT TYPE=file NAME=name> HTML tag uploads a file from the browser-local
system to the server as a POSTed "multipart/form-data" request.  The /MULTIPART
with the /FIELD= qualifiers allow the uploaded file form data field to be
written to a file.  For example, the following form input tag

  <INPUT TYPE=file NAME=file>

could have it's upload contents written to the specified out file using

  $ CGIUTL /MULTIPART /FIELD=FILE /OUTPUT=WASD_ROOT:[LOG.SERVER]CGIUTL_FILE.TMP

Additional information about this field is placed into two special variables
created by CGIUTL, the file's original name/location and it's content-type.

  $ SHOW SYMBOL WWW_FORM_*
  WWW_FORM_MIME_CONTENT_TYPE == "image/jpeg"
  WWW_FORM_MIME_FILENAME == "C:\ftp\example.jpg"

All other fields in the POSTed body that can be contained in a DCL symbol (i.e.
<=255 or <=1023 depending on the VMS version) are created using the usual
prefix of WWW_FORM_*.  If you wish to change this, the /PREFIX qualifier allows
the user to specify the form variable prefixes.

It is possible to have more than one file uploaded per form (or a textarea that
contains data to be written in addition to an uploaded form).  In order to
write more than one file, you must identify the field containing the data to be
written and the file to write.  This is done using the /FIELD and /OUTPUT
qualifiers in pairs with /FIELD occurring first:
  
  $ CGIUTL /MULTIPART /FIELD=FILE1 /OUTPUT=FILE1.DAT -
  	/FIELD=FILE2 /OUTPUT=FILE2.DAT

This causes the multipart form to be processed and the contents of fields FILE1
and FILE2 to be written to FILE1.DAT and FILE2.DAT respectively.


NOTE ON FORM FIELDS
-------------------
Most form fields produce a name in the form data stream (URL-encoded request
body) regardless of whether they are empty or not.  Checkboxes and
none-selected radio buttons fields do not.  Unless checkboxes are checked or
one radion button seelected the associated names and values do not appear in
the data stream and will not have DCL symbols created for them.  Three possible
approaches:

1. Initialize symbols related to checkbox field names to empty values prior to
using CGIUTL.  This way the symbol can always be guaranteed to exist in
subsequent processing, overwritten with the form value if checked.

2. After using CGIUTL use F$TYPE() to check if an associated symbol exists.

3. Include a HIDDEN INPUT field before checkboxes to ensure the relevant field
name always exists in the data stream.  Example:

  <INPUT TYPE=hidden NAME=testing VALUE="">
  <INPUT TYPE=checkbox NAME=testing VALUE=1> Just Testing

Incorrect and/or malicious form POSTings should also be allowed for, where
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~ expected field names may be absent,
disrupting script processing.  Accomodating such possibilities suggests
adopting a strategy of either initializing all expected symbols names BEFORE
calling CGIUTL, or testing for the existance of all expected symbol names AFTER
calling CGIUTL.

Getting parameters from the CGI environment into the command-line qualifiers
and/or parameter is best done without DCL (') substitution.  The /SUBSTITUTE=
qualifier allows the specification of a character that if present as the first
character of a /QUALIFIER=<string> specification results in the rest of the
string being used as an environment variable name (CGI and others).  The
getenv() C-RTL function is used to get a value against that name.  An astersisk
is the default substitution character.  A substitution character may be escaped
using a leading backslash.

In the above example the literal string "*WWW_FORM_URL" (etc.) is read by the
FETCH utility and then detecting the leading asterisk it resolves the
remaining part of the string as an environment variable "WWW_FORM_URL" and uses
the value of that (usually a symbol - see the C-RTL document for the
description of the behaviour of the getenv() function).  The contents of CGI
variables should not be substituted into such a command-line (e.g.
"''WWW_FORM_URL'").

Why an asterisk?  Well, trying to find a character that doesn't have some very
specific command-line interpreter, VMS or HTTP meaning (so as to avoid
confusion) is quite difficult.  The asterisk is slightly reminiscent of the C
language pointer dereference operator.  And anyway, it can be specified locally
using /SUBSTITUTE=.


MASSAGING DCL SYMBOLS
---------------------
The utility will adjust the number of double-quotes in a DCL symbol making it
suitable for substitution, parameter passing, etc., anywhere a single quote in
a symbol would cause problems.  This may be done multiple times, first
doubling, then quadrupling, etc., the number of quotes.  Buffer or symbol
overflow is of course possible.  These are errors.  If the symbol does not
exist or is a local symbol an error is reported.  Example:

  $ SHOW SYMBOL THIS_GLOBAL_SYMBOL
    THIS_GLOBAL_SYMBOL == ""This" is quoted"
  $ CGIUTL THIS_GLOBAL_SYMBOL /2QUOTES
  $ SHOW SYMBOL THIS_GLOBAL_SYMBOL
    THIS_GLOBAL_SYMBOL == """This"" is quoted"

The utility can also be used to split a symbol into multiple symbols according
to the supplied delimiter character.  Explained in detail above.  Example:

  $ SHOW SYMBOL THIS_GLOBAL_SYMBOL
    THIS_GLOBAL_SYMBOL == "comma,separated,values"
  $ CGIUTL THIS_GLOBAL_SYMBOL /SPLIT=","
  $ SHOW SYMBOL THIS_GLOBAL_SYMBOL*
    THIS_GLOBAL_SYMBOL == "comma,separated,values"
    THIS_GLOBAL_SYMBOL$0 == "20"
    THIS_GLOBAL_SYMBOL$0$ == "2"
    THIS_GLOBAL_SYMBOL$1 == "comma"
    THIS_GLOBAL_SYMBOL$1$ == ","
    THIS_GLOBAL_SYMBOL$2 == "separated"
    THIS_GLOBAL_SYMBOL$2$ == ","
    THIS_GLOBAL_SYMBOL$3 == "values"

And finally may be used to URL/percent-decode a symbol.  Example:

  $ SHOW SYMBOL THIS_GLOBAL_SYMBOL
    THIS_GLOBAL_SYMBOL == "this%20is%20a%20test"
  $ CGIUTL THIS_GLOBAL_SYMBOL /UNPERSYM
  $ SHOW SYMBOL THIS_GLOBAL_SYMBOL
    THIS_GLOBAL_SYMBOL == "this is a test"


GENERATING AN HTTP RESPONSE
---------------------------
The utility can be used to provide a response header and/or body.  The
/RESPONSE qualifier generates a full HTTP response (NPH) while the /CGIRESPONSE
qualifier generates a CGI response.  Why use CGI?  If the output is being
generated by DCL this allows the server to check and adjust the carriage
control of each output record.  With NPH the script must supply it all.  The
two qualifiers are in all other respects the same.

The /RESPONSE=[status-code] qualifier generates an "HTTP/1.0 status-code
string" HTTP response.  The default is "200 Success".

If the /CONTENT=string qualifier is applied the specified MIME content-type
header line is generated.  Otherwise content-type defaults to "text/plain".

If the /RESPONSE qualifier is used with a file name parameter, a response
header is generated and then the contents of the file are transfered to the
client as the request body.  The file is either opened in record mode if the
content-type is "text/..." (by default, without a /CONTENT) or in binary mode
if any other content-type.  For example:

  $ CGIUTL /RESPONSE=404 WEB:[ERRORS]NOTFOUND.HTML
  $ CGIUTL /RESPONSE WASD_ROOT:[000000]HTTPDWASD.GIF /CONTENT="image/gif"

If /LENGTH is used with /RESPONSE when specifying a file name, as above, the
file is first completely read to determine the actual content length (not
fstat()ed, which does not work with variable-record-length files) and this
added to the response header, before rewind()ing and transfering the file
contents.  For example:

  $ CGIUTL /RESPONSE /LENGTH WASD_ROOT:[000000]README.TXT

If /COPY is used _without_ /RESPONSE against a parameter file name the content
is copied to the client as above _without_ first sending a response header
(i.e. the script must provide it's own).  This is one way to transfer a binary
file to a client from DCL.  Note that the /CONTENT= is required so that it can
be determined whether it is text or binary content.  Example:

  $ SAY "HTTP/1.0 200 Success" + LF
  $ SAY "Content-Type: image/gif" + LF
  $ SAY LF
  $ CGIUTL /COPY WASD_ROOT:[000000]HTTPDWASD.GIF /CONTENT="image/gif"

Redirection responses may be generated using the /LOCATION=url-path qualifier. 
If this is supplied the status code is forced to 302.  An example:

  $ CGIUTL /LOCATION="http://www.openvms.digital.com/"


WASD DECnet CGI
---------------
When a WASD CGI script is executed via the DECnet script manager it is
necessary to read the request body in record mode via NET$LINK stream.  An
empty record terminates the request body.  This utility checks for the NET$LINK
environment variable and adjusts behaviour if detected.


QUALIFIERS
----------
/2QUOTE              double up the quotes in the parameter symbol
/BODY                output the request body
/BUGSYM              keeps pre-v1.5 buggy symbol naming compatibility
/CGIRESPONSE[=integer]  send CGI header with this status code (default 200)
/CHARSET=string      explicitly specify a "text/" response character set
                     (to suppress just supply an empty string)
/CONTENT=string      response content-type (default "text/plain")
/COPY                copy parameter file to client
/DBUG                turns on all "if (Debug)" statements
/DELIMITER=char      splits symbol content at the specified character
/EXPIRED             response header has an "Expired:" pre-expired time added
/FIELD=              just output the value of this particular field
/FORMAT=             when writing form-URL-encoded body as file
                     "HEADINGS" as underlined headings
                     "NAMES" as "field-name: field-value"
                     "NONE" suppresses field names completely
/GLOBAL              work with global symbols (default)
/HEADER=string	     A repeatable field that, when used inconjunction with
		     the /RESPONSE qualifier allows additional headers
		     to be sent with the response.
/LOCAL               work with local symbols
/LOCATION=string     send a 302 HTTP header with this as the location
/MAXSYM=integer      maximum number of characters per symbol value
/MULTIPART           body is multipart/form-data (file upload)
/OUTPUT=file         output to specified file
/PLUS                CGIplus interface for DCL (see [SRC.CGIPLUS]COMRTEXE.COM)
/PREFIX=string       prefix to symbol name (e.g. "WWW", defaults to "CGIUTL")
/[NO]QUIETLY         when an error occurs exit with the status inhibited
                     (allows the procedure to do it's own error recovery)
/RESPONSE[=integer]  send NPH header with this status code (default 200)
/SOFTWAREID          (and /VERSION) display CGIUTL and CGILIB versions
/SPLIT=char          split symbol into multiple char-delimited symbols
/SUBSTITUTE=char     specify the character for parameter substitution
/SYMBOLS[=LINES,NOCONTROL]   put into DCL symbols,
                             optionally one line per symbol (<LF> delimited)
                             optionally strip control characters (e.g. <HT>)
/UNPERSYM            URL/Percent decode a DCL symbol back into itself
/URLDECODE           decode a form-URL-encoded, POSTed body
                     (use with /SYMBOL and/or /OUTPUT=)


LOGICAL NAMES
-------------
CGIUTL$DBUG        turns on all "if (Debug)" statements
CGIUTL$PARAM[_1..255]
		   equivalent to (overrides) the command line
                   parameters/qualifiers (define as a system-wide logical)
                   may also be assigned as a local/global symbol.  Long
		   command lines may be emitted by creating additional
		   logical names by adding _and a digit.  These must be
		   created sequentially, e.g., _1 _2 _3.  Once a hole is
		   found, processing stops.


BUILD DETAILS
-------------
See BUILD_CGIUTL.COM procedure.


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


VERSION HISTORY (update SOFTWAREVN as well)
---------------
13-JAN-2012  MGD  v1.14.0, add /UNPERSYM
06-NOV-2011  MGD  v1.13.0, add /PLUS
                           bugfix; redundant "WWW_" += 4 after CgiLibVar("*")
16-OCT-2010  MGD  v1.12.0, add /DELIMITER and /SPLIT
26-AUG-2008  MGD  v1.11.4, bugfix; process /BODY
15-OCT-2007  MGD  v1.11.3, workaround for %LIB-F-INVARG described in main()
20-JAN-2006  MGD  v1.11.2, bugfix; when URL-encoded decoding use unsigned char
                           to prevent sign bit issues with the likes of %FC
20-APR-2005  MGD  v1.11.1, bugfix; UrlDecodeBodyWrite() ensure a full
                           buffer does not split a URL-encoding sequence
24-DEC-2003  MGD  v1.11.0, minor conditional mods to support IA64
                           allow it to work with local symbols (for CSWS),
                           maximum symbol size for VMS 7.3-2ff now 8192,
                           bugfix; symbol name creation in POSTed requests
20-APR-2003  DM	  v1.10.1, (munroe@csworks.com)
                           CGIRESPONSE isn't generating headers correctly.
27-FEB-2003  DM   v1.10.0, (munroe@csworks.com)
                          Add /HEADER qualifier that can be used to add
                          additional headers to /RESPONSE streams.
                          Not all exit messages are protected by ExitQuietly.
                          Allow multiple fields to be extracted and written to
                          files from URLENCODED forms.
                          Allow CGIUTL$PARAM to be enumerated thus allowing
                          very long command lines.
                          Allow multipart form processing to define symbols
                          specifically in addition to processing for files.
                          Allow more than one field per multipart form to be
                          written.  A maximum of 20 are allowed.
			  Bugfix: Make the usage of /PREFIX consistent in 
			  Multipart processing (Don't require a trailing "-").
                          Make /PREFIX work in multipart upload file processing.
01-OCT-2002  MGD  v1.9.0, modify command-line parsing,
                          bugfix; CgiLibReadRequestBody() returns NULL body
22-JUL-2001  MGD  v1.8.3, refine /CHARSET= so an empty string suppresses
08-JUN-2001  MGD  v1.8.2, add /SOFTWAREID (/VERSION)
20-DEC-2000  MGD  v1.8.1, minor update, add /FORMAT=NONE
28-OCT-2000  MGD  v1.8.0, use CGILIB object module,
                          support RELAXED_ANSI compilation,
                          /CGIRESPONSE= to generate non-NPH response,
                          bugfix; limit length of FORM_URLENCODED string
                          comparison (Kurt.Schumacher@schumi.ch)
11-AUG-2000  MGD  v1.7.0, /SYMBOLS=LINES,NOCONTROL
19-APR-2000  MGD  v1.6.0, /FIELD= outputs single form field only,
                          minor changes for CGILIB 1.4
29-JAN-2000  MGD  v1.5.0, multiple symbol names for fields with same name,
                          bugfix; multi-symbol value names containing '$'
20-OCT-1999  MGD  v1.4.0, /QUIETLY qualifier
28-SEP-1999  MGD  v1.3.1, bugfix; /PREFIX length
24-APR-1999  MGD  v1.3.0, use CGILIB.C
14-MAR-1999  MGD  v1.2.0, allow for DECnet CGI request body from NET$LINK
13-FEB-1999  MGD  v1.1.0, response generating functionality
06-FEB-1999  MGD  v1.0.0, initial development
*/
/*****************************************************************************/

#define SOFTWAREVN "1.14.0"
#define SOFTWARENM "CGIUTL"
#ifdef __ALPHA
#  define SOFTWAREID SOFTWARENM " AXP-" SOFTWAREVN
#endif
#ifdef __ia64
#  define SOFTWAREID SOFTWARENM " IA64-" SOFTWAREVN
#endif
#ifdef __VAX
#  define SOFTWAREID SOFTWARENM " VAX-" SOFTWAREVN
#endif
#ifdef __x86_64
#  define SOFTWAREID SOFTWARENM " X86-" SOFTWAREVN
#endif

#ifndef __VAX
#   pragma nomember_alignment
#endif

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

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

/* application related header file */
#include <cgilib.h>

#define VMSok(x) ((x) & STS$M_SUCCESS)
#define VMSnok(x) !(((x) & STS$M_SUCCESS))

#define boolean int
#define true 1
#define false 0

#define DEFAULT_PARAM_SUBS_CHAR '*'
#define FORM_URLENCODED "application/x-www-form-urlencoded"
#define FORM_URLENCODED_LENGTH sizeof(FORM_URLENCODED)-1
#define FORM_URLENCODED_FIELD_MAX 8192
#define FORM_URLENCODED_FIELD_NAME_MAX 256
#define MULTIPART_FORMDATA "multipart/form-data;"

char  CopyrightInfo [] =
"Copyright (C) 1999-2012 Mark G.Daniel.\n\
This program comes with ABSOLUTELY NO WARRANTY.\n\
This is free software, and you are welcome to redistribute it under the\n\
conditions of the GNU GENERAL PUBLIC LICENSE, version 3, \
or any later version.\n\
http://www.gnu.org/licenses/gpl.txt";

char  Utility [] = "CGIUTL";

boolean  BugSymbolNaming,
         Debug,
         DoCgiResponse,
         DoContentLength,
         DoCopy,
         DoCgiPlus,
         DoCliSymbols,
         DoCliSymbolsLines,
         DoCliSymbolsNoControl,
         DoDecodeSymbolPercent,
         DoEscapeSymbolQuotes,
         DoSplitSymbol,
         DoFormatHeadings,
         DoFormatNames = true,
         DoMultipartFormData,
         DoPreExpired,
         DoRequestBody,
         DoResponse,
         DoUrlDecode,
         ResponseContentTypeText;

int  BufferCount,
     BufferSize,
     CliSymbolType,
     DelimCharHitCount,
     ExitQuietly,
     FileContentLength,
     ReadCount,
     SymbolValueMax,
     SymbolPrefixLength;

char  DelimChar [2];

char  *BufferPtr,
      *CgiContentTypePtr,
      *CgiRequestMethodPtr,
      *CgiRequestTimeGmtPtr,
      *CgiServerSoftwarePtr,
      *CharsetPtr,
      *CliCharsetPtr,
      *CliContentTypePtr,
      *CliLocationPtr,
      *CliOutputPtr,
      *CliParameterPtr,
      *CliResponsePtr,
      *FieldOnlyPtr,
      *SymbolPrefixPtr;
      
typedef struct
{
    char* FieldNamePtr ;
    char* FileNamePtr ;
}     FieldToFileMap_t;

#define MAX_FIELD_TO_FILE 20

FieldToFileMap_t FieldToFileMap[MAX_FIELD_TO_FILE] ;
int	FieldToFileMapIndex = -1 ;

#define MAX_ADDITIONAL_HEADERS 20

typedef char* AdditionalHeader_t ;

AdditionalHeader_t AdditionalHeaders[MAX_ADDITIONAL_HEADERS];
int	AdditionalHeadersIndex = -1 ;

char  ParamSubsChar = DEFAULT_PARAM_SUBS_CHAR;

char  CharsetString [256],
      SoftwareID [64];

/* required prototypes */
void ExitCgiUtl (int, int);
char* HttpStatusCodeText (int);
char* GetParameterString (char*);

/*****************************************************************************/
/*
'argc' and 'argv' are only required to support CgiLibEnvironmentInit(), in
particular the OSU environment.
*/

main
(
int argc,
char *argv[]
)
{
   boolean  Done;
   char  *cptr, *sptr;

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

   sprintf (SoftwareID, "%s (%s)", SOFTWAREID, CGILIB_SOFTWAREID);

   if (getenv ("CGIUTL$DBUG")) Debug = true;
   CgiLibEnvironmentSetDebug (Debug);

   GetParameters ();

   if (Debug) fprintf (stdout, "Content-Type: text/plain\n\n%s\n", SoftwareID);

   CgiLibEnvironmentInit (argc, argv, false);

   CgiLibResponseSetSoftwareID (SoftwareID);
   CgiLibResponseSetErrorMessage ("Reported by CGIutl");

   if (!CliSymbolType)
      if (CgiLibEnvironmentIsApache())
         CliSymbolType = LIB$K_CLI_LOCAL_SYM;
      else
         CliSymbolType = LIB$K_CLI_GLOBAL_SYM;

   if (CliOutputPtr)
      if (!CliOutputPtr[0])
         CliOutputPtr = CliParameterPtr;

   if (VmsVersion() >= 732)
   {
      /*

         A '%LIB-F-INVARG, invalid argument(s)' error reported on a
         V7.3-2 Alpha but also reproducable on my V8.3 Alpha seems
         to limit symbol size to something below the documented 8191
         of 7.3-2 and later.  Pragmatically determined at about the
         value in the conditional below.  Doesn't seem to be any ECOs
         against this so let's just live with it for now.  Don't forget
         about the /MAXSYM=<integer> qualifier either!
      */
#if 0
      if (SymbolValueMax < 1 || SymbolValueMax > 8191)
         SymbolValueMax = 8191;
#else
      if (SymbolValueMax < 1 || SymbolValueMax > 4095)
         SymbolValueMax = 4095;
#endif
   }
   else
   if (VmsVersion() >= 700)
   {
      if (SymbolValueMax < 1 || SymbolValueMax > 1023)
         SymbolValueMax = 1023;
   }
   else
   {
      if (SymbolValueMax < 1 || SymbolValueMax > 255)
         SymbolValueMax = 255;
   }
   if (Debug) fprintf (stdout, "SymbolValueMax: %d\n", SymbolValueMax);

   if (!SymbolPrefixPtr) SymbolPrefixPtr = Utility;
   SymbolPrefixLength = strlen(SymbolPrefixPtr);
   if (Debug) fprintf (stdout, "SymbolPrefix: %s %d\n", SymbolPrefixPtr, SymbolPrefixLength);

   Done = false;

   if (DoDecodeSymbolPercent)
   {
      /*******************************/
      /* decode a URL-encoded symbol */
      /*******************************/

      DecodeSymbolPercent (CliParameterPtr);
      ExitCgiUtl (SS$_NORMAL, __LINE__);
   }

   if (DoEscapeSymbolQuotes)
   {
      /****************************/
      /* escape a symbol's quotes */
      /****************************/

      EscapeSymbolQuotes (CliParameterPtr);
      ExitCgiUtl (SS$_NORMAL, __LINE__);
   }

   if (DoSplitSymbol)
   {
      /******************/
      /* split a symbol */
      /******************/

      SplitSymbol (CliParameterPtr);
      ExitCgiUtl (SS$_NORMAL, __LINE__);
   }

   if (DoCgiPlus)
   {
      /*********/
      /* /plus */
      /*********/

      if (!CgiLibEnvironmentIsCgiPlus()) ExitCgiUtl (SS$_BUGCHECK, __LINE__);

      CgiLibVar ("");

      while ((cptr = sptr = CgiLibVar ("*")))
      {
         if (Debug) fprintf (stdout, "|%s|\n", cptr);
         if (!memcmp (cptr, "WWW_", 4)) cptr += 4;
         while (*sptr && *sptr != '=') sptr++;
         if (*sptr == '=')
         {
            *sptr = '\0';
            if (strlen(sptr+1) <= SymbolValueMax)
            {
               if (SymbolPrefixPtr)
               {
                  char theName[FORM_URLENCODED_FIELD_NAME_MAX];
                  strcpy (theName, SymbolPrefixPtr);
                  strcat (theName, cptr);
                  SetCliSymbol(theName, sptr+1, 0);
	       }
	       else
                  SetCliSymbol (cptr+1, sptr+1, 0);
            }
            *sptr = '=';
         }
      }

      ExitCgiUtl (SS$_NORMAL, __LINE__);
   }

   if (DoCgiResponse || DoResponse || CliParameterPtr)
   {
      /*********************/
      /* generate response */
      /*********************/

      CgiServerSoftwarePtr = CgiLibVar ("WWW_SERVER_SOFTWARE");
      if (!CgiServerSoftwarePtr[0]) CgiServerSoftwarePtr = SoftwareID;

      CgiRequestTimeGmtPtr = CgiLibVar ("WWW_REQUEST_TIME_GMT");

      if (!CliContentTypePtr)
      {
         CliContentTypePtr = "text/plain";
         ResponseContentTypeText = true;
      }
      else
      {
         /* ensure it's lower case */
         for (cptr = CliContentTypePtr; *cptr; cptr++)
            *cptr = tolower(*cptr);
         ResponseContentTypeText = !memcmp (CliContentTypePtr, "text/", 5);
      }

      if (ResponseContentTypeText)
      {
         if (!(CharsetPtr = CliCharsetPtr))
         {
            CharsetPtr = CgiLibVar ("WWW_SERVER_CHARSET");
            if (!CharsetPtr || !CharsetPtr[0])
               CharsetPtr = "ISO-8859-1";
         }
         if (CharsetPtr[0])
         {
            sprintf (CharsetString, "; charset=%s", CharsetPtr);
            CharsetPtr = CharsetString;
         }
      }
      else
         CharsetPtr = "";

      if (!CliResponsePtr) CliResponsePtr = "200";

      FileContentLength = -1;

      if (DoCopy && !CliParameterPtr)
      {
         if (!ExitQuietly)
            fprintf (stdout, "%%%s-E-COPY, file not specified\n", Utility);
         ExitCgiUtl (STS$K_ERROR, __LINE__);
      }

      if (!CliParameterPtr)
      {
         if (DoCgiResponse)
            SendCgiResponse ();
         else
            SendResponse ();
      }
      else
         SendFile ();

      ExitCgiUtl (SS$_NORMAL, __LINE__);
   }

   /**************************/
   /* process POSTed request */
   /**************************/

   if (DoUrlDecode && DoCliSymbols)
   {
      /* form-URL-decode the body and create corresponding DCL symbols */
      UrlDecodeBodyCliSymbols ();
      Done = true;
   }

   if (DoUrlDecode && FieldOnlyPtr && CliOutputPtr)
   {
      /* form-URL-decode the body and write to file as field name/values */
      UrlDecodeFieldWrite ();
      Done = true;
   }
   else
   if (DoUrlDecode && CliOutputPtr)
   {
      /* form-URL-decode the body and write to file as field name/values */
      UrlDecodeBodyWrite ();
      Done = true;
   }
   else
   if (DoMultipartFormData && FieldOnlyPtr &&
       CliOutputPtr && (FieldToFileMapIndex == 0))
   {
      /* form-URL-decode the body and write to file as field name/values */
      MultipartFormDataFieldWrite ();
      Done = true;
   }
   else
   if (DoMultipartFormData &&
       ((DoCliSymbols) || (FieldOnlyPtr && CliOutputPtr &&
                           (FieldToFileMapIndex > 0))))
   {
      /* form-URL-decode the body and write to file as field name/values */
      Multipart2FormDataFieldWrite ();
      Done = true;
   }

   if (CliOutputPtr &&
       (DoRequestBody || (!DoUrlDecode && !DoMultipartFormData)))
   {
      /* write the request body to file as plain text */
      RequestBodyWrite ();
      Done = true;
   }

   if (!Done)
   {
      if (!ExitQuietly)
         fprintf (stdout, "%%%s-E-HUH, did nothing!\n", Utility);
      ExitCgiUtl (STS$K_ERROR, __LINE__);
   }
}

/*****************************************************************************/
/*
Generate and send to the client an NPH (full HTTP) response header.  Various
global variables feed into the generated header.
*/

SendResponse ()

{
   int  i, StatusCode;
   char  *cptr,
         *PreExpiredPtr;
   char  ContentLengthHeader [32];

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

   if (Debug) fprintf (stdout, "SendResponse()\n");

   if (!Debug)
   {
      /* reopen output stream so that the '\r' and '\n' are not filtered */
      if (!(stdout = freopen ("SYS$OUTPUT", "w", stdout, "ctx=bin")))
         ExitCgiUtl (vaxc$errno, __LINE__);
   }

   if (CliLocationPtr)
   {
      fprintf (stdout,
"HTTP/1.0 302 %s\r\n\
Server: %s\r\n\
Date: %s\r\n\
Location: %s\r\n\
\r\n",
         HttpStatusCodeText(302),
         CgiServerSoftwarePtr,
         CgiRequestTimeGmtPtr,
         CliLocationPtr);
      return;
   }

   if (FileContentLength >= 0)
      sprintf (ContentLengthHeader, "Content-Length: %d\r\n",
               FileContentLength);
   else
      ContentLengthHeader[0] = '\0';

   if (DoPreExpired)
      PreExpiredPtr = "Expires: Fri, 13 Jan 1978 14:00:00 GMT\r\n";
   else
      PreExpiredPtr = "";

   StatusCode = atoi (CliResponsePtr);
   if (StatusCode < 200 || StatusCode > 599) StatusCode = 0;

   fprintf (stdout,
"HTTP/1.0 %d %s\r\n\
Server: %s\r\n\
Date: %s\r\n\
Content-Type: %s%s\r\n\
%s\
%s\
",
      StatusCode, HttpStatusCodeText(StatusCode),
      CgiServerSoftwarePtr,
      CgiRequestTimeGmtPtr,
      CliContentTypePtr, CharsetPtr,
      ContentLengthHeader,
      PreExpiredPtr);

   for (i = 0; i <= AdditionalHeadersIndex; i++)
   {
      fprintf (stdout, "%s\r\n", AdditionalHeaders[i]) ;
   }

   fprintf (stdout, "\r\n") ;
}

/*****************************************************************************/
/*
Generate and send to the client a CGI response header.  Various global
variables feed into the generated header.
*/

SendCgiResponse ()

{
   int  i, StatusCode;
   char  *cptr,
         *PreExpiredPtr;
   char  ContentLengthHeader [32];

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

   if (Debug) fprintf (stdout, "SendCgiResponse()\n");

   if (!Debug)
   {
      /* reopen output stream so that the '\r' and '\n' are not filtered */
      if (!(stdout = freopen ("SYS$OUTPUT", "w", stdout, "ctx=bin")))
         ExitCgiUtl (vaxc$errno, __LINE__);
   }

   if (CliLocationPtr)
   {
      fprintf (stdout,
"Location: %s\r\n\
\r\n",
         CliLocationPtr);
      return;
   }

   if (FileContentLength >= 0)
      sprintf (ContentLengthHeader, "Content-Length: %d\r\n",
               FileContentLength);
   else
      ContentLengthHeader[0] = '\0';

   if (DoPreExpired)
      PreExpiredPtr = "Expires: Fri, 13 Jan 1978 14:00:00 GMT\r\n";
   else
      PreExpiredPtr = "";

   StatusCode = atoi (CliResponsePtr);
   if (StatusCode < 200 || StatusCode > 599) StatusCode = 0;

   fprintf (stdout,
"Content-Type: %s%s\r\n\
%s\
%s\
",
      CliContentTypePtr, CharsetPtr,
      ContentLengthHeader,
      PreExpiredPtr);

   for (i = 0; i <= AdditionalHeadersIndex; i++)
   {
      fprintf (stdout, "%s\r\n", AdditionalHeaders[i]) ;
   }

   fprintf (stdout, "\r\n") ;
}

/*****************************************************************************/
/*
Send a file to the client.  If the file cannot be opened for any reason
exit with error.  If the content-type is text the open it in record-mode,
if not text then in binary mode (this way it should work for files of all
characteristics). If the content-length has been requested count the content
bytes by reading the whole file and rewinding (expensive, but it returns a
valid result even with variable-record-length files).
*/

SendFile ()

{
   int  ReadCount;
   char  Buffer [4096];
   FILE  *InputFile;

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

   if (Debug) fprintf (stdout, "SendFile() |%s|\n", CliParameterPtr);

   if (ResponseContentTypeText)
      InputFile = fopen (CliParameterPtr, "r", "shr=get");
   else
      InputFile = fopen (CliParameterPtr, "r", "ctx=bin", "shr=get");
   if (!InputFile) ExitCgiUtl (vaxc$errno, __LINE__);

   if (DoContentLength)
   {
      FileContentLength = 0;
      if (ResponseContentTypeText)
         while (fgets (Buffer, sizeof(Buffer), InputFile))
            FileContentLength += strlen(Buffer);
      else
         while (ReadCount = fread (Buffer, 1, sizeof(Buffer), InputFile))
            FileContentLength += ReadCount;
      rewind (InputFile);
   }

   if (DoCgiResponse)
      SendCgiResponse ();
   else
   if (DoResponse)
      SendResponse ();
   else
   {
      /* reopen output stream so that the '\r' and '\n' are not filtered */
      if (!(stdout = freopen ("SYS$OUTPUT", "w", stdout, "ctx=bin")))
         ExitCgiUtl (vaxc$errno, __LINE__);
   }


   if (ResponseContentTypeText)
      while (fgets (Buffer, sizeof(Buffer), InputFile))
         fputs (Buffer, stdout);
   else
      while (ReadCount = fread (Buffer, 1, sizeof(Buffer), InputFile))
         fwrite (Buffer, ReadCount, 1, stdout);

   fclose (InputFile);
}

/*****************************************************************************/
/*
Return the a pointer to abbreviated meaning of the supplied HTTP status code.
These are typical of those included on the response header status line.
*/

char *HttpStatusCodeText (int StatusCode)

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

   if (Debug) fprintf (stdout, "HttpStatusCodeText() %d\n", StatusCode);

   switch (StatusCode)
   {
      case 000 : return ("Script Error!");
      case 200 : return ("Success");
      case 201 : return ("Created");
      case 202 : return ("Accepted");
      case 203 : return ("No content");
      case 301 : return ("Moved permanently");
      case 302 : return ("Moved temporarily");
      case 304 : return ("Not modified");
      case 400 : return ("Bad request");
      case 401 : return ("Authorization required");
      case 403 : return ("Forbidden");
      case 404 : return ("Not found");
      case 500 : return ("Internal error");
      case 501 : return ("Not implemented");
      case 502 : return ("Bad gateway");
      case 503 : return ("Service unavailable");
      default :  return ("Unknown code!");
   }
}

/*****************************************************************************/
/*
Write the request body to to the file specified by 'CliOutputPtr'.  Write as
text if form-URL-encoded or text, binary if anything else.
*/

RequestBodyWrite ()

{
   int  Length;
   FILE  *OutputFile;

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

   if (Debug) fprintf (stdout, "RequestBodyWrite()\n");

   if (!BufferPtr)
   {
      CgiLibReadRequestBody (&BufferPtr, &BufferCount);
      if (!BufferPtr) BufferPtr = "";
   }

   if (!CliOutputPtr)
      OutputFile = stdout;
   else
   if (!(OutputFile = fopen (CliOutputPtr, "w")))
      ExitCgiUtl (vaxc$errno, __LINE__);

   CgiContentTypePtr = CgiLibVar ("WWW_CONTENT_TYPE");
   if (strsame (CgiContentTypePtr, FORM_URLENCODED, FORM_URLENCODED_LENGTH))
   {
      Length = CgiLibUrlDecode (BufferPtr);
      /* write as text file */
      if ((int)fwrite (BufferPtr, Length, 1, OutputFile) == EOF)
         ExitCgiUtl (vaxc$errno, __LINE__);
   }
   else
   if (strsame (CgiContentTypePtr, "text/", 5))
   {
      /* write as text file */
      if ((int)fwrite (BufferPtr, BufferCount, 1, OutputFile) == EOF)
         ExitCgiUtl (vaxc$errno, __LINE__);
   }
   else
   {
      /* write as binary */
      if ((int)fwrite (BufferPtr, BufferCount, 1, OutputFile) == EOF)
         ExitCgiUtl (vaxc$errno, __LINE__);
   }

   fclose (OutputFile);
}

/*****************************************************************************/
/*
Write the form-URL-decoded contents of the request body into an output file. 
Two formats for the output document are supported, names and headings.
*/

UrlDecodeBodyWrite ()

{
   int  cnt,
        FieldNameLength;
   char  *cptr, *sptr, *zptr;
   char  FieldName [FORM_URLENCODED_FIELD_NAME_MAX],
         FieldValue [FORM_URLENCODED_FIELD_MAX];
   FILE  *OutputFile;

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

   if (Debug) fprintf (stdout, "UrlDecodeBodyWrite()\n");

   CgiContentTypePtr = CgiLibVar ("WWW_CONTENT_TYPE");
   if (!strsame (CgiContentTypePtr, FORM_URLENCODED, FORM_URLENCODED_LENGTH))
   {
      if (!ExitQuietly)
         fprintf (stdout, "%%%s-E-CONTENT, is not form-URL-encoded\n \\%s\\\n",
                  Utility, CgiContentTypePtr);
      ExitCgiUtl (STS$K_ERROR, __LINE__);
   }

   if (!BufferPtr)
   {
      CgiLibReadRequestBody (&BufferPtr, &BufferCount);
      if (!BufferPtr) BufferPtr = "";
   }

   if (!CliOutputPtr)
      OutputFile = stdout;
   else
   if (!(OutputFile = fopen (CliOutputPtr, "w")))
      ExitCgiUtl (vaxc$errno, __LINE__);

   cptr = BufferPtr;
   while (*cptr)
   {
      FieldNameLength = 0;
      while (*cptr && *cptr != '=')
      {
         zptr = (sptr = FieldName) + sizeof(FieldName)-1;
         while (*cptr && *cptr != '=' && sptr < zptr)
         {
            if (isprint(*cptr))
               *sptr++ = *cptr++;
            else
               cptr++;
         }
         /* if field name is too large it's just truncated and rest ignored */
         while (*cptr && *cptr != '=') cptr++;
         *sptr = '\0';
         if (Debug) fprintf (stdout, "FieldName: |%s|\n", FieldName);

         CgiLibUrlDecode (FieldName);
         if (DoFormatHeadings)
            fprintf (OutputFile, "%s\n", FieldName);
         else
         if (DoFormatNames)
            fprintf (OutputFile, "%s: ", FieldName);
         /* else no field name */
         FieldNameLength += sptr - FieldName;
      }
      if (*cptr == '=') cptr++;

      if (DoFormatHeadings)
      {
         /* underline the field name */
         for (cnt = 0; cnt < FieldNameLength; cnt++)
            fputc ('_', OutputFile);
         fputs ("\n", OutputFile);
      }

      while (*cptr && *cptr != '&')
      {
         zptr = (sptr = FieldValue) + sizeof(FieldValue)-1;
         while (*cptr && *cptr != '&' && sptr < zptr)
         {
            if (isprint(*cptr))
               *sptr++ = *cptr++;
            else
               cptr++;
         }
         if (sptr >= zptr)
         {
            /* hmmm, full buffer - ensure we've got complete URL-encoding */
            if (sptr > FieldValue && sptr[-1] == '%')
            {
               sptr--;
               cptr--;
            }
            else
            if (sptr+1 > FieldValue && sptr[-2] == '%')
            {
               sptr -= 2;
               cptr -= 2;
            }
            if (sptr == FieldValue)
               ExitCgiUtl (SS$_BUGCHECK, __LINE__);
         }
         *sptr = '\0';
         if (Debug)
            fprintf (stdout, "FieldValue: %d |%s|\n",
                     sptr-FieldValue, FieldValue);

         if (CgiLibUrlDecode (FieldValue) < 0)
            ExitCgiUtl (SS$_BUGCHECK, __LINE__);
         StripCarRet (FieldValue);
         fputs (FieldValue, OutputFile);
      }
      if (*cptr == '&') cptr++;

      /* blank line between this field and the next */
      fputs ("\n\n", OutputFile);
   }

   fclose (OutputFile);
}

/*****************************************************************************/
/*
Write the form-URL-decoded contents of form field into an output file. 
*/

UrlDecodeFieldWrite ()

{
   int  i,
	cnt;
   char  *cptr, *sptr, *zptr;
   char  FieldName [FORM_URLENCODED_FIELD_NAME_MAX];
   FILE  *OutputFile;

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

   if (Debug) fprintf (stdout, "UrlDecodeFieldWrite()\n");

   CgiContentTypePtr = CgiLibVar ("WWW_CONTENT_TYPE");
   if (!strsame (CgiContentTypePtr, FORM_URLENCODED, FORM_URLENCODED_LENGTH))
   {
      if (!ExitQuietly)
         fprintf (stdout, "%%%s-E-CONTENT, is not form-URL-encoded\n \\%s\\\n",
                  Utility, CgiContentTypePtr);
      ExitCgiUtl (STS$K_ERROR, __LINE__);
   }

   if (!BufferPtr)
   {
      CgiLibReadRequestBody (&BufferPtr, &BufferCount);
      if (!BufferPtr) BufferPtr = "";
   }

   for (i = 0; i <= FieldToFileMapIndex; i++)
   {
      if (!FieldToFileMap[i].FileNamePtr)
         OutputFile = stdout;
      else
      if (!(OutputFile = fopen (FieldToFileMap[i].FileNamePtr, "w")))
         ExitCgiUtl (vaxc$errno, __LINE__);

      zptr = (sptr = FieldName) + sizeof(FieldName)-1;
      for (cptr = "WWW_"; *cptr && sptr < zptr; *sptr++ = *cptr++);
      for (cptr = FieldToFileMap[i].FieldNamePtr; *cptr && sptr < zptr; *sptr++ = *cptr++);
      *sptr = '\0';

      cptr = CgiLibVar (FieldName);
      cnt = strlen(cptr);

      if ((int)fwrite (cptr, cnt, 1, OutputFile) == EOF)
         ExitCgiUtl (vaxc$errno, __LINE__);

      fclose (OutputFile);
   }
}

/*****************************************************************************/
/*
Write the multipart/form-data contents of a file upload form field into an
output file. 
*/

MultipartFormDataFieldWrite ()

{
   int  cnt;
   char  *cptr, *sptr;
   char  FieldName [FORM_URLENCODED_FIELD_NAME_MAX];
   FILE  *OutputFile;

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

   if (Debug) fprintf (stdout, "MultipartFormDataFieldWrite()\n");

   CgiContentTypePtr = CgiLibVar ("WWW_CONTENT_TYPE");
   if (!strsame (CgiContentTypePtr, MULTIPART_FORMDATA,
                                    strlen(MULTIPART_FORMDATA)))
   {
      if (!ExitQuietly)
          fprintf (stdout, "%%%s-E-CONTENT, is not multipart/form-data\n \\%s\\\n",
                  Utility, CgiContentTypePtr);
      ExitCgiUtl (STS$K_ERROR, __LINE__);
   }

   if (!BufferPtr)
   {
      CgiLibReadRequestBody (&BufferPtr, &BufferCount);
      if (!BufferPtr) BufferPtr = "";
   }

   CgiLibFormRequestBody (BufferPtr, BufferCount);

   while ((cptr = sptr = CgiLibVar ("*")))
   {
      if (Debug) fprintf (stdout, "|%s|\n", cptr);
      if (!memcmp (cptr, "WWW_", 4)) cptr += 4;
      while (*sptr && *sptr != '=') sptr++;
      if (*sptr == '=')
      {
         *sptr = '\0';
         if (strlen(sptr+1) <= SymbolValueMax)
	 {
	    if (SymbolPrefixPtr)
	    {
               char theName[FORM_URLENCODED_FIELD_NAME_MAX];
               strcpy (theName, SymbolPrefixPtr);
               strcat (theName, cptr);
               SetCliSymbol(theName, sptr+1, 0);
	    }
	    else
	       SetCliSymbol (cptr+1, sptr+1, 0);
	 }
         *sptr = '=';
      }
   }

   while ((cptr = sptr = CgiLibVar ("*")))
      if (Debug) fprintf (stdout, "|%s|\n", cptr);

   if (!CliOutputPtr)
      OutputFile = stdout;
   else
   if (!(OutputFile = fopen (CliOutputPtr, "w")))
      ExitCgiUtl (vaxc$errno, __LINE__);

   sprintf (FieldName, "WWW_FORM_%s", FieldOnlyPtr);
   cptr = CgiLibVar (FieldName);
   cnt = CgiLibHtmlDeEntify (cptr);
   if (cnt == -1)
   {
      if (!ExitQuietly)
         fprintf (stdout, "%%%s-E-DEENTIFY, error de-entifying multipart\n",
                  Utility);
      ExitCgiUtl (STS$K_ERROR, __LINE__);
   }

   if ((int)fwrite (cptr, cnt, 1, OutputFile) == EOF)
      ExitCgiUtl (vaxc$errno, __LINE__);

   fclose (OutputFile);
}

/*****************************************************************************/
/*
Write the multipart/form-data contents of more than one file upload form field 
into an output file.  To get this right, the command line has to have two or
more /FIELD ... /OUTPUT pairs (in this order) to identify the fields and
associate file names with them. 
*/

Multipart2FormDataFieldWrite ()

{
   int  cnt,
   	i;
   char  *cptr, *nptr, *sptr;
   char  FieldName [FORM_URLENCODED_FIELD_NAME_MAX];
   FILE  *OutputFile;

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

   if (Debug) fprintf (stdout, "Multipart2FormDataFieldWrite()\n");

   CgiContentTypePtr = CgiLibVar ("WWW_CONTENT_TYPE");
   if (!strsame (CgiContentTypePtr, MULTIPART_FORMDATA,
                                    strlen(MULTIPART_FORMDATA)))
   {
      if (!ExitQuietly)
         fprintf (stdout, "%%%s-E-CONTENT, is not multipart/form-data\n \\%s\\\n",
                  Utility, CgiContentTypePtr);
      ExitCgiUtl (STS$K_ERROR, __LINE__);
   }

   if (!BufferPtr)
   {
      CgiLibReadRequestBody (&BufferPtr, &BufferCount);
      if (!BufferPtr) BufferPtr = "";
   }

   CgiLibFormRequestBody (BufferPtr, BufferCount);

   while ((cptr = sptr = CgiLibVar ("*")))
   {
      if (Debug) fprintf (stdout, "|%s|\n", cptr);
      if (!memcmp (cptr, "WWW_", 4)) cptr += 4;
      while (*sptr && *sptr != '=') sptr++;
      if (*sptr == '=')
      {
         *sptr = '\0';
         if (strlen(sptr+1) <= SymbolValueMax)
	 {
	    if (SymbolPrefixPtr)
	    {
               char theName[FORM_URLENCODED_FIELD_NAME_MAX];
               strcpy (theName, SymbolPrefixPtr);
               strcat (theName, cptr);
               SetCliSymbol(theName, sptr+1, 0);
	    }
	    else
               SetCliSymbol (cptr+1, sptr+1, 0);
	 }
         *sptr = '=';
      }
   }

   while ((cptr = sptr = CgiLibVar ("*")))
      if (Debug) fprintf (stdout, "|%s|\n", cptr);

   for (i = 0; i <= FieldToFileMapIndex; i++)
   {
	if (!FieldToFileMap[i].FileNamePtr)
	    OutputFile = stdout;
	else
	if (!(OutputFile = fopen (FieldToFileMap[i].FileNamePtr, "w")))
           ExitCgiUtl (vaxc$errno, __LINE__);

	sprintf (FieldName, "WWW_FORM_%s", FieldToFileMap[i].FieldNamePtr);
	cptr = CgiLibVar (FieldName);
	cnt = CgiLibHtmlDeEntify (cptr);
	if (cnt == -1)
	{
            if (!ExitQuietly)
   	       fprintf (stdout, "%%%s-E-DEENTIFY, error de-entifying multipart\n",
		        Utility);
	    ExitCgiUtl (STS$K_ERROR, __LINE__);
	}
	
	if ((int)fwrite (cptr, cnt, 1, OutputFile) == EOF)
	    ExitCgiUtl (vaxc$errno, __LINE__);
	
	fclose (OutputFile);
    }
}

/*****************************************************************************/
/*
Decode the form-URL-encoded POSTed request body with the contents of each field
being placed into DCL symbols named using that field name.  Field contents
greater than the capacity of a single DCL symbol (255 on <=6.n  and 1023 on
>=v7.n) have the contents distributed across multiple symbol names. Each of
these fields comprises the basic name with a dollar symbol and an ascending
integer.  Informational symbols are also created.
*/

UrlDecodeBodyCliSymbols ()

{
   boolean  FieldHasMultipleSymbols;
   int  status,
        DuplicateFieldCount,
        DuplicateSymbolCount,
        FieldCount,
        SymbolCount,
        SymbolNameLength,
        SymbolValueCount,
        SymbolValueLength,
        SymbolValuePart,
        SymbolValuePartLength;
   unsigned char  ch;
   char  *cptr, *sptr, *zptr;
   char  Scratch [FORM_URLENCODED_FIELD_MAX],
         SymbolName [FORM_URLENCODED_FIELD_NAME_MAX],
         SymbolValue [FORM_URLENCODED_FIELD_MAX],
         SymbolValueCountName [FORM_URLENCODED_FIELD_NAME_MAX];
   FILE  *OutputFile;

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

   if (Debug) fprintf (stdout, "UrlDecodeBodyCliSymbols()\n");

   CgiContentTypePtr = CgiLibVar ("WWW_CONTENT_TYPE");
   if (!strsame (CgiContentTypePtr, FORM_URLENCODED, FORM_URLENCODED_LENGTH))
   {
      if (!ExitQuietly)
         fprintf (stdout, "%%%s-E-CONTENT, is not form-URL-encoded\n \\%s\\\n",
                  Utility, CgiContentTypePtr);
      ExitCgiUtl (STS$K_ERROR, __LINE__);
   }

   if (!BufferPtr)
   {
      CgiLibReadRequestBody (&BufferPtr, &BufferCount);
      if (!BufferPtr) BufferPtr = "";
   }

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

   DuplicateFieldCount = DuplicateSymbolCount =
      FieldCount = SymbolCount = SymbolNameLength =
      SymbolValueCount = SymbolValueLength = SymbolValuePart = 0;
   SymbolName[0] = SymbolValue[0] = SymbolValueCountName[0] = '\0';

   /**************************/
   /* parse URL-encoded body */
   /**************************/

   cptr = BufferPtr;
   while (*cptr)
   {
      FieldHasMultipleSymbols = false;
      SymbolValuePartLength = 0;

      if (!SymbolNameLength)
      {
         /*******************************/
         /* get the symbol (field) name */
         /*******************************/

         FieldCount++;
         /* allow 16 for appending some dollar-counts later on! */
         zptr = (sptr = SymbolName) + sizeof(SymbolName) - 16;
         memcpy (sptr, SymbolPrefixPtr, SymbolPrefixLength);
         sptr += SymbolPrefixLength;
         if (sptr < zptr) *sptr++ = '_';
         while (*cptr && *cptr != '=' && sptr < zptr)
         {
            if (isprint(*cptr))
               *sptr++ = toupper(*cptr++);
            else
               cptr++;
         }
         if (sptr >= zptr)
         {
            if (!ExitQuietly)
               fprintf (stdout, "%%%s-E-SYMBOLNAME, too big\n \\%s\\\n",
                        Utility, SymbolName);
            ExitCgiUtl (STS$K_ERROR, __LINE__);
         }
         *sptr = '\0';
         if (Debug) fprintf (stdout, "SymbolName: |%s|\n", SymbolName);

         /* substitute underscores for unacceptable symbol name characters */
         SymbolNameLength = CgiLibUrlDecode(SymbolName);
         for (sptr = SymbolName; *sptr; sptr++)
            if (!isalnum(*sptr)) *sptr = '_';

         if (*cptr == '=') cptr++;
      }

      if (!SymbolValueLength)
      {
         /************************************/
         /* get the (next part) symbol value */
         /************************************/

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

         DelimChar[1] = '\0';

         while (*cptr && *cptr != '&' && 
                sptr < zptr &&
                sptr - SymbolValue < SymbolValueMax)
         {
            /* URL decode */
            while (*cptr == '\r' || *cptr == '\n') cptr++;
            if (*cptr == '&') break;
            if (*cptr == '%')
            {
               cptr++;
               while (*cptr == '\r' || *cptr == '\n') cptr++;
               if (*cptr == '&') break;
               ch = 0;
               if (*cptr >= '0' && *cptr <= '9')
                  ch = (*cptr - (int)'0') << 4;
               else
               if (toupper(*cptr) >= 'A' && toupper(*cptr) <= 'F')
                  ch = (toupper(*cptr) - (int)'A' + 10) << 4;
               else
                  ch = 0;
               if (*cptr) cptr++;
               while (*cptr == '\r' || *cptr == '\n') cptr++;
               if (*cptr == '&') break;
               if (*cptr >= '0' && *cptr <= '9')
                  ch += (*cptr - (int)'0');
               else
               if (toupper(*cptr) >= 'A' && toupper(*cptr) <= 'F')
                  ch += (toupper(*cptr) - (int)'A' + 10);
               else
                  ch = 0;
               if (*cptr) cptr++;
            }
            else
            if (*cptr == '+')
            {
               ch = ' ';
               cptr++;
            }
            else
               ch = *cptr++;

            if (DelimChar[0] && (DelimChar[0] == (DelimChar[1] = ch)))
            {
               DelimCharHitCount++;
               break;
            }

            if (DoCliSymbolsLines && ch == '\r')
               continue;
            else
            if (DoCliSymbolsLines && ch == '\n')
               break;
            else
            if (DoCliSymbolsNoControl && iscntrl(ch))
               continue;
            else
            if (isprint(ch) || isspace(ch))
               *sptr++ = ch;
         }
         *sptr = '\0';
         SymbolValueLength = sptr - SymbolValue;
         if (Debug) fprintf (stdout, "SymbolValue: |%s|\n", SymbolValue);

         if (DelimChar[0] && DelimChar[0] == DelimChar[1])
            FieldHasMultipleSymbols = true;
         else
         {
            if (*cptr == '&')
               cptr++;
            else
            if (*cptr)
               FieldHasMultipleSymbols = true;
            else
               FieldHasMultipleSymbols = false;
         }

         if (FieldHasMultipleSymbols || SymbolValueCount)
         {
            SymbolValueCount += SymbolValueLength;
            sprintf (SymbolName+SymbolNameLength, "%c%d",
                     BugSymbolNaming ? '_' : '$', ++SymbolValuePart);
            if (Debug) fprintf (stdout, "SymbolName: |%s|\n", SymbolName);
            SymbolValuePartLength = strlen(SymbolName+SymbolNameLength);
         }
      }

      if (Debug) fprintf (stdout, "|%s=%s|\n", SymbolName, SymbolValue);

      if (DuplicateSymbolCount)
      {
         if (DuplicateSymbolCount == 2)
         {
            if (VMSok (status = GetCliSymbol (SymbolName, Scratch, NULL)))
            {
               /* first instance, move it to a "$$1" name */
               strcpy (SymbolName+SymbolNameLength+SymbolValuePartLength, "$$1");
               SetCliSymbol (SymbolName, Scratch, 0);
               SymbolCount++;
            }
         }
         sprintf (SymbolName+SymbolNameLength+SymbolValuePartLength,
                  "$$%d", DuplicateSymbolCount);
      }

      /*******************************/
      /* check for duplicate symbols */
      /*******************************/

      while (VMSok (status = GetCliSymbol (SymbolName, Scratch, NULL)))
      {
         /* found an existing instance of this symbol name, try another */
         sprintf (SymbolName+SymbolNameLength+SymbolValuePartLength,
                  "$$%d", ++DuplicateSymbolCount);
      }
      if (VMSnok (status) && status != LIB$_NOSUCHSYM)
         ExitCgiUtl (status, __LINE__);

      if (DuplicateSymbolCount == 1)
      {
         DuplicateFieldCount++;
         /* first duplicate, move origninal to a "$$1" name */
         SymbolName[SymbolNameLength+SymbolValuePartLength] = '\0';
         if (VMSok (status = GetCliSymbol (SymbolName, Scratch, NULL)))
         {
            strcpy (SymbolName+SymbolNameLength+SymbolValuePartLength, "$$1");
            SetCliSymbol (SymbolName, Scratch, 0);
            SymbolCount++;
         }
         /* move any related multi-symbol value into a "$$1" also */
         sprintf (SymbolValueCountName, "%*.*s$0",
                  SymbolNameLength+SymbolValuePartLength,
                  SymbolNameLength+SymbolValuePartLength,
                  SymbolName);
         if (VMSok (status =
             GetCliSymbol (SymbolValueCountName, Scratch, NULL)))
         {
            strcpy (SymbolValueCountName+
                    SymbolNameLength+
                    SymbolValuePartLength, "$$1");
            SetCliSymbol (SymbolValueCountName, Scratch, 0);
            SymbolCount++;
         }
         SymbolValueCountName[0] = '\0';
         /* next one will be instance two */
         DuplicateSymbolCount++;
         strcpy (SymbolName+SymbolNameLength+SymbolValuePartLength, "$$2");
      }

      /***************************/
      /* assign the symbol value */
      /***************************/

      SetCliSymbol (SymbolName, SymbolValue, 0);
      SymbolCount++;

      if (DuplicateSymbolCount && !SymbolValueCount)
      {
         /* set again, the last value encountered (backward-compatiblity) */
         SymbolName[SymbolNameLength] = '\0';
         SetCliSymbol (SymbolName, SymbolValue, 0);
      }

      if (DelimChar[0] && DelimChar[0] == DelimChar[1])
      {
         sprintf (Scratch, "%s$", SymbolName);
         DelimChar[1] = '\0';
         SetCliSymbol (Scratch, DelimChar, 0);
      }

      if (FieldHasMultipleSymbols)
      {
         /* per-line symbols, or symbol value reached max size before end */
         if (!SymbolValueCountName[0])
         {
            /* generate a symbol name for total size of multi-symbol value */
            if (DuplicateSymbolCount)
               sprintf (SymbolValueCountName, "%*.*s$0$$%d",
                        SymbolNameLength, SymbolNameLength, SymbolName,
                        DuplicateSymbolCount);
            else
               sprintf (SymbolValueCountName, "%*.*s$0",
                        SymbolNameLength, SymbolNameLength, SymbolName);
         }

         SymbolValueLength = 0;
         SymbolValue[0] = '\0';
      }
      else
      {
         if (SymbolValueCountName[0])
         {
            /* assign symbol for total size of multi-symbol value */
            SetCliSymbol (SymbolValueCountName, NULL, SymbolValueCount);
            SymbolCount++;
            if (DuplicateSymbolCount)
            {
               /* chop "name$0$$n" off at "name$0" (backward compatibility) */
               SymbolValueCountName[SymbolNameLength+2] = '\0';
               SetCliSymbol (SymbolValueCountName, NULL, SymbolValueCount);
            }
         }

         if (DuplicateSymbolCount)
         {
            /* create a symbol containing the count of these duplicate names */
            strcpy (SymbolName+SymbolNameLength, "$$0");
            SetCliSymbol (SymbolName, NULL, DuplicateSymbolCount);
            if (DuplicateSymbolCount <= 2) SymbolCount++;
         }

         DuplicateSymbolCount = SymbolValueCount =
            SymbolValueLength = SymbolValuePart = 0;
         SymbolValue[0] = SymbolValueCountName[0] = '\0';

         /* if delimiter and hit do not reset name, otherwise ... */
         if (!DelimChar[0] || DelimChar[0] != DelimChar[1])
         {
            /* symbol containing number of delimiters encountered */
            strcpy (SymbolName+SymbolNameLength, "$0$");
            SetCliSymbol (SymbolName, NULL, DelimCharHitCount);

            DelimCharHitCount = SymbolNameLength = 0;
            SymbolName[0] = SymbolValueCountName[0] = '\0';
         }
      }
   }

   /***************/
   /* end of body */
   /***************/

   sprintf (SymbolName, "%s$FIELDS", SymbolPrefixPtr);
   SetCliSymbol (SymbolName, NULL, FieldCount);

   sprintf (SymbolName, "%s$FIELDS_DUPLICATE", SymbolPrefixPtr);
   SetCliSymbol (SymbolName, NULL, DuplicateFieldCount);

   sprintf (SymbolName, "%s$MAXSYM", SymbolPrefixPtr);
   SetCliSymbol (SymbolName, NULL, SymbolValueMax);

   sprintf (SymbolName, "%s$SYMBOLS", SymbolPrefixPtr);
   SetCliSymbol (SymbolName, NULL, SymbolCount);
}           

/*****************************************************************************/
/*
Strip carriage-returns, leaving only newlines (for text files).
*/

int StripCarRet (char *String)
{
   char  *cptr, *sptr;

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

   if (Debug) fprintf (stdout, "StripCarRet() |%s|\n", String);

   /* don't start actually copying unless we really have to! */
   cptr = String;
   while (*cptr && *cptr != '\r') cptr++;
   sptr = cptr;
   while (*cptr)
   {
      if (*cptr == '\r')
         cptr++;
      else
         *sptr++ = *cptr++;
   }
   *sptr = '\0';

   if (Debug) fprintf (stdout, "|%s|\n", String);
   return (sptr-String);
}

/*****************************************************************************/
/*
Get the contents of the specified DCL symbol, URL-decode, reset original symbol
name with the decoded value.
*/

DecodeSymbolPercent (char *SymbolName)

{
   int  status,
        SymbolLength;
   char  SymbolValue [8192];

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

   if (Debug) fprintf (stdout, "EscapeSymbolQuotes() |%s|\n", SymbolName);

   if (!CliParameterPtr)
   {
      if (!ExitQuietly)
         fprintf (stdout, "%%%s-E-UNPERSYM, symbol name not specified\n",
                  Utility);
      ExitCgiUtl (STS$K_ERROR, __LINE__);
   }

   if (VMSnok (status =
       GetCliSymbol (SymbolName, SymbolValue, &SymbolLength)))
      ExitCgiUtl (status, __LINE__);

   SymbolValue[SymbolLength] = '\0';
   CgiLibUrlDecode(SymbolValue);
   if (Debug) fprintf (stdout, "|%s|\n", SymbolValue);

   SetCliSymbol (SymbolName, SymbolValue, 0);
}

/*****************************************************************************/
/*
Get the contents of the specified DCL symbol.  The copy to scratch storage,
adding an extra double-quote for each found in the source symbol.  Reset
original symbol name with the value containing doubled-up quotes.
*/

EscapeSymbolQuotes (char *SymbolName)

{
   int  status,
        SymbolLength;
   char  *cptr, *eptr, *sptr, *zptr;
   char  SymbolValue [8192],
         DquoteValue [8192+256];

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

   if (Debug) fprintf (stdout, "EscapeSymbolQuotes() |%s|\n", SymbolName);

   if (!CliParameterPtr)
   {
      if (!ExitQuietly)
         fprintf (stdout, "%%%s-E-2QUOTE, symbol name not specified\n",
                  Utility);
      ExitCgiUtl (STS$K_ERROR, __LINE__);
   }

   if (VMSnok (status =
       GetCliSymbol (SymbolName, SymbolValue, &SymbolLength)))
      ExitCgiUtl (status, __LINE__);

   zptr = (sptr = DquoteValue) + SymbolValueMax;
   eptr = (cptr = SymbolValue) + SymbolLength;
   while (cptr < eptr && sptr < zptr)
   {
      if (*cptr == '\"' && sptr < zptr) *sptr++ = '\"';
      if (sptr < zptr) *sptr++ = *cptr++;
   }
   /* +1 makes it an error */
   if (sptr >= zptr) ExitCgiUtl (SS$_BUFFEROVF+1, __LINE__);
   *sptr = '\0';
   if (Debug) fprintf (stdout, "|%s|\n", DquoteValue);

   SetCliSymbol (SymbolName, DquoteValue, NULL);
}

/*****************************************************************************/
/*
Get the contents of the specified DCL symbol.  Split it into one or more
strings (symbols) according the the delimiter supplied.
*/

SplitSymbol (char *SplitSymbolName)

{
   int  status,
        DelimCharHitCount,
        SymbolCount,
        SymbolLength,
        SymbolValueLength,
        SymbolValueTotal;
   char  *cptr, *eptr, *sptr, *zptr;
   char  SymbolName [256],
         SymbolValue [8192],
         ParseValue [8192];

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

   if (Debug) fprintf (stdout, "SplitSymbol() |%s|\n", SymbolName);

   if (!CliParameterPtr)
   {
      if (!ExitQuietly)
         fprintf (stdout, "%%%s-E-SPLIT, symbol name not specified\n",
                  Utility);
      ExitCgiUtl (STS$K_ERROR, __LINE__);
   }
   if (!DelimChar[0])
   {
      if (!ExitQuietly)
         fprintf (stdout, "%%%s-E-SPLIT, delimiter not specified\n",
                  Utility);
      ExitCgiUtl (STS$K_ERROR, __LINE__);
   }

   if (VMSnok (status =
       GetCliSymbol (SplitSymbolName, SymbolValue, &SymbolLength)))
      ExitCgiUtl (status, __LINE__);

   /* allow 16 for appending some dollar-counts later on! */
   if (strlen(SplitSymbolName) > sizeof(SymbolName)-16)
   {
      if (!ExitQuietly)
         fprintf (stdout, "%%%s-E-SYMBOLNAME, too big\n \\%s\\\n",
                  Utility, SymbolName);
      ExitCgiUtl (STS$K_ERROR, __LINE__);
   }

   DelimCharHitCount = SymbolCount = SymbolValueTotal = 0;
   cptr = SymbolValue;
   while (*cptr)
   {
      zptr = (sptr = SymbolValue) + sizeof(SymbolValue)-1;
      while (*cptr && sptr < zptr && sptr - SymbolValue < SymbolValueMax)
      {
         if (DelimChar[0] && (DelimChar[0] == (DelimChar[1] = *cptr)))
         {
            DelimCharHitCount++;
            cptr++;
            break;
         }
         *sptr++ = *cptr++;
      }
      *sptr = '\0';
      SymbolValueLength = sptr - SymbolValue;
      SymbolValueTotal += SymbolValueLength;

      sprintf (SymbolName, "%s$%d", SplitSymbolName, ++SymbolCount);

      SetCliSymbol (SymbolName, SymbolValue, 0);

      if (DelimChar[0] && DelimChar[0] == DelimChar[1])
      {
         DelimChar[1] = '\0';
         sprintf (SymbolName, "%s$%d$", SplitSymbolName, SymbolCount);
         SetCliSymbol (SymbolName, DelimChar, 0);
         if (!*cptr)
         {
            /* trailing empty delimiter */
            sprintf (SymbolName, "%s$%d", SplitSymbolName, ++SymbolCount);
            SetCliSymbol (SymbolName, "", 0);
         }
      }
   }

   /* symbol containing total characters in all symbols */
   sprintf (SymbolName, "%s$0", SplitSymbolName);
   SetCliSymbol (SymbolName, NULL, SymbolValueTotal);

   /* symbol containing number of delimiters encountered */
   sprintf (SymbolName, "%s$0$", SplitSymbolName);
   SetCliSymbol (SymbolName, NULL, DelimCharHitCount);
}

/****************************************************************************/
/*
Assign a global symbol.  If the string pointer is null the numeric value is
used.  Symbol lengths are adjusted according to the maximum allowed for the
version of the operating system.
*/ 

SetCliSymbol
(
char *Name,
char *String,
int Value
)
{
   static char  ValueString [32];
   static $DESCRIPTOR (NameDsc, "");
   static $DESCRIPTOR (ValueDsc, "");
   static $DESCRIPTOR (ValueFaoDsc, "!UL");
   static $DESCRIPTOR (ValueStringDsc, ValueString);

   int  len, status;

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

   if (Debug)
      fprintf (stdout, "SetCliSymbol() |%s|%s| %d\n",
               Name, String, Value);

   NameDsc.dsc$a_pointer = Name;
   NameDsc.dsc$w_length = strlen(Name);
   if (!String)
   {
      ValueDsc.dsc$a_pointer = ValueString;
      sys$fao (&ValueFaoDsc, &ValueDsc.dsc$w_length, &ValueStringDsc, Value);
      ValueString[ValueDsc.dsc$w_length] = '\0';
   }
   else
   {
      ValueDsc.dsc$a_pointer = String;
      len = strlen(String);
      if (len > SymbolValueMax)
         ValueDsc.dsc$w_length = SymbolValueMax;
      else
         ValueDsc.dsc$w_length = len;
   }

   if (Debug) fprintf (stdout, "|%s| %d\n", Name, ValueDsc.dsc$w_length);

   if (VMSnok (status = lib$set_symbol (&NameDsc, &ValueDsc, &CliSymbolType)))
      ExitCgiUtl (status, __LINE__);
}

/*****************************************************************************/
/*
Gte a global symbol name's value.  Value storage must provide at least 1024
bytes storage for >=7.0 and 256 bytes for <=6.2. 
*/

int GetCliSymbol
(
char *Name,
char *Value,
int *LengthPtr
)
{
   static $DESCRIPTOR (NameDsc, "");
   static $DESCRIPTOR (ValueDsc, "");

   int  status;
   unsigned short  Length;
   unsigned long  SymbolTable;

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

   if (Debug) fprintf (stdout, "GetCliSymbol() |%s|\n", Name);

   NameDsc.dsc$a_pointer = Name;
   NameDsc.dsc$w_length = strlen(Name);
   ValueDsc.dsc$a_pointer = Value;
   if (VmsVersion() < 700)
      ValueDsc.dsc$w_length = 255;
   else
   if (VmsVersion() < 732)
      ValueDsc.dsc$w_length = 1023;
   else
      ValueDsc.dsc$w_length = 8191;

   status = lib$get_symbol (&NameDsc, &ValueDsc, &Length, &SymbolTable);
   if (Debug) fprintf (stdout, "lib$get_symbol() %%X%08.08X\n", status);
   /* if it's not a global symbol then we're not interested! */
   if (SymbolTable != CliSymbolType) status = LIB$_NOSUCHSYM;
   if (VMSnok (status))
   {
      Value[0] = '\0';
      return (status);
   }

   if (LengthPtr) *LengthPtr = Length;
   Value[Length] = '\0';
   if (Debug) fprintf (stdout, "%d |%s|\n", Length, Value);

   return (status);
}

/****************************************************************************/
/*
Return an integer reflecting the major, minor and other VMS version number.
For example, return 600 for "V6.0", 730 for "V7.3" and 732 for "V7.3-2".
*/ 

int VmsVersion ()

{
   static int  VersionInteger;
   static char  SyiVersion [8+1];

   static struct {
      short BufferLength;
      short ItemCode;
      void  *BufferPtr;
      void  *LengthPtr;
   }
   SyiItems [] =
   {
      { 8, SYI$_VERSION, &SyiVersion, 0 },
      { 0,0,0,0 }
   };

   int  status;
   char  *cptr;

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

   if (Debug) fprintf (stdout, "VmsVersion() %d\n", VersionInteger);

   if (VersionInteger) return (VersionInteger);

   if (VMSnok (status = sys$getsyiw (0, 0, 0, &SyiItems, 0, 0, 0)))
      ExitCgiUtl (status, __LINE__);

   if (cptr = getenv("WASD_VMS_VERSION"))
      strncpy (SyiVersion, cptr, sizeof(SyiVersion));

   SyiVersion[sizeof(SyiVersion)-1] = '\0';
   if (Debug) fprintf (stdout, "SyiVersion |%s|\n", SyiVersion);

   if (SyiVersion[0] == 'V' &&
       isdigit(SyiVersion[1]) &&
       SyiVersion[2] == '.' &&
       isdigit(SyiVersion[3]))
   {
      /* e.g. "V7.3" */
      VersionInteger = ((SyiVersion[1]-48) * 100) + ((SyiVersion[3]-48) * 10);
      /* if something like "V7.3-2" */
      if (SyiVersion[4] == '-') VersionInteger += SyiVersion[5]-48;
   }
   else
   {
      if (!ExitQuietly);
         fprintf (stdout,
"%%%s-E-VMS, cannot understand VMS version string \"%s\"\n\
-%s-I-KLUDGE, continue by using WASD_VMS_VERSION environment variable\n",
                      Utility, SyiVersion, Utility);
      ExitCgiUtl (SS$_BUGCHECK, __LINE__);
   }

   if (Debug) fprintf (stdout, "%d\n", VersionInteger);
   return (VersionInteger);
}

/*****************************************************************************/
/*
Just to get a line number when debugging!
*/

void ExitCgiUtl
(
int StatusValue,
int LineNumber
)
{
   /*********/
   /* begin */
   /*********/

   if (Debug)
      fprintf (stdout, "ExitCgiUtl() status:%%X%08.08X line:%d\n",
               StatusValue, LineNumber);

   if (StatusValue == STS$K_ERROR) StatusValue |= STS$M_INHIB_MSG;

   exit (StatusValue | ExitQuietly);
}

/*****************************************************************************/
/*
Get "command-line" parameters, whether from the command-line or from a
configuration symbol or logical containing the equivalent.
*/

ProcessParameters (char* clptr)

{
   static char  CommandLine [256];
   static unsigned long  Flags = 0;

   int  status;
   unsigned short  Length;
   char  ch;
   char  *aptr, *cptr, *sptr;
   $DESCRIPTOR (CommandLineDsc, CommandLine);

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

   if (Debug) fprintf (stdout, "ProcessParameters()\n");

   aptr = NULL;
   ch = *clptr;
   for (;;)
   {
      if (aptr && *aptr == '/') *aptr = '\0';
      if (!ch) break;

      *clptr = ch;
      if (Debug) fprintf (stdout, "clptr |%s|\n", clptr);
      while (*clptr && isspace(*clptr)) *clptr++ = '\0';
      aptr = clptr;
      if (*clptr == '/') clptr++;
      while (*clptr && !isspace (*clptr) && *clptr != '/')
      {
         if (*clptr != '\"')
         {
            clptr++;
            continue;
         }
         cptr = clptr;
         clptr++;
         while (*clptr)
         {
            if (*clptr == '\"')
               if (*(clptr+1) == '\"')
                  clptr++;
               else
                  break;
            *cptr++ = *clptr++;
         }
         *cptr = '\0';
         if (*clptr) clptr++;
      }
      ch = *clptr;
      if (*clptr) *clptr = '\0';
      if (Debug) fprintf (stdout, "aptr |%s|\n", aptr);
      if (!*aptr) continue;

      if (strsame (aptr, "/2QUOTE", 3))
      {
         DoEscapeSymbolQuotes = true;
         continue;
      }
      if (strsame (aptr, "/BODY", 4))
      {
         DoRequestBody = true;
         continue;
      }
      if (strsame (aptr, "/BUGSYM", -1))
      {
         BugSymbolNaming = true;
         continue;
      }
      if (strsame (aptr, "/CGIRESPONSE=", 4))
      {
         DoCgiResponse = true;
         DoResponse = false;
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         CliResponsePtr = cptr;
         continue;
      }
      if (strsame (aptr, "/CHARSET=", 4))
      {
         cptr = GetParameterString (aptr);
         if (!cptr) continue;  /* allow an empty string */
         CliCharsetPtr = cptr;
         continue;
      }
      if (strsame (aptr, "/CONTENT=", 4))
      {
         for (cptr = aptr; *cptr && *cptr != '='; cptr++);
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         CliContentTypePtr = cptr;
         continue;
      }
      if (strsame (aptr, "/COPY", 4))
      {
         DoCopy = true;
         continue;
      }
      if (strsame (aptr, "/DBUG", -1))
      {
         Debug = true;
         continue;
      }
      if (strsame (aptr, "/DELIMITER=", 4))
      {
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
	 DelimChar[0] = cptr[0];
         continue;
      }
      if (strsame (aptr, "/EXPIRED", 4))
      {
         DoPreExpired = true;
         continue;
      }
      if (strsame (aptr, "/FIELD=", 4))
      {
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         FieldOnlyPtr = cptr;
     	 FieldToFileMapIndex++ ;
     	 if (FieldToFileMapIndex == MAX_FIELD_TO_FILE)
	 {
	     if (!ExitQuietly)
		 fprintf (stdout, "%%%s-E-TOOMANY, Too many FIELD qualifiers\n \\%s\\\n",
                          Utility, cptr);
	     ExitCgiUtl (STS$K_ERROR, __LINE__) ;
	 }
	 FieldToFileMap[FieldToFileMapIndex].FieldNamePtr = cptr ;
         continue;
      }
      if (strsame (aptr, "/FORMAT=", 4))
      {
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         if (strsame (cptr, "HEADINGS", 4))
         {
            DoFormatHeadings = true;
            DoFormatNames = false;
         }
         else
         if (strsame (cptr, "NAMES", 4))
         {
            DoFormatHeadings = false;
            DoFormatNames = true;
         }
         else
         if (strsame (cptr, "NONE", 4))
         {
            DoFormatHeadings = false;
            DoFormatNames = false;
         }
         else
         {
            if (!ExitQuietly)
               fprintf (stdout, "%%%s-E-IVKEYW, invalid keyword\n \\%s\\\n",
                        Utility, cptr);
            ExitCgiUtl (STS$K_ERROR, __LINE__);
         }
         continue;
      }
      if (strsame (aptr, "/GLOBAL", -1))
      {
         CliSymbolType = LIB$K_CLI_GLOBAL_SYM;
         continue;
      }
      if (strsame (aptr, "/HEADER=", 4))
      {
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
     	 AdditionalHeadersIndex++ ;
     	 if (AdditionalHeadersIndex == MAX_ADDITIONAL_HEADERS)
	 {
	     if (!ExitQuietly)
		 fprintf (stdout, "%%%s-E-TOOMANY, Too many HEADER qualifiers\n \\%s\\\n",
                          Utility, cptr);
	     ExitCgiUtl (STS$K_ERROR, __LINE__) ;
	 }
	 AdditionalHeaders[AdditionalHeadersIndex] = cptr ;
         continue;
      }
      if (strsame (aptr, "/LENGTH", 4))
      {
         DoContentLength = true;
         continue;
      }
      if (strsame (aptr, "/LOCAL", -1))
      {
         CliSymbolType = LIB$K_CLI_LOCAL_SYM;
         continue;
      }
      if (strsame (aptr, "/LOCATION=", 4))
      {
         DoResponse = true;
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         CliLocationPtr = cptr;
         continue;
      }
      if (strsame (aptr, "/MAXSYM=", 7))
      {
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         SymbolValueMax = atoi(cptr);
         continue;
      }
      if (strsame (aptr, "/MULTIPART", 4))
      {
         DoMultipartFormData = true;
         continue;
      }
      if (strsame (aptr, "/OUTPUT=", 4))
      {
	 if (FieldToFileMapIndex != -1)
	 {
	     FieldToFileMap[FieldToFileMapIndex].FileNamePtr = NULL ;
	 }
	 
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         CliOutputPtr = cptr;
	 if (FieldToFileMapIndex != -1)
	 {
	     FieldToFileMap[FieldToFileMapIndex].FileNamePtr = cptr ;
	 }
         continue;
      }
      if (strsame (aptr, "/UNPERSYM", -1))
      {
         DoDecodeSymbolPercent = true;
         continue;
      }
      if (strsame (aptr, "/PLUS", -1))
      {
         DoCgiPlus = true;
         continue;
      }
      if (strsame (aptr, "/PREFIX=", 4))
      {
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         SymbolPrefixPtr = cptr;
         continue;
      }
      if (strsame (aptr, "/QUIETLY", 4))
      {
         ExitQuietly = STS$M_INHIB_MSG;
         continue;
      }
      if (strsame (aptr, "/NOQUIETLY", 4))
      {
         ExitQuietly = 0;
         continue;
      }
      if (strsame (aptr, "/RESPONSE=", 4))
      {
         DoResponse = true;
         DoCgiResponse = false;
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         CliResponsePtr = cptr;
         continue;
      }
      if (strsame (aptr, "/SPLIT=", 4))
      {
         DoSplitSymbol = true;
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
	 DelimChar[0] = cptr[0];
         continue;
      }
      if (strsame (aptr, "/SUBSTITUTE=", 4))
      {
         /* get this one by hand :^) */
         for (cptr = aptr; *cptr && *cptr != '='; cptr++);
         if (*cptr) cptr++;
         if (*cptr) ParamSubsChar = *cptr;
         continue;
      }
      if (strsame (aptr, "/SOFTWAREID", 4) ||
          strsame (aptr, "/VERSION", 4))
      {
         fprintf (stdout, "%%%s-I-SOFTWAREID, %s\n%s\n",
                  Utility, SoftwareID, CopyrightInfo);
         exit (SS$_NORMAL);
      }
      if (strsame (aptr, "/SYMBOLS=", 4))
      {
         DoCliSymbols = true;
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         while (*cptr)
         {
            if (*cptr == '(' || *cptr == ',' || *cptr == ')')
            {
               cptr++;
               continue;
            }
            if (strsame (cptr, "LINES", 4))
               DoCliSymbolsLines = true;
            else
            if (strsame (cptr, "NOCONTROL", 6))
               DoCliSymbolsNoControl = true;
            else
            {
               if (!ExitQuietly)
                  fprintf (stdout, "%%%s-E-IVKEYW, invalid keyword\n \\%s\\\n",
                           Utility, cptr);
               ExitCgiUtl (STS$K_ERROR, __LINE__);
            }
            while (*cptr && *cptr != ',') cptr++;
         }
         continue;
      }
      if (strsame (aptr, "/URLDECODE", 4))
      {
         DoUrlDecode = true;
         continue;
      }

      if (*aptr == '/')
      {
         if (!ExitQuietly)
            fprintf (stdout, "%%%s-E-IVQUAL, unrecognized qualifier\n \\%s\\\n",
                     Utility, aptr+1);
         ExitCgiUtl (STS$K_ERROR, __LINE__);
      }

      if (!CliParameterPtr)
      {
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         CliParameterPtr = aptr;
         continue;
      }

      if (!ExitQuietly)
         fprintf (stdout, "%%%s-E-MAXPARM, too many parameters\n \\%s\\\n",
                  Utility, aptr);
      ExitCgiUtl (STS$K_ERROR, __LINE__);
   }
}

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

GetParameters ()

{
   static char  CommandLine [256];
   static unsigned long  Flags = 0;

   int  status;
   unsigned short  Length;
   char  ch;
   char  *aptr, *cptr, *clptr, *sptr;
   $DESCRIPTOR (CommandLineDsc, CommandLine);

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

   if (Debug) fprintf (stdout, "GetParameters()\n");

   if (!(clptr = getenv ("CGIUTL$PARAM")))
   {
      /* get the entire command line following the verb */
      status = lib$get_foreign (&CommandLineDsc, 0, &Length, &Flags);
      if (VMSnok (status)) ExitCgiUtl (status, __LINE__);
      (clptr = CommandLine)[Length] = '\0';

      ProcessParameters(clptr) ;
   }
   else
   {
      char theLogicalName[32] ;
      int  i ;

      ProcessParameters(clptr) ;

      for (i = 1;;i++)
      {
	 sprintf(theLogicalName, "CGIUTL$PARAM_%d", i) ;
         clptr = getenv(theLogicalName) ;
	 if (!clptr)
	 {
	    return ;
	 }
	 ProcessParameters(clptr) ;
      }
   }
}

/*****************************************************************************/
/*
Get a string from the command-line.  It can be a qualifier specified string
(e.g. /QUALIFIER=<string>) or just a string supplied as a parameter.  If a
qualifier then it must have a string following the '=' otherwise a NULL is
returned.  If the string begins with the character specified by global variable
'ParamSubsChar' (which in turn can be specified by the /SUBSTITUTE= qualifier)
and the parameter string begins with this as the first character the remainder
of the string is used as a C-RTL getenv() function argument and it's value is
attempted to be resolved.  If it does not exist the function returns a NULL. 
If it does exist the a pointer to it's value is returned.  If the string does
not begin with the substitution character a pointer to it is returned.  The
substitution character may be escaped using a leading backslash.
*/

char* GetParameterString (char *aptr)

{
   char  *cptr;

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

   if (Debug)
      fprintf (stdout, "GetParameterString() %c |%s|\n", ParamSubsChar, aptr);

   if (!aptr) return (NULL);
   if (*aptr == '/')
   {
      for (cptr = aptr; *cptr && *cptr != '=' && !isspace(*cptr); cptr++);
      if (*cptr != '=') return (NULL);
      cptr++;
   }
   else
      cptr = aptr;
   if (*cptr == ParamSubsChar)
      cptr = getenv(cptr+1);
   else
   if (*cptr == '\\' && *(cptr+1) == ParamSubsChar)
      cptr++;

   if (Debug) fprintf (stdout, "|%s|\n", cptr ? cptr : "(null)");
   return (cptr);
}

/****************************************************************************/
/*
Does a case-insensitive, character-by-character string compare and returns 
true if two strings are the same, or false if not.  If a maximum number of 
characters are specified only those will be compared, if the entire strings 
should be compared then specify the number of characters as 0.
*/ 

boolean strsame
(
char *sptr1,
char *sptr2,
int  count
)
{
   /*********/
   /* begin */
   /*********/

   /** if (Debug) fprintf (stdout, "strsame() |%s|%s|\n", sptr1, sptr2); **/

   while (*sptr1 && *sptr2)
   {
      if (toupper (*sptr1++) != toupper (*sptr2++)) return (false);
      if (count)
         if (!--count) return (true);
   }
   if (*sptr1 || *sptr2)
      return (false);
   else
      return (true);
}

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

