/*****************************************************************************/
/*
                                 fetch.c

Provides a number of uses where accessing a remote HTTP or FTP resource is
necessary, including a quasi-proxy, server-up? checking, command-line
document/image inclusion from other servers during DCL script processing,
HEAD/GET method and HTTP 0.9/1.0 experimenting.

MUST be mapped as "/fetch" or it can't be used as a script.  This has been done
quite deliberately to make this functionality only available by deliberate act
of the server administrator. The reason should be obvious.  Want your server to
be acting as a client, getting any old page from any old server any old user
wants?

Why use QIOs instead of Berkeley-style sockets?  Well, this program is also
used as a vehicle for experimentation before functionality is included in the
HTTPd proper.


HTTP-PROXY
----------
This script can be used as a working (but non-caching) HTTP proxy.  The need
has diminished since proxy/caching became an integral function of WASD, but
this functionality may still be useful in some situations.  See also the
"Clayton's proxy" described below.  The default (no protocol specified) is an
HTTP request (can be modified using /FTP).

Rules required in HTTPD$MAP for acting as an agent of (script for) proxy:

  [[the.proxy.service:port]]
  redirect http://* /fetch/http://*
  pass /http://* 
  script+ /fetch/* /cgi-bin/fetch/*
  pass * "403 something's amiss!"


REVERSE-PROXY AGENT
-------------------
Fetch can assist with the provision of reverse-proxy services (access to
internal servers via an external-facing proxy server), particularly for
internal resources that insist on supplying full URLs in anchors.

  *** THE PROVIDING SERVICE DOES NOT NEED TO BE SET UP AS A PROXY! ***
          FETCH CAN DO ALL THE PROXY FUNCTIONALITY REQUIRED!!

In this sense the reverse-proxy service refered to can be a standard, non-proxy
HTTP service.  Though using suitable mapping rules it could perform as both.

Fetch can be used to replace selected host components or all host components
from the URLs in HTTP and FTP anchors and replace them with a host component
representing the reverse proxy server.  It also massages the request "Referer:"
field; the response "Location:" and "Content-Location:", fields; disables the
response "Content-Length:" field (as it intends to alter the content); and will
massage the DOMAIN= and PATH= components of a response cookie if it considers
it necessary.

To make all URLs refer to reverse-proxy-server use a mapping construct with a
asterisk parameter similar to the following example.

Rules required in HTTPD$MAP:

  [[the.reverse-proxy.service:port]]
  script+ /fetch/* /cgi-bin/fetch/* \
          map=once script=params=FETCH_REVERSE_PROXY=*
  redirect /* /fetch/http://the.internal.host/*?
  pass * "403 something's amiss!"

Note that the '?' in the redirect is required to propagate query-strings.

This will change the <A HREF="http://internal.server.name/path">anchor</A> and
<A HREF="http://another.host.name/path">anchor</A> in the
returned page both to <A HREF="http[s]://reverse.proxy.name/path">anchor</A>.

To selectively make all internal-server URLs refer to the reverse-rpoxy-server
use a '#' or specify the internal host name as the script parameter.

  script+ /fetch/* /cgi-bin/fetch/* \
          map=once script=params=FETCH_REVERSE_PROXY=#

This will change the <A HREF="http://internal.server.name/path">anchor</A>
returned page to <A HREF="http[s]://reverse.proxy.name/path">anchor</A> but the
anchor <A HREF="http://another.host.name/path">anchor</A> will remain
unmodified.

Rules required in HTTPD$AUTH if internal authorization is required:

  [[the.reverse-proxy.service:port]]
  if (authorization:%*)
     [EXTERNAL]
     * r+w
  endif

If it is necessary to differentiate multiple resources at the proxy-server end
it is possible to use a path prefix.  For instance, to access separate internal
sites /res1/ and /res2/ via a single reverse proxy service, perhaps

  https://the.reverse-proxy.service/res1/
  https://the.reverse-proxy.service/res2/

these could be mapped using an arrangement similar to

  [[the.reverse-proxy.service:port]]
  set /fetch/http://one.internal.host/* \
      script=params=(FETCH_REVERSE_PROXY="*",FETCH_REVERSE_PATH="/res1")
  set /fetch/http://two.internal.host/* \
      script=params=(FETCH_REVERSE_PROXY="#",FETCH_REVERSE_PATH="/res2")
  script+ /fetch/* /cgi-bin/fetch/* map=once
  redirect /res1/* /fetch/http://one.internal.host/*?
  redirect /res2/* /fetch/http://two.internal.host/*?
  pass * "403 something's amiss!"

where the FETCH=REVERSE=PATH=<string> provides the prepended path.  Note that
because of the two different path settings they can no longer be set on the
script mapping but must be differentiated prior to this.


FTP-PROXY
---------
This script can access FTP servers to provide a script-based FTP proxy access. 
As WASD does not yet support integrated FTP proxy this program provides this
functionality.

The (probable) file system of the FTP server host is determined by examining
the results of an FTP PWD command.  If it returns a current working directory
specification containing a "/" then it's assumes it to be Unix(-like), if ":["
then VMS, if a "\" then DOS.  Anything else is unknown and it tries to do it's
best with an uninterpreted listing.

Note that the content-type of the transfer is determined by the way the local
server interprets the FTP request path's "file" extension.  This may or may not
correspond with what the remote system might consider the file type to be.  The
default content-type for unknown files is "application/octet-stream" (binary). 
This can be changed using the /UNKNOWN= qualifier.  In addition, a directory
listing contains three links indicated by the italicised characters, "aid". 
These allow the user to specify the transfer mode, text ("a" for ASCII), binary
("i" for image) and "d" for directory listing (no RFC959 equivalent), for files
which content-type is not obvious to the software (see immediately below).

Supports the FTP URL ";type=a" (return document as plain text), ";type=i"
(return document as binary) and ";type=d" (return directory listing) modifiers.

By default icons from the proxy server system are used in directory listings. 
The path to directory.gif and file.gif files may be specified using the /ICONS=
qualifier (e.g. /ICON="/path/to/icons/"), or icons my be eliminated from
listings altogether with an empty icon path (e.g. /ICON="").

Also support the WASD extensions ";type=dos", ";type=unix", ";type=unknown" and
";type=vms" modifiers for adjusting the way the script interacts with the FTP
server, and ";type=debug" which for investigative purposes reveals the FTP
client-server dialog in progress.  The ";cwd=initial-directory" WASD extension
explicitly sets the directory before other commands, and so allows the request
to move to directories other than subdirectories of the account.

Rules required in HTTPD$MAP for acting as an agent of (script for) proxy:

  redirect ftp://* /fetch/ftp://*
  pass /ftp://* 
  script+ /fetch/* /cgi-bin/fetch/*

Ad hoc FTP commands may be sent to the FTP server by prefixing and separating
them with vertical bar characters ("|"), and supplying as the path.  This is
only intended for checking the characteristics of the target server, and cannot
create data connections transfering files, etc.  This example show server help
and status being requested.

  ftp://the.host.name/|help|stat

With FTP it is possible to include a username and password with the request. 

  ftp://username:password@the.host.name/pub/

If none are provided they defaults "anonymous" and "anonymous@hostname".


CLAYTON'S-HTTP-PROXY
--------------------
This script can act as a Clayton's proxy (for those not up with Australian
advertising folklore, Clayton's Kola-based mixer at one stage had a campaign
where, it being alcohol-free, was promoted to adults as "the drink you're
having when not having a drink").  This is the proxy you're having when you're
not having genuine proxy. 

When accessed via a URL such as

  http://local.host.name/fetch/~http://remote.host.name/path

it retrieves the remote resource, returning it to the client.  If the resource
is "text/html" it massages the links inside that page so that references are
also accessed via the quasi-proxy local server.  Note that the entire response
is retrieved (and stored dynamically) before returning to the client, so this
is probably not well suited to accessing very large resources.

Occasionally the browser confuses document-relative resources (for instance
graphics).  Adding another one or two '/' after the remote host name will
sometimes resolve this.

Rules required in HTTPD$MAP:

  script+ /fetch/* /cgi-bin/fetch/*
  pass /~http://*
  pass /~ftp://*


INCLUDING A RESPONSE IN OTHER SCRIPT OUTPUT
-------------------------------------------
This program can be used from within other scripts to fetch a document
from a server and display it as part of the script's output, in various
combinations of header, body, and plain-text, as well just check the document
exists.  Output can also be placed directly into a file.

When used in this way the program creates a local CLI symbol for the contents
of each response header field (line) named FETCH_field-name, plus one named
FETCH_STATUS with the response status (first) line.

These should be deleted using DELETE/SYMBOL/LOCAL/ALL before repeated use.

Requires a foreign verb to be assigned.

  $ FETCH="$HT_EXE:FETCH"

To fetch a document from some place:

  $ FETCH "http://the.host.name/path/to/file.html"

To fetch an HTML document displayed as it's plain-text source:

  $ FETCH /ESCAPE "http://the.host.name/path/to/file.html"

To fetch a request and show the complete response (header and body):

  $ FETCH /HEADER "http://the.host.name/path/to/file.html"

Just the request header:

  $ FETCH /HEADER /NOBODY "http://the.host.name/path/to/file.html"

To check whether a particular document is available (HEADs the document). Exits
with a success status is the request was successful, with no message and a
status STS$K_ERROR status if the server was accessable and the request was not
successful, other error status may be returned (e.g. if the server was not
accessable, etc.)

  $ FETCH /CHECK "http://the.host.name/path/to/file.html"

Request a document straight into a file.  FETCH always outputs the request
header, unless directed not to by the /NOHEADER qualifier.  Therefore when
wishing to store a copy of the request body (document, graphic, etc) it is
necessary to specifically suppress the header.

  $ FETCH /OUTPUT=file.html /NOHEAD "http://the.host.name/path/to/file.html"
  $ FETCH /OUTPUT=image.gif /NOHEAD "http://the.host.name/path/to/image.gif"
  $ FETCH /OUTPUT=prog.exe /NOHEAD "http://the.host.name/path/to/image.exe"

FTP services may also be accessed.  HTTP qualifiers, etc., that are not
applicable to FTP are ignored.

  $ FETCH /OUTPUT=file.html "http://the.host.name/path/to/file.html"
  $ FETCH /OUTPUT=image.gif "http://the.host.name/path/to/image.gif"
  $ FETCH /CHECK "http://the.host.name/path/to/file.html"


OTHER COMMAND LINE USE
----------------------
All fetch functionality is available from the command-line.  This makes it
possible to use from batch jobs, etc., to regularly retrieve resources from
the Web, check whether a particular server is (still) available, etc.  Just
supplying it as a parameter is  acceptable.  For example, checking for a
specific server being up:

  $ FETCH /CHECK "http://the.host.name/"
  $ FETCH /CHECK "ftp://the.host.name/"

The /CHECK qualifier produces no output.  It just exits with either a normal
or error status.  No message is generated.  It is up to any procedure to test
and act on that status.  Example procedural use:                        

   $ SET NOON
   $ FETCH = "$HT_EXE:FETCH"
   $ FETCH /CHECK *P1
   $ FETCH_$STATUS = $STATUS .AND. %XFFFFFFF
   $ SHOW SYMBOL FETCH_$STATUS
   $ EXIT FETCH_$STATUS

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.

   $ FETCH = "$HT_EXE:FETCH"
   $ FETCH /URL=*WWW_FORM_URL -
           /HEADER /NOBODY -
           /METHOD=*WWW_FORM_HTTP_METHOD -
           /VERSION=*WWW_FORM_HTTP_VERSION

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=.


QUALIFIERS
----------
Parameters and qualifiers may be supplied to this program via the command line
or via a defined logical or assigned DCL symbol named FETCH$PARAM.

/[NO]BODY       (do not) output the response body (default is BODY)
/CHECK          just check whether the document can be accessed
/CHUNK=         chunks of memory to allocate while reading response (Kbytes)
/[NO]ESCAPE     escape HTML-forbidden characters (<, > and &) (default NO)
/FTP            access via FTP protocol (used in absence of "ftp://...")
/[NO]HEADER     (do not) output full response header (default is NOHEADER)
/HTTP           access via HTTP protocol (used in absence of "http://...")
/ICONS=         path to directory with FTP dir.gif and file.gif icons
/METHOD=        HTTP method to be used, GET (default) or HEAD
/OUTPUT=        file name or "TERMINAL" or "SYS$OUTPUT"
/REPORT         report errors direct to the client using an HTML report
/REVERSE=       reverse proxy match string
/SUBSTITUTE=    specify the character for parameter substitution
/UNKNOWN=       fallback content-type for FTP transfer when file unknown
/URL=           same as first parameter
/USER_AGENT=    browser user-agent string used when making request
/VERSION        (no parameter) output FETCH software version
/VERSION=       make request using HTTP 0.9 or 1.0 (default)
/WATCH          watch the request and response


LOGICAL NAMES
-------------
FETCH$DBUG         turns on all "if (Debug)" statements
FETCH$DBUG_CGILIB  turns on CGILIB debug mode
FETCH$DBUG_FTP     displays FTP dialog
FETCH$PARAM        equivalent to (overrides) the command line
                   parameters/qualifiers
FETCH$WATCH        if defined as an IP address enables 'watch' mode for
                   that client IP address, if not an IP address just enables


BUILD_DETAILS
-------------
See BUILD_FETCH.COM


COPYRIGHT
---------
Copyright (C) 1998-2022 Mark G.Daniel

Licensed under the Apache License, Version 2.0 (the "License");
you may not use this file except in compliance with the License.
You may obtain a copy of the License at

    http://www.apache.org/licenses/LICENSE-2.0

Unless required by applicable law or agreed to in writing, software
distributed under the License is distributed on an "AS IS" BASIS,
WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
See the License for the specific language governing permissions and
limitations under the License.


VERSION HISTORY
---------------
18-MAR-2005  MGD  v1.9.0, reverse proxy link massaging,
                          enhanced 'watch' mode
23-DEC-2003  MGD  v1.8.1, minor conditional mods to support IA64
01-OCT-2002  MGD  v1.8.0, modify command-line parsing
08-JUN-2001  MGD  v1.7.1, modify /VERSION to provide software version
28-OCT-2000  MGD  v1.7.0, use CGILIB object module
15-SEP-2000  MGD  v1.6.0, refine handling of Unix symbolic links,
                          major refinements to FTP processing,
                          use IP-related system services more in-line
02-SEP-2000  MGD  v1.5.2, bugfix; FTP "PORT ..." command q&d IP address
                          octets sign shifted not unsigned shifted - mask!
15-JUL-2000  MGD  v1.5.1, bugfix; OpenConnection() host name resolution
08-JUL-2000  MGD  v1.5.0, add /WATCH, minor fixes
12-APR-2000  MGD  v1.4.0, improve command-line interface handling,
                          minor changes for CGILIB 1.4
30-OCT-1999  MGD  v1.3.0, remove NETLIB support,
                          add "Host:" request header line,
                          bugfix; 302 processing in MessageLinks()
09-MAY-1999  MGD  v1.2.0, use CGILIB.C,
                          add FTP protocol,
                          maintenance and refinement
21-JUN-1998  MGD  v1.1.0, revision of CgiVar()
07-MAR-1998  MGD  v1.0.0, initial
*/
/*****************************************************************************/

#define SOFTWAREVN "1.9.0"
#define SOFTWARENM "FETCH"
#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

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

/* VMS related header files */
#include <descrip.h>
#include <dvidef.h>
#include <iodef.h>
#include <lib$routines.h>
#include <libclidef.h>
#include <lnmdef.h>
#include <rms.h>
#include <ssdef.h>
#include <stsdef.h>
#include <starlet.h>

/* Internet-related header files */
#include <socket.h>
#include <in.h>
#include <netdb.h>
#include <inet.h>

/* define required values from UCX$INETDEF.H (Multinet does not supply one) */
#define INET_PROTYP$C_STREAM 1
#define INETACP$C_TRANS 2
#define INETACP_FUNC$C_GETHOSTBYNAME 1
#define INETACP_FUNC$C_GETHOSTBYADDR 2
#define UCX$C_AF_INET 2
#define UCX$C_DSC_ALL 2
#define UCX$C_FULL_DUPLEX_CLOSE 8192
#define UCX$C_REUSEADDR 4
#define UCX$C_SOCK_NAME 4
#define UCX$C_SOCKOPT 1
#define UCX$C_TCP 6

/* application related header file */
#include "cgilib.h"

#define BOOL int
#define true 1
#define false 0

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

