/*****************************************************************************/
/*
                                 DCLmembuf.c

Bulk data transfer from script to server using a (global section) memory
buffer.  Intended for transfers of multiple megabytes, tens of megabytes, and
so up.  Testing indicates transfers in excess of 500% of the standard mailbox
bandwidth, along with notable improvements in resource utilisation.  YMMV
with platform, O/S version and TCP/IP stack (i.e. as the relative bottlenecks
shuffle about).

The script requests a memory-buffer using a callout.  This module creates and
maps a non-permanent global section with a unique, one-off name.  If this is
successful the script is advised of the global section name using the callout
response.  The script uses this to map the section name and can then populate
the buffer.  When the buffer is full or otherwise ready, the script issues a
callout with the number of bytes to write, and then stalls.  This write is
accomplished asynchronously and may comprise multiple network $QIOs or TLS/SSL
blocks.  When complete a callout response to the script is issued and the
script can continue processing.  Standard script mailbox I/O (SYS$OUTPUT,
<stdout>) and memory-buffer I/O may be interleaved as required.

DCL.C callouts associated with the functionality in this module:

  BUFFER-BEGIN:<integer>[k|M]  create temporary global section for output
                               (default is an integer number of Mbytes)
  BUFFER-END:                  release the global section
  BUFFER-WRITE:<integer>       write <integer> bytes from the buffer

See [SRC.MISC]MEMBUFLIB.C and [SRC.MISC]MEMBUFDEMO.C for examples of script
code suitable to use the memory buffer facility. 

Global section access depends (to a certain extent) on security through
obscurity.  Hmmmm.  The global section allows full access to all.  This
simplifies management of the section between the server and scripting accounts. 
The name of the section comprises "WASD_MEMBUF_" plus twenty hex digits derived
in a non-determinate, non-repeating manner.  The name is passed back to the
script to use for mapping the section.  The likelihood of a(n unprivileged)
third-party operating on the system trying to guess these is improbable.  The
(relatively) short life of each global section decreases the probability
further.


COMPARISON
----------
Actual data comparing standard mailbox IPC with memory-buffer generated using
[SRC.MISC]MEMBUFDEMO.C on a HP rx2660 (1.40GHz/6.0MB) with 4 CPUs and 16383MB
running VMS V8.4-2L1 with Multinet UCX$IPC_SHR V55A-B147, OpenSSL 1.0.2k and
WASD v11.1.1, with [BufferSizeDclOutput] 16384.

|$  wget "-O" nl: http://127.0.0.1/cgi-bin/membufdemo?250
|--2017-10-14 03:19:05--  http://127.0.0.1/cgi-bin/membufdemo?250
|Connecting to 127.0.0.1:80... connected.
|HTTP request sent, awaiting response... 200 OK
|Length: 262144000 (250M) [application/octet-stream]
|Saving to: 'nl:'
|
|nl:                 100%[=====================>] 250.00M  25.6MB/s   in 12s
|
|2017-10-14 03:19:17 (20.5 MB/s) - 'nl:' saved [262144000/262144000]
|
|$  wget "-O" nl: http://127.0.0.1/cgi-bin/membufdemo?250+b
|--2017-10-14 03:19:23--  http://127.0.0.1/cgi-bin/membufdemo?250+b
|Connecting to 127.0.0.1:80... connected.
|HTTP request sent, awaiting response... 200 OK
|Length: 262144000 (250M) [application/octet-stream]
|Saving to: 'nl:'
|
|nl:                 100%[=====================>] 250.00M   105MB/s   in 2.4s
|
|2017-10-14 03:19:26 (105 MB/s) - 'nl:' saved [262144000/262144000]
|
|$  wget "-O" nl: https://127.0.0.1/cgi-bin/membufdemo?250
|--2017-10-14 03:19:50--  https://127.0.0.1/cgi-bin/membufdemo?250
|Connecting to 127.0.0.1:443... connected.
|HTTP request sent, awaiting response... 200 OK
|Length: 262144000 (250M) [application/octet-stream]
|Saving to: 'nl:'
|
|nl:                 100%[=====================>] 250.00M  14.5MB/s   in 17s
|
|2017-10-14 03:20:07 (14.5 MB/s) - 'nl:' saved [262144000/262144000]
|
|$  wget "-O" nl: https://127.0.0.1/cgi-bin/membufdemo?250+b
|--2017-10-14 03:20:12--  https://127.0.0.1/cgi-bin/membufdemo?250+b
|HTTP request sent, awaiting response... 200 OK
|Length: 262144000 (250M) [application/octet-stream]
|Saving to: 'nl:'
|
|nl:                 100%[=====================>] 250.00M  16.6MB/s   in 15s
|
|2017-10-14 03:20:27 (16.6 MB/s) - 'nl:' saved [262144000/262144000]

It is obvious that memory-buffer provides significantly greater throughput than
mailbox (from the http:// test) and that with TLS/SSL network transport the
encryption becomes a significant overhead and choke-point.  Nevertheless, there
is still an approximate 15% dividend, plus the more efficient interface the
script->memory-buffer->server provides.  The VMS TLS/SSL implementation may
improve with time, especially if TLS/SSL hardware engines become available with
the port to x86_64.

POSTSCRIPT: The comparison also illustrates that the WASD environment can
deliver significant bandwidth through its script->server->network pathways.
On the demonstration class of system; ~200Mbps unencrypted and ~120Mbps
encrypted using the standard mailbox IPC; with ~850Mbps unencrypted and
~130Mbps encrypted using the memory-buffer IPC.


VERSION HISTORY
---------------
08-OCT-2017  MGD  initial
*/
/*****************************************************************************/

