/*****************************************************************************/
/*
                                   TCPIP.c

The introduction of IPv6 support to WASD also provided the opportunity for some
overdue rationalization of aspects of WASD networking.  Host name and address
resolution and host name and address address caching to name but two.  Rather
than bloat the NET.C module with further code this module was created to take
some of this more generic TCP/IP functionality (in fact some was pulled back
from NET.C into TCPIP.C).

The server supports both IPv4 and IPv6 addressing.  Two design objectives; a
source that could be compiled on system that did not support or have the header
files for IPv6, and an image that could be executed regardless of whether IPv6
was suported by the underlying TCP/IP kernel.

The TCPIP.H header file contains all the requires IPv4 and IPv6 defintions and
structures to remove dependency on system build environment.

The server runtime uses a WASD address structure that contains both IPv4 and
IPv6 IP address structures and the server adopts the appropriate behaviour for
the underlying address type being processed.  Once a channel is established the
QIO system service I/O isn't concerned with the underlying network protocol. 
IPv6 support was a relatively trivial exercise once the IP address abstraction,
allowing both IPv4 and IPV6 addressing to be concurrently supported, was
established.

If system TCP/IP services do not support IPv6 the expected error would be a

  %SYSTEM-F-PROTOCOL, network protocol error

during any attempted IPv6 service creation.  Of course, IPv4 service creation
would continue successfully as usual.

Server configuration handles the standard dotted-decimal addresses of IPv4, as
well as 'normal' and 'compressed' forms of standard IPv6 literal addresses, and
a (somewhat) standard variation of these that substitutes hyphens for the
colons in these addresses to allow the colon-delimited port component of a
'URL' to be resolved.  Examples:

  normal                         compressed
  ~~~~~~                         ~~~~~~~~~~
  1070:0:0:0:0:800:200C:417B     1070::800:200C:417B
  0:0:0:0:0:0:13.1.68.3          ::13.1.68.3
  0:0:0:0:0:FFFF:129.144.52.38   ::FFFF:129.144.52.38

  hyphen-variant of above
  ~~~~~~~~~~~~~~~~~~~~~~~
  1070-0-0-0-0-800-200C-417B     1070--800-200C-417B
  0-0-0-0-0-0-13.1.68.3          --13.1.68.3
  0-0-0-0-0-FFFF-129.144.52.38   --FFFF-129.144.52.38


25-MAR-2004  MGD  initial (with modifications for IPv6)
*/
/*****************************************************************************/

#ifdef WASD_VMS_V6
#undef _VMS_V6_SOURCE
#define _VMS_V6_SOURCE
#undef __VMS_VER
#define __VMS_VER 60000000
#undef __CRTL_VER
#define __CRTL_VER 60000000
#endif

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

/* VMS related header files */
#include <descrip.h>
#include <iodef.h>

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

#define WASD_MODULE "TCPIP"

#define FI_LI WASD_MODULE, __LINE__

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

BOOL  TcpIpv6Configured;

int  TcpIpHostCacheBytes,
     TcpIpHostCacheCount,
     TcpIpHostCacheExpireSeconds = TCPIP_HOST_CACHE_EXPIRE_SECONDS,
     TcpIpHostCacheMax;

char TcpIpAgentInfo [96];

/* initialized to all zeros and is used for comparison to INADDR_ANY */
IPADDRESS  TcpIpEmptyAddress;

TCPIP_HOST_CACHE  *TcpIpHostCachePtr;

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

int  TcpIp_OptionOn = 1;

VMS_ITEM_LIST2  TcpIp_ReuseAddrOption =
   { sizeof(TcpIp_OptionOn), TCPIP$C_REUSEADDR, &TcpIp_OptionOn };

VMS_ITEM_LIST2  TcpIpSocketReuseAddrOption =
   { sizeof(TcpIp_ReuseAddrOption), TCPIP$C_SOCKOPT, &TcpIp_ReuseAddrOption };

VMS_ITEM_LIST2  TcpIp_ShareOption =
   { sizeof(TcpIp_OptionOn), TCPIP$C_SHARE, &TcpIp_OptionOn };

VMS_ITEM_LIST2  TcpIpSocketShareOption =
   { sizeof(TcpIp_ShareOption), TCPIP$C_SOCKOPT, &TcpIp_ShareOption };

/* not all UCX versions support FULL_DUPLEX_CLOSE, it should be ignored! */
VMS_ITEM_LIST2  TcpIp_ClientSockOpt =
   { sizeof(TcpIp_OptionOn), TCPIP$C_FULL_DUPLEX_CLOSE, &TcpIp_OptionOn };

VMS_ITEM_LIST2  TcpIpFullDuplexCloseOption =
   { sizeof(TcpIp_ClientSockOpt), TCPIP$C_SOCKOPT, &TcpIp_ClientSockOpt };

TCP_SOCKET_ITEM TcpIpSocket4 =
   { TCPIP$C_TCP, INET_PROTYP$C_STREAM, TCPIP$C_AF_INET };

TCP_SOCKET_ITEM TcpIpSocket6 =
   { TCPIP$C_TCP, INET_PROTYP$C_STREAM, TCPIP$C_AF_INET6 };

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

extern int  EfnWait,
            EfnNoWait,
            HttpdTickSecond;

extern char  ErrorSanityCheck[];

extern ACCOUNTING_STRUCT  *AccountingPtr;
extern WATCH_STRUCT  Watch;

/*****************************************************************************/
/*
Set the global storage 'TcpIpAgentInfo' using, amongst other things, some
quick-and-dirty image analysis.  Open the UCX$IPC_SHR shareable image and read
selected fields to get the image name, identification, and linking date.  Don't
quite know how to get this information using header structures, etc., too busy
to investigate (that's my excuse) ... hence this quick mangle.  Also try to
establish which package is involved by checking for likely logical names. 
Anyone know of a more reasonable approach?
*/ 

TcpIpSetAgentInfo ()

