/*****************************************************************************/ /* 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, ) and memory-buffer I/O may be interleaved as required. DCL.C callouts associated with the functionality in this module: BUFFER-BEGIN:[k|M] create temporary global section for output (default is an integer number of Mbytes) BUFFER-END: release the global section BUFFER-WRITE: write 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 #include #include #include #include #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 () 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); } /*****************************************************************************/