#ifdef WASD_VMS_V7
#  undef __VMS_VER
#  define __VMS_VER 70000000
#  undef __CRTL_VER
#  define __CRTL_VER 70000000
#else
#  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
#endif

#include <stdio.h>
#include <ctype.h>
#include <errno.h>
#include <in.h>

#include <secdef.h>

#include "wasd.h"

#define WASD_MODULE "DCLMEMBUF"

/* size of global section in megabytes */
#define  DCLMEMBUF_SIZE_DEF   10
#define  DCLMEMBUF_SIZE_MIN    1
#define  DCLMEMBUF_SIZE_MAX  128 

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

uint  DclMemBufCount,
      DclMemBufFailCount,
      DclMemBufGblPageCount,
      DclMemBufGblPageCountMax,
      DclMemBufGblPageCountMin,
      DclMemBufGblPageMax,
      DclMemBufGblPageMin,
      DclMemBufGblSectionCount,
      DclMemBufSizeDefault = DCLMEMBUF_SIZE_DEF,  /*** temporary ***/
      DclMemBufSizeMax,
      DclMemBufSizeMin;

static char  DclMemBuffer [256];

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

extern int  InstanceNumber;

extern uint  EfnWait,
             EfnNoWait,
             HttpdTickSecond;

extern ulong  GblSecPrvMask[];

extern char  ErrorSanityCheck[];

extern struct dsc$descriptor TcpIpDeviceDsc;
extern TCP_SOCKET_ITEM  TcpIpSocket4;
extern VMS_ITEM_LIST2  TcpIpSocketReuseAddrOption;
extern VMS_ITEM_LIST2  TcpIpSocketShareOption;
extern VMS_ITEM_LIST2  TcpIpFullDuplexCloseOption;

extern ACCOUNTING_STRUCT  *AccountingPtr;
extern CONFIG_STRUCT  Config;
extern WATCH_STRUCT  Watch;

/*****************************************************************************/
/*
Initialise the DCL memory buffer facility.
*/ 

void DclMemBufInit ()

