/*****************************************************************************/
/*
                                  other.c

Miscellaneous functions for soyMAIL.


COPYRIGHT
---------
Copyright (C) 2005-2022 Mark G.Daniel
This program, comes with ABSOLUTELY NO WARRANTY.
This is free software, and you are welcome to redistribute it under the
conditions of the GNU GENERAL PUBLIC LICENSE, version 3, or any later version.


VERSION HISTORY
---------------
22-AOR-2021  MGD  OpcomMessage()
12-MAY-2019  MGD  MemPrint()
17-DEC-2013  MGD  StatusInfoPanel() JavaScript disabled indicator
11-AUG-2013  MGD  SoyMailLogo() strsame() instead of !strcmp()
09-JUN-2013  MGD  SoyMailStyleStuff() add [site-style-sheet] load
05-MAR-2010  MGD  StatTimer() include CgiLibVeeMem..() current and peak
19-FEB-2010  MGD  SoyMailLogo()
13-JUL-2008  MGD  StatusInfoPanel() optional username info
09-JUL-2008  MGD  ReadFileIntoMemory() optimise for stream format files
14-AUG-2007  MGD  SoyMailJavaScriptStuff() has a kludge for detecting Opera
                    child windows - also supported by MainMenuPageBegin()
18-JUN-2006  MGD  maximum count on JavaScript 'working' status (periods)
16-APR-2006  MGD  ErrorExit() change HTTP status from 200 to 403
14-APR-2006  MGD  strzcpy() truncate on overflow
06-APR-2006  MGD  refine targetBlank() using timed event to ensure
                    refreshSoyMailForm() is activated and target reset
23-MAR-2006  MGD  make setWorking() progress dots a little more generic
01-FEB-2005  MGD  initial
*/

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

#ifdef SOYMAIL_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

#pragma nomember_alignment

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

/* VMS related header files */
#include <descrip.h>
#include <jpidef.h>
#include <lnmdef.h>
#include <lib$routines.h>
#include <mailmsgdef.h>
#include <fab.h>
#include <opcdef.h>
#include <rab.h>
#include <rms.h>
#include <ssdef.h>
#include <starlet.h>
#include <stsdef.h>

/* application header file */
#include "soymail.h"
#include "cgilib.h"
#include "callmail.h"
#include "config.h"
#include "lang.h"
#include "other.h"

#define FI_LI __FILE__, __LINE__

/* global storage */

char  *SoyMailStatusPtr;

/* prototypes */

/* external storage */

extern BOOL  Debug,
             WatchEnabled;

extern int  VmsVersion;

extern char  *CgiEnvironmentPtr,
             *SoyMailScriptPath;

extern char  *LangArray[];

extern char  DocType[],
             SoftwareCopy[],
             SoftwareEnv[],
             SoftwareVn[],
             SoyMailQueryVersion[],
             Utility[];

extern CONFIG_DATA  SoyMailConfig;
extern VMS_MAIL_USER VmsMailUser;

int  vsnprintf (__unknown_params);

/*****************************************************************************/
/*
Watch CGI values as they are accessed.
*/

char* SoyCgiVar (char *NamePtr)

{
   char  *DupPtr,
         *ValuePtr;

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

   ValuePtr = CgiLibVar (NamePtr);
   if (ValuePtr[0] && CgiLibBodyIsMultipartFormData())
   {
      /* shouldn't de-entify inside the CGI variable repository!! */
      DupPtr = CgiLibVeeMemCalloc (strlen(ValuePtr)+1);
      if (!DupPtr) ErrorExit (SS$_BUGCHECK, FI_LI);
      strcpy (DupPtr, ValuePtr);
      CgiLibHtmlDeEntify (ValuePtr = DupPtr);
   }
   if (WatchEnabled) WatchThis ("CGIVAR !AZ=!AZ", NamePtr, ValuePtr);
   return (ValuePtr);
}

/*****************************************************************************/
/*
Watch CGI values as they are accessed.
*/

char* SoyCgiVarNull (char *NamePtr)

{
   char  *DupPtr,
         *ValuePtr;

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

   ValuePtr = CgiLibVarNull (NamePtr);
   if (ValuePtr && CgiLibBodyIsMultipartFormData())
   {
      DupPtr = CgiLibVeeMemCalloc (strlen(ValuePtr)+1);
      if (!DupPtr) ErrorExit (SS$_BUGCHECK, FI_LI);
      strcpy (DupPtr, ValuePtr);
      CgiLibHtmlDeEntify (ValuePtr = DupPtr);
   }
   if (WatchEnabled)
       WatchThis ("CGIVAR !AZ=!AZ", NamePtr, ValuePtr ? ValuePtr : "(null)");
   return (ValuePtr);
}

/*****************************************************************************/
/*
JavaScript used to manage some of the message folder and list pages enhanced
functionality.  Although there is no effort to suppress all JavaScript code
scattered throughout soyMAIL any major chunks that don't require too much
if-then-else-ing are not output if the client does not indicate it supports
JavaScript.
*/

void SoyMailJavaScriptStuff (REQUEST_DATA *rdptr)

{
   BOOL  PrintMedia = FALSE;
   USER_OPTIONS  *uoptr;

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

   if (WatchEnabled) WatchThis ("SoyMailJavaScriptStuff()");

   /* messages in double-quotes to allow use of ' in non-English messages */
   fprintf (stdout,
"<noscript><div class=\"noscript\">soyMAIL %s %s</div></noscript>\n\
<script language=\"JavaScript\" src=\"%ssoymail.js%s\"></script>\n\
<script language=\"JavaScript\">\n\
var lang_Close = \"%s\";\n\
var lang_JavaScriptIncompat = \"%s\";\n\
var lang_LogoutDisabled = \"%s\";\n\
var lang_NoMoreMessages = \"%s\";\n\
var lang_NotApplicable = \"%s\";\n\
var lang_Sure = \" %s\";\n\
var lang_WorkingOnIt = \"%s\";\n\
var soy_ExeVersion = \'%s\';\n\
var soy_SoyMailPath = \'%s\'\n\
var soy_RefreshSoyMailAction = \'%s\';\n\
</script>\n",
            SoftwareVn, LangFor("requires_javascript"),
            SoyMailScriptPath,
            SoyMailQueryVersion,
            LANG_FOR_CONFIRM("close"),
            LANG_FOR_CONFIRM("javascript_incompat"),
            LangFor("logout_disabled"),
            LangFor("no_more_messages"),
            LangFor("not_applicable"),
            LANG_FOR_CONFIRM("sure?"),
            LangFor("working_on_it"),
            SoftwareVn,
            SoyMailScriptPath,
            rdptr->FormAction);
}

