/*****************************************************************************/
/*
                                ProxyTunnel.c

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

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


WASD supports the CONNECT method which effectively allows tunnelling of RAW
octets through the proxy server.  This facility is most commonly used to allow
secure SSL connections to be established with hosts on the 'other side' of the
proxy server.  This basic mechanism is also used by WASD to provide an extended
range of tunnelling services.  The term 'RAW' is used here to indicate a raw
8 bit, bidirectional, asynchronous exchange of octets between two entities, as
a protocol family, not necessarily as an application (but can be so).

The mapping SET proxy=tunnel=request=<string> effectively allows requests to be
generated and sent to remote tunnel targets  allowing straight-forward mapping
at the remote end.  See example 7.


1. [ServiceProxyTunnel] CONNECT
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
A service with this configuration is used as a target for CONNECT proxying
(usually SSL through a firewall).  The client expects an HTTP success (200)
response once the remote connection is established, and HTTP error response if
there is a problem, and once established just relays RAW octets through the
proxy server (classic CONNECT behaviour).

  # WASD_CONFIG_SERVICE
  [[http://*:8080]]
  [ServiceProxy]  enabled
  [ServiceProxyTunnel]  connect

  # WASD_CONFIG_MAP
  [[*:8080]]
  if (request-method:connect)
     pass *:443 *:443
  endif
  pass "403"

This configuration enables CONNECT processing and limits any connect to SSL
tunneling (i.e. port 443 on the remote system).


2. [ServiceProxyTunnel] RAW
~~~~~~~~~~~~~~~~~~~~~~~~~~~
This allows any raw octet client (e.g. telnet) to connect to the port and by
mapping be tunnelled to another host and port to connect to it's service (e.g.
a telnet service).  The usual HTTP responses associated with CONNECT processing
are not provided.

  # WASD_CONFIG_SERVICE
  [[http://*:10023]]
  [ServiceProxy]  enabled
  [ServiceProxyTunnel]  raw

  # WASD_CONFIG_MAP
  [[*:10023]]
  if (request-method:connect)
     pass *:0 raw://another.host:23
  endif
  pass "403"

Telnet is used in the example above but the principle equally applies to any
protocol that uses a raw 8 bit, bidirectional, asynchronous exchange of
octets.  Another example might be an SMTP service (port 25).


3. RAW via a CHAINED PROXY
~~~~~~~~~~~~~~~~~~~~~~~~~~
This is basically the same as the RAW tunnel described in 2 above except that
it shows a tunnel being established through an up-stream, chained proxy.  It
relies of that proxy allowing a CONNECT to the destination host and more
importantly port required for the tunnel.  Not all CONNECT proxy will allow
this - it's quite common to restrict CONNECT to port 443.  This chained proxy
configuration is also supported for FIREWALL tunnelling.

  # WASD_CONFIG_SERVICE
  [[http://*:10025]]
  [ServiceProxy]  enabled
  [ServiceProxyTunnel]  raw

  # WASD_CONFIG_MAP
  [[*:10025]]
  if (request-method:connect)
     pass *:0 raw://another.host:25 proxy=chain=proxy.host:8080
  endif
  pass "403"

Any error in connecting to the chained proxy, making the request, connecting to
the destination, etc. (i.e. any error at all) is not reported.  The network
connection is just dropped.  Use WATCH to establish the cause if necessary.


4. [ServiceProxyTunnel] FIREWALL
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
With this configuration a service expects that the first line of text from the
client contains a host name (or IP address) and optional port (e.g.
"the.host.name" or "the.host.name:23").  This allows a variable destination to
be mapped.  The usual HTTP responses associated with CONNECT processing are not
provided.

  # WASD_CONFIG_SERVICE
  [[http://*:10023]]
  [ServiceProxy]  enabled
  [ServiceProxyTunnel]  FIREWALL

  # WASD_CONFIG_MAP
  [[*:10023]]
  if (request-method:connect)
     pass *:* raw://*:23
     pass * raw://*:23
  endif
  pass "403"

The pass rules force the supplied domain name (and optional port) to be mapped
to the telnet port (23).  Of course the mapping rules could allow the supplied
port to be mapped into the destination if desired.


5. ENCRYPTED TUNNEL
~~~~~~~~~~~~~~~~~~~
Up to this point the tunnels have merely been through the proxy server.  It is
possible to establish and maintain ENCRYPTED TUNNELS between WASD servers.  SSL
is used for this purpose.  This is slightly more complex as both ends of the
tunnel need to be configured.

                 +------------+             +------------+
  <-unencrypted->| WASD proxy |<-ENCRYPTED->| WASD proxy |<-unencrypted->
                 +------------+             +------------+

This arrangement may be used for any stream-oriented, network protocol between
two WASD systems.  As it uses standard CONNECT requests (over SSL) it MAY also
be possible to be configured between WASD and non-WASD servers.

The following example is going to maintain an encrypted tunnel between WASD
servers running on systems KLAATU and GORT.  It is designed to allow a user on
KLAATU to connect to a specified port using a telnet client, and have a telnet
session created on GORT, tunnelled between the two systems via an SSL encrypted
connection.

Source of tunnel:

  # KLAATU WASD_CONFIG_SERVICE
  [[http://*:10023]]
  [ServiceProxy]  enabled
  [ServiceClientSSL]  ENABLED
  [ServiceProxyTunnel]  RAW

  # KLAATU WASD_CONFIG_MAP
  [[*:10023]]
  # if the client is on the local subnet
  if (remote-addr:192.168.0.0/24 && request-method:connect)
     pass *:0 https://gort.domain:10443 timeout=none,none,none
  endif
  pass "403"

Destination of tunnel:

  # GORT WASD_CONFIG_SERVICE
  [[https://*:10443]]
  [ServiceProxy]  enabled
  [ServiceProxyTunnel]  CONNECT

  # GORT WASD_CONFIG_MAP
  [[*:10443]]
  # limit the connection to a specific host
  if (remote-addr:192.168.0.10 && request-method:connect)
     pass *:0 raw://gort.domain:23 timeout=none,none,none
  endif
  pass "403"

When a client connects to the service provided by port 10023 on system KLAATU
the connection is immediately processed using a pseudo CONNECT request header. 
The service on this port is a proxy allowed to initiate SSL connections (client
SSL).  This service is mapped to system GORT port 10443, an SSL service that
allows the CONNECT method (tunnelling).  KLAATU's proxy initiates an SSL
connection with GORT.  When established and the CONNECT request from KLAATU is
received, it is mapped via a raw tunnel (8 bit, etc.) to it's own system  port
23 (the telnet service).  Telnet is in use at both ends while encrypted by SSL
inbetween!  Note the use of network addresses and general fail rules used to
control access to this service, as well as the disabling of timers that might
otherwise shutdown the tunnel.


6. ENCRYPTED TUNNEL WITH AUTHENTICATION
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This arrangement is essentially a variation on example 4.  It provides a
cryptographic authentication of the originator (source) of the tunnel.

Source of tunnel:

  # KLAATU WASD_CONFIG_SERVICE
  [[http://*:10023]]
  [ServiceProxy]  enabled
  [ServiceClientSSL]  enabled
  [ServiceProxyTunnel]  RAW
  [ServiceClientSSLcert]  WASD_LOCAL:HTTPD.PEM

  # KLAATU WASD_CONFIG_MAP
  [[*:10023]]
  # if the client is on the local subnet
  if (remote-addr:192.168.0.0/24 && request-method:connect)
     pass *:0 https://gort.domain:10443 timeout=none,none,none
  endif
  pass "403"

Destination of tunnel:

  # GORT WASD_CONFIG_SERVICE
  [[https://*:10443]]
  [ServiceProxy]  enabled
  [ServiceProxyTunnel]  CONNECT
  [ServiceProxyAuth]  ENABLED

  # GORT WASD_CONFIG_MAP
  [[*:10443]]
  # we'll be relying on X509 authentication
  if (request-method:connect)
     pass *:0 raw://gort.domain:23 timeout=none,none,none
  endif
  pass "403"

  # GORT WASD_CONFIG_AUTH
  [[*:10443]]
  [X509]
  * r+w,param="[VF:OPTIONAL]",~4EAB3CBC735F8C7977EBB41D45737E37

This works by configuring the destination service to insist on proxy
authorization.  The authorization realm is X509 which causes the destination to
demand a certificate from the source.  The fingerprint of this certificate is
checked against the authorization rule before the connection is a allowed to
procede.


7. RAW via a CHAINED PROXY and ENCRYPTED TUNNEL
~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
This is similar to the RAW tunnel described in 2 above except that it shows a
tunnel being established through an up-stream, chained proxy to an SSL service
at the destination.

          +------------+        +-------------+        +------------+
  <--PT-->| WASD proxy |<--CT-->| chain proxy |<--CT-->| WASD proxy |<--PT-->
          +------------+        +-------------+        +------------+

This example shows a TELNET (plaintext, PT) service being transfered encrypted
(ciphertext, CT) between the two WASD servers.  The plain-text is private even
to the chained-proxy.  This example uses the standard SSL port 443 and relies
on capabilities available with WASD v10.1 and later.

Source of tunnel:

  # BARADA WASD_CONFIG_SERVICE
  [[http://*:10023]]
  [ServiceProxy]  enabled
  [ServiceProxyTunnel]  raw
  [ServiceClientSSL]  enabled

  # BARADA WASD_CONFIG_MAP
  [[*:10023]]
  if (request-method:connect)
     pass *:0 https://nikto.domain:443 proxy=chain=proxy.host:8080 \
              proxy=tunnel=request="CONNECT telnet"
  endif
  pass "403"

Any error in connecting to the chained proxy, making the request, connecting to
the destination, etc. (i.e. any error at all) is not reported.  The network
connection is just dropped.  Use WATCH to establish the cause if necessary.

Destination of tunnel:

  # NIKTO WASD_CONFIG_SERVICE
  [[https://*:443]]

  # NIKTO WASD_CONFIG_MAP
  [[*:443]]
  if (request-method:CONNECT && request-uri:TELNET)
     pass *:0 raw://nikto.domain:23 timeout=none,none,none
  endif


USAGE EXAMPLE 1
---------------
This is a real-world example used to allow a Mail client (in this case Mozilla
mail, aka Thunderbird) to connect securely to an IMAP and an SMTP server (which
don't natively support SSL) via a WASD tunnel.

Thunderbird settings:

IMAP ... Server Settings ... Use Secure Connection (SSL) ... checked
(that's the port 993).

Outgoing Server (SMTP) ... Use Secure Connection ... SSL ... checked
(that's the port 465).

WASD configuration:

  # WASD_CONFIG_SERVICE
  #
  # SSL->IMAP service
  [[https://*:993]]
  [ServiceProxy]  enabled
  [ServiceProxyTunnel]  RAW
  #
  # SSL->SMTP service
  [[https://*:465]]
  [ServiceProxy]  enabled
  [ServiceProxyTunnel]  RAW

  # WASD_CONFIG_MAP
  #
  # SSL->IMAP service
  [[*:993]]
  if (request-method:connect)
     pass *:0 raw://imap.host.name:143
  endif
  pass "403"
  #
  # SSL->SMTP service
  [[*:465]]
  if (request-method:connect)
     pass *:0 raw://smtp.host.name:25
  endif
  pass "403"


VERSION HISTORY
---------------
28-MAR-2024  MGD  ProxyTunnelLogicalName() prepend new value
                  ProxyTunnelLogicalName() WASD_TUNNEL_SECONDS >= 15
                  bugfix; ProxyTunnelLogicalName() SYSNAM for PSL$C_EXEC
30-JUL-2022  MGD  bugfix; ProxyTunnelLogicalName(NULL) from HttpdTick()
23-MAY-2022  MGD  bugfix; ProxyTunnelBegin() not ProxyTunnelRebuildRequest()
                    PROXY_TUNNEL_HTTP and PROXY_TUNNEL_HTTPS should NetRead()
15-AUG-2020  MGD  ProxyTunnelRequestParse() limit -> munge of the request
19-NOV-2019  MGD  ProxyTunnelBegin() support for reimplemented SHARE_SSH
02-SEP-2018  MGD  ProxyTunnelNetReadAst() "X-Forwarded-For:" from RequestGet()
26-JUL-2018  MGD  ProxyTunnelLogicalName() workaround for page pool leakage(?)
05-MAR-2018  MGD  ProxyTunnelLogicalName() WASD_TUNNEL_SECONDS
24-JAN-2018  MGD  ProxyTunnelLogicalName()
30-MAY-2016  MGD  ProxyTunnelRequestParse() append mapped path for logging
11-AUG-2015  MGD  restructure of network I/O abstractions
30-NOV-2010  MGD  ProxyTunnelNetReadAst() on error proactively close socket
07-SEP-2010  MGD  ProxyTunnelNetReadAst() inject a request
                  ProxyTunnelRebuildRequest() absorb header for tunnel upgrade
11-JAN-2010  JPP  bugfix; ProxyTunnelReadAst() data count tx
26-MAY-2007  MGD  ProxyTunnel..() provide for SSL client connections
03-SEP-2006  MGD  ProxyTunnelChainConnect() and ProxyTunnelChainConnectAst()
                  to implement raw tunnelling through an intermediate proxy
10-AUG-2004  MGD  'tunnelling' concept generalises CONNECT method
*/
/*****************************************************************************/