#define FI_LI __FILE__, __LINE__

#define DEFAULT_BUFFER_CHUNK 32
#define DEFAULT_FTP_CONTENT_TYPE "application/octet-stream"
#define DEFAULT_ICON_PATH "/httpd/-/"
#define DEFAULT_PARAM_SUBS_CHAR '*'
#define DEFAULT_PROXY_SCRIPT_NAME "/fetch"

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

char  CopyrightInfo [] =
"Copyright (C) 1998-2005 Mark G.Daniel.\n\
This software comes with ABSOLUTELY NO WARRANTY.\n\
This is free software, and you are welcome to redistribute it\n\
under the conditions of the GNU GENERAL PUBLIC LICENSE, version 2.";

char  Utility [] = "FETCH";

BOOL  CgiLibDebug,
      Debug,
      DoCheckOnly,
      DoEscapeHtml,
      DoFtp,
      DoMassageLinks,
      DoReport,
      DoResponseBody,
      DoResponseHeader,
      FetchDebugFtp,
      IsCgiPlus,
      IsFetchScript,
      WatchEnabled;

int  BufferChunk,
     BufferCount,
     BufferRemaining,
     BufferSize,
     CgiScriptNameLength,
     FetchPrefixLength,
     RemoteHostPortLength,
     RemotePort,
     RequestHttpVersion,
     ResponseHttpVersion,
     ReverseProxyLength;

char  *BufferPtr,
      *BufferCurrentPtr,
      *CgiContentTypePtr,
      *CgiLibEnvironmentPtr,
      *CgiQueryStringPtr,
      *CgiRequestSchemePtr,
      *CgiRequestMethodPtr,
      *CgiScriptNamePtr,
      *CgiServerNamePtr,
      *CgiServerPortPtr,
      *CgiServerSoftwarePtr,
      *CliHttpMethodPtr,
      *FetchScriptNamePtr,
      *FetchUrlPtr,
      *FtpDefaultContentTypePtr = DEFAULT_FTP_CONTENT_TYPE,
      *HttpMethodPtr,
      *IconPathPtr = DEFAULT_ICON_PATH,
      *OutputPtr,
      *ReversePathPtr,
      *ReverseProxyPtr,
      *UserAgentPtr;

struct HttpEnvironmentStruct
{
   char  *field,
         *cgi;
}
/* those commented out should be commented-out for a reason :-) */
HttpEnvironment [] =
{
   { "Accept: ",          "HTTP_ACCEPT" },
   { "Accept-Charset: ",  "HTTP_ACCEPT_CHARSET" },
   /** { "Accept-Encoding: ", "HTTP_ACCEPT_ENCODING" }, **/
   { "Accept-Language: ", "HTTP_ACCEPT_LANGUAGE" },
   { "Authorization: ",   "HTTP_AUTHORIZATION" },
   /** { "Cache-Control: ",   "HTTP_CACHE_CONTROL" }, **/
   /** { "Connection: ",      "HTTP_CONNECTION" }, **/
   /** { "Content-Length: ",  "HTTP_CONTENT_LENGTH" }, **/
   /* not 'HTTP_' to be backward-compatible with pre-9.0 WASD */
   { "Content-Type: ",    "CONTENT_TYPE" },
   { "Cookie: ",          "HTTP_COOKIE" },
   /** { "Forwarded: ",       "HTTP_FORWARDED" }, **/
   /** { "Host: ",            "HTTP_HOST" }, **/
   { "If-Match: ",        "HTTP_IF_MATCH" },
   { "If-None-Match: ",   "HTTP_IF_NONE_MATCH" },
   { "If-Modified-Since: ", "HTTP_IF_MODIFIED_SINCE" },
   { "If-Unmodified-Since: ", "HTTP_IF_UNMODIFIED_SINCE" },
   { "If-Range: ",        "HTTP_IF_RANGE" },
   /** { "Pragma: ",          "HTTP_PRAGMA" }, **/
   { "Range: ",           "HTTP_RANGE" },
   /** { "Referer: ",         "HTTP_REFERER" }, **/
   { "Trailer: ",         "HTTP_TRAILER" },
   /** { "Transfer-Encoding: ", "HTTP_TRANSFER_ENCODING" }, **/
   /** { "User-Agent: ",      "HTTP_USER_AGENT" }, **/
   /** { "X-Forwarded-For: ", "HTTP_X_FORWARDED_FOR" }, **/
   { NULL, NULL }
};

char  ParamSubsChar = DEFAULT_PARAM_SUBS_CHAR;

char  FetchPrefix [256],
      FetchUrlBuffer [1024],
      FtpIconDirImg [256],
      FtpIconFileImg [256],
      LocalHostPort [256],
      MassageLinksPath [256],
      RemoteHost [256],
      RemoteHostPort [256],
      RequestHeader [4096],
      RequestPath [1024],
      RequestScheme [64],
      ResponseContentType [256],
      ReverseProxyPrefix [256],
      SoftwareId [96];

struct AnIOsb {
   unsigned short  Status;
   unsigned short  Count;
   unsigned long  Unused;
}  IOsb;

#define CGIVAR(p,n) \
{ p = CgiLibVar(n); \
if (WatchEnabled) WatchThis ("CGIVAR !AZ=!AZ",n,p); }

#define CGIVARNULL(p,n) \
{ p = CgiLibVarNull(n); \
if (WatchEnabled) WatchThis ("CGIVAR !AZ=!AZ",n,p?p:"(null)"); }

$DESCRIPTOR (InetDeviceDsc, "UCX$DEVICE");

unsigned short  RemoteChannel;

int  OptionEnabled = 1;

struct {
   unsigned short  Length;
   unsigned short  Parameter;
   void  *Address;
} ReuseAddress =
   { sizeof(OptionEnabled), UCX$C_REUSEADDR, &OptionEnabled },
  ReuseAddressSocketOption =
   { sizeof(ReuseAddress), UCX$C_SOCKOPT, &ReuseAddress };

unsigned short  TcpSocket [3] =
   { UCX$C_TCP, INET_PROTYP$C_STREAM, UCX$C_AF_INET };

/* these 3 strings may be changed to a desired language */

char  FtpCurrentDirectory [] = "Current directory is";

char  FtpFilesDirectories [] =
"<FONT SIZE=-1><I>\n\
<P>Files: %d\n\
<BR>Directories: %d\n\
%s\
</I></FONT>\n";

char  FtpGetAs [] =
"<BR>a ... get as text\n\
<BR>i ... as binary\n\
<BR>d ... as directory\n";

/* required prototypes */

char* FetchFtpResponse ();
char* FetchHttpResponse ();
char* FtpCommand (BOOL, unsigned short, char*, ...);
char* FtpReply (unsigned short);
char* GetParameterString (char*);
char* TrnLnm (char*, char*, int);
int ReadConnection (unsigned short, char*, int, int*, BOOL);
char* ReplyVmsError (int);
int WriteConnection (unsigned short, char*, int);
int WatchDump (char*, int);
int WatchThis (char*, ...);

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

main
(
int argc,
char *argv[]
)
{
   int  status;
   char  *cptr;

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

   sprintf (SoftwareId, "%s, %s", SOFTWAREID, CgiLibEnvironmentVersion());

   FetchScriptNamePtr = DEFAULT_PROXY_SCRIPT_NAME;
   HttpMethodPtr = "GET";
   RequestHttpVersion = 10;
   OutputPtr = "";
   DoResponseBody = DoResponseHeader = true;
   DoEscapeHtml = DoFtp = DoReport = false;

   if (TrnLnm ("FETCH$DBUG", NULL, 0)) Debug = true;
   if (TrnLnm ("FETCH$DBUG_CGILIB", NULL, 0)) CgiLibDebug = true;

   GetParameters ();

   if (CliHttpMethodPtr) HttpMethodPtr = CliHttpMethodPtr;
   if (!HttpMethodPtr[0]) HttpMethodPtr = "GET";

   if (RequestHttpVersion != 9 && RequestHttpVersion != 10)
   {
      fprintf (stdout, "%%%s-E-VERSION, must be 0.9 or 1.0\n", Utility);
      exit (STS$K_ERROR | STS$M_INHIB_MSG);
   }

   /***********/
   /* process */
   /***********/

   CgiLibEnvironmentInit (argc, argv, false);
   CgiLibEnvironmentSetDebug (Debug);

   CgiLibResponseSetSoftwareID (SoftwareId);
   CgiLibResponseSetErrorStatus (502);
   CgiLibResponseSetErrorMessage ("Reported by Proxy Agent");

   IsCgiPlus = CgiLibEnvironmentIsCgiPlus ();

   if (IsCgiPlus)
   {
      for (;;)
      {
         if (Debug) fprintf (stdout,
"Content-Type: text/plain\nScript-Control: X-content-encoding-gzip=0\n\n");
         /* block waiting for the next request */
         CgiLibVar ("");
         ProcessRequest ();
         CgiLibCgiPlusEOF ();
         CgiQueryStringPtr = FetchUrlPtr = NULL;
      }
   }
   else
      ProcessRequest ();

   exit (SS$_NORMAL);
}

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

ProcessRequest ()

{
   int  StatusValue;
   char  *cptr, *sptr;

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

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

   if (cptr = TrnLnm ("FETCH$WATCH", NULL, 0))
   {
      if (Debug) fprintf (stdout, "FETCH$WATCH |%s|\n", cptr);
      WatchEnabled = 1;
      if (isdigit(*cptr))
      {
         /* if it doesn't match the remote address then disable again */
         if (!(sptr = CgiVar ("REMOTE_ADDR"))) sptr = "";
         if (strcmp (cptr, sptr)) WatchEnabled = 0;
      }
   }

   if (Debug) WatchEnabled = 1;

   if (WatchEnabled)
   {
      /* initialize watch mode */
      WatchThis (NULL);
      if (CgiLibVarNull ("SCRIPT_RTE"))
         cptr = "RTE";
      else
      if (IsCgiPlus)
         cptr = "CGIplus";
      else
         cptr = "CGI";
      WatchThis ("BEGIN !AZ; !AZ", cptr, SoftwareId);
   }

   CgiLibEnvironmentPtr = CgiLibEnvironmentName();

   CGIVAR (CgiScriptNamePtr, "WWW_SCRIPT_NAME");
   CgiScriptNameLength = strlen(CgiScriptNamePtr);
   if (CgiScriptNamePtr[0] && !FetchUrlPtr)
   {
      if (!strsame (CgiScriptNamePtr, FetchScriptNamePtr, -1))
      {
         fprintf (stdout, "%%%s-E-SCRIPT, must be mapped to \"%s\"\n",
                  Utility, FetchScriptNamePtr);
         exit (STS$K_ERROR | STS$M_INHIB_MSG);
      }
      IsFetchScript = true;
   }
   else
      IsFetchScript = false;

   CGIVAR (CgiRequestSchemePtr, "WWW_REQUEST_SCHEME");
   CGIVAR (CgiRequestMethodPtr, "WWW_REQUEST_METHOD");
   CGIVAR (CgiServerNamePtr, "WWW_SERVER_NAME");
   CGIVAR (CgiServerPortPtr, "WWW_SERVER_PORT");
   CGIVAR (CgiServerSoftwarePtr, "WWW_SERVER_SOFTWARE");
   CGIVAR (CgiQueryStringPtr, "WWW_QUERY_STRING");
   CGIVAR (UserAgentPtr, "WWW_HTTP_USER_AGENT");
   if (!UserAgentPtr[0]) UserAgentPtr = SoftwareId;

   /* e.g. created with a 'set * script=param=FETCH_REVERSE_PROXY=*' */
   CGIVARNULL (ReverseProxyPtr, "FETCH_REVERSE_PROXY");
   if (ReverseProxyPtr) ReverseProxyLength = strlen(ReverseProxyPtr);

   /* e.g. created with a 'set * script=param=FETCH_REVERSE_PATH=/whatever' */
   CGIVAR (ReversePathPtr, "FETCH_REVERSE_PATH");

   /* URL not supplied on command line, get it from the script path */
   if (!FetchUrlPtr)
   {
      CGIVAR (FetchUrlPtr, "WWW_PATH_INFO");
      FetchUrlPtr++;
   }

   if (!FetchUrlPtr)
   {
      fprintf (stdout, "%%%s-E-URL, no URL supplied\n", Utility);
      exit (STS$K_ERROR | STS$M_INHIB_MSG);
   }

   /* buffer in case the following code distorts the original URL */
   strcpy (FetchUrlBuffer, FetchUrlPtr);

   /* pages with massaged links will have the circumflex before the protocol */
   if (!memcmp (FetchUrlPtr, "~http://", 8) ||
       !memcmp (FetchUrlPtr, "~ftp://", 7))
   {
      /* step over the circumflex */
      FetchUrlPtr++;
      DoMassageLinks = true;
   }
   else
   if (ReverseProxyPtr)
      DoMassageLinks = true;
   else
      DoMassageLinks = false;

   /* the leading '_' is just a contrivance to allow easier HTTPd mapping */
   if (!memcmp (FetchUrlPtr, "_http://", 8) ||
       !memcmp (FetchUrlPtr, "_ftp://", 7))
   {
      /* step over the underscore */
      FetchUrlPtr++;
   }

   if (DoFtp || !memcmp (FetchUrlPtr, "ftp://", 6))
   {
      /***************/
      /* FTP request */
      /***************/

      cptr = FetchFtpResponse ();
      SetLocalSymbol ("FETCH_RESPONSE", cptr);

      if (*cptr != '2')
      {
         if (IsFetchScript || DoReport)
         {
            if (!memcmp (cptr, "599", 3))
               CgiLibResponseError (FI_LI, 0, "<!-- %10.10s --> %s",
                                    cptr+4, cptr+14);
            else
               CgiLibResponseError (FI_LI, 0, "%s", cptr);
         }
         else
         {
            if (!memcmp (cptr, "599", 3))
               sscanf (cptr+6, "%x", &StatusValue);
            else
               StatusValue = STS$K_ERROR;
            exit (StatusValue | (WatchEnabled ? 0 : STS$M_INHIB_MSG));
         }
      }
   }
   else
   {
      /****************/
      /* HTTP request */
      /****************/

      if (DoCheckOnly)
         HttpMethodPtr = "HEAD";
      else
      if (CliHttpMethodPtr)
         HttpMethodPtr = CliHttpMethodPtr;
      else
      if (CgiRequestMethodPtr[0])
      {
         HttpMethodPtr = CgiRequestMethodPtr;
         if (strcmp (HttpMethodPtr, "GET") &&
             strcmp (HttpMethodPtr, "HEAD") &&
             strcmp (HttpMethodPtr, "POST"))
         {
            CgiLibResponseError (FI_LI, 0, "HTTP method %s not supported",
                                 HttpMethodPtr);
            return;
         }
      }
      else
         HttpMethodPtr = "GET";

      cptr = FetchHttpResponse ();
      SetLocalSymbol ("FETCH_RESPONSE", cptr);

      if (*cptr == '2')
      {
         if (DoCheckOnly)
         {
            if (!(cptr = BufferPtr))
               exit (STS$K_ERROR | STS$M_INHIB_MSG);

            if (Debug) fprintf (stdout, "|%s|\n", BufferPtr);
            /* this just creates the informational symbols */
            ProcessHttpResponse ();

            /* check the response status code for success */
            while (*cptr && !isspace(*cptr)) cptr++;
            while (*cptr && isspace(*cptr)) cptr++;
            if (*cptr == '2') exit (SS$_NORMAL);

            if (!memcmp (cptr, "599", 3))
               sscanf (cptr+6, "%x", &StatusValue);
            else
               StatusValue = 0;
            exit (StatusValue | (WatchEnabled ? 0 : STS$M_INHIB_MSG));
         }

         /* HTTP response is being written to a file */
         if (*OutputPtr)
            if (!(stdout = freopen (OutputPtr, "w", stdout)))
               exit (vaxc$errno);

         if (DoMassageLinks)
            MassageLinks ();
         else
            ProcessHttpResponse ();
      }
      else
      if (!memcmp (cptr, "302", 3))
         exit (SS$_NORMAL);
      else
      {
         if (IsFetchScript || DoReport)
         {
            if (!memcmp (cptr, "599", 3))
               CgiLibResponseError (FI_LI, 0, "<!-- %10.10s --> %s",
                                    cptr+4, cptr+14);
            else
               CgiLibResponseError (FI_LI, 0, "%s", cptr);
         }
         else
         {
            if (!memcmp (cptr, "599", 3))
               sscanf (cptr+6, "%x", &StatusValue);
            else
               StatusValue = STS$K_ERROR;
            exit (StatusValue | (WatchEnabled ? 0 : STS$M_INHIB_MSG));
         }
      }
   }

   /* reset watch mode as necessary */
   if (WatchEnabled) WatchThis (NULL);
}