/*****************************************************************************/
/*
CSS definitions that are used internally by soyMAIL.
*/

void SoyMailStyleStuff
(
REQUEST_DATA *rdptr,
char *ThemePtr
)
{
   BOOL  PrintMedia = FALSE;
   USER_OPTIONS  *uoptr;

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

   if (WatchEnabled) WatchThis ("SoyMailStyleStuff()");

   uoptr = &rdptr->UserOptions;

   if (ThemePtr)
      if (!strcmp (ThemePtr, "print"))
         PrintMedia = TRUE;
 
   /* basic soyMAIL styles */
   fprintf (stdout,
"<link rel=\"stylesheet\" type=\"text/css\" href=\"%s%s%s\">\n",
            SOY_PATH, "soymail.css", SoyMailQueryVersion);

   if (PrintMedia)
      fprintf (stdout,
"<style type=\"text/css\">\n\
* { font-family:%s; }\n\
</style>\n",
               uoptr->FontFamily);
   else
      fprintf (stdout,
"<style type=\"text/css\">\n\
* { font-family:%s; font-size:%dpt; }\n\
</style>\n",
               uoptr->FontFamily,
               uoptr->FontSize);

   if (ThemePtr)
      fprintf (stdout,
"<link rel=\"stylesheet\" type=\"text/css\" href=\"%s%s.css%s\">\n",
               SOY_THEME_PATH, ThemePtr, SoyMailQueryVersion);

   /* loaded after and so also may be used to override theme styles */
   if (SoyMailConfig.SiteStyleSheet)
      fprintf (stdout,
"<link rel=\"stylesheet\" type=\"text/css\" href=\"%s\">\n",
               SoyMailConfig.SiteStyleSheet);
}

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

void SoyMailLogo (REQUEST_DATA *rdptr)

{
   char  *cptr;
   USER_OPTIONS  *uoptr;

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

   uoptr = &rdptr->UserOptions;

   for (cptr = uoptr->Theme; *cptr && *(cptr+1); cptr++);
   if (*cptr == '2' || strsame (uoptr->Theme, "default", -1))
      if (rdptr->UserAgent == SOY_USER_AGENT_MSIE &&
          rdptr->UserAgent != SOY_USER_AGENT_MSIE10)
         fprintf (stdout, "<span class=\"css_logo9\">soyMAIL</span>");
      else
         fprintf (stdout, "<span class=\"css_logo\">soyMAIL</span>");
   else
   if (!strcmp (SOY_MAIL, "soyMAIL"))
      fprintf (stdout,
"<span style=\"font-weight:bold;font-size:120%%;letter-spacing:1px;\
text-shadow:#000000 1px 1px 0px;\" class=\"css_logo1\">so</span>\
<span style=\"font-weight:bold;font-size:120%%;letter-spacing:2px;\
text-shadow:#000000 1px 1px 0px;\" class=\"css_logo2\">yMAIL</span>");
   else
      fprintf (stdout,
"<span style=\"font-weight:bold;font-size:120%%;letter-spacing:2px;\" \
class=\"css_logo\">%s</span>\n",
               SOY_MAIL);
}

/*****************************************************************************/
/*
Generate the text used in the HTML page <title>..</title>.
Use $fao() to avoid configuration string overflows.
Return a pointer to static storage.
*/

char* SoyMailPageTitle (REQUEST_DATA *rdptr)

{
   static char  PageTitle [SIZEOF_SOYMAIL_PAGE_TITLE];
   static $DESCRIPTOR (PageTitleFaoDsc, "!AZ!AZ!AZ!AZ\0");
   static $DESCRIPTOR (PageTitleDsc, PageTitle);

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

   if (WatchEnabled) WatchThis ("SoyMailPageTitle()");

   if (rdptr && rdptr->PrevPageIdent == PAGE_HELP)
      sys$fao (&PageTitleFaoDsc, 0, &PageTitleDsc,
               SOY_MAIL, " ", LangFor("help"), SOYMAIL_TITLE_BETA);
   else
   if (rdptr && rdptr->NewMailNoticed)
      strcpy (PageTitle, LangFor("n_e_w_m_a_i_l"));
   else
   if (SoyMailConfig.SoyMailAtTitle)
      sys$fao (&PageTitleFaoDsc, 0, &PageTitleDsc,
               SOY_MAIL, " @ ", SoyMailConfig.SoyMailAtTitle,
               SOYMAIL_TITLE_BETA);
   else
      sys$fao (&PageTitleFaoDsc, 0, &PageTitleDsc,
               SOY_MAIL, " @ ", CgiLibVar("HTTP_HOST"), SOYMAIL_TITLE_BETA);
   PageTitle[SIZEOF_SOYMAIL_PAGE_TITLE-1] = '\0';

   return (PageTitle);
}

/*****************************************************************************/
/*
Display the status panel.

Opera (at least v9) does not support window.opener!!  Kludge some propagating
data for establishing whether a particular window is a child.  JavaScript
function childWindow() uses an HTML form field to propagate an integer value
from request to request.  If the value is 0 (zero) it is a GET method request
and child windows are not created.  If a 1 (one) it's a POST and the history
object length is checked, and if zero then it's (most probably) a new child
window and the value is changed to 2 (two).  Subsequent requests in the same
window will have a non-zero history and so not alter the value again.  If the
history is more than zero then it's (most probably) a parent window and the
value left at 1 (one).  Where there's a will ...
*/

void StatusInfoPanel (REQUEST_DATA *rdptr)