{
   /*********/
   /* begin */
   /*********/

   if (WATCH_MODULE (WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL, "DclMemBufInit()");

   if (DclMemBufSizeMin < DCLMEMBUF_SIZE_MIN)
      DclMemBufSizeMin = DCLMEMBUF_SIZE_MIN;

   if (!DclMemBufSizeMax || DclMemBufSizeMax > DCLMEMBUF_SIZE_MAX)
      DclMemBufSizeMax = DCLMEMBUF_SIZE_MAX;

   if (DclMemBufSizeDefault < DclMemBufSizeMin)
      DclMemBufSizeDefault = DclMemBufSizeMin;
   else
   if (DclMemBufSizeDefault > DclMemBufSizeMax)
      DclMemBufSizeDefault = DclMemBufSizeMax;

   if (WATCH_MODULE (WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL, "min: !UL max: !UL",
                 DclMemBufSizeMin, DclMemBufSizeMax);
}

/*****************************************************************************/
/*
Begin using a memory buffer by passing a string containing an integer number of
Mbytes (2048 x pages or 1024*1024 bytes) to allocate to the buffer.  The size
can be specified in kilobytes if the integer is immediately followed by a
character 'k'.
*/ 

char* DclMemBufBegin
(
DCL_TASK *tkptr,
char *param
)
{
   int  size, status;
   char  *cptr;

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

   if (WATCHMOD (tkptr, WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL, "DclMemBufBegin() !UL !UL !UL !AZ",
                 DclMemBufSizeDefault, DclMemBufSizeMin, DclMemBufSizeMax,
                 param);

   /* if a subsequent begin without intervening delete */
   if (tkptr->MemBufGblSecPtr) DclMemBufDelete (tkptr);

   for (cptr = param; *cptr && isspace(*cptr); cptr++);
   size = 0;
   if (isdigit(*cptr))
   {
      size = atoi(cptr);
      /* if zero is specified then use the configuration default */
      if (!size) size = DclMemBufSizeDefault;
      /* convert to megabytes */
      size *= (1024 * 1024);
      while (*cptr && isdigit(*cptr)) cptr++;
      /* if was specified as kilobytes */
      if (*cptr == 'k' || *cptr == 'K')
         size /= 1024;
      else
      /* only other unit is 'M'egabytes */
      if (*cptr && !(*cptr == 'm' || *cptr == 'M' || isspace(*cptr)))
         size = 0;
   }

   if ((size >= DclMemBufSizeMin * (1024 * 1024)) &&
       (size <= DclMemBufSizeMax * (1024 * 1024)))
      status = DclMemBufCreate (tkptr, size);
   else
      status = SS$_BADBUFLEN;

   if (WATCHING (tkptr, WATCH_DCL))
      WatchThis (WATCHITM(tkptr), WATCH_DCL,
                 "BUFFER begin !UL bytes !UL pages \"!AZ\" !&S",
                tkptr->MemBufSize, tkptr->MemBufSize / 512,
                tkptr->MemBufGblSecName, status);

   if (VMSok (status))
      FaoToBuffer (DclMemBuffer, sizeof(DclMemBuffer), NULL,
                   "200 !AZ", tkptr->MemBufGblSecName);
   else
      FaoToBuffer (DclMemBuffer, sizeof(DclMemBuffer), NULL, "500 !&S", status);

   return (DclMemBuffer);
}

/*****************************************************************************/
/*
End using the memory buffer by deleting the global section and reseting the
task memory buffer fields.
*/ 

char* DclMemBufEnd
(
DCL_TASK *tkptr,
char *param
)
{
   int  status;
   ulong  QuadCount [2];

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

   if (WATCHMOD (tkptr, WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL, "DclMemBufEnd() !AZ", param);

   PUT_QUAD_QUAD (&tkptr->MemBufCount, &QuadCount);

   status = DclMemBufDelete (tkptr);

   if (WATCHING (tkptr, WATCH_DCL))
      WatchThis (WATCHITM(tkptr), WATCH_DCL,
                 "BUFFER end !@SQ bytes transferred !&S",
                 &QuadCount, status);

   if (VMSok (status))
      FaoToBuffer (DclMemBuffer, sizeof(DclMemBuffer), NULL,
                   "200 !&S", status);
   else
      FaoToBuffer (DclMemBuffer, sizeof(DclMemBuffer), NULL,
                   "500 !&S", status);

   return (DclMemBuffer);
}

/*****************************************************************************/
/*
The script is indicating the memory buffer has been written to and the data in
that global section should be written to the client.  The string parameter
contains an integer number of bytes to write from the buffer.  If the write
fails it immediately returns a status string.  If the write is initiated it
return a NULL and the status string will be return asynchonously when the write
completes or fails.
*/ 

char* DclMemBufWrite
(
DCL_TASK *tkptr,
char *param
)
{
   int  bytes, status;
   char  *cptr;
   NETIO_STRUCT  *ioptr;
   REQUEST_STRUCT  *rqptr;

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

   if (WATCHMOD (tkptr, WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL, "DclMemBufWrite() !AZ", param);

   rqptr = tkptr->RequestPtr;
   ioptr = rqptr->NetIoPtr;

   if (rqptr->RequestState >= REQUEST_STATE_ABORT)
   {
      FaoToBuffer (DclMemBuffer, sizeof(DclMemBuffer), NULL, "500 abort");
      return (DclMemBuffer);
   }

   for (cptr = param; *cptr && isspace(*cptr); cptr++);
   bytes = 0;
   if (isdigit(*cptr)) bytes = atoi(cptr);

   if (tkptr->MemBufInProgress)
      status = SS$_OPINCOMPL;
   else
   if (bytes > 0 && bytes <= tkptr->MemBufSize)
   {
      /* ensure any preceding/intervening SYS$OUTPUT (<stdout>) is flushed */
      NetWrite (rqptr, NULL, NULL, 0);
      status = NetIoWrite (ioptr, DclMemBufWriteAst, tkptr,
                           tkptr->MemBufGblSecPtr, bytes);
   }
   else
      status = SS$_BADBUFLEN;

   if (WATCHING (tkptr, WATCH_DCL))
      WatchThis (WATCHITM(tkptr), WATCH_DCL,
                 "BUFFER write !UL bytes !&S", bytes, status);

   if (VMSok (status))
   {
      tkptr->MemBufInProgress = true;
      return (NULL);
   }

   FaoToBuffer (DclMemBuffer, sizeof(DclMemBuffer), NULL, "500 !&S", status);
   return (DclMemBuffer);
}

/*****************************************************************************/
/*
The network write has completed (either successfully or not).  Report that to
the script via a(n asynchronous) callout I/O.
*/ 

void DclMemBufWriteAst (DCL_TASK *tkptr)

{
   int  status;
   unsigned short  slen;
   NETIO_STRUCT  *ioptr;
   REQUEST_STRUCT  *rqptr;

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

   if (WATCHMOD (tkptr, WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL, "DclMemBufWriteAst()");

   rqptr = tkptr->RequestPtr;
   ioptr = rqptr->NetIoPtr;

   tkptr->MemBufInProgress = false;

   ADD_LONG_QUAD (ioptr->WriteCount, &tkptr->MemBufCount);

   if (WATCHING (tkptr, WATCH_DCL))
      WatchThis (WATCHITM(tkptr), WATCH_DCL,
                 "BUFFER written !UL/!@SQ bytes !&S",
                 ioptr->WriteCount, &tkptr->MemBufCount, ioptr->WriteStatus);

   if (rqptr->RequestState >= REQUEST_STATE_ABORT)
      FaoToBuffer (DclMemBuffer, sizeof(DclMemBuffer), NULL, "500 abort");
   else
   if (VMSok (ioptr->WriteStatus))
      FaoToBuffer (DclMemBuffer, sizeof(DclMemBuffer), &slen,
                   "200 !UL/!@SQ", ioptr->WriteCount, &tkptr->MemBufCount);
   else
      FaoToBuffer (DclMemBuffer, sizeof(DclMemBuffer), &slen,
                   "500 !UL/!@SQ !&S", ioptr->WriteCount,
                   &tkptr->MemBufCount, ioptr->WriteStatus);

   DclCalloutQio (rqptr, DclMemBuffer, slen);
}

/*****************************************************************************/
/*
Create the global section associated with this DCL memory buffer.
*/ 

int DclMemBufCreate
(
DCL_TASK *tkptr,
int bytes
)
{
   /* i.e. "WASD_MEMBUF_" followed by 20 indeterminate hex-digits */
   static $DESCRIPTOR (GblSecNameFaoDsc, "WASD_MEMBUF_!2XL!8XL!8XL!2XL");

   /* global, allocate space, system, in page file, writable */
   static int CreFlags = SEC$M_GBL | SEC$M_EXPREG | SEC$M_SYSGBL |
                         SEC$M_PAGFIL | SEC$M_WRT;
   /* system & owner full access, group and world full access */
   static ulong  ProtectionMask = 0x0000;
   /* it is recommended to map into any virtual address in the region (P0) */
   static ulong  InAddr [2] = { 0x200, 0x200 };

   static int  GblSecNameCount;
   static char  GblSecName [32+1];
   static $DESCRIPTOR (GblSecNameDsc, GblSecName);

   int  status,
        GblSecPages,
        PageCount;
   ushort  slen;
   ulong  BinTime [2],
          RetAddr [2];
   char *cptr, *sptr, *zptr;
   void  *gsptr;

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

   if (WATCHMOD (tkptr, WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL, "DclMemBufCreate() !UL", bytes);

   sys$gettim (&BinTime);

   sys$fao (&GblSecNameFaoDsc, &slen, &GblSecNameDsc,
            (InstanceNumber & 0xff), BinTime[0], BinTime[1],
            ((GblSecNameCount++) & 0xff));
   GblSecName[slen] = '\0';
   GblSecNameDsc.dsc$w_length = slen;

   /* buffers are specified in (1024) kilobytes */
   GblSecPages = bytes / 512;

   if (WATCHMOD (tkptr, WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL, "!AZ !&,UL bytes !&,UL pages",
                 GblSecName, GblSecPages * 512, GblSecPages);

   /* create the specified global section */
   sys$setprv (1, &GblSecPrvMask, 0, 0);
   status = sys$crmpsc (&InAddr, &RetAddr, 0, CreFlags,
                        &GblSecNameDsc, 0, 0, 0, GblSecPages, 0,
                        ProtectionMask, GblSecPages);
   sys$setprv (0, &GblSecPrvMask, 0, 0);

   if (WATCHMOD (tkptr, WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL,
                 "sys$crmpsc() !&S begin:!UL end:!UL",
                 status, RetAddr[0], RetAddr[1]);

   if (VMSnok (status))
   {
      DclMemBufFailCount++;
      return (status);
   }

   PageCount = (RetAddr[1]+1) - RetAddr[0] >> 9;
   gsptr = (void*)RetAddr[0];

   memset (gsptr, 0, PageCount * 512);

   DclMemBufCount++;
   DclMemBufGblSectionCount++;
   DclMemBufGblPageCount += PageCount;

   if (!DclMemBufGblPageCountMin ||
       DclMemBufGblPageCount < DclMemBufGblPageCountMin)
      DclMemBufGblPageCountMin = DclMemBufGblPageCount; 

   if (DclMemBufGblPageCount > DclMemBufGblPageCountMax)
      DclMemBufGblPageCountMax = DclMemBufGblPageCount; 

   if (PageCount > DclMemBufGblPageMax) DclMemBufGblPageMax = PageCount; 
   if (PageCount < DclMemBufGblPageMin) DclMemBufGblPageMin = PageCount; 

   tkptr->MemBufGblSecPtr = gsptr;
   tkptr->MemBufSize = PageCount * 512;
   zptr = (sptr = tkptr->MemBufGblSecName) + sizeof(tkptr->MemBufGblSecName)-1;
   for (cptr = GblSecName; *cptr && sptr < zptr; *sptr++ = *cptr++);
   *sptr = '\0';

   return (status);
}

/*****************************************************************************/
/*
Delete the global section and reset the corresponding task fields.
*/ 

int DclMemBufDelete (DCL_TASK *tkptr)

{
   static int DelFlags = SEC$M_SYSGBL;
   static $DESCRIPTOR (GblSecNameDsc, "");

   int  status;

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

   if (WATCHMOD (tkptr, WATCH_MOD_DCL))
      WatchThis (WATCHALL, WATCH_MOD_DCL,
                 "DclMemBufDelete() !AZ !UL bytes !UL pages",
                 tkptr->MemBufGblSecName, tkptr->MemBufSize,
                 tkptr->MemBufSize / 512);

   /* if I/O is in progress then just ensure it aborts */
   if (tkptr->MemBufInProgress)
      if (tkptr->RequestPtr)
         tkptr->RequestPtr->NetIoPtr->VmsStatus = SS$_ABORT;

   if (tkptr->MemBufGblSecPtr)
   {
      GblSecNameDsc.dsc$a_pointer = tkptr->MemBufGblSecName;
      GblSecNameDsc.dsc$w_length = strlen(tkptr->MemBufGblSecName);

      sys$setprv (1, &GblSecPrvMask, 0, 0);
      status = sys$dgblsc (DelFlags, &GblSecNameDsc, 0);
      sys$setprv (0, &GblSecPrvMask, 0, 0);

      DclMemBufGblSectionCount--;
      DclMemBufGblPageCount -= tkptr->MemBufSize / 512;
   }
   else
      status = SS$_BUGCHECK;

   if (VMSnok (status)) ErrorNoticed (NULL, status, NULL, FI_LI);

   tkptr->MemBufGblSecPtr = NULL;
   tkptr->MemBufSize = 0;
   PUT_ZERO_QUAD(&tkptr->MemBufCount);
   tkptr->MemBufGblSecName[0] = '\0';

   return (status);
}

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

