/*****************************************************************************/
/*
                                   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


VERSION HISTORY
---------------
27-FEB-2016  MGD  TcpIpAddressToString() IPv4 in IPv6 as ::FFFF:n.n.n.n
05-JAN-2015  MGD  TcpIpHostCacheReport() "..-->!4ZL.1.." per JPP
28-SEP-2014  MGD  bugfix; TcpIpCacheAddressToName() memcpy null char
28-AUG-2010  MGD  TcpIp6Nodes() to resolve IPv6 AAAA records
25-JUL-2010  MGD  TcpIpSetAgentInfo() revisiting IA64 parsing (yes! again!!)
11-NOV-2009  MGD  bugfix; IPADDRESS_ZERO macro zero full structure
22-JUL-2009  MGD  bugfix; TcpIpSetAgentInfo() refine (perhaps!) IA64 parsing
31-OCT-2007  MGD  TcpIpSocketBufferSize() to set/sense socket send and
                    receive buffer size options
22-AUG-2006  MGD  CCL option structures
04-JUL-2006  MGD  use PercentOf() for more accurate percentages
21-APR-2006  JPP  TcpIpCacheAddressToName() now searches for any entry in a
                  cache element (to support affinity cookie validation)
13-AUG-2005  JPP  support multiple IP addresses per name in the host cache
                  (to support proxy to origin server failover)
             MGD  some coincident refinements to lookup functions,
                  provide WASD_DISABLE_HOSTENT_OFFSET environment variable
                    to force disbling of 'hostent' based lookup
12-JUL-2005  MGD  bugfix; initialize TcpIpHostCacheExpireSeconds (jpp@esme.fr)
10-APR-2005  MGD  IA64 TcpIpSetAgentInfo() Multinet uses UCX$IPC_SHR
                  in the image header (TCP/IP Services' TCPIP$IPC_SHR)
28-JUL-2004  MGD  TcpIpHostCacheSupervisor() can now purge entries
25-MAR-2004  MGD  initial (with modifications for IPv6)
*/
/*****************************************************************************/

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

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

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

#ifdef __ia64
#  define ELVEN
#endif
#ifdef __x86_64
#  define ELVEN
#endif

#ifdef ELVEN
/*** hmmm, elfdef.h preceding wasd.h results in:

    } LKIDEF;
......^
%CC-E-NOLINKAGE, In this declaration, "LKIDEF" has no linkage and has a prior
declaration in this scope at line number *** in file
WASD_ROOT:[SRC.HTTPD]WASD.H;1.
at line number 81 in module LKIDEF of text library
SYS$COMMON:[SYSLIB]SYS$STARLET_C.TLB;1

(HP C V7.1-011 on OpenVMS IA64 V8.3-1H1)
(VSI C V7.4-001 on OpenVMS IA64 V8.4-2L1)
***/
#include <elfdef.h>
#endif

#define WASD_MODULE "TCPIP"

#define FI_LI WASD_MODULE, __LINE__

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

BOOL  TcpIpv6Configured,
      TcpIpUseHostentOffset;

int  TcpIpHostCacheBytes,
     TcpIpHostCacheCount,
     TcpIpHostCacheExpireSeconds,
     TcpIpHostCacheMax,
     TcpIpTcpMaxSeg,
     TcpIpSocketRcvBufSize,
     TcpIpSocketSndBufSize,
     TcpIpRcvBufSize,
     TcpIpSndBufSize;

ushort  TcpIpMaxSegLength,
        TcpIpRcvBufLength,
        TcpIpSndBufLength;

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,
     TcpIp_OptionOff = 0;

VMS_ITEM_LIST2  TcpIp_RcvBufOption =
   { sizeof(TcpIpSocketRcvBufSize), TCPIP$C_RCVBUF, &TcpIpSocketRcvBufSize };

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  TcpIp_SndBufOption =
   { sizeof(TcpIpSocketSndBufSize), TCPIP$C_SNDBUF, &TcpIpSocketSndBufSize };

VMS_ITEM_LIST2  TcpIp_SndRcvBufOption [] = {
      { sizeof(TcpIpSocketSndBufSize), TCPIP$C_SNDBUF, &TcpIpSocketSndBufSize },
      { sizeof(TcpIpSocketRcvBufSize), TCPIP$C_RCVBUF, &TcpIpSocketRcvBufSize }
   };

VMS_ITEM_LIST3  TcpIp_SndRcvBufSense [] = {
      { sizeof(TcpIpSndBufSize), TCPIP$C_SNDBUF,
        &TcpIpSndBufSize, &TcpIpSndBufLength },
      { sizeof(TcpIpRcvBufSize), TCPIP$C_RCVBUF,
        &TcpIpRcvBufSize, &TcpIpRcvBufLength },
      { sizeof(TcpIpTcpMaxSeg), TCPIP$C_TCP_MAXSEG,
        &TcpIpTcpMaxSeg, &TcpIpMaxSegLength }
  };

VMS_ITEM_LIST3  TcpIp_MaxSegSense [] = {
      { sizeof(TcpIpTcpMaxSeg), TCPIP$C_TCP_MAXSEG,
        &TcpIpTcpMaxSeg, &TcpIpMaxSegLength },
  };

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

VMS_ITEM_LIST2  TcpIp_CclOptionOn =
   { sizeof(TcpIp_OptionOn), TCPIP$C_CCL, &TcpIp_OptionOn };

VMS_ITEM_LIST2  TcpIpSocketCclOptionOn =
   { sizeof(TcpIp_CclOptionOn), TCPIP$C_SOCKOPT, &TcpIp_CclOptionOn };

VMS_ITEM_LIST2  TcpIp_CclOptionOff =
   { sizeof(TcpIp_OptionOff), TCPIP$C_CCL, &TcpIp_OptionOff };

VMS_ITEM_LIST2  TcpIpSocketCclOptionOff =
   { sizeof(TcpIp_CclOptionOff), TCPIP$C_SOCKOPT, &TcpIp_CclOptionOff };

VMS_ITEM_LIST2  TcpIpSocketMaxSegSense =
   { sizeof(TcpIp_MaxSegSense), TCPIP$C_TCPOPT, &TcpIp_MaxSegSense };