{
   static char  TimeString [32];
   static $DESCRIPTOR (TimeStringDsc, TimeString);
   static $DESCRIPTOR (TimeFaoDsc, "!#AZ !8%T\0");

   int  dnum;
   unsigned long  DayOfWeek;
   char  *aptr, *cptr, *sptr, *zptr,
         *OperaChildPtr,
         *PostMasterPtr,
         *SpanPtr,
         *SpanEndPtr,
         *InfoPtr;
   char  UserNameInfo [128];
   REQUEST_DATA  *sdptr;

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

   if (WatchEnabled) WatchThis ("StatusInfoPanel()");

   sdptr = (REQUEST_DATA*)rdptr->StateDataPtr;

   if (rdptr->PostMaster)
      PostMasterPtr =
"<span class=\"css_warning\" \
style=\"white-space:nowrap;font-weight:bold;\">\
POSTMASTER&nbsp;&nbsp;</span>";
   else
      PostMasterPtr = "";

   lib$day_of_week (0, &DayOfWeek);
   cptr = LangFor("weekdays");
   for (dnum = 1; dnum < DayOfWeek; dnum++)
   {
      while (*cptr && *cptr != ' ') cptr++;
      while (*cptr && *cptr == ' ') cptr++;
   }
   for (sptr = cptr; *sptr && *sptr != ' '; sptr++);
   sys$fao (&TimeFaoDsc, 0, &TimeStringDsc, sptr-cptr, cptr, 0);

   if (SoyMailConfig.UserNameInfo)
   {
      zptr = (sptr = UserNameInfo) + sizeof(UserNameInfo)-1;
      if (SoyMailConfig.UserNameInfo < 0 &&
          rdptr->LoginAliasLength)
      {
         /* login alias name */
         for (cptr = rdptr->LoginAlias;
              *cptr && sptr < zptr;
              *sptr++ = *cptr++);
      }
      else
      {
         /* VMS user name */
         for (cptr = rdptr->UserName; *cptr && islower(*cptr); cptr++);
         if (*cptr)
            for (cptr = rdptr->UserName;
                 *cptr && sptr < zptr;
                 *sptr++ = *cptr++);
         else
            for (cptr = rdptr->UserName;
                 *cptr && sptr < zptr;
                 *sptr++ = toupper(*cptr++));
      }
      for (cptr = "&nbsp;&nbsp;"; *cptr && sptr < zptr; *sptr++ = *cptr++);
      *sptr = '\0';
   }
   else
      UserNameInfo[0] = '\0';

   SpanPtr = SpanEndPtr = "";
   if (!(InfoPtr = SoyMailStatusPtr))
   {
      InfoPtr = SoftwareEnv;
      SpanPtr = "<span class=\"css_warning\">";
      SpanEndPtr = "</span>";
   }
   else
   if (*InfoPtr  == '!')
   {
      InfoPtr++;
      SpanPtr = "<span class=\"css_warning\">";
      SpanEndPtr = "</span>";
   }
   else
   if (rdptr->PrivateAccess)
   {
      if (!sdptr->StateSaveCount)
      {
         aptr = SoyMailConfig.InitialGreeting;
         if (!aptr) aptr = LangFor("greeting");
         if (*aptr) InfoPtr = aptr;
      }
   }

   /* see description in SoyMailJavaScriptStuff() */
   if (!strcmp (rdptr->CgiRequestMethodPtr, "POST"))
   {
      CGIVARNULL (cptr, "FORM_OPERA_CHILD");
      if (!cptr || *cptr == '0') OperaChildPtr = "1";
   }
   else
      OperaChildPtr = "0";

   fprintf (stdout,
"<!-- status info begin -->\n\
<p class=\"css_p06\">\n\
<table width=\"100%%\" cellpadding=\"1\" cellspacing=\"5\" \
align=\"center\" class=\"css_panel_1\">\n\
<tr>\n\
<td align=\"left\" valign=\"top\" width=\"1%%\" nowrap \
style=\"white-space:nowrap;font-weight:bold;padding-right:1em;\" \
onclick=\"showStats()\">%s</td>\n\
<td align=\"left\" valign=\"top\" width=\"98%%\" \
style=\"white-space:normal;\">\
%s%s\
<span id=\"status_info\">%s%s%s</span>\
<span id=\"status_jscr\">&nbsp;&nbsp;&nbsp;\
<strike><b>JavaScript</b></strike></span>\
</td>\n\
<td align=\"right\" valign=\"top\" width=\"1%%\" nowrap>\
<span style=\"white-space:nowrap;\" id=\"status_clock\"></span>\
</td>\n\
</tr>\n\
</table>\n\
<div id=\"status_stats\" style=\"display:none;\"></div>\n\
<script language=\"JavaScript\">document.getElementById(\'status_jscr\')\
.style.display=\'none\'</script>\n\
<!-- status info end -->\n\n",
            TimeString, PostMasterPtr, UserNameInfo,
            SpanPtr, InfoPtr, SpanEndPtr);
}

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

char* SoyMailTempFileName ()

{
   int  AdditionalUniquifier = 0;
   static $DESCRIPTOR (FileNameFaoDsc, "!AZ!AZ!8XL!8XL!UL.TMP\0");

   unsigned short  slen;
   unsigned long  BinTime [2];
   char  *cptr;
   char  FileName [256];
   $DESCRIPTOR (FileNameDsc, FileName);

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

   if (WatchEnabled) WatchThis ("SoyMailTempFileName()");

   /* generate a file name suitable for the "Sent Items" scratch file */
   sys$gettim (&BinTime);
   sys$fao (&FileNameFaoDsc, &slen, &FileNameDsc,
            VmsMailUser.VmsMailFullDirectory, "SOYMAIL_",
            BinTime[1], BinTime[0], ++AdditionalUniquifier);
   if (Debug) fprintf (stdout, "|%s|\n", FileName);

   cptr =  CgiLibVeeMemCalloc (slen);
   if (!cptr) ErrorExit (vaxc$errno, FI_LI);
   strcpy (cptr, FileName);
   return (cptr);
}

/*****************************************************************************/
/*
Generate a soyMAIL information or error status message intended for display in
the status panel by StatusInfoPanel().
*/