#ifdef WASD_VMS_V7
#undef _VMS__V6__SOURCE
#define _VMS__V6__SOURCE
#undef __VMS_VER
#define __VMS_VER 70000000
#undef __CRTL_VER
#define __CRTL_VER 70000000
#endif

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

/* VMS related header files */
#include <descrip.h>
#include <dvidef.h>
#include <iodef.h>
#include <lnmdef.h>
#include <psldef.h>
#include <ssdef.h>
#include <stsdef.h>

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

#define WASD_MODULE "PROXYTUNNEL"

#define TUNNEL_LOGNAM_TEST 0

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

PROXY_ACCOUNTING_STRUCT  *ProxyAccountingPtr;

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

extern BOOL  ProxyServingEnabled;

extern int  HttpdTickSecond;

extern char  ErrorSanityCheck[],
             SoftwareID[];

extern ulong  SysNamPrvMask[];

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

/*****************************************************************************/
/*
************
*** NOTE ***  This function takes a pointer to a request!!!
************

HTTP CONNECT method (allows SSL connections through proxy system).
Parse the host name and optional port from the request.
*/

ProxyTunnelRequestParse (REQUEST_STRUCT *rqptr)

{
   int  in, len, out;
   PROXY_TASK  *tkptr;
   char  *cptr, *sptr, *zptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_PROXY))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_PROXY,
                 "ProxyTunnelRequestParse() !&Z", rqptr->MappedPathPtr);

   /* if these two are different then */
   if (strcmp (rqptr->rqHeader.RequestUriPtr, rqptr->MappedPathPtr))
   {
      /* append the mapped tunnel to the request URI for logging purposes */
      len = strlen(rqptr->MappedPathPtr) + rqptr->rqHeader.RequestUriLength + 2;
      cptr = rqptr->rqHeader.RequestUriPtr;
      sptr = rqptr->rqHeader.RequestUriPtr = VmGetHeap (rqptr, len);
      while (*cptr) *sptr++ = *cptr++;
      *sptr++ = '-';
      *sptr++ = '>';
      for (cptr = rqptr->MappedPathPtr; *cptr; *sptr++ = *cptr++);
   }

   /*******************/
   /* WASD tunnelling */
   /*******************/

   tkptr = rqptr->ProxyTaskPtr;

   cptr = rqptr->MappedPathPtr;

   /* a pragmatic extension to the usual syntax allowed in CONNECT requests */
   if (strsame (cptr, "http://", 7))
   {
      /* unencrypted octets (expect HTTP response from remote) */
      tkptr->ProxyTunnel = PROXY_TUNNEL_HTTP;
      cptr += 7;
   }
   else
   if (strsame (cptr, "https://", 8))
   {
      /* encrypted octets (expect HTTP response from remote) */
      tkptr->ProxyTunnel = PROXY_TUNNEL_HTTPS;
      cptr += 8;
   }
   else
   if (strsame (cptr, "raw://", 6))
   {
      /* raw octets (expect NO HTTP response from remote) */
      tkptr->ProxyTunnel = PROXY_TUNNEL_RAW;
      cptr += 6;
   }
   else
   if (strsame (cptr, "socks5://", 9))
   {
      /* more raw octets */
      tkptr->ProxyTunnel = PROXY_TUNNEL_RAW;
      cptr += 9;
   }
   else
   {
      /* yet more raw octets, without CONNECT response */
      tkptr->ProxyTunnel = PROXY_TUNNEL_CONNECT;
   }

   /**************/
   /* accounting */
   /**************/

   /* [service-in][proxy-out] (array indices from zero of course!) */
   in = rqptr->ServicePtr->ProxyTunnel;
   if (in) in--;  /* just in case */
   out = tkptr->ProxyTunnel - 1;
   InstanceMutexLock (INSTANCE_MUTEX_HTTPD);
   ProxyAccountingPtr->TunnelCurrent++;
   ProxyAccountingPtr->TunnelCount[in][out]++;
   InstanceMutexUnLock (INSTANCE_MUTEX_HTTPD);

   /*************************/
   /* get server host name  */
   /*************************/

   zptr = (sptr = tkptr->RequestHostName) + sizeof(tkptr->RequestHostName)-1;
   while (*cptr && *cptr != ':' && *cptr != '/' && sptr < zptr)
      *sptr++ = *cptr++;

   if (sptr >= zptr || (*cptr && *cptr != ':'))
   {
      InstanceGblSecIncrLong (&AccountingPtr->RequestErrorCount);
      rqptr->rqResponse.HttpStatus = 502;
      ErrorGeneral (rqptr, MsgFor(rqptr,MSG_REQUEST_FORMAT), FI_LI);
      return (STS$K_ERROR);
   }
   *sptr = '\0';

   /******************************/
   /* get (optional) server port */
   /******************************/

   if (*cptr == ':')
   {
      cptr++;
      if (isdigit(*cptr))
      {
         zptr = (sptr = tkptr->RequestPortString) +
                sizeof(tkptr->RequestPortString)-1;
         while (*cptr && isdigit(*cptr) && sptr < zptr) *sptr++ = *cptr++;
         if (sptr >= zptr)
         {
            InstanceGblSecIncrLong (&AccountingPtr->RequestErrorCount);
            rqptr->rqResponse.HttpStatus = 502;
            ErrorGeneral (rqptr, MsgFor(rqptr,MSG_REQUEST_FORMAT), FI_LI);
            return (STS$K_ERROR);
         }
         *sptr = '\0';
         tkptr->RequestPort = atol (tkptr->RequestPortString);
      }
      else
      {
         tkptr->RequestPort = 443;
         memcpy (tkptr->RequestPortString, "443", 4);
      }
   }
   else
   {
      tkptr->RequestPort = 443;
      memcpy (tkptr->RequestPortString, "443", 4);
   }

   /****************************/
   /* build host name and port */
   /****************************/

   zptr = (sptr = tkptr->RequestHostPort) + sizeof(tkptr->RequestHostPort);
   for (cptr = tkptr->RequestHostName;
        *cptr && sptr < zptr;
        *sptr++ = *cptr++);
   if (sptr < zptr) *sptr++ = ':';
   for (cptr = tkptr->RequestPortString;
        *cptr && sptr < zptr;
        *sptr++ = *cptr++);
   if (sptr >= zptr)
   {
      rqptr->rqResponse.HttpStatus = 500;
      ErrorGeneralOverflow (rqptr, FI_LI);
      return (STS$K_ERROR);
   }
   *sptr = '\0';
   tkptr->RequestHostPortLength = sptr - tkptr->RequestHostPort;

   if (WATCHMOD (rqptr, WATCH_MOD_PROXY))
      WatchDataFormatted ("!&Z !UL !&Z !&Z\n",
                          tkptr->RequestHostName,
                          tkptr->RequestPort, tkptr->RequestPortString,
                          tkptr->RequestHostPort);

   return (SS$_NORMAL);
} 