VMS_ITEM_LIST2  TcpIpSocketRcvBufOption =
   { sizeof(TcpIp_RcvBufOption), TCPIP$C_SOCKOPT, &TcpIp_RcvBufOption };

VMS_ITEM_LIST2  TcpIpSocketSndBufOption =
   { sizeof(TcpIp_SndBufOption), TCPIP$C_SOCKOPT, &TcpIp_SndBufOption };

VMS_ITEM_LIST2  TcpIpSocketSndRcvBufOption =
   { sizeof(TcpIp_SndRcvBufOption), TCPIP$C_SOCKOPT, &TcpIp_SndRcvBufOption };

VMS_ITEM_LIST2  TcpIpSocketSndRcvBufSense =
   { sizeof(TcpIp_SndRcvBufSense), TCPIP$C_SOCKOPT, &TcpIp_SndRcvBufSense };

/* 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 CONFIG_STRUCT  Config;
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?

IA64 ELF image analysis plagiarised from:
//  File: elf_imginfo.c
//  Author: Hartmut Becker
//  Creation Date:  24-Sep-2004
*/ 

TcpIpSetAgentInfo ()

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

#ifdef ELVEN
   static const char MagicPlus [] =
   {
       EHDR$K_ELFMAG0, EHDR$K_ELFMAG1, EHDR$K_ELFMAG2, EHDR$K_ELFMAG3,
       EHDR$K_ELFCLASS64, EHDR$K_ELFDATA2LSB
   };
#endif

   int  status;
   ushort  Length;
   char  *cptr,
         *ImageDatePtr,
         *ImageIdentPtr,
         *ImageNamePtr,
         *PackagePtr;
   char  ErrorInfo [256],
         ImageRecord [512];
   ulong  Genesis [2];
   FILE  *ImageFile;

#ifdef ELVEN
   int  cnt;
   ulong  ImageDate [2];
   char  *secptr = NULL;
   ELF64_EHDR  ElfHeader;
   ELF64_SHDR  *shptr = NULL;
   ELF64_NHDR  *nhptr;
#endif

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

   if (WATCH_MODULE(WATCH_MOD_NET))
      WatchThis (WATCHALL, WATCH_MOD_NET, "TcpIpSetAgentInfo()");

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

#ifdef ELVEN
   /* 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)
   {
      FaoToBuffer (ErrorInfo+1, sizeof(ErrorInfo)-1, &Length,
                   "%X!8XL(!UL)", vaxc$errno, __LINE__);
      goto ImageIdentFailed;
   }

#ifndef ELVEN
   if (fread (&ImageRecord, sizeof(ImageRecord), 1, ImageFile) != 1)
   {
      FaoToBuffer (ErrorInfo+1, sizeof(ErrorInfo)-1, &Length,
                   "%X!8XL(!UL)", vaxc$errno, __LINE__);
      goto ImageIdentFailed;
   }
#endif

#ifdef __ALPHA
   ImageNamePtr = ImageRecord + 200;
   ImageIdentPtr = ImageRecord + 240;
   ImageDatePtr = ImageRecord + 192;
#endif

#ifdef ELVEN

   ImageNamePtr = ImageIdentPtr = "?";
   ImageDatePtr = 0;

   if (fread (&ElfHeader, sizeof(ElfHeader), 1, ImageFile) != 1)
   {
      FaoToBuffer (ErrorInfo+1, sizeof(ErrorInfo)-1, &Length,
                   "%X!8XL(!UL)", vaxc$errno, __LINE__);
      goto ImageIdentFailed;
   }

   if (strncmp ((char*)&ElfHeader.ehdr$t_e_ident,
                MagicPlus,
                sizeof(MagicPlus)-1)) 
   {
      FaoToBuffer (ErrorInfo+1, sizeof(ErrorInfo)-1, &Length,
                   "ELF file format? (!UL)", __LINE__);
      goto ImageIdentFailed;
   }

   shptr = (ELF64_SHDR*) malloc (sizeof *shptr *ElfHeader.ehdr$w_e_shnum);
   if (fseek (ImageFile, ElfHeader.ehdr$q_e_shoff, SEEK_SET))
   {
      FaoToBuffer (ErrorInfo+1, sizeof(ErrorInfo)-1, &Length,
                   "%X!8XL(!UL)", vaxc$errno, __LINE__);
      goto ImageIdentFailed;
   }
   if (fread (shptr, sizeof *shptr*ElfHeader.ehdr$w_e_shnum, 1, ImageFile) != 1)
   {
      FaoToBuffer (ErrorInfo+1, sizeof(ErrorInfo)-1, &Length,
                   "%X!8XL(!UL)", vaxc$errno, __LINE__);
      goto ImageIdentFailed;
   }

   for (cnt = 1; cnt < ElfHeader.ehdr$w_e_shnum; cnt++)
   {
      if (shptr[cnt].shdr$l_sh_type == SHDR$K_SHT_NOTE)
      {
         secptr = malloc (shptr[cnt].shdr$q_sh_size);
         if (fseek (ImageFile, shptr[cnt].shdr$q_sh_offset, SEEK_SET))
         {
            FaoToBuffer (ErrorInfo+1, sizeof(ErrorInfo)-1, &Length,
                         "%X!8XL(!UL)", vaxc$errno, __LINE__);
            goto ImageIdentFailed;
         }
         if (fread (secptr, shptr[cnt].shdr$q_sh_size, 1, ImageFile) != 1)
         {
            FaoToBuffer (ErrorInfo+1, sizeof(ErrorInfo)-1, &Length,
                         "%X!8XL(!UL)", vaxc$errno, __LINE__);
            goto ImageIdentFailed;
         }

         for (nhptr = (ELF64_NHDR*)secptr;
              (char*)nhptr-secptr < shptr[cnt].shdr$q_sh_size;
              nhptr = (ELF64_NHDR*)((char*)nhptr+sizeof(ELF64_NHDR)+
                                ((nhptr->nhdr$q_nh_namesz+7)&~7)+
                                ((nhptr->nhdr$q_nh_descsz+7)&~7)))
         {
            if (nhptr->nhdr$q_nh_descsz > 0)
            {
               switch (nhptr->nhdr$q_nh_type)
               {
                  case NHDR$K_NT_VMS_LINKTIME:
                       ImageDatePtr = (ULONGPTR)
                                      ((char*)nhptr+sizeof(ELF64_NHDR) +
                                       ((nhptr->nhdr$q_nh_namesz+7)&~7));
                       memcpy (ImageDate, ImageDatePtr, 8);
                       ImageDatePtr = ImageDate;
                       break ;
                  case NHDR$K_NT_VMS_IMGNAM:
                       cptr = (char*)nhptr+sizeof(ELF64_NHDR) +
                              ((nhptr->nhdr$q_nh_namesz+7)&~7);
                       ImageNamePtr = malloc (strlen(cptr)+1);
                       strcpy (ImageNamePtr, cptr);
                       break ;
                  case NHDR$K_NT_VMS_IMGID:
                       cptr = (char*)nhptr+sizeof(ELF64_NHDR) +
                              ((nhptr->nhdr$q_nh_namesz+7)&~7);
                       ImageIdentPtr = malloc (strlen(cptr)+1);
                       strcpy (ImageIdentPtr, cptr);
                       break ;
                  case NHDR$K_NT_VMS_GSTNAM:
                       break ;
                  case NHDR$K_NT_VMS_IMGBID:
                       break ;
                  case NHDR$K_NT_VMS_LINKID:
                       break ;
                  default:
                       break ;
               }
            }
         }
         free (secptr);
      }
   }

   free (shptr);

#endif

#ifdef __VAX
   Length = *(USHORTPTR)ImageRecord;
   ImageNamePtr = ImageRecord + Length - 80;
   ImageIdentPtr = ImageRecord + Length - 40;
   ImageDatePtr = ImageRecord + Length - 24;
#endif

   /* goto target */
   ImageIdentFailed:

   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 = "VSI";
      status = sys$trnlnm (0, &LnmSystemDsc, &VsiIpDsc, 0, 0);
   }
   if (status == SS$_NOLOGNAM)
      PackagePtr = "unknown";
   else
   if (VMSnok (status))
      PackagePtr = "sys$trnlnm()_error";

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