void StatusMessage
(
char *SourceFileName,
int SourceLineNumber,
int OverwriteFlag,
char *FormatString,
...
)
{
   static char  MessageBuffer [512];

   int  argcnt, len,
        NameLength;
   char  *cptr, *sptr, *zptr;
   char  FaoBuffer [256];
   va_list  argptr;

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

   if (!SourceFileName && !SourceLineNumber)
   {
      /* (CGIplus) initialise */
      SoyMailStatusPtr = NULL;
      return;
   }

   if (WatchEnabled)
   {
      if (OverwriteFlag < 0)
         cptr = "OVERWRITE";
      else
      if (OverwriteFlag == 0)
         cptr = "INFORM";
      else
      if (OverwriteFlag > 0)
         cptr = "ERROR";
      WatchThis ("STATUS !AZ !AZ:!UL !AZ",
                 cptr, SourceFileName, SourceLineNumber, FormatString);
   }

   va_count (argcnt);

   if (argcnt < 3) ErrorExit (SS$_BUGCHECK, FI_LI);

   /* only ever overwrite a 'normal' status message with an 'error' */
   if ((SoyMailStatusPtr && SoyMailStatusPtr[0] == '!') ||
       (SoyMailStatusPtr && OverwriteFlag == 0))
      return;

   if (OverwriteFlag > 0)
   {
      FaoBuffer[0] = '!';
      strcpy (FaoBuffer+1, FormatString);
      cptr = FaoBuffer;
   }
   else
      cptr = FormatString;

   va_start (argptr, FormatString);
   len = vsprintf (MessageBuffer, cptr, argptr);

   if (OverwriteFlag > 0)
   {
      /* get just the name from the __FILE__ macro */
      for (cptr = SourceFileName; *cptr && *cptr != ']'; cptr++);
      if (*cptr) cptr++;
      if (!*cptr) cptr = SourceFileName;
      for (sptr = cptr; *sptr && *sptr != '.'; sptr++);
      SourceFileName = cptr;
      NameLength = sptr - cptr;

      len += sprintf (MessageBuffer + len,
"\n\n<!-- *****  REPORTING MODULE:LINE IS %*.*s:%d  ***** -->\n\n",
                      NameLength, NameLength,
                      SourceFileName, SourceLineNumber);
   }

   if (len >= sizeof(MessageBuffer)) ErrorExit (SS$_BUGCHECK, FI_LI);

   SoyMailStatusPtr = MessageBuffer;

   if (WatchEnabled) WatchThis ("STATUS !AZ", SoyMailStatusPtr);
}

/*****************************************************************************/
/*
Output the statistics.
*/

void StatTimer (BOOL ShowStat)

{
extern int  CgiPlusUsageCount,
            ContextCacheCount,
            ContextCacheCurrent;
extern unsigned long  CgiLib__VeeMemCurrent;
extern unsigned long  CgiLib__VeeMemPeak;

   static unsigned long  JpiPidItem = JPI$_PID;

   static $DESCRIPTOR (Stat1FaoDsc,
"REAL:!%D CPU:!UL.!2ZL DIO:!UL BIO:!UL FAULTS:!UL MEM:!UL/!UL\0");
   static $DESCRIPTOR (Stat2FaoDsc,
"REAL:!%D CPU:!UL.!2ZL DIO:!UL BIO:!UL FAULTS:!UL PEAK:!UL CGIPLUS:!UL \
CONTEXT:!UL/!UL PID:!8XL\0");

   static unsigned long  CgiContext,
                         CgiPlusContext,
                         JpiPid,
                         VeeMemPeak;

   static unsigned long  LibStatTimerReal = 1,
                         LibStatTimerCpu = 2,
                         LibStatTimerBio = 3,
                         LibStatTimerDio = 4,
                         LibStatTimerFaults = 5;

   int  status;
   unsigned long  CpuBinTime,
                  CountBio,
                  CountDio,
                  CountFaults;
   int64  RealTime64;
   char  StatString [128];
   $DESCRIPTOR (StatStringDsc, StatString);

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

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

   if (!ShowStat)
   {
      if (!JpiPid) lib$getjpi (&JpiPidItem, 0, 0, &JpiPid, 0, 0);
      lib$init_timer (&CgiContext);
      if (CgiPlusUsageCount && !CgiPlusContext)
         lib$init_timer (&CgiPlusContext);
      return;
   }

   /* post-processing reset */
   lib$stat_timer (&LibStatTimerReal, &RealTime64, &CgiContext);
   lib$stat_timer (&LibStatTimerCpu, &CpuBinTime, &CgiContext);
   lib$stat_timer (&LibStatTimerBio, &CountBio, &CgiContext);
   lib$stat_timer (&LibStatTimerDio, &CountDio, &CgiContext);
   lib$stat_timer (&LibStatTimerFaults, &CountFaults, &CgiContext);
   sys$fao (&Stat1FaoDsc, 0, &StatStringDsc,
            &RealTime64, CpuBinTime/100, CpuBinTime%100,
            CountDio, CountBio, CountFaults,
            CgiLib__VeeMemCurrent, CgiLib__VeeMemPeak);

   fprintf (stdout, "<script language=\"JavaScript\">var statusStats = \'%s",
            StatString);

   if (!CgiPlusContext)
   {
      fputs ("\'</script>\n", stdout);
      return;
   }

   if (CgiLib__VeeMemPeak > VeeMemPeak) VeeMemPeak = CgiLib__VeeMemPeak;

   lib$stat_timer (&LibStatTimerReal, &RealTime64, &CgiPlusContext);
   lib$stat_timer (&LibStatTimerCpu, &CpuBinTime, &CgiPlusContext);
   lib$stat_timer (&LibStatTimerBio, &CountBio, &CgiPlusContext);
   lib$stat_timer (&LibStatTimerDio, &CountDio, &CgiPlusContext);
   lib$stat_timer (&LibStatTimerFaults, &CountFaults, &CgiPlusContext);
   sys$fao (&Stat2FaoDsc, 0, &StatStringDsc,
            &RealTime64, CpuBinTime/100, CpuBinTime%100,
            CountDio, CountBio, CountFaults, VeeMemPeak,
            CgiPlusUsageCount, ContextCacheCurrent, ContextCacheCount, JpiPid);

   fprintf (stdout, "<br>%s\'</script>\n", StatString);
}

/*****************************************************************************/
/*
Print to string/<stdout> using $FAO directives.
*/