/****************************************************************************/
/*
When explicitly tunnelling using HTTP or HTTPS use the request header line
("CONNECT host:port HTTP/1.1") to rebuild a request header containing the
original host specification provided in that request line but this time with
the proxied remote host in the "Host:" field.
*/ 

int ProxyTunnelRebuildRequest (PROXY_TASK *tkptr)

{
#define STRCAT(string) \
   for (cptr = string; *cptr && sptr < zptr; *sptr++ = *cptr++);

   char  *cptr, *sptr, *zptr;
   REQUEST_STRUCT  *rqptr;

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

   if (WATCHMOD (tkptr, WATCH_MOD_PROXY))
      WatchThis (WATCHITM(tkptr), WATCH_MOD_PROXY,
                 "ProxyTunnelRebuildRequest()");

   rqptr = tkptr->RequestPtr;

   if (rqptr->rqHeader.UpgradeWASDtunnel)
   {
      if (WATCHMOD (tkptr, WATCH_MOD_PROXY))
         WatchThis (WATCHITM(tkptr), WATCH_MOD_PROXY,
                    "Upgrade: WASD-tunnel");

      tkptr->RebuiltRequestPtr = "";
      tkptr->RebuiltRequestLength = 0;
      return (SS$_NORMAL);
   }

   tkptr->RebuiltRequestPtr = sptr =
      VmGetHeap (rqptr, rqptr->rqHeader.RequestHeaderLength + 512);
   zptr = sptr + rqptr->rqHeader.RequestHeaderLength + 512;

   for (cptr = rqptr->rqHeader.RequestHeaderPtr;
        *cptr && NOTEOL(*cptr) && sptr < zptr;
        *sptr++ = *cptr++);
   STRCAT ("\r\nUser-Agent: ");
   STRCAT (SoftwareID);
   STRCAT ("\r\nHost: ");
   STRCAT (tkptr->ConnectHostPortPtr);
   STRCAT ("\r\nX-Forwarded-For: ");
   STRCAT (&rqptr->ClientPtr->IpAddressString);
   STRCAT ("\r\n\r\n");

   if (sptr >= zptr)
   {
      rqptr->rqResponse.HttpStatus = 500;
      ErrorGeneralOverflow (rqptr, FI_LI);
      return (STS$K_ERROR);
   }
   *sptr = '\0';
   tkptr->RebuiltRequestLength = sptr - tkptr->RebuiltRequestPtr;

   if (WATCHMOD (tkptr, WATCH_MOD_PROXY))
      WatchDataFormatted ("!&Z", tkptr->RebuiltRequestPtr);

   return (SS$_NORMAL);

#undef STRCAT
}

/****************************************************************************/
/*
Begin processing appropriate to the mode of tunneling being employed.  This
includes vanilla HTTP CONNECT method processing as well as where this proxy
chains to another.  Called from ProxyNetHostConnectAst() or
SesolaNetClientConnect().
*/

ProxyTunnelBegin (PROXY_TASK *tkptr)