/****************************************************************************/
/*
Determine the host name and port and then create a request to send to it. 
Connect and send that request, reading the complete response into a buffer of
dynamically allocated memory.
*/

char* FetchHttpResponse ()

{
   static char  HexDigits [] = "0123456789ABCDEF";

   int  idx, status,
        BodyLength,
        LocalPort,
        ReadCount;
   unsigned short  RemoteChannel;
   unsigned char  ch;
   char  *cptr, *hptr, *sptr,
         *BodyPtr;
   char  LocalHost [128];

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

   if (!FetchUrlPtr[0]) return ("599 %x00038268");

   RequestHeader[0] = RemoteHost[0] = '\0';

   hptr = RequestHeader;
   for (cptr = HttpMethodPtr; *cptr; *hptr++ = *cptr++);
   *hptr++ = ' ';

   cptr = FetchUrlPtr;
   if (strsame (cptr, "http://", 7)) cptr += 7;

   if (*CgiServerNamePtr)
      strcpy (LocalHost, CgiServerNamePtr);
   else
      gethostname (LocalHost, sizeof(LocalHost));
   if (*CgiServerPortPtr)
      LocalPort = atoi(CgiServerPortPtr);
   else
      LocalPort = 80;
   if (LocalPort == 80 || LocalPort == 443)
      strcpy (LocalHostPort, LocalHost);
   else
      sprintf (LocalHostPort, "%s:%d", LocalHost, LocalPort);
   if (Debug) fprintf (stdout, "LocalHostPort |%s|\n", LocalHostPort);

   if (*cptr == '/')
   {
      strcpy (RemoteHost, LocalHost);
      RemotePort = LocalPort;
      strcpy (RemoteHostPort, LocalHostPort);
   }
   else
   {
      /* get host and optional port */
      sptr = RemoteHost;
      while (*cptr && *cptr != '/' && *cptr != ':')
          *sptr++ = *cptr++;
      *sptr = '\0';
      if (*cptr == ':')
      {
         cptr++;
         RemotePort = atoi(cptr);
         if (!RemotePort) RemotePort = 80;
         while (*cptr && *cptr != '/') cptr++;
      }
      else
         RemotePort = 80;

      if (RemotePort == 80)
         strcpy (RemoteHostPort, RemoteHost);
      else
         sprintf (RemoteHostPort, "%s:%d", RemoteHost, RemotePort);
   }
   RemoteHostPortLength = strlen(RemoteHostPort);

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

   if (DoMassageLinks)
   {
      sprintf (FetchPrefix, "%s//%s%s/~",
               CgiRequestSchemePtr, LocalHostPort, CgiScriptNamePtr);
      sprintf (MassageLinksPath, "%s/~", CgiScriptNamePtr);
      sprintf (ReverseProxyPrefix, "%s//%s%s",
               CgiRequestSchemePtr, LocalHostPort, ReversePathPtr);
   }
   else
      FetchPrefix[0] = MassageLinksPath[0] = ReverseProxyPrefix[0] = '\0';

   if (IsFetchScript && *cptr != '/')
   {
      /* no path (i.e. "http://remote.host.name") which can break links */
      fprintf (stdout,
"HTTP/1.0 302 Moved temporarily\r\n\
Location: %s%s/\r\n\
\r\n",
         FetchPrefix, FetchUrlPtr);
      return ("302 Redirection!");
   }

   if (!strcmp (CgiRequestMethodPtr, "POST"))
   {
      if (!CgiLibReadRequestBody (&BodyPtr, &BodyLength))
      {
         CgiLibResponseError (FI_LI, 0, "Could not read request body.");
         return ("502 Could not read request body.");
      }
      if (WatchEnabled)
      {
         WatchThis ("POST !UL", BodyLength);
         WatchDump (BodyPtr, BodyLength);
      }
   }

   /* rest of the path, which is actually the desired request path */
   sptr = RequestPath;

   if (!*cptr) *hptr++ = *sptr++ = '/';

   /* escape any URL forbidden characters in the path */
   while (ch = *cptr)
   {
      if (iscntrl(ch) || isspace(ch))
      {
         *hptr++ = *sptr++ = '%';
         *hptr++ = *sptr++ = HexDigits[ch >> 4];
         *hptr++ = *sptr++ = HexDigits[ch & 0x0f];
         cptr++;
      }
      else
         *hptr++ = *sptr++ = *cptr++;
   }

   /* any non-command-line query string */
   if (IsFetchScript && (cptr = CgiQueryStringPtr))
   {
      if (*cptr)
      {
         if (*cptr) *hptr++ = *sptr++ = '?';
         while (*cptr) *hptr++ = *sptr++ = *cptr++;
      }
   }

   /* terminate the request path */
   *sptr = '\0';

   if (RequestHttpVersion == 9)
   {
      /* end of request line */
      *hptr++ = '\r';
      *hptr++ = '\n';
   }
   else
   {
      /* add the HTTP protocol to the request */
      for (cptr = " HTTP/1.0\r\n"; *cptr; *hptr++ = *cptr++);

      /* fudge the "Host:" request field */
      for (sptr = "Host: "; *sptr; *hptr++ = *sptr++);
      cptr = RemoteHostPort;
      while (*cptr) *hptr++ = *cptr++;
      *hptr++ = '\r';
      *hptr++ = '\n';

      cptr = CgiLibVarNull("WWW_HTTP_REFERER");

      if (cptr && ReverseProxyPtr)
      {
         /* if it referes to the proxy server then replace with proxied-to */
         if (strstr (cptr, CgiLibVar("WWW_HTTP_HOST")))
         {
            for (sptr = "Referer: http://"; *sptr; *hptr++ = *sptr++);
            for (sptr = RemoteHostPort; *sptr; *hptr++ = *sptr++);
            /* skip over the scheme and host components */
            while (*cptr && *cptr != '/') cptr++;
            while (*cptr && *cptr == '/') cptr++;
            while (*cptr && *cptr != '/') cptr++;
         }
         else
            for (sptr = "Referer: "; *sptr; *hptr++ = *sptr++);
         while (*cptr) *hptr++ = *cptr++;
         *hptr++ = '\r';
         *hptr++ = '\n';
      }
      else
      if (cptr)
      {
         sptr = cptr;
         if (!memcmp (sptr, "http://", 7))
         {
            sptr += 7;
            while (*sptr && *sptr != '/') sptr++;
            if (!memcmp (sptr, CgiScriptNamePtr, CgiScriptNameLength))
            {
               sptr += CgiScriptNameLength;
               if (*sptr == '/') cptr = sptr + 1;
               if (Debug) fprintf (stdout, "Referer |%s|\n", cptr);
            }
         }
         for (sptr = "Referer: "; *sptr; *hptr++ = *sptr++);
         while (*cptr) *hptr++ = *cptr++;
         *hptr++ = '\r';
         *hptr++ = '\n';
      }

      if (!UserAgentPtr) UserAgentPtr = CgiLibVarNull ("HTTP_USER_AGENT");
      if ((cptr = UserAgentPtr))
      {
         for (sptr = "User-Agent: "; *sptr; *hptr++ = *sptr++);
         while (*cptr) *hptr++ = *cptr++;
         *hptr++ = '\r';
         *hptr++ = '\n';
      }

      if (!strcmp (CgiRequestMethodPtr, "POST"))
         hptr += sprintf (hptr, "Content-Length: %d\r\n", BodyLength);

      for (idx = 0; HttpEnvironment[idx].cgi; idx++)
      {
         if (!(cptr = CgiLibVarNull(HttpEnvironment[idx].cgi))) continue;
         for (sptr = HttpEnvironment[idx].field; *sptr; *hptr++ = *sptr++);
         while (*cptr) *hptr++ = *cptr++;
         *hptr++ = '\r';
         *hptr++ = '\n';
      }

      /* end of request header blank line */
      *hptr++ = '\r';
      *hptr++ = '\n';
   }

   /* terminate the request header */
   *hptr = '\0';

   if (hptr > RequestHeader + sizeof(RequestHeader)) exit (SS$_BUGCHECK);

   if (WatchEnabled) WatchThis ("HTTP\n!AZ", RequestHeader);

   /*******************/
   /* open connection */
   /*******************/

   status = OpenConnection (&RemoteChannel, RemoteHost, RemotePort, NULL);
   if (VMSnok (status)) return (ReplyVmsError (status));

   /****************/
   /* send request */
   /****************/

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

   status = WriteConnection (RemoteChannel, RequestHeader, -1);
   if (VMSnok (status)) return (ReplyVmsError (status));

   if (!strcmp (CgiRequestMethodPtr, "POST"))
   {
      status = WriteConnection (RemoteChannel, BodyPtr, BodyLength);
      if (VMSnok (status)) return (ReplyVmsError (status));
   }

   /*********************/
   /* read the response */
   /*********************/

   if (BufferChunk <= 0) BufferChunk = DEFAULT_BUFFER_CHUNK;

   /* with CGIplus 'BufferPtr'/'BufferSize' may still have memory allocated */
   BufferCount = 0;
   BufferRemaining = BufferSize;
   BufferCurrentPtr = BufferPtr;

   for (;;)
   {
      if (BufferCount == BufferSize)
      {
         BufferSize += (BufferRemaining = (BufferChunk << 10));
         if (!(BufferPtr = realloc (BufferPtr, BufferSize+1)))
            exit (vaxc$errno);
         BufferCurrentPtr = BufferPtr + BufferSize - BufferRemaining;
      }

      ReadCount = BufferRemaining <= 32767 ? BufferRemaining : 32767,
      status = ReadConnection (RemoteChannel, BufferCurrentPtr, ReadCount,
                               &ReadCount, false);
      if (VMSnok (status)) break;

      BufferCount += ReadCount;
      BufferCurrentPtr += ReadCount;
      BufferRemaining -= ReadCount;

      if (Debug)
         fprintf (stdout, "Remaining: %d Count: %d\n",
                  BufferRemaining, BufferCount);
   }

   /****************/
   /* close socket */
   /****************/

   if (status == SS$_LINKDISCON) status = SS$_NORMAL;

   sys$dassgn (RemoteChannel);

   return ("200 OK!");
}

/****************************************************************************/
/*
Output the response.  Can output only the header, only the body, both, and
also escape the HTML-forbidden characters "<", ">", and "&" so an HTML file
can be presented as plain text inside another HTML document.
*/

ProcessHttpResponse ()

{
   int  cnt;
   char  *bptr, *cptr, *sptr;
   char  SymbolName [256],
         SymbolValue [1024];

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

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

   ResponseContentType[0] = '\0';

   if (!(cptr = BufferPtr)) return;
   if (!(cnt = BufferCount)) return;

   if (memcmp (cptr, "HTTP/", 5) ||
       !isdigit(cptr[5]) ||
       cptr[6] != '.' ||
       !isdigit(cptr[7]))
      ResponseHttpVersion = 9;
   else
      ResponseHttpVersion = 10;

   if (ResponseHttpVersion == 9)
   {
      /* HTTP/0.9 only ever returned HTML! */
      strcpy (ResponseContentType, "text/html");
   }
   else
   {
      /* process the response header */
      while (cnt)
      {
         /* create a symbol representing the response header line */
         sptr = SymbolName;
         for (bptr = "FETCH_"; *bptr; *sptr++ = *bptr++);
         if (!memcmp (cptr, "HTTP/", 5))
         {
            for (bptr = "STATUS"; *bptr; *sptr++ = *bptr++);
            *sptr = '\0';
            bptr = cptr;
         }
         else
         {
            for (bptr = cptr;
                 *bptr && *bptr != ':' &&
                    *bptr != ' ' && *bptr != '\t' &&
                    *bptr != '\r' && *bptr != '\n';
                 bptr++)
            {
               if (!isalnum(*bptr))
                  *sptr++ = '_';
               else
                  *sptr++ = *bptr;
            }
            *sptr = '\0';
         }
         if (*bptr == ':') bptr++;
         while (*bptr && (*bptr == ' ' || *bptr == '\t')) bptr++;
         sptr = SymbolValue;
         while (*bptr && *bptr != '\r' && *bptr != '\n')
            *sptr++ = *bptr++;
         *sptr = '\0';
         SetLocalSymbol (SymbolName, SymbolValue);

         if (toupper (cptr[0]) == 'C' &&
             strsame (cptr, "Content-Type:", 13))
         {
            cptr += 13;
            cnt -= 13;
            while (cnt && isspace(*cptr))
            {
               cptr++;
               cnt--;
            }
            sptr = ResponseContentType;
            while (cnt && *cptr != '\r' && *cptr != '\n')
            {
               *sptr++ = *cptr++;
               cnt--;
            }
            *sptr = '\0';
         }

         /* skip to end-of-line */
         while (cnt && *cptr != '\r' && *cptr != '\n')
         {
            cptr++;
            cnt--;
         }
         if (cnt && *cptr == '\r')
         {
            cptr++;
            cnt--;
         }
         if (cnt && *cptr == '\n')
         {
            cptr++;
            cnt--;
         }

         /* break if end of request header */
         if (cnt && *cptr == '\n')
         {
            cptr++;
            cnt--;
            break;
         }
         if (cnt >= 2 && cptr[0] == '\r' && cptr[1] == '\n')
         {
            cptr += 2;
            cnt -= 2;
            break;
         }
      }
   }

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

   if (DoCheckOnly) return;

   if (DoResponseHeader)
   {
      if (Debug) fprintf (stdout, "DoResponseHeader\n");
      if (cptr > BufferPtr)
         fwrite (BufferPtr, cptr-BufferPtr, 1, stdout);
   }

   if (DoResponseBody)
   {
      if (Debug) fprintf (stdout, "DoResponseBody\n");

      if (DoEscapeHtml)
      {
         cptr = (char*)CgiLibHtmlEscape (cptr, cnt, NULL, 0);
         cnt = strlen (cptr);
         fwrite (cptr, cnt, 1, stdout);
      }
      else
      if (cnt)
      {
         /* write response as-is */
         fwrite (cptr, cnt, 1, stdout);
      }
   }
}

/****************************************************************************/
/*
Fetch a response (directory listing or file) using the FTP protocol.
*/

char* FetchFtpResponse ()