int PrintFao
(
char *PrintBuffer,
int SizeOfPrintBuffer,
char *FaoString,
...
)
{
   int  argcnt, status;
   char  LocalBuffer [4096];
   unsigned short  ShortLength;
   unsigned long  *vecptr;
   unsigned long  FaoVector [64];
   $DESCRIPTOR (BufferDsc, LocalBuffer);
   $DESCRIPTOR (FaoStringDsc, FaoString);
   va_list  argptr;

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

   va_count (argcnt);

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

   if (!FaoString) ErrorExit (SS$_BUGCHECK, FI_LI);
   if (argcnt > 64) ErrorExit (SS$_BUGCHECK, FI_LI);

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

   if (PrintBuffer)
   {
      BufferDsc.dsc$a_pointer = PrintBuffer;
      BufferDsc.dsc$w_length = SizeOfPrintBuffer-1;
   }
   FaoStringDsc.dsc$w_length = strlen(FaoString);
   status = sys$faol (&FaoStringDsc, &ShortLength, &BufferDsc,
                      (unsigned long*)&FaoVector);
   if (Debug) fprintf (stdout, "sys$fao() %%X%08.08X\n", status);

   if (!(status & 1) || status == SS$_BUFFEROVF)
      ShortLength = sprintf (BufferDsc.dsc$a_pointer,
                             "$FAO() %%X%08.08X\n", status); 
   else
      PrintBuffer[ShortLength] = '\0';

   if (!PrintBuffer) fputs (LocalBuffer, stdout);

   return (ShortLength);
}

/*****************************************************************************/
/*
Print to dynamically allocated memory.  Return -1 if a printing error.
Return the current size of the resulting string (0..n) for success.  Multiple
prints append.  Reset print structure (deallocate memory) with |fmt| NULL.
*/

int PrintMem
(
PRINT_MEM *pmptr,
char *fmt,
...
)
{
#define USE_CGILIB_VEEMEM

   int  argcnt, result, size;
   va_list  args;

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

   if (!fmt)
   {
#ifdef USE_CGILIB_VEEMEM
      if (pmptr->buffer) CgiLibVeeMemFree (pmptr->buffer);
#else
      if (pmptr->buffer) free (pmptr->buffer);
#endif
      pmptr->buffer = NULL;
      return (pmptr->length = pmptr->size = 0);
   }

   va_count (argcnt);

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

   va_start (args, fmt);
   size = vsnprintf (NULL, 0, fmt, args);
   va_end (args);
   if (size < 0) return (-1);

   if (pmptr->length + size > pmptr->size)
   {
      while (pmptr->length + size > pmptr->size) pmptr->size += PRINTMEM_INCR;
#ifdef USE_CGILIB_VEEMEM
      pmptr->buffer = CgiLibVeeMemRealloc (pmptr->buffer, pmptr->size);
#else
      pmptr->buffer = realloc (pmptr->buffer, pmptr->size);
#endif
      if (!pmptr->buffer) ErrorExit (vaxc$errno, FI_LI);
   }

   va_start (args, fmt);
   result = vsprintf (pmptr->buffer + pmptr->length, fmt, args);
   va_end (args);
   if (result < 0) return (-1);

   if (result != size) ErrorExit (SS$_BUGCHECK, FI_LI);

   pmptr->length += size;

   if (Debug) fprintf (stdout, "%d |%s|\n", pmptr->length, pmptr->buffer);

   return (pmptr->length);
}

/*****************************************************************************/
/*
Ensure the input string has single and double quotes, newlines, etc., are
escaped using a preceding backslash.  Designed to ensure JavaScript string
literals do not contain an unescaped quote.  If the input string contains any
of these a dynamic buffer is allocated and the string escaped while copied.  If
it contains none the original string is returned.
*/

char* EscapeForQuotes (char *string)

{
   int  cnt;
   char  *bptr, *cptr, *sptr;

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

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

   cnt = 0;
   for (cptr = string; *cptr; cptr++)
      if (*cptr == '\"' || *cptr == '\'' || *cptr == '\\' || *cptr == '\n')
         cnt++;
   if (!cnt) return (string);

   bptr = sptr =  CgiLibVeeMemCalloc (cptr - string + cnt + 1);
   for (cptr = string; *cptr; cptr++)
   {
      if (*cptr == '\"' || *cptr == '\'' || *cptr == '\\') *sptr++ = '\\';
      if (*cptr == '\n')
         *sptr++ = ' ';
      else
         *sptr++ = *cptr;
   }
   *sptr = '\0';
   return (bptr);
}

/*****************************************************************************/
/*
Ensure the input string has single and double quotes, newlines, etc., are
escaped using a preceding backslash.  Designed to ensure JavaScript string
literals do not contain an unescaped quote.  If the input string contains any
of these a dynamic buffer is allocated and the string escaped while copied.  If
it contains none the original string is returned.
*/

char* EscapeForJavaScript (char *string)

{
   int  cnt;
   char  *bptr, *cptr, *sptr;

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

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

   cnt = 0;
   for (cptr = string; *cptr; cptr++)
      if (*cptr == '\"' || *cptr == '\'' || *cptr == '\\' ||
          *cptr == '\r' || *cptr == '\n')
         cnt++;
   if (!cnt) return (string);

   bptr = sptr = CgiLibVeeMemCalloc (cptr - string + cnt + 1);
   for (cptr = string; *cptr; cptr++)
   {
      if (*cptr == '\"' || *cptr == '\'' || *cptr == '\\' || *cptr == '\n')
         *sptr++ = '\\';
      if (*cptr == '\n')
         *sptr++ = 'n';
      else
      if (isprint(*cptr))
         *sptr++ = *cptr;
   }
   *sptr = '\0';

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

   return (bptr);
}

/*****************************************************************************/
/*
Return a pointer to a calloc()ed string containing the message component of the
status message of the supplied value.  String has 15 additional unused bytes.
*/

char* SysGetMsg (int StatusValue)

{
   int  status;
   unsigned short  Length;
   char  *cptr;
   char  StatusMsg [256];
   $DESCRIPTOR (StatusMsgDsc, StatusMsg);

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

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

   switch (StatusValue)
   {
      case MAIL$_NOSUCHUSR :
         strcpy (StatusMsg, "No such user");
         break;

      case MAIL$_NOTEXIST :
         strcpy (StatusMsg, "No such folder");
         break;

      case MAIL$_OPENIN :
         strcpy (StatusMsg, "No such mail file");
         break;

      default:
         status = sys$getmsg (StatusValue, &Length, &StatusMsgDsc, 1, 0);
         if (!(status & 1)) ErrorExit (status, FI_LI);
         StatusMsg[Length] = '\0';
         StatusMsg[0] = toupper(StatusMsg[0]);
         if (cptr = strstr (StatusMsg, "!/!_")) *(ULONGPTR)cptr = '.   ';
   }

   cptr =  CgiLibVeeMemCalloc (strlen(StatusMsg)+16);
   if (!cptr) ErrorExit (vaxc$errno, FI_LI);
   strcpy (cptr, StatusMsg);

   return (cptr);
}