#ifdef ELVEN
   /* ever'thin's null-terminated in this brave new world? */
   FaoToBuffer (TcpIpAgentInfo, sizeof(TcpIpAgentInfo), NULL,
                "!AZ !AZ !AZ (!%D)",
                PackagePtr, ImageNamePtr, ImageIdentPtr, ImageDatePtr);
#else
   FaoToBuffer (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';
}                                   

/*****************************************************************************/
/*
Either set the supplied socket to the send and/or receive buffer size
specified in the parameters or if both are zero and WATCHing then report the
current buffer sizes.  If a size parameter is set to -1 the global
configuration setting is used.
*/


int TcpIpSocketBufferSize (void *vptr)

{
   int  status;
   uint  channel;
   IO_SB  SocketIOsb;
   NETIO_STRUCT  *ioptr;
   REQUEST_STRUCT *rqptr;

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

   if (WATCH_MODULE(WATCH_MOD_NET))
      WatchThis (WATCHALL, WATCH_MOD_NET, "TcpIpSocketBufferSize()");

   ioptr = (NETIO_STRUCT*)vptr;
   rqptr = ioptr->RequestPtr;
   channel = ioptr->Channel;

   if (TcpIpSocketSndBufSize && TcpIpSocketRcvBufSize)
      status = sys$qiow (EfnWait, channel, IO$_SETMODE,
                         &SocketIOsb, 0, 0,
                         0, 0, 0, 0, &TcpIpSocketSndRcvBufOption, 0);
   else
   if (TcpIpSocketSndBufSize)
      status = sys$qiow (EfnWait, channel, IO$_SETMODE,
                         &SocketIOsb, 0, 0,
                         0, 0, 0, 0, &TcpIpSocketSndBufOption, 0);
   else
   if (TcpIpSocketRcvBufSize)
      status = sys$qiow (EfnWait, channel, IO$_SETMODE,
                         &SocketIOsb, 0, 0,
                         0, 0, 0, 0, &TcpIpSocketRcvBufOption, 0);

   if (TcpIpSocketSndBufSize || TcpIpSocketRcvBufSize)
   {
      if (VMSok (status)) status = SocketIOsb.Status;
      if (WATCHING (rqptr, WATCH_NETWORK))
         WatchThis (WATCHITM(rqptr), WATCH_NETWORK,
                    "SETMODE sndbuf:!UL rcvbuf:!UL !&S",
                    TcpIpSndBufSize, TcpIpRcvBufSize, status);
   }

   status = SS$_NORMAL;

   if (WATCHING (rqptr, WATCH_NETWORK))
   {
      status = sys$qiow (EfnWait, channel, IO$_SENSEMODE,
                         &SocketIOsb, 0, 0,
                         0, 0, 0, 0, 0, &TcpIpSocketSndRcvBufSense);
      if (VMSok (status)) status = SocketIOsb.Status;
   }

   if (VMSok (status))
   {
      status = sys$qiow (EfnWait, channel, IO$_SENSEMODE,
                         &SocketIOsb, 0, 0,
                         0, 0, 0, 0, 0, &TcpIpSocketMaxSegSense);
      if (VMSok (status)) status = SocketIOsb.Status;
   }

   if (WATCHING (rqptr, WATCH_NETWORK))
      WatchThis (WATCHITM(rqptr), WATCH_NETWORK,
                 "SENSEMODE sndbuf:!UL rcvbuf:!UL maxseg:!UL !&S",
                 TcpIpSndBufSize, TcpIpRcvBufSize, TcpIpTcpMaxSeg, status);

   ioptr->TcpIpTcpMaxSeg = TcpIpTcpMaxSeg;

   return (status);
}

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

TcpIpHostCacheInit ()
{

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

   if (WATCH_MODULE(WATCH_MOD_NET))
      WatchThis (WATCHALL, WATCH_MOD_NET, "TcpIpHostCacheInit()");

   if (Config.cfMisc.DnsLookupLifeTimeSeconds)
      TcpIpHostCacheExpireSeconds = Config.cfMisc.DnsLookupLifeTimeSeconds;
   else
      TcpIpHostCacheExpireSeconds = TCPIP_HOST_CACHE_EXPIRE_SECONDS;

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

   TcpIpHostCacheSupervisor ((uint)-1);
}