{
   char  *aptr, *cptr, *sptr, *zptr;
   DICT_ENTRY_STRUCT  *denptr;
   REQUEST_STRUCT *rqptr;

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

   if (WATCHMOD (tkptr, WATCH_MOD_PROXY))
      WatchThis (WATCHITM(tkptr), WATCH_MOD_PROXY,
                 "ProxyTunnelBegin() !UL", tkptr->ProxyTunnel);

   rqptr = tkptr->RequestPtr;

   if (!tkptr->TunnelEstablished)
   {
      tkptr->TunnelEstablished = true;

      if (WATCHING (tkptr, WATCH_PROXY))
      {
         switch (tkptr->ProxyTunnel)
         {
            case PROXY_TUNNEL_CONNECT : cptr = "CONNECT"; break;
            case PROXY_TUNNEL_HTTP : cptr = "HTTP"; break;
            case PROXY_TUNNEL_HTTPS : cptr = "HTTPS"; break;
            case PROXY_TUNNEL_RAW :
                 if (rqptr->rqHeader.UpgradeSocks5Ptr)
                    cptr = "RAW/SOCKS5";
                 else
                    cptr = "RAW";
                 break;
            default : cptr = "?";
         }
         WatchThis (WATCHITM(tkptr), WATCH_PROXY,
                    "TUNNEL (!AZ) established", cptr);
      }

      if (rqptr->rqHeader.UpgradeSocks5Ptr)
         ProxySocks5Reply (rqptr, SOCKS5_REPLY_SUCCESS);

      ProxyTunnelLogicalName (tkptr);
   }

   if (rqptr->rqPathSet.ProxyTunnelRequestLength)
   {
      if (!tkptr->TunnelRequestGenerated)
      {
         if (WATCHING (tkptr, WATCH_PROXY))
            WatchThis (WATCHITM(rqptr), WATCH_PROXY, "TUNNEL=REQUEST !AZ",
                       rqptr->rqPathSet.ProxyTunnelRequestPtr);

         aptr = sptr =
            VmGetHeap (rqptr, rqptr->rqPathSet.ProxyTunnelRequestLength+128);
         for (cptr = rqptr->rqPathSet.ProxyTunnelRequestPtr;
              *cptr;
              *sptr++ = *cptr++);
         if (!strstr (aptr, "HTTP/1."))
            for (cptr = " HTTP/1.0\r\n"; *cptr; *sptr++ = *cptr++);
         for (cptr = "Upgrade: WASD-tunnel; "; *cptr; *sptr++ = *cptr++);
         for (cptr = SoftwareID; *cptr; *sptr++ = *cptr++);
         for (cptr = "\r\n\r\n"; *cptr; *sptr++ = *cptr++);

         /* AST back to this same function */
         ProxyNetWrite (tkptr, &ProxyTunnelBegin, aptr, sptr-aptr);

         tkptr->TunnelRequestGenerated = true;
         return;
      }
   }

   TcpIpSocketMaxQio (tkptr->NetIoPtr);

   if (tkptr->ProxyTunnel == PROXY_TUNNEL_CONNECT)
   {
      /* CONNECT success response needs to be returned to the client */
      ResponseHeader (rqptr, tkptr->ResponseStatusCode,
                      NULL, -1, NULL, NULL);
      denptr = ResponseDictHeader (rqptr);
      /* ensure this is performed as a data (not header) write */
      rqptr->rqResponse.HeaderSent = true;
      NetWrite (rqptr, &ProxyTunnelConnectResponseAst,
                DICT_GET_VALUE(denptr), DICT_GET_VALUE_LEN(denptr));
      return;
   }

   if (tkptr->ProxyTunnel == PROXY_TUNNEL_HTTP)
   {
      /* rebuild the CONNECT request */
      ProxyTunnelRebuildRequest (tkptr);

      /* send the request on through the tunnel */
      if (tkptr->RebuiltRequestLength)
         ProxyNetWrite (tkptr, &ProxyTunnelWriteAst,
                        tkptr->RebuiltRequestPtr,
                        tkptr->RebuiltRequestLength);
      else
         NetRead (rqptr, &ProxyTunnelNetReadAst,
                  rqptr->rqNet.ReadBufferPtr,
                  rqptr->rqNet.ReadBufferSize);

      /* queue a read direct from the tunneled-to service */
      ProxyNetRead (tkptr, &ProxyTunnelReadAst,
                    tkptr->ResponseBufferPtr, tkptr->ResponseBufferSize);
      return;
   }

   if (tkptr->ProxyTunnel == PROXY_TUNNEL_HTTPS)
   {
      /* rebuild the CONNECT request */
      ProxyTunnelRebuildRequest (tkptr);

      /* send the request on through the tunnel */
      if (tkptr->RebuiltRequestLength)
         ProxyNetWrite (tkptr, &ProxyTunnelWriteAst,
                        tkptr->RebuiltRequestPtr,
                        tkptr->RebuiltRequestLength);
      else
         NetRead (rqptr, &ProxyTunnelNetReadAst,
                  rqptr->rqNet.ReadBufferPtr,
                  rqptr->rqNet.ReadBufferSize);

      /* queue a read direct from the tunneled-to service */
      NetIoRead (tkptr->NetIoPtr, &ProxyTunnelReadAst, tkptr,
                 tkptr->ResponseBufferPtr, tkptr->ResponseBufferSize);
      return;
   }

   if (tkptr->ProxyTunnel == PROXY_TUNNEL_RAW)
   {
      if (rqptr->rqHeader.Method == HTTP_METHOD_SHARE_SSH &&
          !MATCH8 (rqptr->rqNet.ReadBufferPtr, "SSH-(timeout)"))
         /* write the client SSH ident string to the server */
         ProxyNetWrite (tkptr, &ProxyTunnelWriteAst,
                        rqptr->rqNet.ReadBufferPtr,
                        rqptr->NetIoPtr->ReadCount);
      else
         /* queue a read direct from the client */
         NetRead (rqptr, &ProxyTunnelNetReadAst,
                  rqptr->rqNet.ReadBufferPtr,
                  rqptr->rqNet.ReadBufferSize);

      /* queue a read direct from the tunneled-to service */
      ProxyNetRead (tkptr, &ProxyTunnelReadAst,
                    tkptr->ResponseBufferPtr, tkptr->ResponseBufferSize);
      return;
   }

   if (tkptr->ProxyTunnel == PROXY_TUNNEL_FIREWALL)
   {
      /* CONNECT success response needs to be returned to the client */
      ResponseHeader (rqptr, tkptr->ResponseStatusCode,
                      NULL, -1, NULL, NULL);
      denptr = ResponseDictHeader (rqptr);
      /* ensure this is performed as a data (not header) write */
      rqptr->rqResponse.HeaderSent = true;
      NetWrite (rqptr, &ProxyTunnelConnectResponseAst,
                DICT_GET_VALUE(denptr), DICT_GET_VALUE_LEN(denptr));
      return;
   }

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

/****************************************************************************/
/*
Generate a CONNECT request header for the request host:port derived by
ProxyTunnelRequestParse() and then write this to the chained proxy server.
*/ 

int ProxyTunnelChainConnect (PROXY_TASK *tkptr)

{
#define STRCAT(string) \
   for (cptr = string; *cptr && sptr < zptr; *sptr++ = *cptr++);

   char  *cptr, *sptr, *zptr;
   char  EncodedString [256];
   REQUEST_STRUCT  *rqptr;

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

   if (WATCHMOD (tkptr, WATCH_MOD_PROXY))
      WatchThis (WATCHITM(tkptr), WATCH_MOD_PROXY,
                 "ProxyTunnelChainConnect()");

   rqptr = tkptr->RequestPtr;

   tkptr->RebuiltRequestPtr = sptr = VmGetHeap (rqptr, 512);  
   zptr = sptr + 512;

   STRCAT ("CONNECT ");
   STRCAT (tkptr->RequestHostPort);
   if (tkptr->RequestHttpVersion == HTTP_VERSION_1_1)
      STRCAT (" HTTP/1.1")
   else
      STRCAT (" HTTP/1.0")
   STRCAT ("\r\nUser-Agent: ");
   STRCAT (SoftwareID);
   STRCAT ("\r\nHost: ");
   STRCAT (tkptr->ConnectHostPortPtr);
   STRCAT ("\r\nX-Forwarded-For: ");
   STRCAT (&rqptr->ClientPtr->IpAddressString);
   STRCAT ("\r\n");

   if ((cptr = rqptr->ServicePtr->ProxyChainCred)[0] ||
       (cptr = rqptr->rqPathSet.ProxyChainCredPtr))
   {
      /* upstream (chained) proxy require authorization */
      if (strsame (cptr, "basic:", 6))
      {
         /* format is "basic:<username>:<password>" */
         cptr = BasicPrintableEncode (cptr+6, EncodedString,
                                              sizeof(EncodedString));
         if (cptr[0])
         {
            /* error report returned by the encode function */
            rqptr->rqResponse.HttpStatus = 401;
            ErrorGeneral (rqptr, cptr, FI_LI);
            return (STS$K_ERROR);
         }
         STRCAT ("Proxy-Authorization: basic ");
         STRCAT (EncodedString);
         STRCAT ("\r\n")
      }
      else
      {
         rqptr->rqResponse.HttpStatus = 500;
         ErrorGeneral (rqptr, MsgFor(rqptr,MSG_AUTH_SCHEME), FI_LI);
         return (STS$K_ERROR);
      }
   }
   STRCAT ("\r\n");

   if (sptr >= zptr)
   {
      rqptr->rqResponse.HttpStatus = 500;
      ErrorGeneralOverflow (rqptr, FI_LI);
      return (STS$K_ERROR);
   }
   *sptr = '\0';
   tkptr->RebuiltRequestLength = sptr - tkptr->RebuiltRequestPtr;

   if (WATCHMOD (tkptr, WATCH_MOD_PROXY))
      WatchDataFormatted ("!&Z", tkptr->RebuiltRequestPtr);

   /* to the CONNECT request write synchonously */
   ProxyNetWrite (tkptr, NULL,
                  tkptr->RebuiltRequestPtr, tkptr->RebuiltRequestLength);

   /* queue a read for the CONNECT response */
   ProxyNetRead (tkptr, &ProxyTunnelChainConnectAst,
                 tkptr->ResponseBufferPtr, tkptr->ResponseBufferSize);

   return (SS$_NORMAL);

#undef STRCAT
}

/****************************************************************************/
/*
The chained proxy server has responded to the CONNECT request.  Check for
network errors and that the response looks something like HTTP success. If it
does begin reading from each of the client and the chained proxy server.
*/

ProxyTunnelChainConnectAst (PROXY_TASK *tkptr)

{
   int  DataCount;
   char  *DataPtr;
   REQUEST_STRUCT  *rqptr;

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

   if (WATCHMOD (tkptr, WATCH_MOD_PROXY))
      WatchThis (WATCHITM(tkptr), WATCH_MOD_PROXY,
                 "ProxyTunnelChainConnectAst() !&F !&S !UL",
                 &ProxyTunnelChainConnectAst,
                 tkptr->NetIoPtr->ReadStatus,
                 tkptr->NetIoPtr->ReadCount);

   if (VMSnok (tkptr->NetIoPtr->ReadStatus))
   {
      ProxyEnd (tkptr);
      return;
   }

   DataPtr = tkptr->ResponseBufferPtr;
   DataCount = tkptr->NetIoPtr->ReadCount;

   if (WATCHMOD (tkptr, WATCH_MOD_PROXY))
      WatchDataDump (DataPtr, DataCount);

   DataPtr[DataCount] = '\0';
   if (!MATCH7 (DataPtr, "HTTP/1."))
   {
      ProxyEnd (tkptr);
      return;
   }
   DataPtr += 7;
   while (*DataPtr && *DataPtr != ' ') DataPtr++; 
   while (*DataPtr == ' ') DataPtr++; 
   if (!MATCH3 (DataPtr, "200"))
   {
      ProxyEnd (tkptr);
      return;
   }

   rqptr = tkptr->RequestPtr;

   /* it's successful if the remote host accepts it */
   if (rqptr) rqptr->rqResponse.HttpStatus = 200;

   /* once we start reading into the buffer the request header is kaput */
   rqptr->rqHeader.RequestHeaderPtrInvalid = true;

   if (tkptr->ProxyTunnel == PROXY_TUNNEL_HTTPS)
      SesolaNetClientBegin (tkptr);
   else
      ProxyTunnelBegin (tkptr);
}

/****************************************************************************/
/*
************
*** NOTE ***  This function takes a pointer to a request!!!
************

A standard CONNECT response has been sent to the client by this server.
It is necessary to provide this explicitly with a 'raw' connection.
Check status.  If OK then begin to tunnel.
*/

ProxyTunnelConnectResponseAst (REQUEST_STRUCT *rqptr)

{
   PROXY_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_PROXY))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_PROXY,
                 "ProxyTunnelConnectResponseAst() !&F !&S !UL",
                 &ProxyTunnelConnectResponseAst,
                 rqptr->NetIoPtr->WriteStatus,
                 rqptr->NetIoPtr->WriteCount);

   tkptr = rqptr->ProxyTaskPtr; 

   if (VMSnok (rqptr->NetIoPtr->WriteStatus))
   {
      ProxyEnd (tkptr);
      return;
   }

   NetRead (rqptr, &ProxyTunnelNetReadAst,
            rqptr->rqNet.ReadBufferPtr,
            rqptr->rqNet.ReadBufferSize);

   ProxyNetRead (tkptr, &ProxyTunnelReadAst,
                 tkptr->ResponseBufferPtr,
                 tkptr->ResponseBufferSize);
}