/*****************************************************************************/
/*
Return a pointer to an allocated string in the RFC/Unix-style format (e.g. "31
Mar 2005 20:35:16 +0930") for the supplied VMS binary time (current if NULL).
*/

char* LocalRfcBinDate (unsigned long *VmsBinTimePtr)

{
   static char  TimeString [64];
   static $DESCRIPTOR (TimeStringDsc, TimeString);
   static $DESCRIPTOR (TimeFaoDsc, "!#AZ, !2ZL !#AZ !4UL !2ZL:!2ZL:!2ZL\0");

   int  cnt,
        DayNameLength,
        MonthNameLength;
   unsigned short  slen;
   char  *cptr, *sptr,
         *DayName,
         *MonthName;
   unsigned short  NumTime [7];
   unsigned long  DayOfWeek;

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

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

   sys$numtim (&NumTime, VmsBinTimePtr);
   lib$day_of_week (VmsBinTimePtr, &DayOfWeek);

   cptr = LangFor("weekdays");
   for (cnt = 1; cnt < DayOfWeek; cnt++)
   {
      while (*cptr && *cptr != ' ') cptr++;
      while (*cptr && *cptr == ' ') cptr++;
   }
   for (sptr = cptr; *sptr && *sptr != ' '; sptr++);
   DayName = cptr;
   DayNameLength = sptr - cptr;

   cptr = LangFor("months");
   for (cnt = 1; cnt < NumTime[1]; cnt++)
   {
      while (*cptr && *cptr != ' ') cptr++;
      while (*cptr && *cptr == ' ') cptr++;
   }
   for (sptr = cptr; *sptr && *sptr != ' '; sptr++);
   MonthName = cptr;
   MonthNameLength = sptr - cptr;

   sys$fao (&TimeFaoDsc, &slen, &TimeStringDsc,
            DayNameLength, DayName,
            NumTime[2],
            MonthNameLength, MonthName,
            NumTime[0], NumTime[3], NumTime[4], NumTime[5]);

   sptr =  CgiLibVeeMemCalloc (slen);
   strcpy (sptr, TimeString);

   return (sptr);
}

/*****************************************************************************/
/*
Exit after reporting the source code module name and line number.
*/

/* strictly this is a no-no */
extern int CgiLib__Environment;

ErrorExit
(
int StatusValue,
char *SourceFileName,
int SourceLineNumber
)
{
   int  NameLength;
   char  *cptr, *sptr;

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

   /* get just the name from the __FILE__ macro */
   for (cptr = SourceFileName; *cptr && *cptr != ']'; cptr++);
   if (*cptr) cptr++;
   if (!*cptr) cptr = SourceFileName;
   for (sptr = cptr; *sptr && *sptr != '.'; sptr++);
   SourceFileName = cptr;
   NameLength = sptr - cptr;

   if (CgiLib__Environment)
      cptr = CgiLibVarNull ("SERVER_SOFTWARE");
   else
      cptr = NULL;

   if (cptr)
   {
      /* running as a CGI, report to client */
      CgiLibResponseHeader (403, "text/html");

      fprintf (stdout,
"%s\n\
<html>\n\
<head>\n\
%s\
<meta name=\"generator\" content=\"%s\">\n\
<meta name=\"environment\" content=\"%s\">\n\
<meta name=\"copyright\" content=\"%s - Apache-2.0 licensed\">\n\
<meta name=\"language\" content=\"%s %s\">\n\
<title>%s</title>\n\
</head>\n\
<body>\n\
<b>%s:</b>&nbsp; %s.\n\
<!-- ***** REPORTING MODULE:LINE IS %*.*s:%d ***** --> \n\
</body>\n\
</html>\n",
               DocType,
               CgiLibXUACompatible(NULL),
               SoftwareEnv,
               CgiEnvironmentPtr,
               SoftwareCopy,
               LangFor("lang_name"),
               LangFor("lang_author"),
               SoyMailPageTitle(NULL),
               "Fatal soyMAIL Error",
               SysGetMsg(StatusValue),
               NameLength, NameLength, SourceFileName, SourceLineNumber);
      exit (SS$_NORMAL);
   }

   fprintf (stdout, "%%%s-E-EXIT, %%X%08.08X %*.*s:%d\n",
            Utility, StatusValue, NameLength, NameLength,
            SourceFileName, SourceLineNumber);
   exit (StatusValue);
}

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

int WatchThis
(
char *FaoString,
...
)
{
   static int  WatchCount;

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

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

   va_count (argcnt);

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

   if (!FaoString)
   {
      if (WatchCount)
      {
         /* post-processing reset */
         WatchThis ("WATCH end");
         WatchEnabled = WatchCount = 0;
      }
      else
      {
         /* pre-processing initialize */
         WatchCount = 1;
         CgiLibResponseSetRecordMode (1);
         CgiLibResponseHeader (200, "text/plain",
                               "Script-Control: X-content-encoding-gzip=0\n");
         WatchThis ("WATCH begin");
      }
      return (SS$_NORMAL);
   }

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

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

   return (status);
}

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

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

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

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

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

   return (1);
}

/****************************************************************************/
/*
Read the file contents specified by 'FileName' into memory, set the pointer
at 'FileTextPtr' to the contents and the file size at 'FileSizePtr'.  Returns a
VMS status value that should be checked.
*/ 