{
   BOOL IsDirList,
        IsDosFileSystem,
        IsTypeAscii,
        IsUnixFileSystem,
        IsVmsFileSystem,
        IsUnknownFileSystem;
   int  status,
        ListenPort,
        LocalPort,
        IpAddress,
        ReadCount,
        ReturnLength;
   unsigned short  DataChannel,
                   FtpChannel,
                   ListenChannel;
   char  ch;
   char  *cptr, *sptr,
         *FileSystemPtr,
         *RemotePassPtr;
   char  Buffer [4096],
         CwdFtpDirectory [256],
         CwdFtpDirEncoded [256],
         FtpDirectory [256],
         FtpFile [256],
         FtpGreetingEscaped [256],
         FtpPwdEscaped [256],
         FtpStatEscaped [256],
         FtpSystemEscaped [256],
         LocalHost [128],
         RemotePass [256],
         RemoteUser [256],
         RemoteUserPass [256],
         RemoteUserPassEncoded [256],
         RequestPathEncoded [256],
         RequestPathEscaped [256],
         Scratch [1024];
   struct AnIOsb  IOsb;
   struct sockaddr_in  SocketName;
   struct {
      unsigned long  Length;
      void  *Address;
      int  *LengthPtr;
   } SocketNameItem =
      { sizeof(SocketName), &SocketName, &ReturnLength };

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

   if (WatchEnabled) WatchThis ("FTP !AZ", FetchUrlPtr);

   if (WatchEnabled)
      FetchDebugFtp = true;
   else
   if (!TrnLnm ("FETCH$DBUG_FTP", NULL, 0))
      FetchDebugFtp = false;
   else
   {
      FetchDebugFtp = true;
      fprintf (stdout,
"HTTP/1.0 200 Success\n\
Content-Type: text/plain\n\
Script-Control: X-content-encoding-gzip=0\n\
\n");
   }

   CgiContentTypePtr = CgiLibVar ("WWW_CONTENT_TYPE");
   if (!CgiContentTypePtr[0])
      CgiContentTypePtr = FtpDefaultContentTypePtr;
   else
   if (!strcmp (CgiContentTypePtr, "x-internal/unknown"))
      CgiContentTypePtr = FtpDefaultContentTypePtr;

   RemotePassPtr = NULL;
   RemoteHost[0] = RemoteUser[0] =
      RemoteUserPass[0] = RemoteUserPassEncoded[0] = '\0';

   if (strsame (FetchUrlPtr, "/ftp://", 7)) FetchUrlPtr++;
   cptr = FetchUrlPtr;
   if (strsame (cptr, "ftp://", 6)) cptr += 6;

   if (*CgiServerNamePtr)
      strcpy (LocalHost, CgiServerNamePtr);
   else
      strcpy (LocalHost, "localhost");
   if (*CgiServerPortPtr)
      LocalPort = atoi(CgiServerPortPtr);
   else
      LocalPort = 21;
   if (LocalPort == 21)
      strcpy (LocalHostPort, LocalHost);
   else
      sprintf (LocalHostPort, "%s:%d", LocalHost, LocalPort);
   if (Debug) fprintf (stdout, "LocalHostPort |%s|\n", LocalHostPort);

   if (*cptr == '/')
   {
      strcpy (RemoteHost, LocalHost);
      RemotePort = LocalPort;
      strcpy (RemoteHostPort, LocalHostPort);
   }
   else
   {
      /* get optional username[:password], host and optional port */
      for (sptr = cptr; *sptr && *sptr != '/' && *sptr != '@'; sptr++);
      if (*sptr == '@')
      {
         sptr = RemoteUser;
         while (*cptr && *cptr != '@') *sptr++ = *cptr++;
         *sptr = '\0';
         if (*cptr) cptr++;
         for (sptr = RemoteUser; *sptr && *sptr != ':'; sptr++);
         if (*sptr)
         {
            *sptr++ = '\0';
            RemotePassPtr = sptr;
         }
         sprintf (RemoteUserPass, "%s:%s", RemoteUser, RemotePassPtr);
      }
      sptr = RemoteHost;
      while (*cptr && *cptr != '/' && *cptr != ':')
          *sptr++ = *cptr++;
      *sptr = '\0';
      if (*cptr == ':')
      {
         cptr++;
         RemotePort = atoi(cptr);
         if (!RemotePort) RemotePort = 80;
         while (*cptr && *cptr != '/') cptr++;
      }
      else
         RemotePort = 21;

      if (RemotePort == 21)
         strcpy (RemoteHostPort, RemoteHost);
      else
         sprintf (RemoteHostPort, "%s:%d", RemoteHost, RemotePort);
   }
   RemoteHostPortLength = strlen(RemoteHostPort);
   if (Debug) fprintf (stdout, "|%s|%s|\n", RemoteHostPort, cptr);

   if (IsFetchScript && *cptr != '/')
   {
      /* no path (i.e. "http://remote.host.name") which can break links */
      fprintf (stdout,
"HTTP/1.0 302 Moved temporarily\r\n\
Location: %s%s/\r\n\
\r\n",
         FetchPrefix, FetchUrlPtr);
      return ("302 Redirection!");
   }

   if (DoMassageLinks)
   {
      sprintf (FetchPrefix, "%s//%s%s/~",
               CgiRequestSchemePtr, LocalHostPort, CgiScriptNamePtr);
      sprintf (MassageLinksPath, "%s/~", CgiScriptNamePtr);
   }
   else
      FetchPrefix[0] = MassageLinksPath[0] = '\0';

   sptr = RequestPath;
   while (*cptr) *sptr++ = *cptr++;
   *sptr = '\0';
   if (Debug) fprintf (stdout, "|%s|\n", RequestPath);

   if (RemoteUserPass[0])
   {
      sptr = RemoteUserPassEncoded;
      cptr = RemoteUserPass;
      while (*cptr)
      {
         switch (*cptr)
         {
            case ' ' :
               *sptr++ = '%'; *sptr++ = '2'; *sptr++ = '0'; cptr++; break;
            case '?' :
               *sptr++ = '%'; *sptr++ = '3'; *sptr++ = 'f'; cptr++; break;
            case '@' :
               *sptr++ = '%'; *sptr++ = '4'; *sptr++ = '0'; cptr++; break;
            default : *sptr++ = *cptr++;
         }
      }
      *sptr++ = '@';
      *sptr = '\0';
   }
   if (Debug)
      fprintf (stdout, "RemoteUserPassEncoded |%s|\n", RemoteUserPassEncoded);

   if (DoMassageLinks)
   {
      sprintf (FetchPrefix, "%s//%s%s/",
               CgiRequestSchemePtr, LocalHostPort, CgiScriptNamePtr);
      if (Debug) fprintf (stdout, "FetchPrefix |%s|\n", FetchPrefix);
   }
   else
      FetchPrefix[0] = '\0';

   IsDirList = IsTypeAscii = false;
   CwdFtpDirectory[0] = CwdFtpDirEncoded[0] = FtpDirectory[0] = '\0';

   for (cptr = RequestPath; *cptr && *cptr != ';'; cptr++);
   if (cptr[-1] == '/') IsDirList = true;
   if (*cptr)
      *cptr++ = '\0';
   else
   {
      /* no request modifies on path, have a look on the query string */
      strcpy (cptr = Scratch, CgiQueryStringPtr);
      CgiLibUrlDecode (cptr);
   }

   while (*cptr)
   {
      /**************************/
      /* URL file type modifier */
      /**************************/

      if (Debug) fprintf (stdout, "cptr |%s|\n", cptr);
      if (*cptr == ';') cptr++; 
      if (!memcmp (cptr, "type=", 5))
      {
         if (!memcmp (cptr, "type=debug", 10))
         {
            cptr += 10;
            FetchDebugFtp = true;
         }
         else
         if (!memcmp (cptr, "type=dos", 8))
         {
            cptr += 8;
            IsUnixFileSystem = IsUnknownFileSystem = IsVmsFileSystem = false;
            IsDosFileSystem = true;
         }
         else
         if (!memcmp (cptr, "type=unix", 9))
         {
            cptr += 9;
            IsDosFileSystem = IsUnknownFileSystem = IsVmsFileSystem = false;
            IsUnixFileSystem = true;
         }
         else
         if (!memcmp (cptr, "type=unknown", 12))
         {
            cptr += 12;
            IsDosFileSystem = IsUnixFileSystem = IsVmsFileSystem = false;
            IsUnknownFileSystem = true;
         }
         else
         if (!memcmp (cptr, "type=vms", 8))
         {
            cptr += 8;
            IsDosFileSystem = IsUnknownFileSystem = IsUnixFileSystem = false;
            IsVmsFileSystem = true;
         }
         else
         if (!memcmp (cptr, "type=a", 6))
         {
            cptr += 6;
            IsTypeAscii = true;
            CgiContentTypePtr = "text/plain";
         }
         else
         if (!memcmp (cptr, "type=d", 6))
         {
            cptr += 6;
            IsDirList = true;
            /* if not already that way terminate the path with a '/' */
            strcat (RequestPath, "/");
         }
         else
         if (!memcmp (cptr, "type=i", 6))
         {
            cptr += 6;
            IsTypeAscii = false;
            CgiContentTypePtr = "application/octet-stream";
         }
      }
      else
      if (!memcmp (cptr, "cwd=", 4))
      {
         cptr += 4;
         sptr = CwdFtpDirectory;
         while (*cptr && *cptr != ';') *sptr++ = *cptr++;
         *sptr = '\0';
         if (Debug) fprintf (stdout, "CwdFtpDirectory |%s|\n", CwdFtpDirectory);
         strcpy (CwdFtpDirEncoded, "cwd=");
         CgiLibUrlEncode (CwdFtpDirectory, -1,
                          CwdFtpDirEncoded+4, sizeof(CwdFtpDirEncoded)-4);
      }
      else
         return ("500 Unknown modifier.");
   }

   if (IsDirList || !memcmp(CgiContentTypePtr, "text/", 5))
      IsTypeAscii = true;

   /*********/
   /* login */
   /*********/

   status = OpenConnection (&FtpChannel, RemoteHost, RemotePort, NULL);
   if (VMSnok (status)) return (ReplyVmsError (status));
   cptr = FtpReply (FtpChannel);
   for (sptr = cptr; *sptr && *sptr != '\r' && *sptr != '\n'; sptr++);
   *sptr = '\0';
   if (cptr[0] == '4' || cptr[0] == '5')
   {
      sys$dassgn (FtpChannel);
      return (cptr);
   }
   CgiLibHtmlEscape (cptr+4, -1, FtpGreetingEscaped,
                    sizeof(FtpGreetingEscaped));
   
   /* get the IP address of the connected command socket */
   if (Debug) fprintf (stdout, "sys$qiow() IO$_SENSEMODE\n");
   status = sys$qiow (0, FtpChannel, IO$_SENSEMODE, &IOsb, 0, 0,
                      0, 0, &SocketNameItem, 0, 0, 0);
   if (Debug)
      fprintf (stdout, "sys$qiow() %%X%08.08X IOsb %%X%08.08X\n",
               status, IOsb.Status);
   if (VMSok (status) && VMSnok (IOsb.Status)) status = IOsb.Status;
   if (VMSnok (status)) return (ReplyVmsError (status));
   memcpy (&IpAddress, &SocketName.sin_addr.s_addr, 4);

   /* now we've got the IP address we can build an anonymous password */
   if (!RemoteUser[0]) strcpy (RemoteUser, "anonymous");
   if (!RemotePassPtr)
   {
      sprintf (RemotePassPtr = RemotePass, "proxy@%d.%d.%d.%d",
               IpAddress & 0x000000ff,
               (IpAddress & 0x0000ff00) >> 8,
               (IpAddress & 0x00ff0000) >> 16,
               /* signed ints, mask off the shifted sign bit */
               ((IpAddress & 0xff000000) >> 24) & 0xff);
   }

   cptr = FtpCommand (true, FtpChannel, "USER %s\r\n", RemoteUser);
   if (cptr[0] == '4' || cptr[0] == '5')
   {
      sys$dassgn (FtpChannel);
      return (cptr);
   }

   if (!memcmp (cptr, "331", 3))
   {
      cptr = FtpCommand (true, FtpChannel, "PASS %s\r\n", RemotePassPtr);
      if (cptr[0] == '4' || cptr[0] == '5')
      {
         sys$dassgn (FtpChannel);
         return (cptr);
      }
   }

   if (IsTypeAscii)
      cptr = FtpCommand (true, FtpChannel, "TYPE A\r\n");
   else
      cptr = FtpCommand (true, FtpChannel, "TYPE I\r\n");
   if (cptr[0] == '4' || cptr[0] == '5')
   {
      sys$dassgn (FtpChannel);
      return (cptr);
   }

   if (RequestPath[0] == '/' && RequestPath[1] == '|')
   {
      /********************/
      /* ad hoc commands */
      /*******************/

      fprintf (stdout,
"HTTP/1.0 200 Success\n\
Content-Type: text/plain\n\
\n");

      strcpy (sptr = Scratch, RequestPath+2);
      CgiLibUrlDecode (sptr);

      while (*sptr)
      {
         cptr = sptr;
         while (*sptr && *sptr != '|') sptr++;
         if (*sptr) *sptr++ = '\0';
         cptr = FtpCommand (false, FtpChannel, "%s\r\n", cptr);
         if (cptr[0] == '4' || cptr[0] == '5')
         {
            fprintf (stdout, "%s\n", ReplyVmsError (status));
            break;
         }

         for (;;)
         {
            status = ReadConnection (FtpChannel, Buffer, sizeof(Buffer),
                                     &ReadCount, true);
            if (VMSnok (status))
            {
               fprintf (stdout, "%s\n", ReplyVmsError (status));
               break;
            }
            fprintf (stdout, "%s", Buffer);
            cptr = Buffer;
            while (*cptr)
            {
               if (isdigit(cptr[0]) && isdigit(cptr[1]) &&
                   isdigit(cptr[2]) && cptr[3] == ' ') break;
               while (*cptr && *cptr != '\r' && *cptr != '\n') cptr++;
               while (*cptr == '\r' || *cptr == '\n') cptr++;
            }
            if (isdigit(cptr[0]) && isdigit(cptr[1]) &&
                isdigit(cptr[2]) && cptr[3] == ' ') break;
         }
      }

      sys$dassgn (FtpChannel);

      return ("200 OK!");
   }

   /************************************/
   /* determine (probable) file system */
   /************************************/

   cptr = FtpCommand (true, FtpChannel, "SYST\r\n");
   if (cptr[0] == '4' || cptr[0] == '5')
   {
      sys$dassgn (FtpChannel);
      return (cptr);
   }
   for (sptr = cptr; *sptr && *sptr != '\r' && *sptr != '\n'; sptr++);
   *sptr = '\0';
   CgiLibHtmlEscape (cptr+4, -1, FtpSystemEscaped, sizeof(FtpSystemEscaped));

   cptr = FtpCommand (true, FtpChannel, "PWD\r\n");
   if (cptr[0] == '4' || cptr[0] == '5')
   {
      sys$dassgn (FtpChannel);
      return (cptr);
   }

   IsDosFileSystem = IsUnixFileSystem =
      IsUnknownFileSystem = IsVmsFileSystem = false;
   if (strchr (cptr, '/'))
   {
      IsUnixFileSystem = true;
      FileSystemPtr = "Unix";
   }
   else
   if (strstr (cptr, ":["))
   {
      IsVmsFileSystem = true;
      FileSystemPtr = "VMS";
   }
   else
   if (strchr (cptr, '\\'))
   {
      IsDosFileSystem = true;
      FileSystemPtr = "DOS";
   }
   else
   {
      IsUnknownFileSystem = true;
      FileSystemPtr = "unknown";
   }

   if (WatchEnabled) WatchThis ("FTP FILE-SYSTEM !AZ", FileSystemPtr);

   if (RequestPath[1] && IsVmsFileSystem)
   {
      sptr = FtpDirectory;
      if (strchr (RequestPath+1, '/'))
      {
         *sptr++ = '[';
         *sptr++ = '.';
      }
      for (cptr = RequestPath+1; *cptr; *sptr++ = *cptr++);
      *sptr = '\0';
      /* turn any final '/' into a directory delimiting ']' */
      while (sptr > FtpDirectory && *sptr != '/')
      {
         sptr--;
         cptr--;
      }
      if (*sptr == '/')
      {
         *sptr++ = ']';
         cptr++;
      }
      *sptr = '\0';
      /* turn any intermediate '/' into directory separating '.' */
      for (sptr = FtpDirectory; *sptr; sptr++)
         if (*sptr == '/') *sptr = '.';
      /* get any file component */
      sptr = FtpFile;
      while (*cptr) *sptr++ = *cptr++;
      *sptr = '\0';
   }
   else
   if (RequestPath[1])
   {
      sptr = FtpDirectory;
      *sptr++ = '.';
      for (cptr = RequestPath; *cptr; *sptr++ = *cptr++);
      *sptr = '\0';
      while (sptr > FtpDirectory && *sptr != '/')
      {
         sptr--;
         cptr--;
      }
      if (*sptr == '/')
      {
         sptr++;
         cptr++;
      }
      *sptr = '\0';
      /* get any file component */
      sptr = FtpFile;
      while (*cptr) *sptr++ = *cptr++;
      *sptr = '\0';
      if (IsDosFileSystem)
      {
         /* for DOS, turn each forward slash into a back-slash */
         for (sptr = FtpDirectory; *sptr; sptr++)
            if (*sptr == '/') *sptr = '\\';
      }
   }
   else
      strcpy (FtpFile, RequestPath+1);
   if (Debug) fprintf (stdout, "|%s|%s|\n", FtpDirectory, FtpFile);

   if (CwdFtpDirectory[0])
   {
      /*******************/
      /* ;cwd= directory */
      /*******************/

      cptr = FtpCommand (true, FtpChannel, "CWD %s\r\n", CwdFtpDirectory);
      if (cptr[0] == '4' || cptr[0] == '5')
      {
         sys$dassgn (ListenChannel);
         sys$dassgn (FtpChannel);
         return (cptr);
      }
   }

   if (FtpDirectory[0])
   {
      /*********************/
      /* request directory */
      /*********************/

      cptr = FtpCommand (true, FtpChannel, "CWD %s\r\n", FtpDirectory);
      if (cptr[0] == '4' || cptr[0] == '5')
      {
         sys$dassgn (ListenChannel);
         sys$dassgn (FtpChannel);
         return (cptr);
      }
   }

   if (IsDirList)
   {
      /* get the directory location for inclusion in the directory listing */
      cptr = FtpCommand (true, FtpChannel, "PWD\r\n");
      if (cptr[0] == '4' || cptr[0] == '5')
      {
         sys$dassgn (FtpChannel);
         return (cptr);
      }
      for (sptr = cptr; *sptr && *sptr != '\r' && *sptr != '\n'; sptr++)
         if (*sptr == '\"') *sptr = '\'';
      *sptr = '\0';
      CgiLibHtmlEscape (cptr+4, -1, FtpPwdEscaped, sizeof(FtpPwdEscaped));
   }

   /**********************/
   /* open listen socket */
   /**********************/

   /* assign a channel to the internet template device */
   if (VMSnok (status = sys$assign (&InetDeviceDsc, &ListenChannel, 0, 0)))
      return (ReplyVmsError (status));

   SocketNameItem.Length = sizeof(SocketName);
   SocketNameItem.Address = &SocketName;

   status = sys$qiow (0, ListenChannel, IO$_SETMODE, &IOsb, 0, 0,
                      &TcpSocket, 0, 0, 1, 0, 0);
   if (Debug)
      fprintf (stdout, "sys$qiow() %%X%08.08X IOsb %%X%08.08X\n",
               status, IOsb.Status);
   if (VMSok (status) && VMSnok (IOsb.Status)) status = IOsb.Status;
   if (VMSnok (status))
   {
      sys$dassgn (FtpChannel);
      return (ReplyVmsError (status));
   }

   /* get the port number listening */
   if (Debug) fprintf (stdout, "sys$qiow() IO$_SENSEMODE\n");
   status = sys$qiow (0, ListenChannel, IO$_SENSEMODE, &IOsb, 0, 0,
                      0, 0, &SocketNameItem, 0, 0, 0);
   if (Debug)
      fprintf (stdout, "sys$qiow() %%X%08.08X IOsb %%X%08.08X\n",
               status, IOsb.Status);
   if (VMSok (status) && VMSnok (IOsb.Status)) status = IOsb.Status;
   if (VMSnok (status))
   {
      sys$dassgn (FtpChannel);
      sys$dassgn (ListenChannel);
      return (ReplyVmsError (status));
   }
   ListenPort = (int)SocketName.sin_port;

   /*****************************/
   /* tell FTP server data port */
   /*****************************/

   cptr = FtpCommand (true, FtpChannel, "PORT %d,%d,%d,%d,%d,%d\r\n",
                      IpAddress & 0x000000ff,
                      (IpAddress & 0x0000ff00) >> 8,
                      (IpAddress & 0x00ff0000) >> 16,
                      /* signed ints, mask off the shifted sign bit */
                      ((IpAddress & 0xff000000) >> 24) & 0xff,
                      (ListenPort & 0x000000ff),
                      (ListenPort & 0x0000ff00) >> 8);
   if (cptr[0] == '4' || cptr[0] == '5')
   {
      sys$dassgn (FtpChannel);
      return (cptr);
   }
 
   if (IsDirList)
   {
      /*********************/
      /* directory listing */
      /*********************/

      if (!FtpIconDirImg[0] && IconPathPtr[0])
      {
         sprintf (FtpIconDirImg,
            "<IMG SRC=\"%s//%s:%s%sdirectory.gif\" ALT=\" [DIR] \" ALIGN=top> ",
            CgiRequestSchemePtr, CgiServerNamePtr,
            CgiServerPortPtr, IconPathPtr); 
         sprintf (FtpIconFileImg,
            "<IMG SRC=\"%s//%s:%s%sfile.gif\" ALT=\"[FILE] \" ALIGN=top> ",
            CgiRequestSchemePtr, CgiServerNamePtr,
            CgiServerPortPtr, IconPathPtr); 
      }

      if (IsVmsFileSystem)
         cptr = FtpCommand (true, FtpChannel, "LIST *.*;0\r\n");
      else
      if (IsUnixFileSystem || IsDosFileSystem)
         cptr = FtpCommand (true, FtpChannel, "LIST\r\n");
      else
         cptr = FtpCommand (true, FtpChannel, "NLST\r\n");
      if (cptr[0] == '4' || cptr[0] == '5')
      {
         sys$dassgn (ListenChannel);
         sys$dassgn (FtpChannel);
         return (cptr);
      }
      /* it has been observed that responses can span commands with LIST */
      while (*cptr && *cptr != '\n') cptr++;
      if (*cptr) cptr++;

      /*************************/
      /* accept on data socket */
      /*************************/

      /* assign a channel to the internet template device */
      if (VMSnok (status = sys$assign (&InetDeviceDsc, &DataChannel, 0, 0)))
         return (ReplyVmsError (status));

      status = sys$qiow (0, ListenChannel, IO$_ACCESS|IO$M_ACCEPT, &IOsb, 0, 0,
                         0, 0, &SocketNameItem, &DataChannel, 0, 0);
      if (Debug)
         fprintf (stdout, "sys$qiow() %%X%08.08X IOsb %%X%08.08X\n",
                  status, IOsb.Status);
      if (VMSok (status) && VMSnok (IOsb.Status)) status = IOsb.Status;
      if (VMSnok (status))
      {
         sys$dassgn (ListenChannel);
         sys$dassgn (FtpChannel);
         return (ReplyVmsError (status));
      }

      /********************/
      /* read data stream */
      /********************/

      if (BufferChunk <= 0) BufferChunk = DEFAULT_BUFFER_CHUNK;

      /* with CGIplus 'BufferPtr'/'BufferSize' may still have memory */
      BufferCount = 0;
      BufferRemaining = BufferSize;
      BufferCurrentPtr = BufferPtr;

      for (;;)
      {
         if (BufferCount == BufferSize)
         {
            BufferSize += (BufferRemaining = (BufferChunk << 10));
            if (!(BufferPtr = realloc (BufferPtr, BufferSize+1)))
               exit (vaxc$errno);
            BufferCurrentPtr = BufferPtr + BufferSize - BufferRemaining;
         }

         ReadCount = BufferRemaining <= 32767 ? BufferRemaining : 32767,
         status = ReadConnection (DataChannel, BufferCurrentPtr, ReadCount,
                                  &ReadCount, false);
         if (VMSnok (status)) break;

         BufferCount += ReadCount;
         BufferCurrentPtr += ReadCount;
         BufferRemaining -= ReadCount;

         if (Debug)
            fprintf (stdout, "Remaining: %d Count: %d\n",
                     BufferRemaining, BufferCount);
      }

      BufferPtr[BufferCount] = '\0';
      /** if (Debug) fprintf (stdout, "|%s|\n", BufferPtr); **/

      if (FetchDebugFtp) fprintf (stdout, "->|%s|\n", BufferPtr);

      sys$dassgn (DataChannel);
      sys$dassgn (ListenChannel);

      /*******************/
      /* final FTP reply */
      /*******************/

      /* it has been observed that responses can span commands with LIST */
      if (!*cptr) cptr = FtpReply (FtpChannel);
      if (cptr[0] == '4' || cptr[0] == '5')
      {
         sys$dassgn (FtpChannel);
         return (cptr);
      }

      if (DoCheckOnly)
      {
         FtpCommand (true, FtpChannel, "QUIT\r\n");
         sys$dassgn (FtpChannel);
         return ("200 OK!");
      }

      /*****************/
      /* generate page */
      /*****************/

      CgiLibUrlEncode (RequestPath, -1,
                       RequestPathEncoded, sizeof(RequestPathEncoded));
      CgiLibHtmlEscape (RequestPath, -1,
                        RequestPathEscaped, sizeof(RequestPathEscaped));

      fprintf (stdout,
"HTTP/1.0 200 Success\n\
Server: %s\n\
Content-Type: text/html\n\
\n\
<HTML>\n\
<HEAD>\n\
<META NAME=\"generator\" CONTENT=\"%s\">\n\
<META NAME=\"ftp-greeting\" CONTENT=\"%s\">\n\
<META NAME=\"ftp-system\" CONTENT=\"%s\">\n\
<META NAME=\"ftp-pwd\" CONTENT=\"%s\">\n\
<META NAME=\"file-system\" CONTENT=\"%s\">\n\
<TITLE>Directory of %s</TITLE>\n\
</HEAD>\n\
<BODY>\n\
<H2>%s %s</H2>\n\
%s\
<PRE>",
         CgiServerSoftwarePtr, SoftwareId,
         FtpGreetingEscaped, FtpSystemEscaped, FtpPwdEscaped, FileSystemPtr,
         RequestPathEscaped, FtpCurrentDirectory, RequestPathEscaped,
         IsUnknownFileSystem ?
           "<B>Note:</B> &nbsp;FTP server type not recognized!\n<P>\n" : "");

      if (IsVmsFileSystem)
         ProcessFtpVmsList (RequestPathEncoded,
                            RemoteUserPassEncoded,
                            CwdFtpDirEncoded);
      else
      if (IsUnixFileSystem)
         ProcessFtpUnixList (RequestPathEncoded,
                             RemoteUserPassEncoded,
                             CwdFtpDirEncoded);
      else
      if (IsDosFileSystem)
         ProcessFtpDosList (RequestPathEncoded,
                            RemoteUserPassEncoded,
                            CwdFtpDirEncoded);
      else
         ProcessFtpUnknownList (RequestPathEncoded,
                                RemoteUserPassEncoded,
                                CwdFtpDirEncoded);

      fprintf (stdout,
"</PRE>\n\
</BODY>\n\
</HTML>\n");
   }
   else
   {
      /*****************/
      /* file transfer */
      /*****************/

      cptr = FtpCommand (true, FtpChannel, "RETR %s\r\n", FtpFile);
      if (Debug) fprintf (stdout, "cptr |%s|\n", cptr);
      if (cptr[0] == '4' || cptr[0] == '5')
      {
         sys$dassgn (ListenChannel);
         sys$dassgn (FtpChannel);
         return (cptr);
      }
      /* it has been observed that responses can span commands with RETR */
      while (*cptr && *cptr != '\n') cptr++;
      if (*cptr) cptr++;

      /*************************/
      /* accept on data socket */
      /*************************/

      /* assign a channel to the internet template device */
      if (VMSnok (status = sys$assign (&InetDeviceDsc, &DataChannel, 0, 0)))
         return (ReplyVmsError (status));

      status = sys$qiow (0, ListenChannel, IO$_ACCESS|IO$M_ACCEPT, &IOsb, 0, 0,
                         0, 0, &SocketNameItem, &DataChannel, 0, 0);
      if (Debug)
         fprintf (stdout, "sys$qiow() %%X%08.08X IOsb %%X%08.08X\n",
                  status, IOsb.Status);
      if (VMSok (status) && VMSnok (IOsb.Status)) status = IOsb.Status;
      if (VMSnok (status))
      {
         sys$dassgn (ListenChannel);
         sys$dassgn (FtpChannel);
         return (ReplyVmsError (status));
      }

      /********************/
      /* read data stream */
      /********************/

      if (*OutputPtr)
      {
         /* FTP response is being output to a file */
         if (!(stdout = freopen (OutputPtr, "w", stdout)))
            exit (vaxc$errno);
      }
      else
      {
         fprintf (stdout,
"HTTP/1.0 200 Success\n\
Server: %s\n\
Content-Type: %s\n\
\n",
            CgiServerSoftwarePtr, CgiContentTypePtr);
      }

      for (;;)
      {
         status = ReadConnection (DataChannel, Buffer, sizeof(Buffer),
                                  &ReadCount, false);
         if (VMSnok (status)) break;
         if (!DoCheckOnly) fwrite (Buffer, ReadCount, 1, stdout);
      }

      sys$dassgn (DataChannel);
      sys$dassgn (ListenChannel);

      /* was being written to a file, reopen to <stdout> */
      if (*OutputPtr)
      {
         if (!(stdout = freopen ("SYS$OUTPUT:", "w", stdout)))
            exit (vaxc$errno);
      }

      /* it has been observed that responses can span commands with RETR */
      if (!*cptr) cptr = FtpReply (FtpChannel);
      if (Debug) fprintf (stdout, "cptr |%s|\n", cptr);
      if (cptr[0] == '4' || cptr[0] == '5')
      {
         sys$dassgn (FtpChannel);
         return (cptr);
      }
   }

   /********************/
   /* close connection */
   /********************/

   if (status == SS$_LINKDISCON) status = SS$_NORMAL;

   FtpCommand (true, FtpChannel, "QUIT\r\n");
   sys$dassgn (FtpChannel);

   if (VMSnok (status)) return (ReplyVmsError (status));

   return ("200 OK!");
}