/****************************************************************************/
/*
************
*** NOTE ***  This function takes a pointer to a request!!!
************

A read from the client has completed.
Check status.  If OK write it to the remote connection.

This function is also used to insert an "X-Forwarded-For: <client-ip-addr>"
header immediately following the HTTP request line, if the path is SET
"proxy=xforwardedfor=address", as in the following example

   pass *:0 raw://192.168.1.15:80 notimeout proxy=xforwardedfor=address 

The algorithm relies on the HTTP request line being at the front of a read
buffer and there be no pipelined requests inside buffer-fulls of tunneled data. 
So each request  must have a distinct beginning and end in the network reads
and writes, which is (mostly and generally) the case.
*/

ProxyTunnelNetReadAst (REQUEST_STRUCT *rqptr)

{
   int  bcnt, xflen, rlen;
   char  ch;
   char  *bptr, *cptr, *czptr, *xfptr;
   PROXY_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_PROXY))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_PROXY,
                 "ProxyTunnelNetReadAst() !&F !&S !UL",
                 &ProxyTunnelNetReadAst,
                 rqptr->NetIoPtr->ReadStatus,
                 rqptr->NetIoPtr->ReadCount);

   tkptr = rqptr->ProxyTaskPtr; 

   if (VMSnok (rqptr->NetIoPtr->ReadStatus))
   {
      ProxyNetCloseSocket (tkptr);
      ProxyEnd (tkptr);
      return;
   }

   rqptr->BytesRx64 += rqptr->NetIoPtr->ReadCount;

   bptr = rqptr->rqNet.ReadBufferPtr;
   bcnt = rqptr->NetIoPtr->ReadCount;

   if ((rqptr->rqPathSet.ProxyXForwardedFor == PROXY_XFORWARDEDFOR_ADDRESS) &&
       (xfptr = rqptr->rqHeader.XForwardedForPtr))
   {
      rlen = 0;
      for (czptr = (cptr = bptr) + bcnt;
           cptr < czptr && !MATCH2(cptr,"\r\n") && *cptr != '\n';
           cptr++)
      {
         if (MATCH7 (cptr, "HTTP/1."))
         {
            cptr += 7;
            if (!(MATCH2 (cptr, "1\n") || MATCH3 (cptr, "1\r\n") ||
                  MATCH2 (cptr, "0\n") || MATCH3 (cptr, "0\r\n")))
               continue;
            /* found end-of-line that looks suspiciously like an HTTP request */
            cptr++;
            if (*cptr == '\r') cptr++;
            if (*cptr == '\n') cptr++;
            /* length of request line */
            rlen = cptr - bptr;
            break;
         }
      } 

      if (rlen)
      {
         /* found what looks like an HTTP request line */
         xflen = strlen(xfptr) + sizeof("X-Forwarded-For: %s\r\n")-3;

         if (bcnt + xflen > rqptr->NetIoPtr->ReadSize)
         {
            /* won't fit into the original buffer */
            bptr = VmGetHeap (rqptr, bcnt + xflen);  
            memcpy (bptr, rqptr->rqNet.ReadBufferPtr, bcnt);
         }

         /* move to allow insertion of the forwarded line */
         memmove (bptr + rlen + xflen, bptr + rlen, bcnt - rlen);

         /* insert the forwarded line reversing the trailing null overwrite */
         ch = *(bptr + rlen + xflen);
         sprintf (bptr + rlen, "X-Forwarded-For: %s\r\n", xfptr);
         *(bptr + rlen + xflen) = ch;

         /* length of the buffer is the original plus length of forwarded */
         bcnt += xflen;
      }
   }

   ProxyNetWrite (tkptr, &ProxyTunnelWriteAst, bptr, bcnt);
}