int ReadFileIntoMemory
(
char *FileName,
char **FileTextPtr,
int *FileSizePtr
)
{
   int  status,
        Bytes,
        BytesRemaining,
        BufferCount;
   char  *cptr, *sptr,
         *BufferPtr,
         *LinePtr;
   FILE  *FilePtr;
   stat_t  StatBuffer;

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

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

   if (FileTextPtr != NULL) *FileTextPtr = NULL;
   if (FileSizePtr != NULL) *FileSizePtr = 0;

   if (stat (FileName, &StatBuffer) < 0)
   {
      status = vaxc$errno;
      if (Debug) fprintf (stdout, "stat() %%X%08.08X\n", status);
      return (status);
   }

   if (StatBuffer.st_fab_rfm == FAB$C_VAR ||
       StatBuffer.st_fab_rfm == FAB$C_VFC)
      FilePtr = fopen (FileName, "r", "shr=put");
   else
      FilePtr = fopen (FileName, "r", "shr=put", "ctx=bin");
   if (FilePtr == NULL)
   {
      status = vaxc$errno;
      if (Debug) fprintf (stdout, "fopen() %%X%08.08X\n", status);
      return (status);
   }

   Bytes = StatBuffer.st_size;
   if (Debug) fprintf (stdout, "%d bytes\n", Bytes);

   /* a little margin for error ;^) */
   BufferPtr = CgiLibVeeMemCalloc (Bytes+32);
   if (BufferPtr == NULL) ErrorExit (vaxc$errno, FI_LI);

   BufferCount = 0;

   if (StatBuffer.st_fab_rfm == FAB$C_VAR ||
       StatBuffer.st_fab_rfm == FAB$C_VFC)
   {
      BytesRemaining = Bytes;
      LinePtr = BufferPtr;
      while (fgets (LinePtr, BytesRemaining, FilePtr) != NULL)
      {
         /** if (Debug) fprintf (stdout, "|%s|\n", LinePtr); **/
         if (!*LinePtr) break;
         for (cptr = LinePtr; *cptr; cptr++);
         BufferCount += cptr - LinePtr;
         BytesRemaining -= cptr - LinePtr;
         LinePtr = cptr;
      }
   }
   else
   {
      status = fread (BufferPtr, Bytes, 1, FilePtr);
      if (status == 1) BufferCount = Bytes;
   }

   fclose (FilePtr);

   if (StatBuffer.st_fab_rfm == FAB$C_STMLF)
   {
      /* text file, newlines only (check first 512 characters and quit) */
      for (cptr = BufferPtr; *cptr && cptr < BufferPtr+512; cptr++)
         if (*(USHORTPTR)cptr == '\r\n')
         {
            sptr = cptr;
            while (*cptr)
            {
               if (*(USHORTPTR)cptr == '\r\n') cptr++;
               *sptr++ = *cptr++;
            }
            *sptr = '\0';
            BufferCount = sptr - BufferPtr;
            break;
         }
   }

   if (Debug)
      if (BufferCount < 50000)
         fprintf (stdout, "%d |%s|\n", BufferCount, BufferPtr);
      else
         fprintf (stdout, "%d || TOO LARGE!\n", BufferCount);

   if (FileTextPtr != NULL) *FileTextPtr = BufferPtr;
   if (FileSizePtr != NULL) *FileSizePtr = BufferCount;

   return (SS$_NORMAL);
}

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

char* FileSpecSearch
(
int NameOnly,
char *DirSpec,
char *FileSpec
)
{
   static char  ExpFileName [255+1],
                RetFileName [255+1],
                ResFileName [255+1];
   static struct FAB  SearchFab;
   static struct NAM  SearchNam;

   int  status;
   char  *cptr, *sptr;

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

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

   if (FileSpec)
   {
      SearchFab = cc$rms_fab;
      SearchFab.fab$l_dna = DirSpec;
      SearchFab.fab$b_dns = strlen(DirSpec);
      SearchFab.fab$l_fna = FileSpec;
      SearchFab.fab$b_fns = strlen(FileSpec);
      SearchFab.fab$l_nam = &SearchNam;

      SearchNam = cc$rms_nam;
      SearchNam.nam$l_esa = ExpFileName;
      SearchNam.nam$b_ess = sizeof(ExpFileName)-1;
      SearchNam.nam$l_rsa = ResFileName;
      SearchNam.nam$b_rss = sizeof(ResFileName)-1;

      if (VMSnok (status = sys$parse (&SearchFab, 0, 0)))
      {
         if (Debug) fprintf (stdout, "sys$parse() %%X%08.08X\n", status);
         return (NULL);
      }
      SearchNam.nam$l_ver[SearchNam.nam$b_ver] = '\0';
      if (Debug) fprintf (stdout, "|%s|\n", ExpFileName);
   }

   if (VMSok (status = sys$search (&SearchFab, 0, 0)))
   {
      SearchNam.nam$l_ver[SearchNam.nam$b_ver] = '\0';
      if (Debug) fprintf (stdout, "|%s|\n", ResFileName);
      sptr = RetFileName;
      if (NameOnly)
      {
         for (cptr = ResFileName; *cptr; cptr++);
         while (cptr > ResFileName && *cptr != ']') cptr--;
         if (*cptr == ']')
         {
            cptr++;
            while (*cptr) *sptr++ = *cptr++;
            *sptr = '\0';
         }
         else
            ErrorExit (SS$_BUGCHECK, FI_LI);
      }
      else
      {
         for (cptr = ResFileName; *cptr; *sptr++ = *cptr++);
         *sptr = '\0';
      }
      while (sptr > RetFileName && *sptr != ';') sptr--;
      *sptr = '\0';
      return (RetFileName);
   }
   if (Debug) fprintf (stdout, "sys$search() %%X%08.08X\n", status);
   return (NULL);
}

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

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

   int  status;
   char  *cptr;

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

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

   LnmIndex = IndexValue;

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

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

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

/****************************************************************************/
/*
Set an integer reflecting the major, minor version and update release of VMS
(e.g. 600, 610, 620...730, 731, 732, etc.)
*/ 

int GetVmsVersion ()

{
#define SYI$_VERSION 4096

   static char  SyiVersion [16];
   static VMS_ITEM_LIST3 SyiItems [] = {
      { 8, SYI$_VERSION, &SyiVersion, 0 },
      { 0,0,0,0 }
   };

   int  status, version;

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

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

   if (VMSnok (status = sys$getsyiw (0, 0, 0, &SyiItems, 0, 0, 0)))
      exit (status);
   SyiVersion[8] = '\0';
   if (SyiVersion[0] == 'V' && isdigit(SyiVersion[1]) &&
       SyiVersion[2] == '.' && isdigit(SyiVersion[3]))
   {
      /* e.g. "V7.3" */
      version = ((SyiVersion[1]-48) * 100) + (SyiVersion[3]-48) * 10;
      /* if something like "V7.3-2" */
      if (SyiVersion[4] == '-') version += SyiVersion[5]-48;
   }
   else
      /* unknown format, assume it's version 6.0 */
      version = 600;
   if (Debug) fprintf (stdout, "|%s| %d\n", SyiVersion, version);
   return (version);
}

/****************************************************************************/
/*
Return a pointer to a buffer containg a string describing the hardware and VMS
version.
*/ 

char* GetPlatformDescription ()