{
   static $DESCRIPTOR (LnmSystemDsc, "LNM$SYSTEM");
   static $DESCRIPTOR (MultinetDsc, "MULTINET");
   static $DESCRIPTOR (TcpWareDsc, "TCPWARE");
   static $DESCRIPTOR (TcpIpExamplesDsc, "TCPIP$EXAMPLES");
   static $DESCRIPTOR (UcxExamplesDsc, "UCX$EXAMPLES");

   int  status;
   unsigned short  Length;
   char  *cptr,
         *ImageDatePtr,
         *ImageIdentPtr,
         *ImageNamePtr,
         *PackagePtr;
   char  ErrorInfo [32],
         ImageRecord [512];
   unsigned long  Genesis [2];
   FILE  *ImageFile;

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

   if (WATCH_MODULE(WATCH_MOD_NET))
      WatchThis (NULL, FI_LI, WATCH_MOD_NET, "TcpIpSetAgentInfo()");

   memset (ErrorInfo, 0, sizeof(ErrorInfo));

#ifdef __ia64
   /* no history of UCX (now that's gotta be a plus!) */
   ImageFile = fopen ("TCPIP$IPC_SHR", "r", "shr=get", "dna=SYS$SHARE:.EXE");
#else
   ImageFile = fopen ("UCX$IPC_SHR", "r", "shr=get", "dna=SYS$SHARE:.EXE");
#endif
   if (!ImageFile)
   {
      WriteFao (ErrorInfo+1, sizeof(ErrorInfo)-1, &Length,
                "!&S", vaxc$errno);
      ErrorInfo[0] = Length;
   }
   else
   if (!fread (&ImageRecord, sizeof(ImageRecord), 1, ImageFile))
   {
      WriteFao (ErrorInfo+1, sizeof(ErrorInfo)-1, &Length,
                "!&S", vaxc$errno);
      ErrorInfo[0] = Length;
   }
   else
   {
#ifdef __ALPHA
      ImageNamePtr = ImageRecord + 200;
      ImageIdentPtr = ImageRecord + 240;
      ImageDatePtr = ImageRecord + 192;
#endif
#ifdef __ia64
      /* absolutely no idea on IA64 (some would say not only) */
      for (;;)
      {
         if (!fread (&ImageRecord, sizeof(ImageRecord), 1, ImageFile))
         {
            WriteFao (ErrorInfo+1, sizeof(ErrorInfo)-1, &Length,
                      "!&S", vaxc$errno);
            ErrorInfo[0] = Length;
            break;
         }
         /* check this record for some key strings */
         if (memcmp (ImageRecord+24, "IPF/VMS", 7)) continue;
         if (memcmp (ImageRecord+32, "TCPIP$IPC_SHR", 13)) continue;
         if (memcmp (ImageRecord+72, "IPF/VMS", 7)) continue;
         ImageNamePtr = ImageRecord + 80;
         ImageIdentPtr = ImageRecord + 128;
         ImageDatePtr = ImageRecord + 168;
         break;
      }
#endif
#ifdef __VAX
      Length = *(unsigned short*)ImageRecord;
      ImageNamePtr = ImageRecord + Length - 80;
      ImageIdentPtr = ImageRecord + Length - 40;
      ImageDatePtr = ImageRecord + Length - 24;
#endif
   }

   fclose (ImageFile);

   PackagePtr = "TCPware";
   status = sys$trnlnm (0, &LnmSystemDsc, &TcpWareDsc, 0, 0);
   if (status == SS$_NOLOGNAM)
   {
      PackagePtr = "Multinet";
      status = sys$trnlnm (0, &LnmSystemDsc, &MultinetDsc, 0, 0);
   }
   if (status == SS$_NOLOGNAM)
   {
      /* Compaq/HP TCP/IP (UCX) v5.n-> */
      if (strstr (ImageIdentPtr, "V5.0") || strstr (ImageIdentPtr, "V5.1") ||
          strstr (ImageIdentPtr, "V5.2") || strstr (ImageIdentPtr, "V5.3"))
         PackagePtr = "Compaq";
      else
         PackagePtr = "HP";
      status = sys$trnlnm (0, &LnmSystemDsc, &TcpIpExamplesDsc, 0, 0);
   }
   if (status == SS$_NOLOGNAM)
   {
      PackagePtr = "UCX";
      status = sys$trnlnm (0, &LnmSystemDsc, &UcxExamplesDsc, 0, 0);
   }
   if (status == SS$_NOLOGNAM)
      PackagePtr = "unknown";
   else
   if (VMSnok (status))
      PackagePtr = "sys$trnlnm()_error";

   if (ErrorInfo[0])
   {
#ifdef __ia64
      /* uses null-terminated strings */
      ImageNamePtr = ImageIdentPtr = ErrorInfo + 1;
#else
      /* uses counted strings */
      ImageNamePtr = ImageIdentPtr = ErrorInfo;
#endif
      memset (Genesis, 0, sizeof(Genesis));
      ImageDatePtr = Genesis;
   }

#ifdef __ia64
   /* ever'thin's null-terminated in this brave new world? */
   WriteFao (TcpIpAgentInfo, sizeof(TcpIpAgentInfo), NULL, "!AZ !AZ !AZ (!%D)",
             PackagePtr, ImageNamePtr, ImageIdentPtr, ImageDatePtr);
#else
   WriteFao (TcpIpAgentInfo, sizeof(TcpIpAgentInfo), NULL, "!AZ !AC !AC (!%D)",
             PackagePtr, ImageNamePtr, ImageIdentPtr, ImageDatePtr);
#endif
   /* hate that leading space! */
   if (cptr = strchr (TcpIpAgentInfo, '('))
      if (*(++cptr) == ' ')
         *cptr = '0';
}                                   

/*****************************************************************************/
/*
Initialize the host name/address cache.
*/

TcpIpHostCacheInit ()
{

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

   if (WATCH_MODULE(WATCH_MOD_NET))
      WatchThis (NULL, FI_LI, WATCH_MOD_NET, "TcpIpHostCacheInit()");

   TcpIpHostCacheCount = 0;
   TcpIpHostCacheMax = TCPIP_HOST_CACHE_CHUNK;
   TcpIpHostCacheBytes = sizeof(TCPIP_HOST_CACHE) * TcpIpHostCacheMax;
   TcpIpHostCachePtr = (TCPIP_HOST_CACHE*)VmGet (TcpIpHostCacheBytes);
}

/*****************************************************************************/
/*
Called once a minute by HttpdTick().
Scan through the host name/address cache flushing expired entries.
'NewCacheCount' is used to shrink the number of entries needing to be checked
to the last valid entry (which in a fully expired cache would be zero).
*/

TcpIpHostCacheSupervisor ()

{
   int  cnt,
        NewCacheCount;
   TCPIP_HOST_CACHE  *hcptr;

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

   if (WATCH_MODULE(WATCH_MOD_NET))
      WatchThis (NULL, FI_LI, WATCH_MOD_NET, "TcpIpHostCacheSupervisor()");

   if (!TcpIpHostCachePtr || !TcpIpHostCacheCount) return;

   NewCacheCount = 0;
   hcptr = TcpIpHostCachePtr;
   for (cnt = 0; cnt < TcpIpHostCacheCount; hcptr++, cnt++)
   {
      if (!hcptr->HostNameLength) continue;
      if (hcptr->ExpiresTickSecond <= HttpdTickSecond)
         hcptr->HostNameLength = 0;
      else
         NewCacheCount = cnt + 1;
   }
   TcpIpHostCacheCount = NewCacheCount; 
}

/*****************************************************************************/
/*
Search for the specified host name in the host name/address cache.
Modify the host-lookup IP address field if found.
*/

int TcpIpCacheNameToAddress
(
TCPIP_HOST_LOOKUP *hlptr,
char *HostName,
int HostNameLength
)
{
   int  cnt;
   TCPIP_HOST_CACHE  *hcptr;

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

   if (WATCH_MODULE(WATCH_MOD_NET))
      WatchThis (NULL, FI_LI, WATCH_MOD_NET,
                 "TcpIpCacheNameToAddress() !&Z", HostName);

   if (!TcpIpHostCachePtr || !TcpIpHostCacheCount) return (SS$_ENDOFFILE);

   hcptr = TcpIpHostCachePtr;
   for (cnt = 0; cnt < TcpIpHostCacheCount; hcptr++, cnt++)
   {
      if (hcptr->HostNameLength != HostNameLength) continue;
      if (memcmp (hcptr->HostName, HostName, HostNameLength)) continue;
      if (hcptr->ExpiresTickSecond > HttpdTickSecond) 
      {
         if (WATCH_MODULE(WATCH_MOD_NET))
            WatchThis (NULL, FI_LI, WATCH_MOD_NET, "HIT !UL !&I",
                       hcptr->HitCountNameToAddress+1, &hcptr->IpAddress);
         hcptr->HitCountNameToAddress++;
         IPADDRESS_COPY (&hlptr->IpAddress, &hcptr->IpAddress)
         InstanceGblSecIncrLong (&AccountingPtr->LookupCacheNameCount);
         return (SS$_NORMAL);
      }
      /* time to refresh the entry */
      hcptr->HostNameLength = 0;
      if (WATCH_MODULE(WATCH_MOD_NET))
         WatchThis (NULL, FI_LI, WATCH_MOD_NET, "EXPIRED");
      return (SS$_ENDOFFILE);
   }
   if (WATCH_MODULE(WATCH_MOD_NET))
      WatchThis (NULL, FI_LI, WATCH_MOD_NET, "MISSED");
   return (SS$_ENDOFFILE);
}

/*****************************************************************************/
/*
Search for the specified address in the host name/address cache.
Modify the host-lookup host name field if found.
*/

int TcpIpCacheAddressToName
(
TCPIP_HOST_LOOKUP *hlptr,
IPADDRESS *ipaptr
)
{
   int  cnt;
   TCPIP_HOST_CACHE  *hcptr;

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

   if (WATCH_MODULE(WATCH_MOD_NET))
      WatchThis (NULL, FI_LI, WATCH_MOD_NET,
                 "TcpIpCacheAddressToName() !&I", ipaptr);

   if (!TcpIpHostCachePtr || !TcpIpHostCacheCount) return (SS$_ENDOFFILE);;

   hcptr = TcpIpHostCachePtr;
   for (cnt = 0; cnt < TcpIpHostCacheCount; hcptr++, cnt++)
   {
      if (!hcptr->HostNameLength) continue;
      if (!IPADDRESS_IS_SAME(&hcptr->IpAddress, ipaptr)) continue;
      if (hcptr->ExpiresTickSecond > HttpdTickSecond)
      {
         if (WATCH_MODULE(WATCH_MOD_NET))
            WatchThis (NULL, FI_LI, WATCH_MOD_NET, "HIT !UL !&Z",
                       hcptr->HitCountAddressToName+1, &hcptr->HostName);
         hcptr->HitCountAddressToName++;
         memcpy (hlptr->HostName, hcptr->HostName, hcptr->HostNameLength);
         hlptr->HostNameLength = hcptr->HostNameLength;
         InstanceGblSecIncrLong (&AccountingPtr->LookupCacheAddressCount);
         return (SS$_NORMAL);
      }
      /* time to refresh the entry */
      hcptr->HostNameLength = 0;
      if (WATCH_MODULE(WATCH_MOD_NET))
         WatchThis (NULL, FI_LI, WATCH_MOD_NET, "EXPIRED");
      return (SS$_ENDOFFILE);
   }
   if (WATCH_MODULE(WATCH_MOD_NET))
      WatchThis (NULL, FI_LI, WATCH_MOD_NET, "MISSED");
   return (SS$_ENDOFFILE);
}