/****************************************************************************/
/*
************
*** NOTE ***  This function takes a pointer to a request!!!
************

A write to the client has completed.
Check status.  If OK read more from the remote connection.
*/

ProxyTunnelNetWriteAst (REQUEST_STRUCT *rqptr)

{
   PROXY_TASK  *tkptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_PROXY))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_PROXY,
                 "ProxyTunnelNetWriteAst() !&F !&S !UL",
                 &ProxyTunnelNetWriteAst,
                 rqptr->NetIoPtr->WriteStatus,
                 rqptr->NetIoPtr->WriteCount);

   tkptr = rqptr->ProxyTaskPtr; 

   if (VMSnok (rqptr->NetIoPtr->WriteStatus))
   {
      ProxyEnd (tkptr);
      return;
   }

   ProxyNetRead (tkptr, &ProxyTunnelReadAst,
                 tkptr->ResponseBufferPtr,
                 tkptr->ResponseBufferSize);
}

/****************************************************************************/
/*
AST completion of read from remote connection.
Check status.  If OK write it to the client connection.
*/

ProxyTunnelReadAst (PROXY_TASK *tkptr)

{
   int  DataCount;
   char  *cptr, *zptr,
         *DataPtr;
   REQUEST_STRUCT *rqptr;

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

   if (WATCHMOD (tkptr, WATCH_MOD_PROXY))
      WatchThis (WATCHITM(tkptr), WATCH_MOD_PROXY,
                 "ProxyTunnelReadAst() !&F !&S !UL",
                 &ProxyTunnelReadAst,
                 tkptr->NetIoPtr->ReadStatus,
                 tkptr->NetIoPtr->ReadCount);

   rqptr = tkptr->RequestPtr;

   if (VMSnok (tkptr->NetIoPtr->ReadStatus))
   {
      ProxyEnd (tkptr);
      return;
   }

   DataPtr = tkptr->ResponseBufferPtr;
   DataCount = tkptr->NetIoPtr->ReadCount;

   if (tkptr->ProxyTunnel == PROXY_TUNNEL_HTTP ||
       tkptr->ProxyTunnel == PROXY_TUNNEL_HTTPS)
   {
      rqptr->BytesTx64 += DataCount;
      NetWrite (rqptr, &ProxyTunnelNetWriteAst, DataPtr, DataCount);
      return;
   }

   if (tkptr->ProxyTunnel == PROXY_TUNNEL_CONNECT &&
       (rqptr->ServicePtr->ProxyTunnel == PROXY_TUNNEL_FIREWALL ||
        rqptr->ServicePtr->ProxyTunnel == PROXY_TUNNEL_RAW))
   {
      /* need to absorb any CONNECT response header */
      if (tkptr->ResponseConsecutiveNewLineCount < 2)
      {
         zptr = (cptr = DataPtr) + DataCount;
         while (cptr < zptr)
         {
            if (*cptr == '\n')
               tkptr->ResponseConsecutiveNewLineCount++;
            else
            if (*cptr != '\r')
               tkptr->ResponseConsecutiveNewLineCount = 0;
            cptr++;
            if (tkptr->ResponseConsecutiveNewLineCount >= 2) break;
         }
         DataCount -= cptr - DataPtr;
         DataPtr = cptr;

         if (!DataCount)
         {
            /* fudge these and directly deliver the AST */
            NetIoWriteStatus (rqptr->NetIoPtr, ProxyTunnelNetWriteAst, rqptr,
                              SS$_NORMAL, 0);
            return;
         }
      }
   }

   rqptr->BytesTx64 += DataCount;
   NetWrite (rqptr, &ProxyTunnelNetWriteAst, DataPtr, DataCount);
}

/****************************************************************************/
/*
A write to the remote connection has completed. 
Check status.  If OK read more from the client connection.
*/

ProxyTunnelWriteAst (PROXY_TASK *tkptr)

{
   REQUEST_STRUCT *rqptr;

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

   if (WATCHMOD (tkptr, WATCH_MOD_PROXY))
      WatchThis (WATCHITM(tkptr), WATCH_MOD_PROXY,
                 "ProxyTunnelWriteAst() !&F !&S !UL",
                 &ProxyTunnelWriteAst,
                 tkptr->NetIoPtr->WriteStatus,
                 tkptr->NetIoPtr->WriteCount);

   rqptr = tkptr->RequestPtr;

   if (VMSnok (tkptr->NetIoPtr->WriteStatus))
   {
      ProxyEnd (tkptr);
      return;
   }

   NetRead (rqptr, &ProxyTunnelNetReadAst,
            rqptr->rqNet.ReadBufferPtr,
            rqptr->rqNet.ReadBufferSize);
}

/****************************************************************************/
/*
Function name indicates all!
*/

#if TUNNEL_LOGNAM_TEST

int ProxyTunnelTestPort = 10000;

ProxyTunnelTest ()

{
   int  count;
   REQUEST_STRUCT *rqptr;
   PROXY_TASK  *tkptr;

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

   for (count = 0; count < 260; count++)
   {
      rqptr = VmGet (sizeof(REQUEST_STRUCT));
      rqptr->WatchItem = 999;
      rqptr->ClientPtr = VmGet (sizeof(CLIENT_STRUCT));
      rqptr->ServicePtr = VmGet (sizeof(SERVICE_STRUCT));
      rqptr->rqPathSet.ProxyForwardedBy = PROXY_FORWARDED_ADDRESS;
      strzcpy (rqptr->ServicePtr->ServerHostPort, "server.host:80", 32);
      strzcpy (rqptr->ClientPtr->IpAddressString, "192.168.1.1", 32);
      rqptr->ClientPtr->IpPort = ProxyTunnelTestPort++ + 1000;

      tkptr = VmGet (sizeof(PROXY_TASK));
      tkptr->WatchItem = rqptr->WatchItem;
      tkptr->RequestPtr = rqptr;
      strzcpy (tkptr->RequestHostName, "request.host", 32);

      ProxyTunnelLogicalName (tkptr);
      sleep (1);
   }
}

#endif /* TUNNEL_LOGNAM_TEST */