/****************************************************************************/
/*
Variable length argument list.  Send the printf()ed command to the FTP server,
optionally reading the reply.
*/

char* FtpCommand
(
BOOL GetReply,
unsigned short Channel,
char *FormatString,
...
)
{
   int  status,
        argcnt,
        Length;
   char  *cptr;
   char  Buffer [1024];
   va_list  argptr;

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

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

   va_count (argcnt);

   va_start (argptr, FormatString);
   Length = vsprintf (Buffer, FormatString, argptr);
   if (Debug) fprintf (stdout, "%d |%s|\n", Length, Buffer);

   if (FetchDebugFtp)
   {
      for (cptr = Buffer + Length;
           cptr > Buffer && (!*cptr || *cptr == '\r' || *cptr == '\n');
           cptr--);
      if (*cptr && *cptr != '\r' && *cptr != '\n') cptr++;
      fprintf (stdout, "->|%*.*s|\n", cptr-Buffer, cptr-Buffer, Buffer);
   }
   status = WriteConnection (Channel, Buffer, Length);
   if (VMSnok (status)) return (ReplyVmsError (status));

   if (GetReply) return (FtpReply (Channel));

   return ("200 OK!");
}

/****************************************************************************/
/*
Read and return a single line response from the FTP server (With multi-line
responses it returns only the last line).
*/

char* FtpReply (unsigned short Channel)

{
   static char  Message [256] = "599 ",
                Buffer [1024];
   static $DESCRIPTOR (MessageDsc, Message);

   int  status,
        BufferRemaining,
        ReadCount;
   short int  Length;
   char  *cptr, *sptr,
         *BufferPtr;

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

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

   BufferPtr = Buffer;
   BufferRemaining = sizeof(Buffer)-1;

   for (;;)
   {
      status = ReadConnection (Channel, BufferPtr, BufferRemaining,
                               &ReadCount, true);
      if (VMSnok (status)) return (ReplyVmsError (status));

      for (cptr = BufferPtr; *cptr && *cptr != '\r' && *cptr != '\n'; cptr++);
      if (*cptr != '\r' && *cptr != '\n')
      {
         /* all lines must be terminated with carriage control, get rest */
         BufferPtr += ReadCount;
         BufferRemaining -= ReadCount;
         continue;
      }
      if (Debug) fprintf (stdout, "|%s|\n", Buffer);

      if (FetchDebugFtp) fprintf (stdout, "<-|%s|\n", Buffer);

      cptr = sptr = Buffer;
      while (*cptr)
      {
         sptr = cptr;
         if (isdigit(cptr[0]) && isdigit(cptr[1]) &&
             isdigit(cptr[2]) && cptr[3] == ' ') break;
         while (*cptr && *cptr != '\r' && *cptr != '\n') cptr++;
         while (*cptr == '\r' || *cptr == '\n') cptr++;
      }
      if (isdigit(cptr[0]) && isdigit(cptr[1]) &&
          isdigit(cptr[2]) && cptr[3] == ' ') return (sptr);
   }
}

/****************************************************************************/
/*
Convert a VMS status value into a pseudo-reply-message containing the
corresponding VMS error message.  For example,
"599 %X0000028C Remote node is unknown".  The hexadecimal status value can be
converted back and used as an exit status.
*/

char* ReplyVmsError (int StatusValue)