/*****************************************************************************/
/*
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). 
Calling with (uint)-1 purges all entries and resets the host entry
lookup mode.
*/

TcpIpHostCacheSupervisor (uint TickSecond)

{
   int  cnt,
        NewCacheCount;
   TCPIP_HOST_CACHE  *hcptr;

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

   if (WATCH_MODULE(WATCH_MOD_NET))
      WatchThis (WATCHALL, WATCH_MOD_NET,
                 "TcpIpHostCacheSupervisor() !UL", TickSecond);

   if (TickSecond == (uint)-1)
   {
      /* allow use of INETACP$C_HOSTENT_OFFSET to be explicitly disabled */
      if (getenv("WASD_DISABLE_HOSTENT_OFFSET"))
         TcpIpUseHostentOffset = false;
      else
         TcpIpUseHostentOffset = true;
   }

   if (!TcpIpHostCachePtr || !TcpIpHostCacheCount) return;

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

/*****************************************************************************/
/*
Search for the specified host name in the host name/address cache.
Use (any) previous lookup data to try and short-circuit the search.
Always returns the first IP address in the entry.
Modify the host-lookup IP address field if found.
*/

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

   int  cnt;

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

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

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

   /* check against (any) previous lookup */
   if (hcptr && hcptr->HostNameLength != HostNameLength) hcptr = NULL;
   if (hcptr && !MATCH0 (hcptr->HostName, HostName, HostNameLength)) hcptr = NULL;

   if (!hcptr)
   {
      hcptr = TcpIpHostCachePtr;
      for (cnt = 0; cnt < TcpIpHostCacheCount; hcptr++, cnt++)
      {
         if (hcptr->HostNameLength != HostNameLength) continue;
         if (!MATCH0 (hcptr->HostName, HostName, HostNameLength)) continue;
         break;
      }
      if (cnt >= TcpIpHostCacheCount) hcptr = NULL;
   }

   if (hcptr)
   {
      if (hcptr->ExpiresTickSecond > HttpdTickSecond) 
      {
         if (WATCH_MODULE(WATCH_MOD_NET))
            WatchThis (WATCHALL, WATCH_MOD_NET, "HIT !UL !&I",
                       hcptr->HitCountNameToAddress+1, &hcptr->IpAddress[0]);
         hcptr->HitCountNameToAddress++;
         IPADDRESS_COPY (&hlptr->IpAddress, &hcptr->IpAddress[0])
         InstanceGblSecIncrLong (&AccountingPtr->LookupCacheNameCount);
         return (SS$_NORMAL);
      }
      /* time to refresh the entry */
      hcptr->HostNameLength = 0;
      hcptr = NULL;
      if (WATCH_MODULE(WATCH_MOD_NET))
         WatchThis (WATCHALL, WATCH_MOD_NET, "EXPIRED");
      return (SS$_ENDOFFILE);
   }

   if (WATCH_MODULE(WATCH_MOD_NET))
      WatchThis (WATCHALL, WATCH_MOD_NET, "MISSED");
   return (SS$_ENDOFFILE);
}