/*****************************************************************************/
/*
Set the specified entry in the host name/address cache.

The cache is a relatively simple (but hopefully efficient) dynamic array
structure through which a linear search is performed.  The potential smaller
size makes the absence of hashing less of an issue.  The top search limit are
constantly adjusted as entries expire attempting to minimise the extent of any
search.  Seems to be efficient enough in practice.
*/

int TcpIpCacheSetEntry
(
char *HostName,
int HostNameLength,
IPADDRESS *ipaptr
)
{
   int  cnt;
   char  *cptr, *sptr, *zptr;
   TCPIP_HOST_CACHE  *hcptr;

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

   if (WATCH_MODULE(WATCH_MOD_NET))
      WatchThis (NULL, FI_LI, WATCH_MOD_NET,
                 "TcpIpCacheSetEntry() !&Z !&I",
                 HostName, ipaptr ? ipaptr : &TcpIpEmptyAddress);

   if (!TcpIpHostCachePtr) return (SS$_ENDOFFILE);

   /* first check whether it's currently in the cache */
   hcptr = TcpIpHostCachePtr;
   for (cnt = 0; cnt < TcpIpHostCacheCount; hcptr++, cnt++)
   {
      if (hcptr->HostNameLength != HostNameLength) continue;
      if (memcmp (hcptr->HostName, HostName, HostNameLength)) continue;
      /* yes it is and it was a valid entry so just return */
      if (ipaptr) return (SS$_NORMAL);
      /* the NULL 'ipaptr' indicates it should be declared an invalid entry */
      hcptr->HostNameLength = 0;
      return (SS$_NORMAL);
   }
   /* if trying to invalidate an apparently non-existant entry */
   if (!ipaptr) return (SS$_NORMAL);

   if (cnt >= TcpIpHostCacheCount)
   {
      /* nope, find an empty or already expired entry */
      hcptr = TcpIpHostCachePtr;
      for (cnt = 0; cnt < TcpIpHostCacheCount; hcptr++, cnt++)
      {
         if (!hcptr->HostNameLength) break;
         if (hcptr->ExpiresTickSecond <= HttpdTickSecond) break;
      }
   }

   if (cnt >= TcpIpHostCacheCount)
   {
      /* didn't find one that could be reused */
      if (TcpIpHostCacheCount < TcpIpHostCacheMax)
      {
         /* still unused space in the cache */
         TcpIpHostCacheCount++;
      }
      else
      {
         /* can we expand the cache size? */
         if (TcpIpHostCacheMax < TCPIP_HOST_CACHE_MAX)
         {
            TcpIpHostCacheMax += TCPIP_HOST_CACHE_CHUNK;
            TcpIpHostCacheBytes = sizeof(TCPIP_HOST_CACHE) * TcpIpHostCacheMax;
            TcpIpHostCachePtr = (TCPIP_HOST_CACHE*)
               VmRealloc (TcpIpHostCachePtr, TcpIpHostCacheBytes, FI_LI);
            /* recalculate the cache pointer */
            TcpIpHostCacheCount++;
            hcptr = &TcpIpHostCachePtr[TcpIpHostCacheCount];
         }
      }
   }

   if (cnt < TcpIpHostCacheCount)
   {
      /* got one */
      zptr = (sptr = hcptr->HostName) + sizeof(hcptr->HostName)-1;
      for (cptr = HostName; *cptr && sptr < zptr; *sptr++ = *cptr++);
      *sptr = '\0';
      hcptr->HostNameLength = cptr - HostName;
      IPADDRESS_COPY (&hcptr->IpAddress, ipaptr)
      hcptr->HitCountAddressToName = hcptr->HitCountNameToAddress = 0;
      hcptr->ExpiresTickSecond = HttpdTickSecond + TcpIpHostCacheExpireSeconds;
      if (WATCH_MODULE(WATCH_MOD_NET))
         WatchThis (NULL, FI_LI, WATCH_MOD_NET,
                    "SET !UL/!UL", cnt, TcpIpHostCacheCount);
   }

   return (SS$_NORMAL);
}

/*****************************************************************************/
/*
Report on valid entries in host name/address cache.
*/ 

/* report a number of seconds as HH:MM:SS */
#define REP_HHMMSS(s) \
*vecptr++ = "!2ZL:!2ZL:!2ZL"; \
*vecptr++ = s / 3600; \
*vecptr++ = (s % 3600) / 60; \
*vecptr++ = (s % 3600) % 60;