{
   static $DESCRIPTOR (StringFaoDsc, "599 %X!XL !AZ.");
   static char  Message [256],
                String [256];
   static $DESCRIPTOR (MessageDsc, Message);
   static $DESCRIPTOR (StringDsc, String);

   int  status;
   short int  Length;

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

   if (Debug) fprintf (stdout, "ReplyVmsError() %%X%08.08X\n", StatusValue);

   status = sys$getmsg (StatusValue, &Length, &MessageDsc, 1, 0); 
   if (VMSok (status))
   {
      Message[Length] = '\0';
      Message[0] = toupper(Message[0]);
   }
   else
      strcpy (Message, "&quot;sys$getmsg() failed&quot;");

   status = sys$fao (&StringFaoDsc, &Length, &StringDsc, StatusValue, Message); 
   if (VMSok (status))
      String[Length] = '\0';
   else
      strcpy (String, "599 %X00000002 &quot;sys$fao() failed&quot;");

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

/****************************************************************************/
/*
HTML format a VMS FTP server directory listing.
Expected format: "file-name  size-blocks  date_time  any-thing-else..."
*/

ProcessFtpVmsList 
(
char *RequestPathEncoded,
char *RemoteUserPassEncoded,
char *CwdFtpDirEncoded
)
{
   BOOL  IsDirectory;
   int  DirectoryCount,
        FileCount;
   char  *cptr, *sptr;
   char  FileDate [256],
         FileNameEncoded [256],
         FileNameEscaped [256],
         FileName [256],
         FileSize [256];

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

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

   DirectoryCount = FileCount = 0;

   cptr = BufferPtr;
   while (*cptr)
   {
      /* skip leading white-space, blank lines, etc. */
      while (*cptr && *cptr == ' ') cptr++;
      if (!cptr) break;
      if (*cptr == '\r' || *cptr == '\n')
      {
         while (*cptr == '\r' || *cptr == '\n') cptr++;
         continue;
      }

      sptr = FileName;
      while (*cptr && *cptr != ' ' && *cptr != ';' &&
             *cptr != '\r' && *cptr != '\n')
         *sptr++ = *cptr++;
      *sptr = '\0';

      if (*cptr == ';')
      {
         /* skip version number in file specification */
         while (*cptr && *cptr != ' ' && *cptr != '\r' && *cptr != '\n')
            cptr++;
      }
      /* absorb white-space between name and size */
      while (*cptr == ' ') cptr++;

      sptr = FileSize;
      while (*cptr && *cptr != ' ' && *cptr != '\r' && *cptr != '\n')
         *sptr++ = *cptr++;
      *sptr = '\0';

      /* absorb white-space between size and date */
      while (*cptr == ' ') cptr++;

      sptr = FileDate;
      while (*cptr && *cptr != ' ' && *cptr != '\r' && *cptr != '\n')
         *sptr++ = *cptr++;
      while (*cptr == ' ') *sptr++ = *cptr++;
      while (*cptr && *cptr != ' ' && *cptr != '\r' && *cptr != '\n')
         *sptr++ = *cptr++;
      *sptr = '\0';

      /* skip to start of next line */
      while (*cptr && *cptr != '\r' && *cptr != '\n') cptr++;
      while (*cptr == '\r' || *cptr == '\n') cptr++;

      if (FileName[0] && !FileSize[0] && !FileDate[0] &&
          strlen(FileName) > 16)
      {
         /***************************************************/
         /* file name too long, distibuted across two lines */
         /***************************************************/

         /* skip leading white-space */
         while (*cptr && *cptr == ' ') cptr++;
         if (!cptr) break;

         sptr = FileSize;
         while (*cptr && *cptr != ' ' && *cptr != '\r' && *cptr != '\n')
            *sptr++ = *cptr++;
         *sptr = '\0';

         /* absorb white-space between size and date */
         while (*cptr == ' ') cptr++;

         sptr = FileDate;
         while (*cptr && *cptr != ' ' && *cptr != '\r' && *cptr != '\n')
            *sptr++ = *cptr++;
         while (*cptr == ' ') *sptr++ = *cptr++;
         while (*cptr && *cptr != ' ' && *cptr != '\r' && *cptr != '\n')
            *sptr++ = *cptr++;
         *sptr = '\0';
      }

      /* if all components not present then just ignore */
      if (!FileName[0] || !FileSize[0] || !FileDate[0]) continue;

      /* try to eliminate other lines ... file size really look like one? */
      for (sptr = FileSize; isdigit(*sptr) || *sptr == '/'; sptr++);
      if (*sptr) continue;

      /* try to eliminate other lines ... file date really look like one? */
      sptr = FileDate;
      if (!((isdigit(sptr[0]) && isdigit(sptr[1]) && sptr[2] == '-') ||
            (isdigit(sptr[0]) && sptr[1] == '-')))
         continue;

      for (sptr = FileName; *sptr; sptr++);
      while (sptr > FileName && *sptr != '.') sptr--;
      if (*(unsigned long*)sptr == '.DIR')
      {
         /* terminate to eliminate the ".DIR" */
         *sptr++ = '/';
         *sptr = '\0';
         IsDirectory = true;
         sptr = FtpIconDirImg;
         DirectoryCount++;
      }
      else
      {
         IsDirectory = false;
         sptr = FtpIconFileImg;
         FileCount++;
      }

      CgiLibUrlEncode (FileName, -1, FileNameEncoded, sizeof(FileNameEncoded));
      CgiLibHtmlEscape (FileName, -1, FileNameEscaped, sizeof(FileNameEscaped));

      fprintf (stdout,
" %s<A HREF=\"%sftp://%s%s%s%s%s%s\">%s</A>%*s ",
         sptr, MassageLinksPath,
         RemoteUserPassEncoded, RemoteHostPort, RequestPathEncoded,
         FileNameEncoded, CwdFtpDirEncoded[0] ? ";" : "", CwdFtpDirEncoded,
         FileNameEscaped, 30-strlen(FileName), "");

      if (IsDirectory)
      {
         for (sptr = FileNameEncoded; *sptr; sptr++);
         *--sptr = '\0';
      }

      fprintf (stdout,
"<I>\
<A HREF=\"%sftp://%s%s%s%s;type=a%s%s\">a</A>\
<A HREF=\"%sftp://%s%s%s%s;type=i%s%s\">i</A>\
<A HREF=\"%sftp://%s%s%s%s;type=d%s%s\">d</A>\
</I>",
         MassageLinksPath, RemoteUserPassEncoded, RemoteHostPort,
         RequestPathEncoded, FileNameEncoded,
         CwdFtpDirEncoded[0] ? ";" : "", CwdFtpDirEncoded,
         MassageLinksPath, RemoteUserPassEncoded, RemoteHostPort,
         RequestPathEncoded, FileNameEncoded, 
         CwdFtpDirEncoded[0] ? ";" : "", CwdFtpDirEncoded,
         MassageLinksPath, RemoteUserPassEncoded, RemoteHostPort,
         RequestPathEncoded, FileNameEncoded,
         CwdFtpDirEncoded[0] ? ";" : "", CwdFtpDirEncoded);

      if (IsDirectory)
         fprintf (stdout, "\n");
      else
         fprintf (stdout, "  %14s   %20s\n", FileSize, FileDate);
   }

   fprintf (stdout, FtpFilesDirectories,
            FileCount, DirectoryCount,
            FileCount || DirectoryCount ? FtpGetAs : "");
}

/****************************************************************************/
/*
HTML format a "Unix" FTP server directory listing.
Expected format: "mode  links  owner  group  size  time_time_time  file-name"  
*/

ProcessFtpUnixList
(
char *RequestPathEncoded,
char *RemoteUserPassEncoded,
char *CwdFtpDirEncoded
)
{
#define MAX_FIELDS 16

   static char  *MonthName [] = { "Jan","Feb","Mar","Apr","May","Jun",
                                  "Jul","Aug","Sep","Oct","Nov","Dec" };

   BOOL  IsDirectory;
   int  idx,
        DirectoryCount,
        FieldCount,
        FileCount,
        MonthField;
   char  *cptr, *sptr;
   char  *FieldPtr [MAX_FIELDS];
   char  FileName [256],
         FileNameEncoded [256],
         FileNameEscaped [256],
         LinkTarget [256];

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

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

   DirectoryCount = FileCount = 0;

   cptr = BufferPtr;
   while (*cptr)
   {
      /* skip leading white-space, blank lines, etc. */
      while (*cptr == ' ') cptr++;
      if (!cptr) break;
      if (*cptr == '\r' || *cptr == '\n')
      {
         while (*cptr == '\r' || *cptr == '\n') cptr++;
         continue;
      }

      FieldCount = 0;
      while (*cptr && *cptr != '\r' && *cptr != '\n')
      {
         if (FieldCount >= MAX_FIELDS) continue;
         FieldPtr[FieldCount++] = cptr;
         while (*cptr && *cptr != ' ' && *cptr != '\r' && *cptr != '\n') cptr++;
         /* terminate that field */
         if (*cptr) *cptr++ = '\0';
         while (*cptr == ' ') cptr++;
      }
      if (Debug)
         for (idx = 1; idx < FieldCount; idx++)
             fprintf (stdout, "%d |%s|\n", idx, FieldPtr[idx]);

      /* skip to start of next line */
      while (*cptr && *cptr != '\r' && *cptr != '\n') cptr++;
      while (*cptr == '\r' || *cptr == '\n') cptr++;

      /* won't make any sense at all unless there are at least six fields */
      if (FieldCount < 6) continue;

      /* find field containing month name */
      for (MonthField = 1; MonthField < FieldCount; MonthField++)
      {
         for (idx = 0; idx < 12; idx++)
             if (strsame (FieldPtr[MonthField], MonthName[idx], 3))
                break;
         if (idx < 12) break;
      }

      /* doesn't make sense if it doesn't contain a month name somewhere */
      if (MonthField >= FieldCount) continue;

      strcpy (FileName, FieldPtr[MonthField+3]);

      /* dot and double-dot directories are ignored */
      if (FileName[0] == '.' && !FileName[1]) continue;
      if (FileName[0] == '.' && FileName[1] == '.' && !FileName[2]) continue;

      if (FieldPtr[0][0] == 'd')
      {
         IsDirectory = true;
         strcat (FileName, "/");
         sptr = FtpIconDirImg;
         DirectoryCount++;
      }
      else
      if (FieldPtr[0][0] == 'l')
      {
         for (sptr = FieldPtr[MonthField+5]; *sptr; sptr++);
         if (sptr > FieldPtr[MonthField+5] && sptr[-1] == '/')
         {
            IsDirectory = true;
            strcat (FileName, "/");
            sptr = FtpIconDirImg;
            DirectoryCount++;
         }
         else
         {
            IsDirectory = false;
            sptr = FtpIconFileImg;
            FileCount++;
         }
      }
      else
      {
         IsDirectory = false;
         sptr = FtpIconFileImg;
         FileCount++;
      }

      CgiLibUrlEncode (FileName, -1, FileNameEncoded, sizeof(FileNameEncoded));
      CgiLibHtmlEscape (FileName, -1, FileNameEscaped, sizeof(FileNameEscaped));

      fprintf (stdout,
" %s<A HREF=\"%sftp://%s%s%s%s%s%s\">%s</A>%*s ",
         sptr, MassageLinksPath,
         RemoteUserPassEncoded, RemoteHostPort, RequestPathEncoded,
         FileNameEncoded, CwdFtpDirEncoded[0] ? ";" : "", CwdFtpDirEncoded,
         FileNameEscaped, 30-strlen(FileName), "");

      if (IsDirectory)
      {
         for (sptr = FileNameEncoded; *sptr; sptr++);
         *--sptr = '\0';
      }

      fprintf (stdout,
"<I>\
<A HREF=\"%sftp://%s%s%s%s;type=a%s%s\">a</A>\
<A HREF=\"%sftp://%s%s%s%s;type=i%s%s\">i</A>\
<A HREF=\"%sftp://%s%s%s%s;type=d%s%s\">d</A>\
</I>",
         MassageLinksPath, RemoteUserPassEncoded, RemoteHostPort,
         RequestPathEncoded, FileNameEncoded,
         CwdFtpDirEncoded[0] ? ";" : "", CwdFtpDirEncoded,
         MassageLinksPath, RemoteUserPassEncoded, RemoteHostPort,
         RequestPathEncoded, FileNameEncoded, 
         CwdFtpDirEncoded[0] ? ";" : "", CwdFtpDirEncoded,
         MassageLinksPath, RemoteUserPassEncoded, RemoteHostPort,
         RequestPathEncoded, FileNameEncoded,
         CwdFtpDirEncoded[0] ? ";" : "", CwdFtpDirEncoded);

      if (IsDirectory)
         fprintf (stdout, "\n");
      else
         fprintf (stdout, "  %10s   %3.3s %2.2s %4.4s\n",
                  FieldPtr[MonthField-1], FieldPtr[MonthField],
                  FieldPtr[MonthField+1], FieldPtr[MonthField+2]);
   }

   fprintf (stdout, FtpFilesDirectories,
            FileCount, DirectoryCount,
            FileCount || DirectoryCount ? FtpGetAs : "");
}

/****************************************************************************/
/*
HTML format a "DOS" FTP server directory listing.
Expected format: "mm-dd-yy_hh:mm  <DIR>|size  file-name"
*/

ProcessFtpDosList
(
char *RequestPathEncoded,
char *RemoteUserPassEncoded,
char *CwdFtpDirEncoded
)
{
   BOOL  IsDirectory;
   int  DirectoryCount,
        FileCount;
   char  *cptr, *sptr;
   char  FileDate [256],
         FileName [256],
         FileNameEncoded [256],
         FileNameEscaped [256],
         FileSize [256];

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

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

   DirectoryCount = FileCount = 0;

   cptr = BufferPtr;
   while (*cptr)
   {
      /* skip leading white-space, blank lines, etc. */
      while (*cptr && *cptr == ' ') cptr++;
      if (!cptr) break;
      if (*cptr == '\r' || *cptr == '\n')
      {
         while (*cptr == '\r' || *cptr == '\n') cptr++;
         continue;
      }

      IsDirectory = false;

      /* get the two fields comprising the date */
      sptr = FileDate;
      while (*cptr && *cptr != ' ' && *cptr != '\r' && *cptr != '\n')
         *sptr++ = *cptr++;
      while (*cptr == ' ') *sptr++ = *cptr++;
      while (*cptr && *cptr != ' ' && *cptr != '\r' && *cptr != '\n')
         *sptr++ = *cptr++;
      *sptr = '\0';

      /* absorb white-space */
      while (*cptr == ' ') cptr++;

      if (*cptr == '<')
      {
         /* it's a directory */
         if (!memcmp (cptr, "<DIR>", 5)) IsDirectory = true;
         while (*cptr && *cptr != ' ' && *cptr != '\r' && *cptr != '\n') cptr++;
         FileSize[0] = '\0';
      }
      else
      {
         /* file size */
         sptr = FileSize;
         while (*cptr && *cptr != ' ' && *cptr != '\r' && *cptr != '\n')
            *sptr++ = *cptr++;
         *sptr = '\0';
      }

      /* absorb white space between <DIR> or file size and file name */
      while (*cptr == ' ') cptr++;

      sptr = FileName;
      while (*cptr && *cptr != ' ' && *cptr != '\r' && *cptr != '\n')
         *sptr++ = *cptr++;
      *sptr = '\0';

      /* skip to start of next line */
      while (*cptr && *cptr != '\r' && *cptr != '\n') cptr++;
      while (*cptr == '\r' || *cptr == '\n') cptr++;

      /* if all components not present then just ignore */
      if (!FileName[0]) continue;
      if (!IsDirectory && !FileSize[0]) continue;

      /* dot and double-dot directories are ignored */
      if (FileName[0] == '.' && !FileName[1]) continue;
      if (FileName[0] == '.' && FileName[1] == '.' && !FileName[2]) continue;

      CgiLibUrlEncode (FileName, -1, FileNameEncoded, sizeof(FileNameEncoded));
      CgiLibHtmlEscape (FileName, -1, FileNameEscaped, sizeof(FileNameEscaped));

      if (IsDirectory)
      {
         IsDirectory = true;
         strcat (FileName, "/");
         sptr = FtpIconDirImg;
         DirectoryCount++;
      }
      else
      {
         IsDirectory = false;
         sptr = FtpIconFileImg;
         FileCount++;
      }

      CgiLibUrlEncode (FileName, -1, FileNameEncoded, sizeof(FileNameEncoded));
      CgiLibHtmlEscape (FileName, -1, FileNameEscaped, sizeof(FileNameEscaped));

      fprintf (stdout,
" %s<A HREF=\"%sftp://%s%s%s%s%s%s\">%s</A>%*s ",
         sptr, MassageLinksPath,
         RemoteUserPassEncoded, RemoteHostPort, RequestPathEncoded,
         FileNameEncoded, CwdFtpDirEncoded[0] ? ";" : "", CwdFtpDirEncoded,
         FileNameEscaped, 30-strlen(FileName), "");

      if (IsDirectory)
      {
         for (sptr = FileNameEncoded; *sptr; sptr++);
         *--sptr = '\0';
      }

      fprintf (stdout,
"<I>\
<A HREF=\"%sftp://%s%s%s%s;type=a%s%s\">a</A>\
<A HREF=\"%sftp://%s%s%s%s;type=i%s%s\">i</A>\
<A HREF=\"%sftp://%s%s%s%s;type=d%s%s\">d</A>\
</I>",
         MassageLinksPath, RemoteUserPassEncoded, RemoteHostPort,
         RequestPathEncoded, FileNameEncoded,
         CwdFtpDirEncoded[0] ? ";" : "", CwdFtpDirEncoded,
         MassageLinksPath, RemoteUserPassEncoded, RemoteHostPort,
         RequestPathEncoded, FileNameEncoded, 
         CwdFtpDirEncoded[0] ? ";" : "", CwdFtpDirEncoded,
         MassageLinksPath, RemoteUserPassEncoded, RemoteHostPort,
         RequestPathEncoded, FileNameEncoded,
         CwdFtpDirEncoded[0] ? ";" : "", CwdFtpDirEncoded);

      if (IsDirectory)
         fprintf (stdout, "\n");
      else
         fprintf (stdout, "  %10s   %s\n", FileSize, FileDate);
   }

   fprintf (stdout, FtpFilesDirectories,
            FileCount, DirectoryCount,
            FileCount || DirectoryCount ? FtpGetAs : "");
}

/****************************************************************************/
/*
HTML format an unknown format FTP server directory listing.  Now this was done
as a "NLST" and so should contain one name per lines, that's all!
*/

ProcessFtpUnknownList
(
char *RequestPathEncoded,
char *RemoteUserPassEncoded,
char *CwdFtpDirEncoded
)
{
   int  FileCount;
   char  *cptr, *sptr;
   char  FileName [256],
         FileNameEncoded [256],
         FileNameEscaped [256];

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

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

   FileCount = 0;

   cptr = BufferPtr;
   while (*cptr)
   {
      /* skip leading white-space, blank lines, etc. */
      while (*cptr && *cptr == ' ') cptr++;
      if (!cptr) break;
      if (*cptr == '\r' || *cptr == '\n')
      {
         while (*cptr == '\r' || *cptr == '\n') cptr++;
         continue;
      }

      sptr = FileName;
      while (*cptr && *cptr != ' ' && *cptr != '\r' && *cptr != '\n')
         *sptr++ = *cptr++;
      *sptr = '\0';

      /* skip to start of next line */
      while (*cptr && *cptr != '\r' && *cptr != '\n') cptr++;
      while (*cptr == '\r' || *cptr == '\n') cptr++;

      if (!FileName[0]) continue;
      FileCount++;

      CgiLibUrlEncode (FileName, -1, FileNameEncoded, sizeof(FileNameEncoded));
      CgiLibHtmlEscape (FileName, -1, FileNameEscaped, sizeof(FileNameEscaped));

      fprintf (stdout,
" %s<A HREF=\"%sftp://%s%s%s%s\">%s</A>%*s \
<I>\
<A HREF=\"%sftp://%s%s%s%s;type=a%s\">a</A>\
<A HREF=\"%sftp://%s%s%s%s;type=i%s\">i</A>\
<A HREF=\"%sftp://%s%s%s%s;type=d%s\">d</A>\
</I>\n",
         FtpIconFileImg, MassageLinksPath,
         RemoteUserPassEncoded, RemoteHostPort, RequestPathEncoded,
         FileNameEncoded, FileNameEscaped, 30-strlen(FileName), "",
         MassageLinksPath, RemoteUserPassEncoded, RemoteHostPort,
         RequestPathEncoded, FileNameEncoded, CwdFtpDirEncoded,
         MassageLinksPath, RemoteUserPassEncoded, RemoteHostPort,
         RequestPathEncoded, FileNameEncoded, CwdFtpDirEncoded, 
         MassageLinksPath, RemoteUserPassEncoded, RemoteHostPort,
         RequestPathEncoded, FileNameEncoded, CwdFtpDirEncoded);
   }

   fprintf (stdout, FtpFilesDirectories,
            FileCount, 0,
            FileCount ? FtpGetAs : "");
}

/****************************************************************************/
/*
Open a "socket" connect to the specific host name and port.  If 'IpAddressPtr'
is not NULL then set where it points to the 32 IP address of the remote system.
*/

OpenConnection
(
unsigned short *ChannelPtr,
char *RemoteName,
int RemotePort,
int *IpAddressPtr
)
{
   int  status,
        IpAddress;
   unsigned short Channel;
   char  *cptr;
   struct AnIOsb  IOsb;
   struct sockaddr_in  SocketName;
   struct hostent  *HostEntryPtr;

   struct {
      unsigned long  Length;
      void  *Address;
      int  *LengthPtr;
   } SocketNameItem =
      { sizeof(SocketName), &SocketName, 0 };

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

   if (WatchEnabled)
      WatchThis ("TCPIP CONNECT !AZ:!UL", RemoteName, RemotePort);

   if (isdigit((cptr = RemoteName)[0]))
      while (*cptr && (isdigit(*cptr) || *cptr == '.')) cptr++;
   if (!*cptr)
   {
      /*************************/
      /* address "131.185.2.4" */
      /*************************/

      if ((IpAddress = inet_addr (RemoteName)) == -1)
         return (vaxc$errno);
   }
   else
   {
      /***************************/
      /* address "the.host.name" */
      /***************************/

      if (!(HostEntryPtr = gethostbyname (RemoteName)))
      {
         if (vaxc$errno == RMS$_RNF) return (SS$_NOSUCHNODE);
         if (vaxc$errno == SS$_ENDOFFILE) return (SS$_NOSUCHNODE);
         return (vaxc$errno);
      }
      memcpy (&IpAddress, HostEntryPtr->h_addr, 4);
   }

   /* assign a channel to the internet template device */
   if (VMSnok (status = sys$assign (&InetDeviceDsc, &Channel, 0, 0)))
      return (status);

   /* make the channel a TCP, connection-oriented socket */
   status = sys$qiow (0, Channel, IO$_SETMODE, &IOsb, 0, 0,
                      &TcpSocket, 0, 0, 0, 0, 0);

   if (Debug)
      fprintf (stdout, "sys$qiow() %%X%08.08X IOsb.Status %%X%08.08X\n",
               status, IOsb.Status);
   if (VMSok (status) && VMSnok (IOsb.Status)) status = IOsb.Status;
   if (VMSnok (status)) return (status);

   SocketName.sin_family = AF_INET;
   SocketName.sin_port = htons (RemotePort);
   memcpy (&SocketName.sin_addr.s_addr, &IpAddress, 4);
   if (IpAddressPtr) memcpy (IpAddressPtr, &IpAddress, 4);

   status = sys$qiow (0, Channel, IO$_ACCESS, &IOsb, 0, 0,
                      0, 0, &SocketNameItem, 0, 0, 0);
   if (Debug)
      fprintf (stdout, "sys$qiow() %%X%08.08X IOsb.Status %%X%08.08X\n",
               status, IOsb.Status);

   if (VMSok (status) && VMSnok (IOsb.Status)) status = IOsb.Status;
   if (VMSok (status))
      *ChannelPtr = Channel;
   else
      *ChannelPtr = 0;
   return (status);
}

/****************************************************************************/
/*
Read from the specific "socket" into the the supplied buffer.  If 'AsText' is
true the allow for and supply a terminating null character.  If 'ReadCountPtr'
is not NULL then set it's location to the number of bytes read.
*/

int ReadConnection
(
unsigned short Channel,
char *DataBuffer,
int SizeOfDataBuffer,
int *ReadCountPtr,
BOOL AsText
)
{
   int  status;
   struct AnIOsb  IOsb;

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

   if (Debug)
      fprintf (stdout, "ReadConnection() %d %d\n", SizeOfDataBuffer, AsText);

   if (AsText) SizeOfDataBuffer--;

   status = sys$qiow (0, Channel, IO$_READVBLK, &IOsb, 0, 0,
                      DataBuffer, SizeOfDataBuffer, 0, 0, 0, 0);
   if (Debug)
      fprintf (stdout,
          "sys$qiow() status %%X%08.08X IOsb.Status %%X%08.08X %d bytes\n",
          status, IOsb.Status, IOsb.Count);

   if (VMSok (status) && VMSnok (IOsb.Status)) status = IOsb.Status;
   if (VMSok (status))
   {
      if (AsText)
      {
         DataBuffer[IOsb.Count] = '\0';
         if (Debug) fprintf (stdout, "|%s|\n", DataBuffer);
      }

      if (WatchEnabled)
      {
         WatchThis ("TCPIP READ !UL", IOsb.Count);
         WatchDump (DataBuffer, IOsb.Count);
      }

      if (ReadCountPtr) *ReadCountPtr = IOsb.Count;
   }
   else
   {
      if (WatchEnabled) WatchThis ("TCPIP READ %X!8XL", status);
      if (ReadCountPtr) *ReadCountPtr = 0;
   }

   return (status);
}

/****************************************************************************/
/*
Write the supplied data to the specific "socket".  If 'DataLength' is -1 then
consider the data to be a null-terminated string and get it's length using
strlen().
*/

int WriteConnection
(
unsigned short Channel,
char *DataPtr,
int DataLength
)
{
   int  status;
   struct AnIOsb  IOsb;

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

   if (Debug)
      fprintf (stdout, "WriteConnection() %d |%s|\n", DataLength, DataPtr);

   if (DataLength == -1) DataLength = strlen(DataPtr);

   if (WatchEnabled)
   {
      WatchThis ("TCPIP WRITE !UL", DataLength);
      WatchDump (DataPtr, DataLength);
   }

   status = sys$qiow (0, Channel, IO$_WRITEVBLK, &IOsb, 0, 0,
                      DataPtr, DataLength, 0, 0, 0, 0);
   if (Debug)
      fprintf (stdout, "sys$qiow() %%X%08.08X IOsb.Status %%X%08.08X\n",
               status, IOsb.Status);

   if (VMSok (status) && VMSnok (IOsb.Status)) status = IOsb.Status;

   if (WatchEnabled && VMSnok(status))
      WatchThis ("TCPIP WRITE %X!8XL", status);

   return (status);
}

/****************************************************************************/
/*
Script is being used as a quasi-proxy.  Examine the response header.  If not
"text/html" content type just return it directly to the client.  If HTML then
parse the body looking for things that look like HTTP URL links.   When found
either 1) prefix the link with the quasi-proxy server host name (and port if
not 80) and the quasi-proxy script name, or 2) convert it from an absolute to
relative link for reverse proxy purposes.
*/

MassageLinks ()

{
#define FLUSH_TO_CPTR { \
\
   if (cptr > BufferCurrentPtr) \
   { \
      ch = *cptr; \
      *cptr = '\0'; \
      fputs (BufferCurrentPtr, stdout); \
      *cptr = ch; \
   } \
}

   BOOL  FullUrl,
         NextPlease;
   char  ch;
   char  *cptr, *hptr, *sptr;

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

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

   cptr = BufferCurrentPtr = BufferPtr;
   cptr[BufferCount] = '\0';

   /* when massaging let's limit ourselves to HTTP/1.0 responses */
   if (!memcmp (cptr, "HTTP/1.1", 8)) memcpy (cptr, "HTTP/1.0", 8);

   while (*cptr)
   {
      if (toupper (cptr[0]) == 'C' && tolower(cptr[1]) == 'o' &&
          strsame (cptr, "Content-Type:", 13))
      {
         sptr = cptr + 13;
         if (Debug) fprintf (stdout, "|%13.13s|\n", cptr);
         while (*sptr && isspace(*sptr)) *sptr++;
         if (Debug) fprintf (stdout, "|%20.20s|\n", sptr);

         /* if not HTML, just output original data */
         if (!strsame (sptr, "text/html", 9))
         {
            fwrite (BufferPtr, BufferCount, 1, stdout);
            return;
         }
      }

      if (toupper(cptr[0]) == 'C' && strsame (cptr, "Content-Length:", 15))
      {
         /* as we're intending to alter the content disable the length field */
         memcpy (cptr, "C_ntent-L_ngth:", 15);
      }
      else
      if (toupper(cptr[0]) == 'S' && strsame (cptr, "Set-Cookie:", 11))
      {
         /* certain components will need massaging to reflect the proxy */
         cptr += 11;
         while (*cptr && *cptr != '\r' && *cptr != '\n')
         {
            if (tolower(*cptr) == 'd' && strsame (cptr, "domain=", 7))
            {
               /* make any cookie domain reflect the reverse-proxy server */
               cptr += 7;

               FLUSH_TO_CPTR
               while (*cptr && *cptr != ';' && *cptr != ',' && !isspace(*cptr))
                  cptr++;
               BufferCurrentPtr = cptr;

               fputs (CgiServerNamePtr, stdout);
            }
            else
            if (tolower(*cptr) == 'p' && strsame (cptr, "path=", 5) &&
                ReversePathPtr[0])
            {
               /* prepend the path discriminator */
               cptr += 5;

               FLUSH_TO_CPTR
               BufferCurrentPtr = cptr;

               fputs (ReversePathPtr, stdout);
            }
            else
               cptr++;
         }
      }
      else
      if ((toupper (cptr[0]) == 'L' &&
           strsame (cptr, "Location:", 9)) ||
          (toupper (cptr[0]) == 'C' &&
           strsame (cptr, "Content-Location:", 17)))
      {
         while (*cptr && *cptr != ' ') cptr++;
         if (*cptr == ' ') cptr++;

         FLUSH_TO_CPTR

         if (ReverseProxyPtr)
         {
            hptr = cptr + 7;
            if (!strsame (cptr, "http://", 7))
               fprintf (stdout, "%s", ReversePathPtr);
            else
            if (ReverseProxyPtr[0] == '*')
            {
               /* modify all full URLs */
               cptr = hptr;
               while (*cptr && *cptr != '/' &&
                      (isalnum(*cptr) || *cptr == '.' ||
                       *cptr == '-' || *cptr == '_')) cptr++;
               fprintf (stdout, "%s%s",
                        ReverseProxyPrefix, *cptr == '/' ? "" : "/");
            }
            else
            if (ReverseProxyPtr[0] == '#')
            {
               /* modify URLs only belonging to the proxied-to host */
               if (strsame (hptr, RemoteHostPort, RemoteHostPortLength) &&
                   !isalnum(hptr[RemoteHostPortLength]) &&
                   hptr[RemoteHostPortLength] != '.')
               {
                  /* matches the reverse-proxied-to host so modify */
                  cptr = hptr + RemoteHostPortLength;
                  fprintf (stdout, "%s%s",
                           ReverseProxyPrefix, *cptr == '/' ? "" : "/");
               }
            }
            else
            if (strsame (hptr, ReverseProxyPtr, ReverseProxyLength) &&
                !isalnum(hptr[ReverseProxyLength]) &&
                hptr[ReverseProxyLength] != '.')
            {
               /* matches the supplied string (host name) so modify */
               cptr = hptr + ReverseProxyLength;
               fprintf (stdout, "%s%s",
                        ReverseProxyPrefix, *cptr == '/' ? "" : "/");
            }
         }
         else
            fprintf (stdout, "%s%s", FetchPrefix, cptr);

         BufferCurrentPtr = cptr;
      }
 
      /* skip to end-of-line */
      while (*cptr && *cptr != '\r' && *cptr != '\n') cptr++;

      /* break if end of request header */
      if (*(unsigned long*)cptr == '\r\n\r\n')
      {
         cptr += 4;
         break;
      }
      if (*(unsigned short*)cptr == '\n\n')
      {
         cptr += 2;
         break;
      }

      /* skip to start-of-line */
      while (*cptr && (*cptr == '\r' || *cptr == '\n')) cptr++;
   }

   NextPlease = true;

   while (*cptr)
   {
      if (*cptr != '=')
      {
         cptr++;
         continue;
      }

      FullUrl = false;
      hptr = "";

      if (!memcmp (cptr, "=\"http://", 9))
      {
         if (Debug) fprintf (stdout, "|%9.9s|\n", cptr);
         cptr += 2;
         hptr = cptr + 7;
         FullUrl = true;
         NextPlease = false;
      }
      else
      if (!memcmp (cptr, "=\"ftp://", 8))
      {
         if (Debug) fprintf (stdout, "|%8.8s|\n", cptr);
         cptr += 2;
         hptr = cptr + 6;
         FullUrl = true;
         NextPlease = false;
      }
      else
      if (!memcmp (cptr, "=\'http://", 9))
      {
         if (Debug) fprintf (stdout, "|%9.9s|\n", cptr);
         cptr += 2;
         hptr = cptr + 7;
         FullUrl = true;
         NextPlease = false;
      }
      else
      if (!memcmp (cptr, "=\'ftp://", 8))
      {
         if (Debug) fprintf (stdout, "|%8.8s|\n", cptr);
         cptr += 2;
         hptr = cptr + 6;
         FullUrl = true;
         NextPlease = false;
      }
      else
      if (!memcmp (cptr, "=http://", 8))
      {
         if (Debug) fprintf (stdout, "|%8.8s|\n", cptr);
         cptr++;
         hptr = cptr + 7;
         FullUrl = true;
         NextPlease = false;
      }
      else
      if (!memcmp (cptr, "=ftp://", 7))
      {
         if (Debug) fprintf (stdout, "|%7.7s|\n", cptr);
         cptr++;
         hptr = cptr + 6;
         FullUrl = true;
         NextPlease = false;
      }
      else
      if (*(unsigned short*)(cptr+1) == '\"/')
      {
         if (Debug) fprintf (stdout, "|%2.2s|\n", cptr);
         sptr = cptr+2;
         while (*sptr && *sptr != '\"') sptr++;
         if (*sptr == '\"')
         {
            /* starts with a '="/' and ends with a '"', looks likely */
            if (Debug) fprintf (stdout, "|%c|\n", *sptr);
            cptr += 2;
            NextPlease = false;
         }
      }
      else
      if (*(unsigned short*)(cptr+1) == '\'/')
      {
         if (Debug) fprintf (stdout, "|%2.2s|\n", cptr);
         sptr = cptr+2;
         while (*sptr && *sptr != '\'') sptr++;
         if (*sptr == '\'')
         {
            /* starts with a '='/' and ends with a ''', looks likely */
            if (Debug) fprintf (stdout, "|%c|\n", *sptr);
            cptr += 2;
            NextPlease = false;
         }
      }
      else
      if (*(cptr+1) == '/')
      {
         if (Debug) fprintf (stdout, "|%2.2s|\n", cptr);
         sptr = cptr+1;
         while (*sptr &&
                *sptr != ' ' &&
                *sptr != '\t' &&
                *sptr != '>' &&
                *sptr != '\r' &&
                *sptr != '\n') sptr++;

         if (*sptr == ' ' ||
             *sptr == '\t' ||
             *sptr == '>' ||
             *sptr == '\r' ||
             *sptr == '\n')
         {
            /* starts with a '=/' and ends plausably, looks possible */
            if (Debug) fprintf (stdout, "|%c|\n", *sptr);
            cptr++;
            NextPlease = false;
         }
      }

      if (NextPlease)
      {
         cptr++;
         continue;
      }

      FLUSH_TO_CPTR

      if (FullUrl)
      {
         if (ReverseProxyPtr)
         {
            if (ReverseProxyPtr[0] == '*')
            {
               /* modify all full URLs */
               cptr = hptr;
               while (*cptr && *cptr != '/' &&
                      (isalnum(*cptr) || *cptr == '.' ||
                       *cptr == '-' || *cptr == '_')) cptr++;
               fprintf (stdout, "%s%s",
                        ReverseProxyPrefix, *cptr == '/' ? "" : "/");
            }
            else
            if (ReverseProxyPtr[0] == '#')
            {
               /* modify URLs only belonging to the proxied-to host */
               if (strsame (hptr, RemoteHostPort, RemoteHostPortLength) &&
                   !isalnum(hptr[RemoteHostPortLength]) &&
                   hptr[RemoteHostPortLength] != '.')
               {
                  /* matches the reverse-proxied-to host so modify */
                  cptr = hptr + RemoteHostPortLength;
                  fprintf (stdout, "%s%s",
                           ReverseProxyPrefix, *cptr == '/' ? "" : "/");
               }
            }
            else
            if (strsame (hptr, ReverseProxyPtr, ReverseProxyLength) &&
                !isalnum(hptr[ReverseProxyLength]) &&
                hptr[ReverseProxyLength] != '.')
            {
               /* matches the supplied string (host name) so modify */
               cptr = hptr + ReverseProxyLength;
               fprintf (stdout, "%s%s",
                        ReverseProxyPrefix, *cptr == '/' ? "" : "/");
            }
         }
         else
            fputs (MassageLinksPath, stdout);
      }
      else
      if (ReverseProxyPtr)
         fprintf (stdout, "%s%s", ReversePathPtr, *cptr == '/' ? "" : "/");
      else
         fprintf (stdout, "%shttp://%s%s",
                  MassageLinksPath, RemoteHostPort, *cptr == '/' ? "" : "/");

      BufferCurrentPtr = cptr++;

      NextPlease = true;
   }

   FLUSH_TO_CPTR
}