/*****************************************************************************/
/*
Search for the specified address in the host name/address cache.
Use (any) previous lookup data to try and short-circuit the search.
Modify the host-lookup host name field if found.
*/

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

   int  cnt,ent;
   BOOL found;

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

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

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

   /* check against (any) previous lookup */
   if (hcptr && !hcptr->HostNameLength) hcptr = NULL;
   if (hcptr && !IPADDRESS_IS_SAME(&hcptr->IpAddress[0], ipaptr)) hcptr = NULL;

   if (!hcptr)
   {
      hcptr = TcpIpHostCachePtr;
      found = false;
      for (cnt = 0; cnt < TcpIpHostCacheCount; hcptr++, cnt++)
      {
         if (!hcptr->HostNameLength) continue;
	 for (ent = 0; ent < TCPIP_HOST_CACHE_ENTRIES_MAX; ent++) 
         {
	    if (!IPADDRESS_IS_SET (&hcptr->IpAddress[ent])) break;
            if (IPADDRESS_IS_SAME (&hcptr->IpAddress[ent], ipaptr))
	    {
	       found = true;
	       break;
	    }
         }
         if (found) break;
      }
      if (!found) hcptr = NULL;
   }

   if (hcptr)
   {
      if (hcptr->ExpiresTickSecond > HttpdTickSecond)
      {
         if (WATCH_MODULE(WATCH_MOD_NET))
            WatchThis (WATCHALL, WATCH_MOD_NET, "HIT !UL !&Z",
                       hcptr->HitCountAddressToName+1, &hcptr->HostName);
         hcptr->HitCountAddressToName++;
         memcpy (hlptr->HostName, hcptr->HostName, hcptr->HostNameLength+1);
         hlptr->HostNameLength = hcptr->HostNameLength;
         InstanceGblSecIncrLong (&AccountingPtr->LookupCacheAddressCount);
         return (SS$_NORMAL);
      }
      /* time to refresh the entry */
      hcptr->HostNameLength = 0;
      hcptr = NULL;
      if (WATCH_MODULE(WATCH_MOD_NET))
         WatchThis (WATCHALL, WATCH_MOD_NET, "EXPIRED");
      return (SS$_ENDOFFILE);
   }

   if (WATCH_MODULE(WATCH_MOD_NET))
      WatchThis (WATCHALL, 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.

Each line of cache can accomodate up to TCPIP_HOST_CACHE_ENTRIES_MAX
addresses.  Attempts to set an address beyond that limit just drop into the
bit-bucket.

When called for invalidation, only the first entry in the first line of cache
for the given host name is erased.  This is done by moving the other entries
one step towards the beginning of the array and padding the last position with
a null entry.  The rationale for this is:

  o  the size of the array (TCPIP_HOST_CACHE_ENTRIES_MAX) is very small
  o  invalidation is far less frequent than searching
  o  cache search has only to be concerned with the first array element

When all entries have been erased, the whole line is marked free by setting
HostNameLength to zero.
*/

int TcpIpCacheSetEntry
(
char *HostName,
int HostNameLength,
IPADDRESS *ipaptr
)
{
   static TCPIP_HOST_CACHE  *hcptr;

   int  cnt, ent;
   char  *cptr, *sptr, *zptr;

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

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

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

   if (hcptr && hcptr->HostNameLength != HostNameLength) hcptr = NULL;
   if (hcptr && !MATCH0 (hcptr->HostName, HostName, HostNameLength)) hcptr = NULL;

   if (!hcptr)
   {
      /* check whether it's currently in the cache */
      hcptr = TcpIpHostCachePtr;
      for (cnt = 0; cnt < TcpIpHostCacheCount; hcptr++, cnt++)
      {
         if (hcptr->HostNameLength != HostNameLength) continue;
         if (!MATCH0 (hcptr->HostName, HostName, HostNameLength)) continue;
         break;
      }
      if (cnt >= TcpIpHostCacheCount) hcptr = NULL;
   }

   if (hcptr)
   {
      /* found the host name entry */
      if (ipaptr)
      {
         /* look for an empty IP address entry */
	 for (ent = 0; ent < TCPIP_HOST_CACHE_ENTRIES_MAX; ent++) 
         {
	    if (!IPADDRESS_IS_SET (&hcptr->IpAddress[ent])) break;
            if (IPADDRESS_IS_SAME (&hcptr->IpAddress[ent], ipaptr)) break;
         }
         /* if there is host entry space (IP address) still available */
         if (ent < TCPIP_HOST_CACHE_ENTRIES_MAX)
            IPADDRESS_COPY (&hcptr->IpAddress[ent], ipaptr)
      }
      else
      {
         /* the NULL 'ipaptr' indicates it should be declared invalid */
	 if (IPADDRESS_IS_SET (&hcptr->IpAddress[1]))
	 {
	    /* shift all addresses one step backwards */
	    for (ent = 1; ent < TCPIP_HOST_CACHE_ENTRIES_MAX; ent++)
               IPADDRESS_COPY (&hcptr->IpAddress[ent-1],
                               &hcptr->IpAddress[ent]);
	    /* reset last address in list */
	    IPADDRESS_ZERO (&hcptr->IpAddress[TCPIP_HOST_CACHE_ENTRIES_MAX-1]);
         }
	 else
	 {
	    /* mark this cache entry as unused */
            hcptr->HostNameLength = 0;
         }
      }
      return (SS$_NORMAL);
   }

   /* if trying to invalidate an apparently (now) non-existant entry */
   if (!ipaptr) return (SS$_NORMAL);

   /* look for 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) hcptr = NULL;

   if (!hcptr)
   {
      /* didn't find one that could be reused */
      if (TcpIpHostCacheCount < TcpIpHostCacheMax)
      {
         /* still unused space in the cache */
         hcptr = &TcpIpHostCachePtr[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 */
            hcptr = &TcpIpHostCachePtr[TcpIpHostCacheCount++];
         }
         else
         {
            /* can't expand so just ignore! */
            return (SS$_NORMAL);
         }
      }
   }

   /* populate the entry */
   hcptr->HitCountAddressToName = hcptr->HitCountNameToAddress = 0;
   hcptr->ExpiresTickSecond = HttpdTickSecond + TcpIpHostCacheExpireSeconds;
   IPADDRESS_COPY (&hcptr->IpAddress[0], ipaptr);
   for (ent = 1; ent < TCPIP_HOST_CACHE_ENTRIES_MAX; ent++)
      IPADDRESS_ZERO (&hcptr->IpAddress[ent]);
   zptr = (sptr = hcptr->HostName) + sizeof(hcptr->HostName)-1;
   for (cptr = HostName; *cptr && sptr < zptr; *sptr++ = *cptr++);
   *sptr = '\0';
   hcptr->HostNameLength = cptr - HostName;
   if (WATCH_MODULE(WATCH_MOD_NET))
      WatchThis (WATCHALL, WATCH_MOD_NET,
                 "SET !UL/!UL", cnt, TcpIpHostCacheCount);

   return (SS$_NORMAL);
}

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

TcpIpHostCacheReport (REQUEST_STRUCT *rqptr)