TcpIpHostCacheReport
(
REQUEST_STRUCT *rqptr,
REQUEST_AST NextTaskFunction
)
{
   static char  BeginPageFao [] =
"<!!-- max:!UL count:!UL bytes:!UL -->\n\
<P><TABLE CELLPADDING=3 CELLSPACING=0 BORDER=1>\n\
<TR><TH>Statistics</TH></TR>\n\
<TR><TD>\n\
<TABLE CELLPADDING=0 CELLSPACING=5 BORDER=0>\n\
<TR><TH></TH>\
<TH ALIGN=right>&nbsp;&nbsp;<U>Literal</U></TH>\
<TH ALIGN=right COLSPAN=2><CENTER><U>DNS</U></CENTER></TH>\
<TH ALIGN=right>&nbsp;&nbsp;<U>Cache</U></TH>\
<TH ALIGN=right>&nbsp;&nbsp;<U>Error</U>&nbsp;</TH>\
</TR>\n\
<TR><TH ALIGN=right>Address:</TH>\
<TD ALIGN=right>&nbsp;&nbsp;!UL</TD>\
<TD></TD>\
<TD></TD>\
<TD></TD>\
<TD ALIGN=right>&nbsp;&nbsp;!UL&nbsp;</TD>\
</TR>\n\
<TR><TH ALIGN=right>Address-to-name:</TH>\
<TD></TD>\
<TD ALIGN=right>&nbsp;&nbsp;!UL</TD>\
<TD ALIGN=left>&nbsp;(!UL%)</TD>\
<TD ALIGN=right>&nbsp;&nbsp;!UL</TD>\
<TD ALIGN=right>&nbsp;&nbsp;!UL&nbsp;</TD>\
</TR>\n\
<TR><TH ALIGN=right>Name-to-address:</TH>\
<TD></TD>\
<TD ALIGN=right>&nbsp;&nbsp;!UL</TD>\
<TD ALIGN=left>&nbsp;(!UL%)</TD>\
<TD ALIGN=right>&nbsp;&nbsp;!UL</TD>\
<TD ALIGN=right>&nbsp;&nbsp;!UL&nbsp;</TD>\
</TR>\n\
</TABLE>\n\
</TD></TR>\n\
</TABLE>\n\
\
<P><TABLE CELLPADDING=3 CELLSPACING=0 BORDER=1>\n\
<TR><TH>Cache</TH></TR>\n\
<TR><TD>\n\
<P><TABLE CELLPADDING=4 CELLSPACING=0 BORDER=0>\n\
<TR><TD>\n\
<TABLE CELLPADDING=1 CELLSPACING=0 BORDER=0>\n\
<TR>\
<TH></TH>\
<TH ALIGN=left><U>Host&nbsp;Name</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=left><U>IP&nbsp;Address</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=right><U>Name-&gt;Addr</U>&nbsp;&nbsp;</TH>\
<TH ALIGN=right><U>Addr-&gt;Name</U>&nbsp;&nbsp;&nbsp;&nbsp;</TH>\
<TH ALIGN=right><U>Expires</U>&nbsp;</TH>\
</TR>\n\
<TR HEIGHT=5></TR>\n";

   static char  ItemFao [] =
"<TH ALIGN=right><!!-- !UL -->!3ZL&nbsp;&nbsp;</TH>\
<TD ALIGN=left>!AZ&nbsp;&nbsp;</TD>\
<TD ALIGN=left>!&I&nbsp;&nbsp;</TD>\
<TD ALIGN=right>!UL&nbsp;&nbsp;</TD>\
<TD ALIGN=right>!UL&nbsp;&nbsp;&nbsp;&nbsp;</TD>\
<TD ALIGN=right>!&@&nbsp;</TD>\
<TR>\n";

   static char EmptyCacheFao [] =
"<TR><TH><B>000</B>&nbsp;&nbsp;</TH><TD COLSPAN=5><I>empty</I></TD><TR>\n";

   static char  EndPageFao [] =
"</TABLE>\n\
</TD></TR>\n\
</TABLE>\n\
</TD></TR>\n\
</TABLE>\n\
</BODY>\n\
</HTML>\n";

   int  cnt, status,
        EntryCount,
        ExpireSeconds,
        PercentDnsAddress,
        PercentDnsName,
        TotalCount;
   unsigned long  FaoVector [16];
   unsigned long  *vecptr;
   TCPIP_HOST_CACHE  *hcptr;

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_NET))
      WatchThis (rqptr, FI_LI, WATCH_MOD_NET,
                 "TcpIpHostCacheReport() !&A", NextTaskFunction);

   rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN;
   RESPONSE_HEADER_200_HTML (rqptr);
   AdminPageTitle (rqptr, "Host Resolution Report");

   vecptr = FaoVector;

   *vecptr++ = TcpIpHostCacheMax;
   *vecptr++ = TcpIpHostCacheCount;
   *vecptr++ = TcpIpHostCacheBytes;

   InstanceMutexLock (INSTANCE_MUTEX_HTTPD);

   TotalCount = AccountingPtr->LookupDnsAddressCount +
                AccountingPtr->LookupCacheAddressCount;
   if (TotalCount)
      PercentDnsAddress = AccountingPtr->LookupDnsAddressCount * 100 /
                          TotalCount;
   else
      PercentDnsAddress = 0;

   TotalCount = AccountingPtr->LookupDnsNameCount +
                AccountingPtr->LookupCacheNameCount;
   if (TotalCount)
      PercentDnsName = AccountingPtr->LookupDnsNameCount * 100 / TotalCount;
   else
      PercentDnsName = 0;

   *vecptr++ = AccountingPtr->LookupLiteralCount;
   *vecptr++ = AccountingPtr->LookupLiteralErrorCount;
   *vecptr++ = AccountingPtr->LookupDnsAddressCount;
   *vecptr++ = PercentDnsAddress;
   *vecptr++ = AccountingPtr->LookupCacheAddressCount;
   *vecptr++ = AccountingPtr->LookupDnsAddressErrorCount;
   *vecptr++ = AccountingPtr->LookupDnsNameCount;
   *vecptr++ = PercentDnsName;
   *vecptr++ = AccountingPtr->LookupCacheNameCount;
   *vecptr++ = AccountingPtr->LookupDnsNameErrorCount;

   InstanceMutexUnLock (INSTANCE_MUTEX_HTTPD);

   status = NetWriteFaol (rqptr, BeginPageFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);

   EntryCount = 0;
   hcptr = TcpIpHostCachePtr;
   for (cnt = 0; cnt < TcpIpHostCacheCount; hcptr++, cnt++)
   {
      if (!hcptr->HostNameLength) continue;
      if (hcptr->ExpiresTickSecond <= HttpdTickSecond) continue;

      vecptr = FaoVector;
      *vecptr++ = cnt;
      *vecptr++ = ++EntryCount;
      *vecptr++ = hcptr->HostName;
      *vecptr++ = &hcptr->IpAddress;
      *vecptr++ = hcptr->HitCountNameToAddress;
      *vecptr++ = hcptr->HitCountAddressToName;
      ExpireSeconds = hcptr->ExpiresTickSecond - HttpdTickSecond;
      REP_HHMMSS(ExpireSeconds);

      status = NetWriteFaol (rqptr, ItemFao, &FaoVector);
      if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);
   }

   if (!EntryCount)
   {
      status = NetWriteFaol (rqptr, EmptyCacheFao, NULL);
      if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);
   }

   status = NetWriteFaol (rqptr, EndPageFao, NULL);
   if (VMSnok (status)) ErrorNoticed (status, "NetWriteFaol()", FI_LI);

   SysDclAst (NextTaskFunction, rqptr);
}

#undef REP_HHMMSS

/*****************************************************************************/
/*
Get the IP address using name-to-address lookup.
Synchronous and asynchronous is supported.

The AST function is designed to be used with a parameter of request pointer,
etc., but of course depends specific usage.

In AST mode this function can be called multiple times (by itself) to retry
host name resolution.  After resolution or timeout it calls the AST routine.
*/