{
#define SYI$_HW_NAME 4362
#define SYI$_VERSION 4096

   static unsigned short  SyiHwNameLength;
   static char  Description [61+9+5],
                SyiHwName [61],
                SyiVersion [9];
   static VMS_ITEM_LIST3 SyiItems [] = {
      { sizeof(SyiHwName)-1, SYI$_HW_NAME, &SyiHwName, &SyiHwNameLength },
      { sizeof(SyiVersion)-1, SYI$_VERSION, &SyiVersion, 0 },
      { 0,0,0,0 }
   };

   int  status, version;
   char  *cptr;

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

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

   if (Description[0]) return (Description);
   if (VMSnok (status = sys$getsyiw (0, 0, 0, &SyiItems, 0, 0, 0)))
      exit (status);
   SyiHwName[SyiHwNameLength] = '\0';
   SyiVersion[8] = '\0';
   for (cptr = SyiVersion; *cptr && *cptr != ' '; cptr++);
   *cptr = '\0';
   sprintf (Description, "%s VMS %s", SyiHwName, SyiVersion);
   return (Description);
}

/****************************************************************************/
/*
$FAO formatted print statement to OPCOM.  A fixed-size, internal buffer of 986
bytes maximum is used and the result output as an OPCOM message.  If the format
string begins with "S/" it is sent to SOFTWARE, otherwise CENTRAL. 
*/

void OpcomMessage
(
char *FormatString,
...
)
{
   static $DESCRIPTOR (FaoDsc, "");
   static $DESCRIPTOR (OpcomDsc, "");
   static $DESCRIPTOR (OpcomMsgDsc, "");

   int  status, argcnt, target;
   unsigned short  ShortLength;
   unsigned long  *vecptr;
   unsigned long  FaoVector [31+1];
   va_list  argptr;
   struct
   {
      unsigned long  TargetType;
      unsigned long  RequestId;
      char  MsgText [986+1];
   } OpcomMsg;

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

   va_count (argcnt);

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

   if (argcnt > 31+1) exit (SS$_OVRMAXARG);

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

   if (*(USHORTPTR)FormatString == 'S/')
   {
      target = OPC$M_NM_SOFTWARE;
      FormatString += 2;
   }
   else
      target = OPC$M_NM_CENTRL;
   FaoDsc.dsc$a_pointer = FormatString;
   FaoDsc.dsc$w_length = strlen(FormatString);

   OpcomMsgDsc.dsc$a_pointer = (char*)&OpcomMsg.MsgText;
   OpcomMsgDsc.dsc$w_length = sizeof(OpcomMsg.MsgText)-1;

   status = sys$faol (&FaoDsc, &ShortLength, &OpcomMsgDsc, &FaoVector);
   if (VMSnok (status)) exit (status);

   OpcomMsg.MsgText[ShortLength] = '\0';
   if (Debug) fprintf (stdout, "%d |%s|\n", ShortLength, OpcomMsg.MsgText);

   OpcomMsg.TargetType = OPC$_RQ_RQST + ((target & 0xffffff) << 8);
   OpcomMsg.RequestId = 0;

   OpcomDsc.dsc$a_pointer = (char*)&OpcomMsg;
   OpcomDsc.dsc$w_length = ShortLength + 8;

   status = sys$sndopr (&OpcomDsc, 0);
   if (VMSnok (status)) exit (status);
}

/****************************************************************************/
/*
Trace of call stack for debug purposes.  Include call in code to use :-)
The output is buffered, sized to be included in an OPCOM message.
*/

#include <libicb.h>

/*
VSI C V7.4-002 on OpenVMS Alpha V8.4-2L1
%CC-I-IMPLICITFUNC, In this statement, the identifier "snprintf" is implicitly
declared as a function.
*/
int snprintf (char*, size_t, const char*, ...);

char* StackTrace
(
char* module,
int line
)
{
   static char  *bufptr;
   static char  buf [32];

   int  status;
   char  *bptr, *bzptr;
   struct invo_context_blk icb;

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

   if (!bufptr) bufptr = calloc (1, 900);
   bzptr = (bptr = bufptr) + (900-16);

   bptr += sprintf (bptr, "%s:%d\r\n", module, line);

#ifdef __ALPHA
   lib$get_curr_invo_context (&icb);
   while (lib$get_prev_invo_context (&icb), !icb.libicb$v_bottom_of_stack)
      bptr += snprintf (bptr, bzptr-bptr, "%08.08X%08.08X\r\n",
                        icb.libicb$q_program_counter[1],
                        icb.libicb$q_program_counter[0]);
#endif
#ifdef __ia64
   lib$i64_init_invo_context (&icb, LIBICB$K_INVO_CONTEXT_VERSION);

   lib$i64_get_curr_invo_context (&icb);
   while (lib$i64_get_prev_invo_context (&icb), !icb.libicb$v_bottom_of_stack)
      bptr += snprintf (bptr, bzptr-bptr, "%08.08X%08.08X\r\n",
                        ((ULONGPTR)&icb.libicb$ih_pc)[1],
                        ((ULONGPTR)&icb.libicb$ih_pc)[0]);
#endif
#ifdef __x86_64
   lib$x86_init_invo_context (&icb, LIBICB$K_INVO_CONTEXT_VERSION);

   lib$x86_get_curr_invo_context (&icb);
   while (lib$x86_get_prev_invo_context (&icb), !icb.libicb$v_bottom_of_stack)
      bptr += snprintf (bptr, bzptr-bptr, "%08.08X%08.08X\r\n",
                        ((ULONGPTR)&icb.libicb$ih_ip)[1],
                        ((ULONGPTR)&icb.libicb$ih_ip)[0]);
#endif

   if (bptr >= bzptr)
      sprintf (bptr, "TRUNCATED!");
   else
      sprintf (bptr, "COMPLETE");

   return (bufptr);
}

/****************************************************************************/
/*
Copies null-terminated string 'SrcPtr' to 'DestPtr'.
Returns length of copied string.
Truncate on overflow!
*/ 
int strzcpy
(
char *DestPtr,
char *SrcPtr,
int SizeOfDest
)
{
   char  *cptr, *sptr, *zptr;

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

   zptr = (sptr = DestPtr) + SizeOfDest-1;
   for (cptr = SrcPtr; *cptr && sptr < zptr; *sptr++ = *cptr++);
   *sptr = '\0';
   return (sptr - DestPtr);
}

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

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

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

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