{
   static char  BeginPageFao [] =
"<!!-- max:!UL count:!UL bytes:!UL -->\n\
<p><table class=\"ctgry\">\n\
<tr><th class=\"ctttl\">Statistics</th></tr>\n\
<tr><td>\n\
<table class=\"rghtrght\">\n\
<tr><th></th>\
<th class=\"sbttl\">Literal</th>\
<th class=\"sbttl talft\" colspan=\"2\">DNS</th>\
<th class=\"sbttl\">Cache</th>\
<th class=\"sbttl\">Error</th>\
</tr>\n\
<tr><th>Address:</th>\
<td>!&L</td>\
<td></td>\
<td></td>\
<td></td>\
<td>!&L</td>\
</tr>\n\
<tr><th>Address-to-name:</th>\
<td></td>\
<td>&nbsp;&nbsp;!&L</td>\
<td class=\"talft\">(!UL%)</td>\
<td>!&L</td>\
<td>!&L</td>\
</tr>\n\
<tr><th>Name-to-address:</th>\
<td></td>\
<td>!&L</td>\
<td>(!UL%)</td>\
<td>!&L</td>\
<td>!&L</td>\
</tr>\n\
</table>\n\
</td></tr>\n\
</table>\n\
\
<p><table class=\"lftlft\">\n\
<tr>\
<th></th>\
<th class=\"sbttl talft\">Host&nbsp;Name</th>\
<th class=\"sbttl talft\">IP&nbsp;Address</th>\
<th class=\"sbttl\">Name-&gt;Addr</th>\
<th class=\"sbttl\">Addr-&gt;Name</th>\
<th class=\"sbttl\">Expires</th>\
</tr>\n";

   static char  Item1Fao [] =
"<tr><th><!!-- !UL -->!4ZL.1</th>\
<td class=\"talft\">!AZ</td>\
<td class=\"talft\">!&I</td>\
<td>!&L</td>\
<td>!&L</td>\
<td>!AZ</td>\
<tr>\n";

   static char  Item2Fao [] =
"<th>.!UL</th>\
<td></td>\
<td class=\"talft\">!&I</td>\
<td></td>\
<td></td>\
<td></td>\
<tr>\n";

   static char EmptyCacheFao [] =
"<tr class=\"hlght\"><th>000</th>\
<td class=\"talft\" colspan=\"5\"><i>empty</i></td><tr>\n";

   static char  EndPageFao [] =
"</table>\n\
!AZ\
</div>\n\
</body>\n\
</html>\n";

   int  cnt, ent, status,
        EntryCount,
        ExpireSeconds;
   ulong  FaoVector [16];
   ulong  *vecptr;
   TCPIP_HOST_CACHE  *hcptr;

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

   if (WATCHMOD (rqptr, WATCH_MOD_NET))
      WatchThis (WATCHITM(rqptr), WATCH_MOD_NET, "TcpIpHostCacheReport()");

   AdminPageTitle (rqptr, "Host Resolution Report");

   vecptr = FaoVector;

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

   InstanceMutexLock (INSTANCE_MUTEX_HTTPD);

   *vecptr++ = AccountingPtr->LookupLiteralCount;
   *vecptr++ = AccountingPtr->LookupLiteralErrorCount;
   *vecptr++ = AccountingPtr->LookupDnsAddressCount;
   *vecptr++ = PercentOf (AccountingPtr->LookupDnsAddressCount,
                          AccountingPtr->LookupDnsAddressCount +
                          AccountingPtr->LookupCacheAddressCount);
   *vecptr++ = AccountingPtr->LookupCacheAddressCount;
   *vecptr++ = AccountingPtr->LookupDnsAddressErrorCount;
   *vecptr++ = AccountingPtr->LookupDnsNameCount;
   *vecptr++ = PercentOf (AccountingPtr->LookupDnsNameCount,
                          AccountingPtr->LookupDnsNameCount +
                          AccountingPtr->LookupCacheNameCount);
   *vecptr++ = AccountingPtr->LookupCacheNameCount;
   *vecptr++ = AccountingPtr->LookupDnsNameErrorCount;

   InstanceMutexUnLock (INSTANCE_MUTEX_HTTPD);

   status = FaolToNet (rqptr, BeginPageFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (NULL, status, NULL, 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[0];
      *vecptr++ = hcptr->HitCountNameToAddress;
      *vecptr++ = hcptr->HitCountAddressToName;
      ExpireSeconds = hcptr->ExpiresTickSecond - HttpdTickSecond;
      *vecptr++ = MetaConShowSeconds (rqptr, ExpireSeconds);
      status = FaolToNet (rqptr, Item1Fao, &FaoVector);
      if (VMSnok (status)) ErrorNoticed (NULL, status, NULL, FI_LI);

      for (ent = 1; ent < TCPIP_HOST_CACHE_ENTRIES_MAX; ent++)
      {
         if (!IPADDRESS_IS_SET (&hcptr->IpAddress[ent])) break;
         vecptr = FaoVector;
         *vecptr++ = ent+1;
         *vecptr++ = &hcptr->IpAddress[ent];
         *vecptr++ = MetaConShowSeconds (rqptr, ExpireSeconds);
         status = FaolToNet (rqptr, Item2Fao, &FaoVector);
         if (VMSnok (status))
            ErrorNoticed (NULL, status, NULL, FI_LI);
      }
   }

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

   vecptr = FaoVector;
   *vecptr++ = AdminRefresh();

   status = FaolToNet (rqptr, EndPageFao, &FaoVector);
   if (VMSnok (status)) ErrorNoticed (NULL, status, NULL, FI_LI);

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

   AdminEnd (rqptr);
}

/*****************************************************************************/
/*
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.

At least MultiNet V3.2 (and yes, that's very old :-) has issues with using
INETACP$C_HOSTENT_OFFSET (up to and including 4.1 if I've Googled correctly). 
So, have a fall-back that attempts to recover from 'hostent' sanity checking or
an unexpected lookup status by going back to just getting a single IP address. 
This can also be forced by defining a WASD_DISABLE_HOSTENT_OFFSET logical name
accessable to the server image.

Purging the host cache (/DO=PROXY=PURGE=HOST) resets the host entry lookup to
it's default or the above disabled setting.
*/

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

   static uchar ControlSubFunction [4] =
      { INETACP_FUNC$C_GETHOSTBYNAME, 0, 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;
   __unaligned int  *hostptr;
   char  *cptr, *sptr, *zptr;
   char *baseptr;
   struct dsc$descriptor *dscptr;

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

   if (WATCH_MODULE(WATCH_MOD_NET))
   {
      if (hlptr->LookupChannel)
         WatchThis (WATCHALL, WATCH_MOD_NET,
                    "TcpIpNameToAddress() !&F !UL !&S !&X",
                    TcpIpNameToAddress, hlptr->RetryCount,
                    hlptr->LookupIOsb.Status,
                    IPADDRESS_SIZE(&hlptr->IpAddress));
      else
         WatchThis (WATCHALL, 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 (TcpIpUseHostentOffset)
               {
                  if (hlptr->HostEntry.HOST$L_H_ADDRTYPE != TCPIP$C_AF_INET &&
                      hlptr->HostEntry.HOST$L_H_ADDRTYPE != TCPIP$C_AF_INET6)
                  {
                     /* sanity check, try to fall back to IP address lookup */
                     TcpIpUseHostentOffset = false;
                     hlptr->LookupIOsb.Status = SS$_BUGCHECK;
                     ErrorNoticed (NULL, SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
                  }
                  else
                  if (hlptr->HostEntry.HOST$L_H_LENGTH == 4)
                     IPADDRESS_V4 (&hlptr->IpAddress);
                  else
                  if (hlptr->HostEntry.HOST$L_H_LENGTH == 16)
                     IPADDRESS_V6 (&hlptr->IpAddress);
                  else
                  {
                     /* sanity check, try to fall back to IP address lookup */
                     TcpIpUseHostentOffset = false;
                     hlptr->LookupIOsb.Status = SS$_BUGCHECK;
                     ErrorNoticed (NULL, SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
                  }

                  if (TcpIpUseHostentOffset)
                  {
                     baseptr = (char*)&hlptr->HostEntry;
                     hostptr = hlptr->HostEntry.HOST$L_H_ADDR_LIST + baseptr; 
                     while (*hostptr)
                     {
                        IPADDRESS_SET (&hlptr->IpAddress, *hostptr+baseptr);
                        /* set an entry in the host cache */
                        TcpIpCacheSetEntry (hlptr->HostName,
                                            hlptr->HostNameLength,
                                            &hlptr->IpAddress);
                        hostptr++;
                     }
                     /*
                        Make sure to use the first address in list for request
                        because, if it fails, cache invalidation mechanism will
                        always clear the first entry found.
                     */
                     hostptr = hlptr->HostEntry.HOST$L_H_ADDR_LIST + baseptr;
                     IPADDRESS_SET (&hlptr->IpAddress, *hostptr+baseptr);
                  }
               }
               else
               {
                  if (IPADDRESS_SIZE(&hlptr->IpAddress) == 4 ||
                      IPADDRESS_SIZE(&hlptr->IpAddress) == 16)
                  {
                     /* set an entry in the host cache */
                     TcpIpCacheSetEntry (hlptr->HostName,
                                         hlptr->HostNameLength,
                                         &hlptr->IpAddress);
                  }
                  else
                  {
                     /* this should never happen but */
                     hlptr->LookupIOsb.Status = SS$_BUGCHECK;
                     ErrorNoticed (NULL, SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
                  }
               }
               InstanceGblSecIncrLong (&AccountingPtr->LookupDnsNameCount);
            }
            else
            {
               /* lookup finished unsuccessfully */
               if (TcpIp6Nodes (hlptr->HostName, &hlptr->IpAddress))
               {
                  TcpIpCacheSetEntry (hlptr->HostName,
                                      hlptr->HostNameLength,
                                      &hlptr->IpAddress);
                  hlptr->LookupIOsb.Status = SS$_NORMAL;
                  InstanceGblSecIncrLong (&AccountingPtr->LookupDnsNameCount);
               }

               if (VMSnok(hlptr->LookupIOsb.Status))
               {
                  /* these are not likely to indicate anything untoward */
                  if (hlptr->LookupIOsb.Status != SS$_ENDOFFILE &&
                      hlptr->LookupIOsb.Status != SS$_BADPARAM)
                  {
                     if (TcpIpUseHostentOffset)
                     {
                        /* sanity check, fall back to IP address lookup */
                        TcpIpUseHostentOffset = false;
                        ErrorNoticed (NULL, hlptr->LookupIOsb.Status,
                                      ErrorSanityCheck, FI_LI);
                     }
                  }
                  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;
      if (TcpIpUseHostentOffset)
      {
         dscptr->dsc$w_length = sizeof(hlptr->HostEntry);
         dscptr->dsc$a_pointer = &hlptr->HostEntry;
      }
      else
      {
         /* 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 (TcpIpUseHostentOffset)
      ControlSubFunction[1] = INETACP$C_HOSTENT_OFFSET;
   else
      ControlSubFunction[1] = INETACP$C_TRANS;

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

      status = sys$qio (EfnNoWait, hlptr->LookupChannel, IO$_ACPCONTROL,
                        &hlptr->LookupIOsb, &TcpIpNameToAddress, hlptr,
                        &ControlSubFunctionDsc,
                        &hlptr->HostNameDsc,
                        /* only used with INETACP$C_TRANS lookup */
                        &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,
                            /* only used with INETACP$C_TRANS lookup */
                            &IPADDRESS_SIZE(&hlptr->IpAddress),
			    &hlptr->HostAddressDsc, 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))
      {
         /* lookup succeeded */
         if (TcpIpUseHostentOffset)
         {
            if (hlptr->HostEntry.HOST$L_H_ADDRTYPE != TCPIP$C_AF_INET &&
                hlptr->HostEntry.HOST$L_H_ADDRTYPE != TCPIP$C_AF_INET6)
            {
               /* sanity check, try to fall back to IP address lookup */
               TcpIpUseHostentOffset = false;
               hlptr->LookupIOsb.Status = SS$_BUGCHECK;
               ErrorNoticed (NULL, SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
            }
            else
            if (hlptr->HostEntry.HOST$L_H_LENGTH == 4)
               IPADDRESS_V4 (&hlptr->IpAddress);
            else
            if (hlptr->HostEntry.HOST$L_H_LENGTH == 16)
               IPADDRESS_V6 (&hlptr->IpAddress);
            else
            {
               /* sanity check, try to fall back to IP address lookup */
               TcpIpUseHostentOffset = false;
               hlptr->LookupIOsb.Status = SS$_BUGCHECK;
               ErrorNoticed (NULL, SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
            }

            if (TcpIpUseHostentOffset)
            {
               baseptr = (char*)&hlptr->HostEntry;
               hostptr = hlptr->HostEntry.HOST$L_H_ADDR_LIST + baseptr; 
               while (*hostptr)
               {
                  IPADDRESS_SET (&hlptr->IpAddress, *hostptr+baseptr);
                  /* set an entry in the host cache */
                  TcpIpCacheSetEntry (hlptr->HostName,
                                      hlptr->HostNameLength,
                                      &hlptr->IpAddress);
                  hostptr++;
               }
               /*
                  Make sure to use the first address in list for request
                  because, if it fails, cache invalidation mechanism will
                  always clear the first entry found.
               */
               hostptr = hlptr->HostEntry.HOST$L_H_ADDR_LIST + baseptr;
               IPADDRESS_SET (&hlptr->IpAddress, *hostptr+baseptr);
            }
         }
         else
         {
            if (IPADDRESS_SIZE(&hlptr->IpAddress) == 4 ||
                IPADDRESS_SIZE(&hlptr->IpAddress) == 16)
            {
               /* set an entry in the host cache */
               TcpIpCacheSetEntry (hlptr->HostName,
                                   hlptr->HostNameLength,
                                   &hlptr->IpAddress);
            }
            else
            {
               /* this should never happen but */
               hlptr->LookupIOsb.Status = SS$_BUGCHECK;
               ErrorNoticed (NULL, SS$_BUGCHECK, ErrorSanityCheck, FI_LI);
            }
         }
         InstanceGblSecIncrLong (&AccountingPtr->LookupDnsNameCount);
      }
      else
      {
         /* lookup failed */
         if (TcpIp6Nodes (hlptr->HostName, &hlptr->IpAddress))
         {
            TcpIpCacheSetEntry (hlptr->HostName,
                                hlptr->HostNameLength,
                                &hlptr->IpAddress);
            hlptr->LookupIOsb.Status = SS$_NORMAL;
            InstanceGblSecIncrLong (&AccountingPtr->LookupDnsNameCount);
         }

         if (VMSnok(hlptr->LookupIOsb.Status))
         {
            /* these status are not likely to indicate anything untoward */
            if (hlptr->LookupIOsb.Status != SS$_ENDOFFILE &&
                hlptr->LookupIOsb.Status != SS$_BADPARAM)
            {
               if (TcpIpUseHostentOffset)
               {
                  /* sanity check, try to fall back to IP address lookup */
                  TcpIpUseHostentOffset = false;
                  ErrorNoticed (NULL, hlptr->LookupIOsb.Status,
                                ErrorSanityCheck, FI_LI);
               }
            }
            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,
ulong AstParam
)
{
   /* this is two seconds delta */
   static ulong  RetryDelta [2] = { -20000000, -1 };

   static uchar 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 (WATCHALL, WATCH_MOD_NET,
                    "TcpIpAddressToName() !&F !&X !UL !&S",
                    TcpIpAddressToName, hlptr, hlptr->RetryCount,
                    hlptr->LookupIOsb.Status);
      else
         WatchThis (WATCHALL, 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';
               /* set an entry in the host cache */
               TcpIpCacheSetEntry (hlptr->HostName,
                                   hlptr->HostNameLength,
                                   &hlptr->IpAddress);
               InstanceGblSecIncrLong (&AccountingPtr->LookupDnsAddressCount);

            }
            else
            {
               /* lookup failed */
               hlptr->HostName[hlptr->HostNameLength = 0] = '\0';
               if (TcpIp6Nodes (hlptr->HostName, &hlptr->IpAddress))
               {
                  hlptr->HostNameLength = strlen(hlptr->HostName);
                  TcpIpCacheSetEntry (hlptr->HostName,
                                      hlptr->HostNameLength,
                                      &hlptr->IpAddress);
                  hlptr->LookupIOsb.Status = SS$_NORMAL;
                  InstanceGblSecIncrLong (&AccountingPtr->
                                          LookupDnsAddressCount);
               }
               else
               {
                  /* set a can't-be-resolved entry in the host cache */
                  TcpIpCacheSetEntry ("?", 1, &hlptr->IpAddress);
                  InstanceGblSecIncrLong (&AccountingPtr->
                                          LookupDnsAddressErrorCount);
               }
            }

            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)) 
      {
         /* lookup succeeded */
         hlptr->HostName[hlptr->HostNameLength] = '\0';
         /* set an entry in the host cache */
         TcpIpCacheSetEntry (hlptr->HostName, hlptr->HostNameLength,
                             &hlptr->IpAddress);
         InstanceGblSecIncrLong (&AccountingPtr->LookupDnsAddressCount);

      }
      else
      {
         /* lookup failed */
         hlptr->HostName[hlptr->HostNameLength = 0] = '\0';
         if (TcpIp6Nodes (hlptr->HostName, &hlptr->IpAddress))
         {
            hlptr->HostNameLength = strlen(hlptr->HostName);
            TcpIpCacheSetEntry (hlptr->HostName,
                                hlptr->HostNameLength,
                                &hlptr->IpAddress);
            hlptr->LookupIOsb.Status = SS$_NORMAL;
            InstanceGblSecIncrLong (&AccountingPtr->LookupDnsAddressCount);
         }
         else
         {
            /* set a 'could-not-resolve-address' entry in the host cache */
            TcpIpCacheSetEntry ("?", 1, &hlptr->IpAddress);
            InstanceGblSecIncrLong (&AccountingPtr->
                                    LookupDnsAddressErrorCount);
         }
      }

      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 $DESCRIPTOR (IP4inIPv6FaoDsc, "::FFFF:!UL.!UL.!UL.!UL\0");
   static char  String [48];
   static $DESCRIPTOR (StringDsc, String);

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

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

   if (WATCH_MODULE(WATCH_MOD_NET))
      WatchThis (WATCHALL, 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 = (uchar*)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
   */

   if (*(ULONGPTR)ucptr == 0x00000000 &&
       *(ULONGPTR)(ucptr+4) == 0x00000000 &&
       *(ULONGPTR)(ucptr+8) == 0xffff0000)
   {
      /* IPv4 in IPv6 */
      status = sys$fao (&IP4inIPv6FaoDsc, 0, &StringDsc,
                        ucptr[12], ucptr[13], ucptr[14], ucptr[15]);
      return (String);
   }

   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 (SAME2(cptr,'0:'))
   {
      sptr = cptr;
      while (cptr < zptr && SAME2(cptr,'0:')) cptr += 2;
      *sptr++ = ':';
      sptr++;
      while (cptr < zptr) *sptr++ = *cptr++;
      *sptr = '\0';
   }
   else
   {
      while (cptr < zptr && !SAME2(cptr,':0')) cptr++;
      if (cptr < zptr)
      {
         cptr++;
         sptr = cptr;
         while (cptr < zptr && SAME2(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];
   ushort  Ip6Address [8];
   ushort  *ip6ptr;
   uint  unint;
   uint  Ip6Octets [10];  /* well sort-of */
   char  *cptr, *sptr, *zptr;

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

   if (WATCH_MODULE(WATCH_MOD_NET))
      WatchThis (WATCHALL, 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 (WATCHALL, 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 */
         unint = (ulong)strtol (cptr, NULL, 16);
         if (unint > 0xffff) return (SS$_ENDOFFILE);
         /* network byte-order */
         Ip6Octets[idx] = (unint >> 8) | (unint << 8);
         idx++;
         if (SAME2(sptr,'::') ||
             SAME2(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 (WATCHALL, 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];
   ulong  *ulptr;
   char  *cptr, *sptr, *zptr;
   char  Ipv6StringAddr [64],
         Ipv6StringMask [16];
   IPADDRESS  IpAddressHost,
              IpAddressNet;

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

   if (WATCHMOD (rqptr, WATCH_MOD_NET))
      WatchThis (WATCHITM(rqptr), 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, WatchCategory))
         WatchThis (WATCHITM(rqptr), 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, WatchCategory))
   {
      IPADDRESS  IpAddressNetTmp;
      TcpIpStringToAddress (Ipv6StringAddr, &IpAddressNetTmp);
      Ip6Mask = atoi(Ipv6StringMask);
      WatchThis (WATCHITM(rqptr), 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);
}

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