int TcpIpNameToAddress
(
TCPIP_HOST_LOOKUP *hlptr,
char *HostName,
int RetryAttempts,
void *AstFunction,
unsigned long AstParam
)
{
   /* this is two seconds delta */
   static unsigned long  RetryDelta [2] = { -20000000, -1 };

   static unsigned char ControlSubFunction [4] =
      { INETACP_FUNC$C_GETHOSTBYNAME, INETACP$C_TRANS, 0, 0 };
   static struct dsc$descriptor AddressDsc =
      { 0, DSC$K_DTYPE_T, DSC$K_CLASS_S, 0};
   static struct dsc$descriptor ControlSubFunctionDsc =
      { 4, DSC$K_DTYPE_T, DSC$K_CLASS_S, &ControlSubFunction };

   int  status;
   char  *cptr, *sptr, *zptr;
   struct dsc$descriptor *dscptr;

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

   if (WATCH_MODULE(WATCH_MOD_NET))
   {
      if (hlptr->LookupChannel)
         WatchThis (NULL, FI_LI, WATCH_MOD_NET,
                    "TcpIpNameToAddress() !&F !UL !&S !&X",
                    TcpIpNameToAddress, hlptr->RetryCount,
                    hlptr->LookupIOsb.Status,
                    IPADDRESS_SIZE(&hlptr->IpAddress));
      else
         WatchThis (NULL, FI_LI, WATCH_MOD_NET,
                    "TcpIpNameToAddress() !&F !&Z !UL !&X !&X",
                    TcpIpNameToAddress, HostName, RetryAttempts,
                    AstFunction, AstParam);
   }

   if (hlptr->LookupChannel)
   {
      /***********************/
      /* resolution AST call */
      /***********************/

      if (hlptr->LookupIOsb.Status)
      {
         if (VMSok(hlptr->LookupIOsb.Status) || !hlptr->RetryCount)
         {
            /* lookup has finished (successfully or not) */
            if (VMSok(hlptr->LookupIOsb.Status))
            {
               if (IPADDRESS_SIZE(&hlptr->IpAddress) != 4 &&
                   IPADDRESS_SIZE(&hlptr->IpAddress) != 16)
               {
                  hlptr->LookupIOsb.Status = SS$_BUGCHECK;
                  ErrorNoticed (SS$_BUGCHECK, "TcpIpNameToAddress()", FI_LI);
               }
               /* set an entry in the host cache */
               TcpIpCacheSetEntry (hlptr->HostName, hlptr->HostNameLength,
                                   &hlptr->IpAddress);
               InstanceGblSecIncrLong (&AccountingPtr->LookupDnsNameCount);
            }
            else
               InstanceGblSecIncrLong (&AccountingPtr->LookupDnsNameErrorCount);
            sys$dassgn (hlptr->LookupChannel);
            hlptr->LookupChannel = 0;
            SysDclAst (hlptr->AstFunction, hlptr->AstParam);
            return (hlptr->LookupIOsb.Status);
         }

         /* indicate (with a zero status) that this is a timer expiry */
         hlptr->LookupIOsb.Status = 0;
         /* queue up a timer event scheduling the next retry */
         status = sys$setimr (0, &RetryDelta, &TcpIpNameToAddress, hlptr, 0);
         if (VMSok (status)) return (status);

         /* oops, problem */
         sys$dassgn (hlptr->LookupChannel);
         hlptr->LookupChannel = 0;
         hlptr->LookupIOsb.Status = status;
         SysDclAst (hlptr->AstFunction, hlptr->AstParam);
         return (status);
      }
      /* timer has expired, continue, trying again */
   }
   else
   {
      /**************/
      /* first call */
      /**************/

      hlptr->AstFunction = AstFunction;
      hlptr->AstParam = AstParam;

      zptr = (sptr = hlptr->HostName) + sizeof(hlptr->HostName)-1;
      for (cptr = HostName; *cptr && sptr < zptr; *sptr++ = *cptr++);
      *sptr = '\0';
      hlptr->HostNameLength = sptr - hlptr->HostName;

      /* first, IPv4 literal address */
      for (cptr = hlptr->HostName; isdigit(*cptr) || *cptr == '.'; cptr++);
      if (*cptr)
      {
         /* if not then, IPv6 literal address */
         for (cptr = hlptr->HostName;
              isxdigit(*cptr) || *cptr == ':' || *cptr == '-' || *cptr == '.';
              cptr++);
      }
      if (!*cptr)
      {
         /*******************/
         /* literal address */
         /*******************/

         status = TcpIpStringToAddress (hlptr->HostName, &hlptr->IpAddress);
         if (VMSok (status))
            InstanceGblSecIncrLong (&AccountingPtr->LookupLiteralCount);
         else
            InstanceGblSecIncrLong (&AccountingPtr->LookupLiteralErrorCount);
         hlptr->LookupIOsb.Status = status;
         /* if asynchronous then manually queue the AST */
         if (hlptr->AstFunction)
            SysDclAst (hlptr->AstFunction, hlptr->AstParam);
         return (hlptr->LookupIOsb.Status);
      }

      status = TcpIpCacheNameToAddress (hlptr, hlptr->HostName,
                                        hlptr->HostNameLength);
      if (VMSok (status))
      {
         /* found in cache */
         hlptr->LookupIOsb.Status = status;
         if (hlptr->AstFunction)
            SysDclAst (hlptr->AstFunction, hlptr->AstParam);
         return (status);
      }

      /* assign a channel to the internet template device */
      status = sys$assign (&TcpIpDeviceDsc, &hlptr->LookupChannel, 0, 0);
      if (VMSnok (status))
      {
         /* leave it to the AST function to report! */
         hlptr->LookupIOsb.Status = status;
         if (hlptr->AstFunction)
            SysDclAst (hlptr->AstFunction, hlptr->AstParam);
         return (status);
      }

      dscptr = &hlptr->HostNameDsc;
      dscptr->dsc$b_class = DSC$K_CLASS_S;
      dscptr->dsc$b_dtype = DSC$K_DTYPE_T;
      dscptr->dsc$w_length = hlptr->HostNameLength;
      dscptr->dsc$a_pointer = hlptr->HostName;

      dscptr = &hlptr->HostAddressDsc;
      dscptr->dsc$b_class = DSC$K_CLASS_S;
      dscptr->dsc$b_dtype = DSC$K_DTYPE_T;
      /* give the full buffer and then check the returned length */
      dscptr->dsc$w_length = sizeof(IPADDRESS_ADR6(&hlptr->IpAddress));
      dscptr->dsc$a_pointer = &IPADDRESS_ADR6(&hlptr->IpAddress);
      memset (&hlptr->IpAddress, 0, sizeof(hlptr->IpAddress));

      if (RetryAttempts <= 0) RetryAttempts = 1;
      hlptr->RetryCount = RetryAttempts;
   }

   if (hlptr->AstFunction)
   {
      /****************/
      /* asynchronous */
      /****************/

      status = sys$qio (EfnNoWait, hlptr->LookupChannel, IO$_ACPCONTROL,
                        &hlptr->LookupIOsb, &TcpIpNameToAddress, hlptr,
                        &ControlSubFunctionDsc,
                        &hlptr->HostNameDsc,
                        &IPADDRESS_SIZE(&hlptr->IpAddress),
                        &hlptr->HostAddressDsc, 0, 0);

      if (WATCH_MODULE(WATCH_MOD_NET))
         WatchDataFormatted ("sys$qio() !&S\n", status);

      if (VMSnok (status))
      {
         /* failed, fudged the status and manually queue the AST */
         hlptr->LookupIOsb.Status = status;
         sys$dassgn (hlptr->LookupChannel);
         hlptr->LookupChannel = 0;
         SysDclAst (hlptr->AstFunction, hlptr->AstParam);
      }

      hlptr->RetryCount--;
      return (status);
   }
   else
   {
      /***************/
      /* synchronous */
      /***************/

      while (hlptr->RetryCount--)
      {
         status = sys$qiow (EfnWait, hlptr->LookupChannel, IO$_ACPCONTROL,
                            &hlptr->LookupIOsb, 0, 0,
                            &ControlSubFunctionDsc,
                            &hlptr->HostNameDsc,
                            &IPADDRESS_SIZE(&hlptr->IpAddress),
                            &hlptr->HostAddressDsc, 0, 0);

         if (WATCH_MODULE(WATCH_MOD_NET))
            WatchDataFormatted ("sys$qiow() !&S !&S !&X\n",
                                status, hlptr->LookupIOsb,
                                IPADDRESS_SIZE(&hlptr->IpAddress));

         if (VMSnok (status)) hlptr->LookupIOsb.Status = status;
         if (VMSok (hlptr->LookupIOsb.Status)) break;

         sys$schdwk (0, 0, &RetryDelta, 0);
         sys$hiber();
      }

      if (VMSok(hlptr->LookupIOsb.Status))
      {
         if (IPADDRESS_SIZE(&hlptr->IpAddress) != 4 &&
             IPADDRESS_SIZE(&hlptr->IpAddress) != 16)
         {
            hlptr->LookupIOsb.Status = SS$_BUGCHECK;
            ErrorNoticed (SS$_BUGCHECK, "TcpIpNameToAddress()", FI_LI);
         }
         /* set an entry in the host cache */
         TcpIpCacheSetEntry (hlptr->HostName, hlptr->HostNameLength,
                             &hlptr->IpAddress);
         InstanceGblSecIncrLong (&AccountingPtr->LookupDnsNameCount);
      }
      else
         InstanceGblSecIncrLong (&AccountingPtr->LookupDnsNameErrorCount);

      sys$dassgn (hlptr->LookupChannel);
      hlptr->LookupChannel = 0;
      return (hlptr->LookupIOsb.Status);
   }
}

/*****************************************************************************/
/*
Get the host name using address-to-name lookup.
Synchronous and asynchronous is supported.

The AST function is designed to be used with a parameter of request pointer,
etc., but of course depends specific usage.

In AST mode this function can be called multiple times (by itself) to retry
host name resolution.  After resolution or timeout it calls the AST routine.

The can't-be-resolved entry, a host name comprising a single question-mark, is
used for address-to-name lookup (i.e. client name resolution) where the name is
resolvable.  It prevents lengthy delays for this situation by having the cache
report this for the duration of the entry life-time.
*/