/*****************************************************************************/
/*
Hmmm, idea look familiar? :-)
*/

int WatchThis
(
char *FaoString,
...
)
{
   static unsigned long  LibStatTimerReal = 1,
                         LibStatTimerCpu = 2;

   static int  WatchCount;

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

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

   va_count (argcnt);

   if (Debug) fprintf (stdout, "WatchThis() %d |%s|\n", argcnt, FaoString);

   if (!FaoString)
   {
      if (WatchCount)
      {
         /* post-processing reset */
         lib$stat_timer (&LibStatTimerReal, &RealBinTime, 0);
         lib$stat_timer (&LibStatTimerCpu, &CpuBinTime, 0);
         WatchThis ("TIME REAL=!%T CPU=!UL.!2ZL",
                    &RealBinTime, CpuBinTime/100, CpuBinTime%100);
         WatchThis ("WATCH end");
         WatchEnabled = WatchCount = 0;

         /* back to binary mode (remove if necessary) */
         if (!(stdout = freopen ("SYS$OUTPUT:", "w", stdout, "ctx=bin")))
            exit (vaxc$errno);
         if (!(stderr = freopen ("SYS$OUTPUT:", "w", stderr, "ctx=bin")))
            exit (vaxc$errno);
      }
      else
      {
         /* pre-processing initialize */
         WatchCount = 1;

         /* back to record mode as WATCH is line-oriented output */
         if (!(stdout = freopen ("SYS$OUTPUT:", "w", stdout, "ctx=rec")))
            exit (vaxc$errno);
         if (!(stderr = freopen ("SYS$OUTPUT:", "w", stderr, "ctx=rec")))
            exit (vaxc$errno);

         lib$init_timer (0);
         fprintf (stdout,
"Content-Type: text/plain\nScript-Control: X-content-encoding-gzip=0\n\n");
         WatchThis ("WATCH begin");
      }
      return (SS$_NORMAL);
   }

   vecptr = FaoVector;
   *vecptr++ = WatchCount++;
   *vecptr++ = 0;
   va_start (argptr, FaoString);
   for (argcnt -= 1; argcnt; argcnt--)
      *vecptr++ = (unsigned long)va_arg (argptr, unsigned long);
   va_end (argptr);

   zptr = (sptr = FaoBuffer) + sizeof(FaoBuffer)-3;
   for (cptr = "|!4ZL|!%T|"; *cptr; *sptr++ = *cptr++);
   for (cptr = FaoString; *cptr && sptr < zptr; *sptr++ = *cptr++);
   *sptr++ = '|';
   *sptr++ = '\n';
   *sptr++ = '\0';
   FaoBufferDsc.dsc$a_pointer = FaoBuffer;
   FaoBufferDsc.dsc$w_length = sptr - FaoBuffer;
   status = sys$faol (&FaoBufferDsc, 0, &BufferDsc,
                      (unsigned long*)&FaoVector);
   if (Debug) fprintf (stdout, "sys$fao() %%X%08.08X\n", status);
   if (!(status & 1)) exit (status);
   fputs (Buffer, stdout);

   return (status);
}