/****************************************************************************/
/*
Multiple value logical name WASD_TUNNEL where the zeroeth element contains
internal run-time data for use by WASD and elements 1 through 127 contain the
tunnel data.

The path must be SET .. PROXY=FORWARDED=FOR or SET .. PROXY=FORWARDED=ADDRESS
for the logical name to be created.  "=FOR" uses the resolved client host name
(if enabled) and "=ADDRESS" always the client IP address.

Tunnel data value format:

<internal-host:port>=<external-host:port>=<client-host:port>

"localhost:54321=external.host.net:2222=client.host.net:23456"

Where 'localhost:54321' is the internal host name and port,
'external.host.net:2222' the external service the client connected to, and
'client.host.net:23456' the client's host and port.

By default the logical name will be deleted if a minute or more has passed
since last updated.  This can be increased by defining the logical name
WASD_TUNNEL_SECONDS to an integer value of seconds.  The deletion can be
disabled completely by defining it to zero or some non-digit.

ProxyTunnelLogicalName(NULL) is called by HttpdTick() every minute.

The INSTANCE_MUTEX_HTTPD is used to coordinate potential multiple instances.

Example DCL code to extract the client "<host>:<port>" using the <port>
provided by TT_ACCPORNAM.  If it is not found logical name TT_CLIENT does not
exist.  Adapt to suit local requirements.

$ if P1 .eqs. "" then P1 = f$element(1,":",f$getdvi("TT:","TT_ACCPORNAM"))
$ value = ""
$ local = ""
$ service = ""
$ client = ""
$ index = 1
$ index_loop:
$    value = f$trnlnm("WASD_TUNNEL","WASD_TABLE",index)
$    if value .eqs. ""
$    then
$       wait 00:00:01
$       value = f$trnlnm("WASD_TUNNEL","WASD_TABLE",index)
$    endif
$    if value .eqs. "" then goto end_index_loop
$    local = f$element(0,"=",value)
$    addr = f$element(0,":",local)
$    port = f$element(1,":",local)
$    if port .eqs. P1
$    then
$       service = f$element(1,"=",value)
$       client = f$element(2,"=",value)
$       goto end_index_loop
$    endif
$    index = index + 1
$    goto index_loop
$ end_index_loop:
$ if f$trnlnm("TT_CLIENT","LNM$PROCESS") .nes. "" -
     then deassign /process TT_CLIENT
$ if client .nes. "" then define /process TT_CLIENT "''client'"

*/

ProxyTunnelLogicalName (PROXY_TASK *tkptr)

{
   static int  LnmCount,
               TunnelSeconds;
   static char  LogicalName[] = "WASD_TUNNEL";
   static $DESCRIPTOR (LogNameDsc, LogicalName);
   static $DESCRIPTOR (WasdTableDsc, "WASD_TABLE");
   static $DESCRIPTOR (NumberFaoDsc, "!UL");
   static $DESCRIPTOR (StampFaoDsc, "!UL !%D !UL");
   static uchar  ExecMode = 1;  /* PSL$C_EXEC */
   static VMS_ITEM_LIST3 LnmItems [] =
   {
      { sizeof(LnmCount), LNM$_INDEX, &LnmCount, 0 },
      { 255, LNM$_STRING, 0, 0 },
      { 0,0,0,0 }
   };

   int  idx, port, status,
        TickSecond,
        TrnLnmStatus;
   short  slen;
   short  LogValueLength [128];
   char  *cptr, *clptr, *sptr, *zptr;
   char  LocalHostPort [255+1],
         LogValue [128][255+1],
         PortString [32];
   REQUEST_STRUCT *rqptr;
   $DESCRIPTOR (PortStringDsc, PortString);
   $DESCRIPTOR (StampDsc, LogValue[0]);
   VMS_ITEM_LIST3 CreLnmItems [128+1];

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

   if (WATCHMOD (tkptr, WATCH_MOD_PROXY))
      WatchThis (WATCHITM(tkptr), WATCH_MOD_PROXY, "ProxyTunnelLogicalName()");

   if (!tkptr)
   {
      /************/
      /* maintain */
      /************/

#if TUNNEL_LOGNAM_TEST
      static int  count;
      if (!count++) return;
      ProxyTunnelTest ();
      return;
#endif

      if (!ProxyServingEnabled) return;

      InstanceMutexLock (INSTANCE_MUTEX_HTTPD);

      /* zeroeth element contains the time stamp */
      LnmCount = 0;
      LnmItems[1].buf_addr = &LogValue[0];
      LnmItems[1].ret_len = &LogValueLength[0];
      status = sys$trnlnm (0, &WasdTableDsc, &LogNameDsc, 0, &LnmItems);
      if (VMSnok (status))
      {
         /* logical name does not exist or error */
         InstanceMutexUnLock (INSTANCE_MUTEX_HTTPD);
         return;
      }
      LogValue[0][LogValueLength[0]] = '\0';
      TickSecond = atoi(LogValue[0]);

      TunnelSeconds = 60;
      if (cptr = SysTrnLnm(WASD_TUNNEL_SECONDS))
      {
         TunnelSeconds = atoi(cptr);
         if (TunnelSeconds <= 0)
         {
            InstanceMutexUnLock (INSTANCE_MUTEX_HTTPD);
            return;
         }
         if (TunnelSeconds < 15) TunnelSeconds = 60;
      }

      /* allow the name to exist for at least this number of seconds */
      if (HttpdTickSecond - TickSecond > 0 &&
          HttpdTickSecond - TickSecond < TunnelSeconds)
      {
         InstanceMutexUnLock (INSTANCE_MUTEX_HTTPD);
         return;
      }

      if (WATCH_CAT && WATCH_CATEGORY(WATCH_PROXY))
         WatchThis (WATCHALL, WATCH_PROXY, "WASD_TUNNEL delete");

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

      status = sys$dellnm (&WasdTableDsc, &LogNameDsc, &ExecMode);
      if (VMSnok (status) && status != SS$_NOLOGNAM)
         ErrorNoticed (NULL, status, LogicalName, FI_LI);

      if (VMSnok (status = sys$setprv (0, &SysNamPrvMask, 0, 0)))
         ErrorExitVmsStatus (status, "sys$setprv()", FI_LI);

      InstanceMutexUnLock (INSTANCE_MUTEX_HTTPD);

      return;
   }

   /**************/
   /* new tunnel */
   /**************/

   rqptr = tkptr->RequestPtr;

   if (rqptr->rqPathSet.ProxyForwardedBy != PROXY_FORWARDED_FOR &&
       rqptr->rqPathSet.ProxyForwardedBy != PROXY_FORWARDED_ADDRESS) return;

   if (rqptr->rqPathSet.ProxyForwardedBy == PROXY_FORWARDED_FOR)
      clptr = rqptr->ClientPtr->Lookup.HostName;
   else
   if (rqptr->rqPathSet.ProxyForwardedBy == PROXY_FORWARDED_ADDRESS)
      clptr = rqptr->ClientPtr->IpAddressString;
   else
      clptr = "SS$_BUGCHECK";

   /* get the originating port for the local connection */
#if TUNNEL_LOGNAM_TEST
   port = ProxyTunnelTestPort;
#else
   port = ProxyNetLocalPort (tkptr);
#endif

   /***********************/
   /* get current content */
   /***********************/

   InstanceMutexLock (INSTANCE_MUTEX_HTTPD);

   /* anything currently occupying [127] is just discarded */
   for (LnmCount = 1; LnmCount <= 126; LnmCount++)
   {
      idx = LnmCount + 1;
      LnmItems[1].buf_addr = &LogValue[idx];
      LnmItems[1].ret_len = &LogValueLength[idx];
      TrnLnmStatus = sys$trnlnm (0, &WasdTableDsc, &LogNameDsc, 0, &LnmItems);
      if (VMSok (TrnLnmStatus))
      {
         if (!LogValueLength[idx]) break;
         LogValue[idx][LogValueLength[idx]] = '\0';
      }
      else
      {
         if (TrnLnmStatus == SS$_NOLOGNAM) break;
         InstanceMutexUnLock (INSTANCE_MUTEX_HTTPD);
         ErrorNoticed (rqptr, TrnLnmStatus, LogicalName, FI_LI);
         return;
      }
   }

   /******************/
   /* no duplicates! */
   /******************/

   zptr = (sptr = LocalHostPort) + sizeof(LocalHostPort)-1;
   for (cptr = tkptr->RequestHostName; *cptr && sptr < zptr; *sptr++ = *cptr++);
   if (sptr < zptr) *sptr++ = ':';
   sys$fao (&NumberFaoDsc, &slen, &PortStringDsc, port);
   for (cptr = PortString; slen-- && sptr < zptr; *sptr++ = *cptr++);
   *sptr = '\0';

   for (idx = 2; idx <= LnmCount; idx++)
   {
      /* compare logical name local host:port with the tunnel host:port */
      for (cptr = LogValue[idx]; *cptr && *cptr != '='; cptr++);
      if (!*cptr) continue;
      *cptr = '\0';
      if (strsame (LogValue[idx], LocalHostPort, -1))
      {
         *cptr = '=';
         break;
      }
      *cptr = '=';
   }

   /* if a duplicate then just quit here */
   if (idx <= LnmCount)
   {
      InstanceMutexUnLock (INSTANCE_MUTEX_HTTPD);
      return;
   }

   /*************/
   /* timestamp */
   /*************/

   /* time stamp of last update into the zeroeth element */
   StampDsc.dsc$a_pointer = LogValue[0];
   StampDsc.dsc$w_length = sizeof(LogValue[0]);
   sys$fao (&StampFaoDsc, &slen, &StampDsc,
            HttpdTickSecond, 0, LnmCount);
   LogValue[0][slen] = '\0';
   LogValueLength[0] = slen;

   CreLnmItems[0].buf_len = LogValueLength[0];
   CreLnmItems[0].item = LNM$_STRING;
   CreLnmItems[0].buf_addr = &LogValue[0];
   CreLnmItems[0].ret_len = 0;

   /*****************/
   /* prepend entry */
   /*****************/

   /* into the first entry */
   zptr = (sptr = &LogValue[1]) + 255;

   for (cptr = LocalHostPort; *cptr && sptr < zptr; *sptr++ = *cptr++);
   if (sptr < zptr) *sptr++ = '=';

   for (cptr = rqptr->ServicePtr->ServerHostPort;
        *cptr && sptr < zptr;
        *sptr++ = *cptr++);
   if (sptr < zptr) *sptr++ = '=';

   for (cptr = clptr; *cptr && sptr < zptr; *sptr++ = *cptr++);
   if (sptr < zptr) *sptr++ = ':';
   sys$fao (&NumberFaoDsc, &slen, &PortStringDsc, rqptr->ClientPtr->IpPort);
   for (cptr = PortString; slen-- && sptr < zptr; *sptr++ = *cptr++);
   *sptr = '\0';
   LogValueLength[1] = sptr - (char*)&LogValue[1];

   if (sptr >= zptr)
   {
      InstanceMutexUnLock (INSTANCE_MUTEX_HTTPD);
      ErrorNoticed (rqptr, SS$_RESULTOVF, LogValue, FI_LI);
      return;
   }

   CreLnmItems[1].buf_len = LogValueLength[1];
   CreLnmItems[1].item = LNM$_STRING;
   CreLnmItems[1].buf_addr = &LogValue[1];
   CreLnmItems[1].ret_len = 0;

   if (WATCHING (tkptr, WATCH_PROXY))
      WatchThis (WATCHITM(tkptr), WATCH_PROXY, "WASD_TUNNEL !UL !AZ",
                 LnmCount, LogValue[1]);

   /***************/
   /* update rest */
   /***************/

   for (idx = 2; idx <= LnmCount; idx++)
   {
      CreLnmItems[idx].buf_len = LogValueLength[idx];
      CreLnmItems[idx].item = LNM$_STRING;
      CreLnmItems[idx].buf_addr = &LogValue[idx];
      CreLnmItems[idx].ret_len = 0;
   }

   /* terminate item list */
   CreLnmItems[idx].buf_len = 0;
   CreLnmItems[idx].item = 0;
   CreLnmItems[idx].buf_addr = 0;
   CreLnmItems[idx].ret_len = 0;

   /************************/
   /* update logical value */
   /************************/

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

   if (TrnLnmStatus != SS$_NOLOGNAM)
   {
      /******************/
      /* delete current */
      /******************/

/*
      After a couple of dynamic page pool exhaustions Jeremy Begg using
        SDA> show pool/paged/summary
        SDA> show pool/page/type=lnm
      suggested perhaps leakage associated with multi-value logical name
      (re)creation.  This deletion is an attempt to test/workaround that.
*/

      status = sys$dellnm (&WasdTableDsc, &LogNameDsc, &ExecMode);
      if (VMSnok (status) && status != SS$_NOLOGNAM)
         ErrorNoticed (NULL, status, LogicalName, FI_LI);
   }

   status = sys$crelnm (0, &WasdTableDsc, &LogNameDsc, &ExecMode, &CreLnmItems);
   if (VMSnok (status)) ErrorNoticed (rqptr, status, LogicalName, FI_LI);

   if (VMSnok (status = sys$setprv (0, &SysNamPrvMask, 0, 0)))
      ErrorExitVmsStatus (status, "sys$setprv()", FI_LI);

   InstanceMutexUnLock (INSTANCE_MUTEX_HTTPD);
}