int TcpIpAddressToName
(
TCPIP_HOST_LOOKUP *hlptr,
IPADDRESS *ipaptr,
int RetryAttempts,
void *AstFunction,
unsigned long AstParam
)
{
   /* this is two seconds delta */
   static unsigned long  RetryDelta [2] = { -20000000, -1 };

   static unsigned char ControlSubFunction [4] =
      { INETACP_FUNC$C_GETHOSTBYADDR, INETACP$C_TRANS, 0, 0 };
   static struct dsc$descriptor ControlSubFunctionDsc =
      { 4, DSC$K_DTYPE_T, DSC$K_CLASS_S, &ControlSubFunction };

   int  status;
   char  *cptr, *sptr, *zptr;
   struct dsc$descriptor *dscptr;

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

   if (WATCH_MODULE(WATCH_MOD_NET))
   {
      if (hlptr->LookupChannel)
         WatchThis (NULL, FI_LI, WATCH_MOD_NET,
                    "TcpIpAddressToName() !&F !&X !UL !&S",
                    TcpIpAddressToName, hlptr, hlptr->RetryCount,
                    hlptr->LookupIOsb.Status);
      else
         WatchThis (NULL, FI_LI, WATCH_MOD_NET,
                    "TcpIpAddressToName() !&F !UL !&X !UL",
                    TcpIpAddressToName, RetryAttempts,
                    AstFunction, AstParam);
   }

   if (hlptr->LookupChannel)
   {
      /***********************/
      /* resolution AST call */
      /***********************/

      if (hlptr->LookupIOsb.Status)
      {
         if (VMSok(hlptr->LookupIOsb.Status) || !hlptr->RetryCount)
         {
            /* lookup has finished (successfully or not) */
            if (VMSok (hlptr->LookupIOsb.Status)) 
            {
               hlptr->HostName[hlptr->HostNameLength] = '\0';
               InstanceGblSecIncrLong (&AccountingPtr->LookupDnsAddressCount);

               /* set an entry in the host cache */
               TcpIpCacheSetEntry (hlptr->HostName, hlptr->HostNameLength,
                                   &hlptr->IpAddress);
            }
            else
            {
               hlptr->HostName[hlptr->HostNameLength = 0] = '\0';
               InstanceGblSecIncrLong (&AccountingPtr->LookupDnsAddressErrorCount);

               /* set a can't-be-resolved entry in the host cache */
               TcpIpCacheSetEntry ("?", 1, &hlptr->IpAddress);
            }

            sys$dassgn (hlptr->LookupChannel);
            hlptr->LookupChannel = 0;
            SysDclAst (hlptr->AstFunction, hlptr->AstParam);
            return (hlptr->LookupIOsb.Status);
         }

         /* indicate (with a zero status) that this is a timer expiry */
         hlptr->LookupIOsb.Status = 0;
         /* queue up a timer event scheduling the next retry */
         status = sys$setimr (0, &RetryDelta, &TcpIpAddressToName, hlptr, 0);
         if (VMSok (status)) return (status);

         /* oops, problem */
         sys$dassgn (hlptr->LookupChannel);
         hlptr->LookupChannel = 0;
         hlptr->LookupIOsb.Status = status;
         SysDclAst (hlptr->AstFunction, hlptr->AstParam);
         return (status);
      }
      /* timer has expired, continue, trying again */
   }
   else
   {
      /**************/
      /* first call */
      /**************/

      hlptr->AstFunction = AstFunction;
      hlptr->AstParam = AstParam;

      IPADDRESS_COPY (&hlptr->IpAddress, ipaptr)

      status = TcpIpCacheAddressToName (hlptr, ipaptr);
      if (VMSok (status))
      {
         /* check for special case 'unresolvable address' */
         if (hlptr->HostName[0] == '?') status = SS$_ENDOFFILE;
         /* found in cache */
         hlptr->LookupIOsb.Status = status;
         if (hlptr->AstFunction)
            SysDclAst (hlptr->AstFunction, hlptr->AstParam);
         return (status);
      }

      /* assign a channel to the internet template device */
      status = sys$assign (&TcpIpDeviceDsc, &hlptr->LookupChannel, 0, 0);
      if (VMSnok (status))
      {
         /* leave it to the AST function to report! */
         hlptr->LookupIOsb.Status = status;
         if (hlptr->AstFunction)
            SysDclAst (hlptr->AstFunction, hlptr->AstParam);
         return (status);
      }

      dscptr = &hlptr->HostNameDsc;
      dscptr->dsc$b_class = DSC$K_CLASS_S;
      dscptr->dsc$b_dtype = DSC$K_DTYPE_T;
      dscptr->dsc$w_length = sizeof(hlptr->HostName)-1;
      dscptr->dsc$a_pointer = &hlptr->HostName;

      dscptr = &hlptr->HostAddressDsc;
      dscptr->dsc$b_class = DSC$K_CLASS_S;
      dscptr->dsc$b_dtype = DSC$K_DTYPE_T;
      if (IPADDRESS_IS_V4 (ipaptr))
      {
         dscptr->dsc$w_length = sizeof(IPADDRESS_ADR4(ipaptr));
         dscptr->dsc$a_pointer = &IPADDRESS_ADR4(ipaptr);
      }
      else
      if (IPADDRESS_IS_V6 (ipaptr))
      {
         dscptr->dsc$w_length = sizeof(IPADDRESS_ADR6(ipaptr));
         dscptr->dsc$a_pointer = &IPADDRESS_ADR6(ipaptr);
      }
      else
         ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI);

      if (RetryAttempts <= 0) RetryAttempts = 1;
      hlptr->RetryCount = RetryAttempts;
   }

   if (hlptr->AstFunction)
   {
      /****************/
      /* asynchronous */
      /****************/

      status = sys$qio (EfnNoWait, hlptr->LookupChannel, IO$_ACPCONTROL,
                        &hlptr->LookupIOsb, &TcpIpAddressToName, hlptr,
                        &ControlSubFunctionDsc, &hlptr->HostAddressDsc,
                        &hlptr->HostNameLength, &hlptr->HostNameDsc, 0, 0);

      if (WATCH_MODULE(WATCH_MOD_NET))
         WatchDataFormatted ("sys$qio() !&S\n", status);

      if (VMSnok (status))
      {
         /* failed, fudged the status and manually queue the AST */
         hlptr->LookupIOsb.Status = status;
         sys$dassgn (hlptr->LookupChannel);
         hlptr->LookupChannel = 0;
         SysDclAst (hlptr->AstFunction, hlptr->AstParam);
      }

      hlptr->RetryCount--;
      return (status);
   }
   else
   {
      /***************/
      /* synchronous */
      /***************/

      while (hlptr->RetryCount--)
      {
         status = sys$qiow (EfnWait, hlptr->LookupChannel, IO$_ACPCONTROL,
                            &hlptr->LookupIOsb, 0, 0,
                            &ControlSubFunctionDsc, &hlptr->HostAddressDsc,
                            &hlptr->HostNameLength, &hlptr->HostNameDsc, 0, 0);

         if (WATCH_MODULE(WATCH_MOD_NET))
            WatchDataFormatted ("sys$qiow() !&S !&S\n",
                                status, hlptr->LookupIOsb);

         if (VMSnok (status)) hlptr->LookupIOsb.Status = status;
         if (VMSok (hlptr->LookupIOsb.Status)) break;

         sys$schdwk (0, 0, &RetryDelta, 0);
         sys$hiber();
      }

      if (VMSok (hlptr->LookupIOsb.Status)) 
      {
         hlptr->HostName[hlptr->HostNameLength] = '\0';
         InstanceGblSecIncrLong (&AccountingPtr->LookupDnsAddressCount);

         /* set an entry in the host cache */
         TcpIpCacheSetEntry (hlptr->HostName, hlptr->HostNameLength,
                             &hlptr->IpAddress);
      }
      else
      {
         hlptr->HostName[hlptr->HostNameLength = 0] = '\0';
         InstanceGblSecIncrLong (&AccountingPtr->LookupDnsAddressErrorCount);

         /* set a 'could-not-resolve-address' entry in the host cache */
         TcpIpCacheSetEntry ("?", 1, &hlptr->IpAddress);
      }

      sys$dassgn (hlptr->LookupChannel);
      hlptr->LookupChannel = 0;
      return (hlptr->LookupIOsb.Status);
   }
}

/*****************************************************************************/
/*
Format an IPv4 (32 bit integer) or IPv6 (128 bit vector) into a dotted-decimal
address or IPv6-hexadecimal (compressed) string respectively.  Return a pointer
to a static buffer containing the string.  Note that parameter 2, named
'AddressType' is actually the 'fw' (field-width) of the calling routine.  Here
field-width is overloaded and not used as field-width at all.  When non-zero it
indicates which type of address is actually being pointed at, 4 or 6.
*/