/*****************************************************************************/
/*
Ditto? :-)
*/

int WatchDump
(
char *DataPtr,
int DataLength
)
{
   int  cnt, len;
   char  *cptr, *lptr, *sptr;
   char  WatchBuffer [256];

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

   if (Debug) fprintf (stdout, "WatchDump() %d\n", DataLength);

   cptr = DataPtr;
   len = DataLength;
   while (len)
   {
      sptr = WatchBuffer;
      lptr = cptr;
      cnt = 0;
      while (cnt < 32)
      {
         if (cnt < len)
            sptr += sprintf (sptr, "%02.02X", (unsigned char)*cptr++);
         else
         {
            *sptr++ = ' ';
            *sptr++ = ' ';
         }
         if (!(++cnt % 4)) *sptr++ = ' ';
      }
      *sptr++ = ' ';
      cptr = lptr;
      cnt = 0;
      while (cnt < 32 && cnt < len)
      {
         if (isprint(*cptr))
            *sptr++ = *cptr;
         else
            *sptr++ = '.';
         cptr++;
         cnt++;
      }
      if (len > 32) len -= 32; else len = 0;
      *sptr++ = '\n';
      *sptr = '\0';
      fputs (WatchBuffer, stdout);
   }

   return (1);
}

/*****************************************************************************/
/*
Translate a logical name using LNM$FILE_DEV.  Returns a pointer to the value
string, or NULL if the name does not exist.  If 'LogValue' is supplied the
logical name is translated into that (assumed to be large enough), otherwise
it's translated into an internal static buffer.  'IndexValue' should be zero
for a 'flat' logical name, or 0..127 for interative translations.
*/

char* TrnLnm
(
char *LogName,
char *LogValue,
int IndexValue
)
{
   static unsigned short  ValueLength;
   static unsigned long  LnmAttributes,
                         LnmIndex;
   static char  StaticLogValue [256];
   static $DESCRIPTOR (LogNameDsc, "");
   static $DESCRIPTOR (LnmFileDevDsc, "LNM$FILE_DEV");
   static struct {
      short int  buf_len;
      short int  item;
      void  *buf_addr;
      unsigned short  *ret_len;
   } LnmItems [] =
   {
      { sizeof(LnmIndex), LNM$_INDEX, &LnmIndex, 0 },
      { sizeof(LnmAttributes), LNM$_ATTRIBUTES, &LnmAttributes, 0 },
      { 255, LNM$_STRING, 0, &ValueLength },
      { 0,0,0,0 }
   };

   int  status;
   char  *cptr;

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

   if (Debug) fprintf (stdout, "TrnLnm() |%s| %d\n", LogName, IndexValue);

   LnmIndex = IndexValue;

   LogNameDsc.dsc$a_pointer = LogName;
   LogNameDsc.dsc$w_length = strlen(LogName);
   if (LogValue)
      cptr = LnmItems[2].buf_addr = LogValue;
   else
      cptr = LnmItems[2].buf_addr = StaticLogValue;

   status = sys$trnlnm (0, &LnmFileDevDsc, &LogNameDsc, 0, &LnmItems);
   if (Debug) fprintf (stdout, "sys$trnlnm() %%X%08.08X\n", status);
   if (!(status & 1) || !(LnmAttributes & LNM$M_EXISTS))
   {
      if (Debug) fprintf (stdout, "|(null)|\n");
      return (NULL);
   }

   cptr[ValueLength] = '\0';
   if (Debug) fprintf (stdout, "|%s|\n", cptr);
   return (cptr);
}

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

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 ("FETCH$PARAM")))
   {
      /* get the entire command line following the verb */
      if (VMSnok (status =
          lib$get_foreign (&CommandLineDsc, 0, &Length, &Flags)))
         exit (status);
      (clptr = CommandLine)[Length] = '\0';
   }

   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, "/BODY", 4))
      {
         DoResponseBody = true;
         continue;
      }
      if (strsame (aptr, "/NOBODY", 6))
      {
         DoResponseBody = false;
         continue;
      }

      if (strsame (aptr, "/CHECK", 4))
      {
         DoCheckOnly = true;
         continue;
      }

      if (strsame (aptr, "/CHUNK=", 4))
      {
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         BufferChunk = atoi(cptr);
         continue;
      }

      if (strsame (aptr, "/DBUG", -1))
      {
         Debug = true;
         continue;
      }

      if (strsame (aptr, "/ESCAPE_HTML", 4))
      {
         DoEscapeHtml = true;
         continue;
      }
      if (strsame (aptr, "/NOESCAPE_HTML", 6))
      {
         DoEscapeHtml = false;
         continue;
      }

      if (strsame (aptr, "/FETCH=", 4))
      {
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         FetchScriptNamePtr = cptr;
         continue;
      }

      if (strsame (aptr, "/FTP", 4))
      {
         DoFtp = true;
         continue;
      }

      if (strsame (aptr, "/HEADER", 4))
      {
         DoResponseHeader = true;
         continue;
      }
      if (strsame (aptr, "/NOHEADER", 6))
      {
         DoResponseHeader = false;
         continue;
      }

      if (strsame (aptr, "/HTTP", 4))
      {
         DoFtp = false;
         continue;
      }

      if (strsame (aptr, "/ICONS=", 4))
      {
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         IconPathPtr = cptr;
         continue;
      }

      if (strsame (aptr, "/METHOD=", 4))
      {
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         CliHttpMethodPtr = cptr;
         continue;
      }

      if (strsame (aptr, "/OUTPUT=", 4))
      {
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         OutputPtr = cptr;

         if (strsame (OutputPtr, "TT:", -1) ||
             strsame (OutputPtr, "TERMINAL", -1) ||
             strsame (OutputPtr, "SYS$OUTPUT", 10))
            OutputPtr = "";

         continue;
      }

      if (strsame (aptr, "/REPORT", 4))
      {
         DoReport = true;
         continue;
      }

      if (strsame (aptr, "/REVERSE=", 4))
      {
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         ReverseProxyPtr = cptr;
         ReverseProxyLength = strlen(cptr);
         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, "/URL=", 4))
      {
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         FetchUrlPtr = cptr;
         continue;
      }

      if (strsame (aptr, "/UNKNOWN=", 4))
      {
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         FtpDefaultContentTypePtr = cptr;
         continue;
      }

      if (strsame (aptr, "/USER_AGENT=", 4))
      {
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr) continue;
         UserAgentPtr = cptr;
         continue;
      }

      if (strsame (aptr, "/VERSION=", 4))
      {
         cptr = GetParameterString (aptr);
         if (!cptr || !*cptr)
         {
            fprintf (stdout, "%%%s-I-SOFTWAREID, %s\n%s\n",
                     Utility, SoftwareId, CopyrightInfo);
            exit (SS$_NORMAL);
         }
         if (strsame (cptr, "1.0", -1))
            RequestHttpVersion = 10;
         else
         if (strsame (cptr, "0.9", -1))
            RequestHttpVersion = 9;
         else
            RequestHttpVersion = -1;
         continue;
      }

      if (strsame (aptr, "/WATCH", 4))
      {
         WatchEnabled = true;
         continue;
      }

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

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

      fprintf (stdout, "%%%s-E-MAXPARM, too many parameters\n \\%s\\\n",
               Utility, aptr);
      exit (STS$K_ERROR | STS$M_INHIB_MSG);
   }
}

/*****************************************************************************/
/*
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 != '='; 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);
}

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

int SetLocalSymbol
(
char *SymbolName,
char *SymbolValue
)
{
   static int  LocalSymbol = LIB$K_CLI_LOCAL_SYM;
   static $DESCRIPTOR (SymbolNameDsc, "");
   static $DESCRIPTOR (SymbolValueDsc, "");

   int  status;

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

   if (WatchEnabled) WatchThis ("SYMBOL !AZ \"!AZ\"", SymbolName, SymbolValue);

   SymbolNameDsc.dsc$w_length = strlen(SymbolName);
   SymbolNameDsc.dsc$a_pointer = SymbolName;

   SymbolValueDsc.dsc$w_length = strlen(SymbolValue);
   SymbolValueDsc.dsc$a_pointer = SymbolValue;

   status = lib$set_symbol (&SymbolNameDsc, &SymbolValueDsc, &LocalSymbol);
   if (Debug) fprintf (stdout, "lib$set_symbol() %%X%08.08X\n", status);
   return (status);
}

/****************************************************************************/
/*
Does a case-insensitive, character-by-character string compare and returns
true if two strings are the same, or false if not.
*/

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

   if (count > 0)
      return (strncasecmp (sptr1, sptr2, count) == 0);
   else
      return (strcasecmp (sptr1, sptr2) == 0);
}
/****************************************************************************/