/****************************************************************************/
/*
Report the contents of the WASD_TUNNEL logical name (NSS).
*/

ProxyTunnelReport (REQUEST_STRUCT *rqptr)

{
   static int  LnmCount;
   static short  LogValueLength;
   static char  LogValue [255+1];
   static char  LogicalName[] = "WASD_TUNNEL";
   static $DESCRIPTOR (LogNameDsc, LogicalName);
   static $DESCRIPTOR (WasdTableDsc, "WASD_TABLE");
   static VMS_ITEM_LIST3 LnmItems [] =
   {
      { sizeof(LnmCount), LNM$_INDEX, &LnmCount, 0 },
      { 255, LNM$_STRING, LogValue, &LogValueLength },
      { 0,0,0,0 }
   };

   int  status, tsecs;
   char  ago [48];

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

   if (WATCHMOD (rqptr, WATCH_MOD_PROXY))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_PROXY, "ProxyTunnelReport()");

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   ResponseHeader200 (rqptr, "text/html", NULL);

   AdminPageTitle (rqptr, "Proxy Tunnel Report");

   FaoToNet (rqptr,
"<p><table class=\"ctgry\">\n\
<tr><th class=\"ctttl\">Logical Name !AZ</th></tr>\n\
<tr><td>\n\
<table class=\"rghtlft\">\n",
             LogicalName);

   InstanceMutexLock (INSTANCE_MUTEX_HTTPD);

   for (LnmCount = 0; LnmCount <= 127; LnmCount++)
   {
      status = sys$trnlnm (0, &WasdTableDsc, &LogNameDsc, 0, &LnmItems);
      if (VMSok (status))
      {
         if (!LogValueLength) break;
         LogValue[LogValueLength] = ago[0]= '\0';
         if (!LnmCount)
         {
            tsecs = atol (LogValue);
            tsecs = HttpdTickSecond - tsecs;
            if (tsecs == 0)
               strzcpy (ago, "&nbsp;&nbsp;(just now)", sizeof(ago));
            else
               FaoToBuffer (ago, sizeof(ago), NULL,
                            "&nbsp;&nbsp;(!SL second!%s ago)", tsecs);
         }
         FaoToNet (rqptr, "<tr><td class=\"targht pdrght1\">!UL</td>\
<td><span class=\"txt\">!AZ</span>!AZ</td></tr>\n",
                   LnmCount, LogValue, ago);
         continue;
      }
      if (!LnmCount && status == SS$_NOLOGNAM)
      {
         FaoToNet (rqptr, "<tr><td>!&S</td></tr>\n", SS$_NOLOGNAM);
         break;
      }
      break;
   }

   InstanceMutexUnLock (INSTANCE_MUTEX_HTTPD);

   FaoToNet (rqptr,
"</table>\n\
</td></tr>\n\
</table>\n");

   AdminEnd (rqptr);
}

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