char* TcpIpAddressToString
(
int Parameter,
int AddressType
)
{
   static char  HexDigitsUpper [] = "0123456789ABCDEF";
   static $DESCRIPTOR (IP4FaoDsc, "!UL.!UL.!UL.!UL\0");
   static char  String [48];
   static $DESCRIPTOR (StringDsc, String);

   int  cnt, status,
        Ip4Address;
   char  *cptr, *sptr, *zptr;
   unsigned char  *ucptr;
   unsigned char  Ip6Address [16];
   IPADDRESS  *ipaptr;

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

   if WATCH_MODULE(WATCH_MOD_NET)
      WatchThis (NULL, FI_LI, WATCH_MOD_NET, 
                 "TcpIpAddressToString() !UL", AddressType);

   if (AddressType <= 0)
   {
      ipaptr = (IPADDRESS*)Parameter;
      if (IPADDRESS_IS_V4(ipaptr))
      {
         AddressType = 4;
         IPADDRESS_SET4 (Ip4Address, ipaptr)
      }
      else
      if (IPADDRESS_IS_V6(ipaptr))
      {
         AddressType = 6;
         IPADDRESS_SET6 (Ip6Address, ipaptr)
         ucptr = Ip6Address;
      }
      else
      if (!IPADDRESS_SIZE(ipaptr))
         return ("0");
      else
         return (ErrorSanityCheck);
   }
   else
   {
      if (AddressType == 4)
         Ip4Address = Parameter;
      else
      if (AddressType == 6)
         ucptr = (unsigned char*)Parameter;
      else
      if (!AddressType)
         return ("0");
      else
         return (ErrorSanityCheck);
   }

   if (AddressType == 4)
   {
      /********/
      /* IPv4 */
      /********/

      status = sys$fao (&IP4FaoDsc, 0, &StringDsc,
                        Ip4Address & 0x000000ff,
                        (Ip4Address & 0x0000ff00) >> 8,
                        (Ip4Address & 0x00ff0000) >> 16,
                        (Ip4Address & 0xff000000) >> 24);

      return (String);
   }

   /********/
   /* IPv6 */
   /********/

   /*
      _normal_                       _compressed_
      1070:0:0:0:0:800:200C:417B     1070::800:200C:417B
      0:0:0:0:0:0:13.1.68.3          ::13.1.68.3
      0:0:0:0:0:FFFF:129.144.52.38   ::FFFF:129.144.52.38
   */

   sptr = zptr = String;
   for (cnt = 0; cnt < 8; cnt++)
   {
      if ((*ucptr >> 4) & 0x0f)
         *sptr++ = HexDigitsUpper[(*ucptr >> 4) & 0x0f];
      if ((*ucptr & 0x0f) || sptr > zptr)
         *sptr++ = HexDigitsUpper[*ucptr & 0x0f];
      ucptr++;
      if (((*ucptr >> 4)) & 0x0f || sptr > zptr)
         *sptr++ = HexDigitsUpper[(*ucptr >> 4) & 0x0f];
      if ((*ucptr & 0x0f) || sptr > zptr)
         *sptr++ = HexDigitsUpper[*ucptr & 0x0f];
      ucptr++;
      if (sptr == zptr) *sptr++ = '0';
      if (cnt < 7) *sptr++ = ':';
      zptr = sptr;
   }
   *sptr = '\0';

   /* compress */
   cptr = String;
   zptr = sptr;
   if (*cptr && *(unsigned short*)cptr == '0:')
   {
      sptr = cptr;
      while (cptr < zptr && *(unsigned short*)cptr == '0:') cptr += 2;
      *sptr++ = ':';
      sptr++;
      while (cptr < zptr) *sptr++ = *cptr++;
      *sptr = '\0';
   }
   else
   {
      while (cptr < zptr && *(unsigned short*)cptr != ':0') cptr++;
      if (cptr < zptr)
      {
         cptr++;
         sptr = cptr;
         while (cptr < zptr && *(unsigned short*)cptr == '0:') cptr += 2;
         *sptr++ = ':';
         while (cptr < zptr) *sptr++ = *cptr++;
         *sptr = '\0';
      }
   }

   return (String);
}

/*****************************************************************************/
/*
Convert an IPv4 dotted-decimal or IPv6 hexadecimal format (normal or
compressed) string into an appropriate address.
*/

int TcpIpStringToAddress
(
char *String,
IPADDRESS *ipaptr
)
{
   int  cnt, idx,
        Ip4Address;
   int  Ip4Octets [4];
   unsigned short  Ip6Address [8];
   unsigned short  *ip6ptr;
   unsigned int  uint;
   unsigned int  Ip6Octets [10];  /* well sort-of */
   char  *cptr, *sptr, *zptr;

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

   if WATCH_MODULE(WATCH_MOD_NET)
      WatchThis (NULL, FI_LI, WATCH_MOD_NET, 
                 "TcpIpStringToAddress() !&Z", String);

   IPADDRESS_SET_UNUSABLE (ipaptr)

   /* will reach end-of-string if it's an IPv4 address */
   for (cptr = String; isdigit(*cptr) || *cptr == '.'; cptr++);

   if (!*cptr)
   {
      /********/
      /* IPv4 */
      /********/

      memset (Ip4Octets, 0, sizeof(Ip4Octets));
      cnt = sscanf (String, "%d.%d.%d.%d",
                    &Ip4Octets[0], &Ip4Octets[1],
                    &Ip4Octets[2], &Ip4Octets[3]);
      if (cnt != 4) return (SS$_ENDOFFILE);
      Ip4Address = 0;
      for (idx = 0; idx <= 3; idx++)
      {
         if (Ip4Octets[idx] < 0 || Ip4Octets[idx] > 255)
            return (SS$_ENDOFFILE);
         Ip4Address |= Ip4Octets[idx] << idx * 8;
      }
      if WATCH_MODULE(WATCH_MOD_NET)
         WatchThis (NULL, FI_LI, WATCH_MOD_NET, "!&X !4&I",
                    Ip4Address, Ip4Address);
      IPADDRESS_GET4 (ipaptr, Ip4Address)
      return (SS$_NORMAL);
   }

   /********/
   /* IPv6 */
   /********/

   memset (Ip4Octets, 0, sizeof(Ip4Octets));
   memset (Ip6Octets, 0, sizeof(Ip6Octets));

   /*
      _normal_                       _compressed_
      1070:0:0:0:0:800:200C:417B     1070::800:200C:417B
      0:0:0:0:0:0:13.1.68.3          ::13.1.68.3
      0:0:0:0:0:FFFF:129.144.52.38   ::FFFF:129.144.52.38
      _hyphen-variant_
      1070-0-0-0-0-800-200C-417B     1070--800-200C-417B
      0-0-0-0-0-0-13.1.68.3          --13.1.68.3
      0-0-0-0-0-FFFF-129.144.52.38   --FFFF-129.144.52.38
   */

   idx = 0;
   zptr = "";
   cptr = String;
   while (*cptr)
   {
      if (idx > 7) return (SS$_ENDOFFILE);
      /* look ahead at the next delimiter */
      for (sptr = cptr; isxdigit(*sptr); sptr++);
      if (*sptr == ':' || (!*sptr && *zptr == ':') ||
          *sptr == '-' || (!*sptr && *zptr == '-'))
      {
         /* IPv6 (or variant) syntax */
         uint = (unsigned long)strtol (cptr, NULL, 16);
         if (uint > 0xffff) return (SS$_ENDOFFILE);
         /* network byte-order */
         Ip6Octets[idx] = (uint >> 8) | (uint << 8);
         idx++;
         if (*(unsigned short*)sptr == '::' ||
             *(unsigned short*)sptr == '--')
         {
            /* indicate the ellipsis zeroes */
            Ip6Octets[idx] = 0xffffffff;
            idx++;
            sptr++;
         }
      }
      else
      if (*sptr == '.' || (!*sptr && *zptr == '.'))
      {
         /* dropped into dotted-decimal, IPv4 compatible syntax */
         cnt = sscanf (cptr, "%d.%d.%d.%d",
                       &Ip4Octets[3], &Ip4Octets[2],
                       &Ip4Octets[1], &Ip4Octets[0]);
         if (cnt != 4) return (SS$_ENDOFFILE);
         while (isdigit(*cptr) || *cptr == '.') cptr++;
         if (*cptr) return (SS$_ENDOFFILE);
         if (Ip4Octets[0] < 0 || Ip4Octets[0] > 255) return (SS$_ENDOFFILE);
         if (Ip4Octets[1] < 0 || Ip4Octets[1] > 255) return (SS$_ENDOFFILE);
         if (Ip4Octets[2] < 0 || Ip4Octets[2] > 255) return (SS$_ENDOFFILE);
         if (Ip4Octets[3] < 0 || Ip4Octets[3] > 255) return (SS$_ENDOFFILE);
         Ip6Octets[idx++] = (Ip4Octets[3] << 8) | Ip4Octets[2];
         Ip6Octets[idx++] = (Ip4Octets[1] << 8) | Ip4Octets[0];
         break;
      }
      else
         return (SS$_ENDOFFILE);
      cptr = zptr = sptr;
      if (*cptr) cptr++;
   }

   memset (ip6ptr = Ip6Address, 0, sizeof(Ip6Address));
   cnt = 9 - idx;
   for (idx = 0; idx < 8; idx++)
   {
      if (Ip6Octets[idx] == 0xffffffff)
      {
         if (cnt < 0) return (SS$_ENDOFFILE);
         while (cnt--) ip6ptr++;
      }
      else
         *ip6ptr++ = Ip6Octets[idx];
   }

   IPADDRESS_GET6 (ipaptr, Ip6Address)

   if WATCH_MODULE(WATCH_MOD_NET)
      WatchThis (NULL, FI_LI, WATCH_MOD_NET, 
                 "!16&H !&I", Ip6Address, ipaptr);

   return (SS$_NORMAL);
}

/*****************************************************************************/
/*
Parse a network mask from the supplied string.
With a successful parse change the string pointer to point at the first
character after the mask.  If unsuccessful the pointer is not modified. 
Routines calling this function where this is undesireable should pass a
temporary, throw-away pointer.

The mask is a dotted-decimal network address, a slash, then an optional
dotted-decimal mask (e.g. "131.185.250.23/255.255.255.192", i.e. a 6 bit
subnet), or a dotted-decimal network address with a slash-separated, mask
length count (i.e. VLSM, e.g. "131.185.250.23/26" for the same mask as above).
An IP address specified without a mask becomes just an IP address (i.e. mask of
255.255.255.255).

Returns:
SS$_ENDOFFILE if there is a problem with the mask.
SS$_NORMAL if the mask matches the IP address.
SS$_UNREACHABLE if they do not match.
SS$_PROTOCOL if the mask type does not match the IPv4/IPv6 address supplied.
*/

int TcpIpNetMask
(
REQUEST_STRUCT *rqptr,
int WatchCategory,
char **StringPtrPtr,
IPADDRESS *ipaptr
)
{
   BOOL  Ip6Match;
   int  cnt, idx, status;
   int  Ip4Address,
        Ip4Mask,
        Ip4Net,
        Ip6Mask;
   int  Ip6AddressMask [4],
        OctetsMask [4],
        OctetsNet [4];
   unsigned long  *ulptr;
   char  *cptr, *sptr, *zptr;
   char  Ipv6StringAddr [64],
         Ipv6StringMask [16];
   IPADDRESS  IpAddressHost,
              IpAddressNet;

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

   if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_NET))
      WatchThis (rqptr, FI_LI, WATCH_MOD_NET, "TcpIpNetMask() !&Z !UL",
                 *StringPtrPtr, IPADDRESS_SIZE(ipaptr));

   for (cptr = *StringPtrPtr;
        isdigit(*cptr) || *cptr == '.' || *cptr == '/';
        cptr++);

   if (*cptr != ':' && *cptr != '-')
   {
      /********/
      /* IPv4 */
      /********/

      /* if we haven't been supplied with an IPv4 address to mask */
      if (!IPADDRESS_IS_V4 (ipaptr)) return (SS$_ENDOFFILE);

      memset (&OctetsNet, 0, sizeof(OctetsNet));
      memset (&OctetsMask, 0xff, sizeof(OctetsMask));

      /* get each octet in network order so we don't need htonl()s */
      cnt = sscanf (*StringPtrPtr, "%d.%d.%d.%d/%d.%d.%d.%d",
                    &OctetsNet[3], &OctetsNet[2],
                    &OctetsNet[1], &OctetsNet[0],
                    &OctetsMask[3], &OctetsMask[2],
                    &OctetsMask[1], &OctetsMask[0]);

      if (cnt == 4)
      {
         /* just an IP address */
         Ip4Net = 0;
         for (idx = 0; idx <= 3; idx++)
         {
            if (OctetsNet[idx] < 0 || OctetsNet[idx] > 255)
               return (SS$_ENDOFFILE);
            Ip4Net |= (OctetsNet[idx] & 0xff) << (idx * 8);
         }
         Ip4Mask = 0xffffffff;
      }
      else
      if (cnt == 5)
      {
         /* variable-length subnet mask style, e.g. '131.185.250/24' */
         Ip4Net = 0;
         for (idx = 0; idx <= 3; idx++)
         {
            if (OctetsNet[idx] < 0 || OctetsNet[idx] > 255)
               return (SS$_ENDOFFILE);
            Ip4Net |= (OctetsNet[idx] & 0xff) << (idx * 8);
         }
         cnt = OctetsMask[3];
         if (cnt < 0 || cnt > 32) return (SS$_ENDOFFILE);
         if (cnt)
         {
            /* needs to be signed int for this to work */
            Ip4Mask = 0x80000000;
            Ip4Mask = Ip4Mask >> (cnt - 1);
         }
      }
      else
      if (cnt == 8)
      {
         /* octet style, e.g. '131.185.250.0/255.255.255.0' */
         Ip4Mask = Ip4Net = 0;
         for (idx = 0; idx <= 3; idx++)
         {
            if (OctetsNet[idx] < 0 || OctetsNet[idx] > 255)
               return (SS$_ENDOFFILE);
            Ip4Net |= (OctetsNet[idx] & 0xff) << (idx * 8);
            if (OctetsMask[idx] < 0 || OctetsMask[idx] > 255)
               return (SS$_ENDOFFILE);
            Ip4Mask |= (OctetsMask[idx] & 0xff) << (idx * 8);
         }
      }
      else
         return (SS$_ENDOFFILE);

      /* now scan across the string's components */
      for (cptr = *StringPtrPtr;
           isdigit(*cptr) || *cptr == '.' || *cptr == '/';
           cptr++);
      *StringPtrPtr = cptr;
 
      IPADDRESS_SET4 (Ip4Address, ipaptr)

      if (WATCHING(rqptr) && WATCH_CATEGORY(WatchCategory))
         WatchThis (rqptr, FI_LI, WatchCategory,
"ADDRESS mask:!8XL/!8XL=!8XL host:!8XL/!8XL=!8XL match:!&?YES\rNO\r",
            Ip4Net, Ip4Mask, Ip4Net & Ip4Mask,
            ntohl(Ip4Address), Ip4Mask, ntohl(Ip4Address) & Ip4Mask,
            (Ip4Net & Ip4Mask) == (ntohl(Ip4Address) & Ip4Mask));

      if ((htonl(Ip4Address) & Ip4Mask) == (Ip4Net & Ip4Mask))
         return (SS$_NORMAL);
      else
         return (SS$_UNREACHABLE);
   }

   /********/
   /* IPv6 */
   /********/

   /* if we haven't been supplied with an IPv6 address to mask */
   if (!IPADDRESS_IS_V6 (ipaptr)) return (SS$_ENDOFFILE);

   /* parse out the address and mask components */
   zptr = (sptr = Ipv6StringAddr) + sizeof(Ipv6StringAddr)-1;
   for (cptr = *StringPtrPtr;
        isxdigit(*cptr) || *cptr == ':' || *cptr == '-' || *cptr == '.';
        *sptr++ = *cptr++); 
   *sptr = '\0';
   if (*cptr == '/') cptr++;
   zptr = (sptr = Ipv6StringMask) + sizeof(Ipv6StringMask)-1;
   while (isdigit(*cptr) && sptr < zptr) *sptr++ = *cptr++; 
   *sptr = '\0';

   status = TcpIpStringToAddress (Ipv6StringAddr, &IpAddressNet);
   if (VMSnok (status)) return (status);

   if (!IPADDRESS_IS_V6 (&IpAddressNet)) return (SS$_ENDOFFILE);

   if (Ipv6StringMask[0] && !isdigit(Ipv6StringMask[0])) return (SS$_ENDOFFILE);
   Ip6Mask = atoi(Ipv6StringMask);
   if (Ip6Mask < 0 || Ip6Mask > 128) return (SS$_ENDOFFILE);

   IPADDRESS_COPY (&IpAddressHost, ipaptr)

   cnt = 96;
   for (idx = 3; idx >= 0; idx--)
   {
      Ip6AddressMask[idx] = 0;
      if (Ip6Mask > cnt)
      {
         /* needs to be signed int for this to work */
         Ip6AddressMask[idx] = 0x80000000;
         Ip6AddressMask[idx] = Ip6AddressMask[idx] >> (Ip6Mask - cnt - 1);
         Ip6Mask -= 32;
      }
      IpAddressHost.address[idx] &= Ip6AddressMask[idx];
      IpAddressNet.address[idx] &= Ip6AddressMask[idx];
      cnt -= 32;
   }

   Ip6Match = IPADDRESS_IS_SAME (&IpAddressNet, &IpAddressHost);

   if (WATCHING(rqptr) && WATCH_CATEGORY(WatchCategory))
   {
      IPADDRESS  IpAddressNetTmp;
      TcpIpStringToAddress (Ipv6StringAddr, &IpAddressNetTmp);
      Ip6Mask = atoi(Ipv6StringMask);
      WatchThis (rqptr, FI_LI, WatchCategory,
"ADDRESS mask:!16&H/!16&H=!16&H host:!16&H/!16&H=!16&H match:!&?YES\rNO\r",
         IPADDRESS_ADR6(&IpAddressNetTmp),
         &Ip6AddressMask,
         IPADDRESS_ADR6(&IpAddressNet),
         IPADDRESS_ADR6(ipaptr),
         &Ip6AddressMask,
         IPADDRESS_ADR6(&IpAddressHost),
         Ip6Match);
   }

   *StringPtrPtr = cptr;
 
   if (Ip6Match)
      return (SS$_NORMAL);
   else
      return (SS$_UNREACHABLE);
}

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

