/*****************************************************************************/ #ifdef COMMENTS_WITH_COMMENTS /* DCL.c ************* ** CAUTION ** ************* THIS MODULE IS TASK-ORIENTED, NOT REQUEST-ORIENTED. That is, most of the functions take a pointer to DCL task rather than a pointer to request as do other modules. The reason is simple. In this module the more-permanent data-structures are those associated with the DCL script processes, which persist for multiple requests. With the requests transient the DCL script processes must be managed in their absence. Hence requests are associated with DCL script processes not vice-versa. OVERVIEW -------- Provides multi-threaded, concurrent HTTPd script processes executing DCL. This module never returns a valid status and ALWAYS calls the supplied next task (AST) function. This should check for a generated error message to determine is there were any problems. The DCL can either be in the form of a command, or a procedure or executable image file specification. Both should not be supplied, but file specifications have precedence. If a file specfication is supplied the module verifies its existance, and if not qualified with an extension, looks for a procedure first (".COM"), then an executable image (".EXE"), then through any user-defined list of file types (extensions) and associated scripting executables (e.g. ".PL" associated with the verb "PERL"). Furthermore, the DCL can be executed either standalone or as a CGI script (indicated by the presence of a script name in the request data structure). If a CGI script, then the output stream is parsed for header information, if not a script then the stream is just checked for correct carriage control (terminated by a newline). CGI variables are created for both standalone DCL and scripts, although some (e.g. WWW_SCRIPT_NAME) will be empty, and meaningless, for standalone DCL. The AST-driven nature makes the code a little more difficult to follow, but creates a powerful, event-driven, multi-threaded server. All of the necessary functions implementing this module are designed to be non-blocking. All of these functions are designed to be, and should be, called at AST delivery level, which means they cannot be interrupted at the same level (in this case USER mode), and so their actions are essentially atomic at that level, meaning no additional synchronization is required for such activities as thread disposal, etc. The HTTPd can maintain a number of script processes limited only by its process quotas, memory is dynamically allocated and there are no fixed data structures related to script process management. The use of byte-streams (effectively "pipes") allows even DCL procedures to output as HTTP servers, without the need for explicit network I/O. Four mailboxes are created for each script process' IPC: 1. A mailbox connected to its SYS$COMMAND. This is used to pass DCL commands and/or other data to the script process. It effectively allows the HTTPd to control the activities of the script process this way. 2. A mailbox connected to its SYS$OUTPUT. This receives records from the script process, if required appends HTTP-required carriage-control (single ), then sends the record to the client via the network. This allows even DCL procedures to supply a correct output stream to the client (see next paragraph). If the first line from a script is an HTTP status line (e.g. "HTTP/1.0 200 ok") then HTTPD assumes the script will be supplying a complete HTTP data stream, including full header and required carriage control (single terminating each line). If the first line is not a HTTP status line it assumes CGI script output compliance and also ensures each record (line) received has correct HTTP carriage-control. This stream also attempts to maintain compliance with CGI scripting. If the first line output by a script is not an HTTP status line it creates and sends one to the client before sending the first line. 3. A mailbox defined for the script process by the name HTTP$INPUT. This may be used to read the request data steam sent by the client. Note that from v4.2 this is also the SYS$INPUT stream as well, which appears to be the more common CGI implementation. As of version 4.3 the default behaviour is to supply only the request body to the script (CGI standard and the more common implementation). Defining the environment variable HTTPD_DCL_FULL_REQUEST it is possible to revert to the previous behaviour of supplying the header then the body. (It's an easy enough modification for most scripts to skip the header by reading until the header-separating empty (blank) line is encountered.) 4. A mailbox defined by the name CGIPLUSIN. This allows CGIplus scripts to read a stream of CGI variable information. Each request begins with a comment line "!", which can be used for request start synchronisation and may always be discarded, and ends with an empty record (blank line), with a variable number of records in between. The script script processes can use the basic CGI variables (VMS CERN-like) and behave very much like a CGI script. That is, if a script wants to be CGI-compliant it provides as the first line a "Status:", "Content-type:" or a "Location:" then a blank line. If the first line output by a script is a "Content-Type:" header line an HTTP "200" status line is prepended. If the first line output by a script is a "Location:" redirection header line the redirection is processed to ensure CERN HTTPD/CGI behaviour. An HTTP "302" status line is prepended if not a local redirection. If none of these, HTTPD creates a complete HTTP header comprising status line, "Content-Type: text/plain" and blank line (this is an extension of CERN HTTPD behaviour). If the first characters are "HTTP/1.0 ..." the script will be considered to be supplying the raw HTTP stream and record boundaries, carriage-control, etc., are of no further concern to the module. This is the equivalent of a "no-parse-header" script. If CGI-compliant each record should represent a line of output. That is lines should not be buffered together and sent as a block unless the script is supplying a raw HTTP data stream. CGI VARIABLES ------------- See CGI.C module. BUILD-RECORD OUTPUT MODE ------------------------ Generally the script's response header output would be issued as records. A record is defined as a 'line' of script output that is delimited by a newline character ('\n', 0x0a), or a carriage-return then newline character ('\r\n', 0x0d 0x0a). The CGI header processing code of CGI.C can also cope with non-record header responses because the logical line is delimited by the newline. The script body can be issued in any way consistent with the response MIME content-type and required record carriage control (which the server will supply if required). Generally compiled scripts output in record-mode unless explicitly programmed to output in binary mode. Some pre-built scripting environments are somewhat poorly designed or ported to VMS and will provide all the output as single character 'records'. Horribly inefficient!! This server still allows for such environments by noting the first record. If a single byte it switches to 'build-record' mode. In 'build-record' mode each "real" record is assumed to be any zero or more bytes delimited by a newline character. A zero-byte record is transmogrified into a single-byte, newline character record. In this mode the single byte I/Os are buffered until the newline is received (and appended to the buffer) whereupon that built-up record is then processed as if received as a single record. (For more detail query Alex Ivanov about the vicissitudes of GhostScript PostScript RTE programming. :^) CGI-PLUS -------- CGI plus lower latency, plus greater efficiency, plus less system impact! CGIplus attempts to eliminate the overhead associated with creating the script process and then executing the image of a CGI script. It does this by allowing the script process and associated image to continue executing in-between uses, eliminating the startup overhead. This both reduces the load on the system and the request latency where one of these scripts is involved. In this sense these advantages parallel those offered by commercial HTTP server-integration APIs, such as Netscape NSAPI and Microsoft ISAPI. The script interface is still largely CGI, which means a new API does not need to be learned and that existing CGI scripts are simple to modify. The script must read the CGI variables from CGIPLUSIN. They are supplied either as: 1) A series of plain-text, records (lines). The first contains a single "!", used as a start sentinal. A series of records then follows, containing the CGI variable name, an equate symbol and then the variable value. This format may be easily parsed and as the value contains no encoded characters may be directly used. An empty record (blank line) indicates the end of the request information. (This is the default mode, though can be reverted to by a "CGIPLUS: record" callout - see below.) 2) Two records. The first contains a leading sequence of "!!" followed by a series of ASCII characters forming a number representing in plain-test the size of the following binary record (e.g. "!!1563"). This binary record has the structure described in the CGI.C module topic "CGIplus Variable Structure", and must be parsed by the receiving application. (This is by far the more efficient mode and can be selected using a "CGIPLUS: struct" callout - see below.) Although the author had already developed a concept similar in approach it was the independent suggestion and some initial performance bench-marking by Jean-François Piéronne (jf.pieronne@laposte.net) that prompted it's inclusion in the 7.2 release. The request may be processed at that stage. After processing the CGIplus script can loop, waiting to read the details of the next request from CGIPLUSIN. The first record read may ALWAYS be discarded allowing a read to be used as a simple synchronization mechanism. HTTP output (to the client) is written to SYS$OUTPUT (stdout). End of output MUST be indicated by writing a special EOF string to the output stream. This is a KLUDGE, and the least elegant part of CGIplus design, BUT it is also the simplest implementation and should work in all but the most exceptional circumstances. The special EOF string has been chosen to be most unlikely to occur in normal output (a hopefully unique 224 bit sequence), but there is still a very, very small chance! The CGIplus EOF string is obtained from the logical name CGIPLUSEOF, defined in the script process's process table, using the language's equivalent of F$TRNLNM(), SYS$TRNLNM(), or a getenv() call in the C Language. This string will always contain less than 32 characters and comprise only common, printable characters. It must be written at the conclusion of a request's output to the output stream as a single record (line) but may also contain a or just trailing carriage-control (to allow for programming language constraints). See examples in HT_ROOT:[SRC.CGIPLUS] HTTP input (raw request stream, header and any body) is still available to the CGIplus script. Multiple CGIplus scripts may be executing in script processes at any one time. This includes multiple instances of any particular script. It is the server's task to track these, distributing appropriate requests to idle script processes, monitoring those currently processing requests, creating new instances if and when necessary, and deleting the least-used, idle CGIplus script processes when configurable thresholds are reached. A CGIplus script can be terminated by the server at any time (the script process $FORCEX()ed then $DELPRC()ed) so resources should be largely quiescent when not actually processing. CGIplus script processes may also be terminated from the command line using STOP/id=. The server administration menu provides a simple mechansim to purge (stop) all CGIplus processes, allowing the server to be flushed of all script processes. This can be useful if some new compilation of a CGIplus script executable needs to made available. CGIplus scripts are differentiated from "normal" CGI scripts in the mapping rule configuration file using the "script+" and "exec+" directives. Of course it would be possible to design a script to simply modify it's behaviour so it was possible to execute in both environments. Simply detecting the presence or absence of one of the "normal" CGI variables (i.e. DCL symbols, e.g. WWW_PATH_INFO, WWW_CGI_GATEWAY_INTERFACE, etc.) would be sufficient indication. See examples in HT_ROOT:[SRC.CGIPLUS] April 1998 Note: It has been observed that under rare circumstances a persistent script process script-serviced request can die unexpectedly. This has been isolated to the following scenario. A request underway results in a CGIplus script terminating and the script process exiting. Any output in the script's C RTL buffers is flushed during exit, including possibly the CGI output EOF indicator, generating an I/O AST which is serviced indicating the request is complete and the CGIplus script is ready for reuse. In fact it isn't because the process is running-down. Before the script process termination AST can be processed another AST containing a request for that same CGIplus script is serviced. The DCL task structure is allocated to the new request but shortly, possibly immediately after, that DCL task receives the termination AST and is run-down. The request receives no output and Netscape Navigator for instance reports "Document contains no data". This has been addressed by checking whether the script has begun processing (by reading from the COMMAND or CGIPLUSIN variable stream. If this stream has not been read from it is considered the above has happened and the script request is resubmitted to DclBegin(). A limit is placed on the number of times this may happen in succession, to prevent an errant script from producing a runaway condition in the server. October 2005 Note: Further to the April 1998 note above it has been shown that a timing window exists for an exiting script to cause a similar problem. It's unknown whether this existed from the original fix or has crept back in during subsequent development. This issue was closed by placing a test in DclSysCommandAst() to ensure that the script is only marked as having responded after allowing for a CGIplus script's SYS$COMMAND queued STOP/id=0 and EOF. CGIPLUS RUNTIME --------------- This is a variation on the CGIplus environment. It allows for mapping a request path into *three* components (well sort of). MAPURL.C allows an EXEC to do some special mapping, essentially the derivation of a special run-time file (script), then completely remapping the whole thing again to derive a script file name (provided as a "parameter" to the executing run-time file) and a resultant path. The idea is the run-time environment is some sort of persistent engine/interpreter operating in a CGIplus environment and getting its requests via the CGIplus stream. The actual script to be processed by it is passed as CGI variables SCRIPT_NAME and SCRIPT_FILENAME which the engine can then use as source for it's interpreter. The rest of the environment is normal CGI/CGIplus. When finished the engine then runs-down the processing environment, signals CGIplus-EOF and goes quiescent waiting for the next request. These run-time environments are so much like CGIplus scripts (with only a slightly different handling of the script file name itself) that CGIplus scripts can behave as run-time environments. For example the CONAN script. It essentially "interprets" the "scripting" input of a VMS Help or text library. See the examples in the section immediately below. WEB SOCKETS ----------- For WASD a Web Socket script is one that is activated in the same fashion as an equivalent CGI/CGIplus/RTE and has an identical CGI environment (variables, streams, etc.) but which uses a unique HTTP response and communicates with its client using the Web Socket protocol. See further description in WEBSOCKET.C prologue. WASD can also tunnel Web Socket connections to Web Socket and non- Web Socket services (see PROXYTUNNEL.C). SCRIPT RUNTIME ENVIRONMENTS --------------------------- File types (extensions) and associated scripting languages can be defined in the configuration file. The syntax is "type foreign-verb". For example: [DclRunTime] .PL $PERL_EXE:PERL.EXE .CGI PERL Three are predefined, ".COM" for DCL procedures, ".CLD" to define a verb via command-definition file, and ".EXE" for executables. There are two further run-time types, CGIplus and (persitant) Run-Time Environment (RTE) indicated by enclosing them in parentheses. For example: [DclRunTime] .PL (HT_EXE:PERLRTE.EXE) .HLB (CGI-BIN:[000000]CONAN) When these are encountered against a file type the script processing is restarted from the current CGI type, to either CGIplus or RTE respectively. This incurs a small request processing penalty but the potential efficiencies of the latter two environments make it well worthwhile. NOTE: it is assumed the RTE executable/procedure exists. No check is made by the server for its existance or access permissions before activating under DCL. SCRIPT COMMAND PARAMETERS ------------------------- The mapping rule SET * script=command="" can be used to provide optional command-line qualifiers and parameters during CGI and CGIplus script activation. To add such to a script activation the first character in the string should be an asterisk. This indicates the verb created by the DCL modules should be used to activate the script and anything followed should just be appended to the verb's command-line. The following mapping SET /cgi-bin/script.exe script=command="* /QUALIFIER1 PARAMETER1" would result in the script being activated using the following DCL commands WASDVERB:=$CGI-BIN:[000000]SCRIPT.EXE WASDVERB /QUALIFIER1 PARAMETER1 If the first character is not an asterisk the path SETing completely replaces the server-generated script activation command allowing a completely different command to be used to activate the script. This mapping SET /cgi-bin/script.exe script=command="OKEYDOKEY /QUALIFIER1 PARAMETER1" would result in the following DCL commands being generated WASDVERB:=$CGI-BIN:[000000]SCRIPT.EXE OKEYDOKEY /QUALIFIER1 PARAMETER1 As can be seen the first command is effectively ignored. CGI CALLOUT ----------- The CGIplus input/output streams are used to provide support for the script process to "escape" from the normal SYS$OUTPUT stream and send records directly to a server function for interpretation and processing. In turn this function can return records to the script via the CGIPLUSIN stream. This works for *BOTH* CGIplus *AND* vanilla CGI scripting! The script indicates it wishes to suspend normal output by providing a record containing the string found in the script process' CGIPLUSESC logical. End of this mode of communication is indicated by a record containing the string from the CGIPLUSEOT logical (after which output to the client is resumed). These sequences are generated and used in much the same way as CGIPLUSEOF. This functionality is used to supports CGIplus scripts that act not in the traditional role as a CGI script but as "agents" to perform some required function transparently to request processing. An obvious example is an external authentication/authorization processor. These agents execute in the normal CGI environment, with the request's CGI variables available (with some minor differences depending on authorization state), output stream, etc. There are some behavioural constraints on agents but this general approach confers the considerable benefits of being able to write and operate these agents as if CGI/CGIplus scripts, even as (CG)ISAPI DLLs. A default callout for a CGIplus script is provided. This function provides a number of operations that may be useful to special-purpose scripts. The responses provided by the server are always an HTTP-like code, 200 for success, 400 for script request error, etc., with trailing plain-text explanation. The provision of and requirement for reading a response may be suppressed by leading the directive with a '!' or '#'. CGI "callout" requests (case-insensitive): 100 AUTHAGENT-CALLOUT avoid auth agents being run as scripts AUTH-FILE:string authorize/deny SYSPRV access to file specified BODY: obsolete CGIPLUS:string provide CGI variables, "struct" or "record" CLIENT-READ:[string] initiate reads directly from client to script CONTENT-TYPE:string map the file extension to a MIME content-type GATEWAY-BEGIN:integer HTTP response status code (e.g. 200) BG: device GATEWAY-CCL:integer 1 enables, 0 disables BG: device carriage-control GATEWAY-END:integer count of bytes output directly to the BG: device ICON-TYPE:string map the content-type/file extension to icon URL LIFETIME:integer|hh:mm:ss or "do-not-disturb" (re)sets process lifetime MAP-FILE:string map the supplied file to a path MAP-PATH:string map the supplied path to a file NOOP:[string] do nothing, just return a success status REDACT:opaque append the trailing binary data to the buffer REDACT-SIZE:integer pre-allocate buffer space SCRIPT-CONTROL:string equivalent of CGI response Script-Control: field TIMEOUT-BIT-BUCKET:integer or "none" sets script into bit-bucket timeout TIMEOUT-NOPROGRESS:integer or "none" sets request no-progress timeout TIMEOUT-OUTPUT:integer or "none" sets request output timeout WATCH:string when WATCHing 'script' display this string CLIENT-READ: CALLOUT -------------------- A script can initiate reads direct from the client using the CLIENT-READ: callout. Although this has little value for the standard browser, which when using HTTP will only supply a body with a POSTed request and then only as a block of request data, a custom application or Java applet could initiate an "interactive" dialog with a script. When the CLIENT-READ: callout is received by the server it queues a network read from the client. If an when this completes the record is written to the script via the normal HTTP$INPUT stream. The script can write records to the client via it's normal SYS$OUTPUT stream. This I/O is asynchronous. The client records read are transported via the normal server protocols and so support communication via SSL, providing a secured stream for such communication. Any functionality that can be built into a server-end script and it's associated client-end application should be able to be supported via this mechanism. Of course, for extended transactions some consideration must be given to request and script timeouts. REQUEST REDACTION ----------------- Callout processing may redact (completely rewrite and restart) a request. re-dact -verb (used with object) 1. to put into suitable literary form; revise; edit. 2. to draw up or frame (a statement, proclamation, etc.). [Origin: 13501400; ME < L redctus (ptp. of redigere to lead back), equiv. to red- red- + ctus, ptp. of agere to lead; see act] To do this a script must use the REDACT: callout to send back to the server a completely new request header and body (if applicable) which the server then treats as if received from the client over the network. This allows a request to be partially or completely rewritten (as required) and restarted. The data supplied to this callout is treated as completely opaque and care must be taken to include all and no extra carriage-control, etc. An elementary (and somewhat contrived) example: stdout = freopen ("SYS$OUTPUT:", "w", stdout, "ctx=bin", "ctx=xplct"); fputs (getenv("CGIPLUSESC"),stdout); fflush (stdout); fwrite ("REDACT:HTTP/1.1 POST /and_example.php\r\n", 39, 1, stdout); fflush (stdout); fwrite ("REDACT:Host: example.com\r\n", 26, 1, stdout); fflush (stdout); fwrite ("REDACT:Content-Length: 26\r\n", 27, 1, stdout); fflush (stdout); fwrite ("REDACT:Content-Type: application/x-www-form-urlencoded\r\n", 58, 1, stdout); fflush (stdout); fputs ("REDACT:\r\n",stdout); fflush (stdout); fwrite ("REDACT:one=two&three=four\n", 26, 1, stdout); fflush (stdout); fputs (getenv("CGIPLUSEOT"),stdout); fflush (stdout); Once the request has been redacted the script just finishes processing without other output and the server transparently restarts processing. This facility was originally incorporated to allow a PAPI http://papi.rediris.es/ http://en.wikipedia.org/wiki/Point_of_Access_for_Providers_of_Information authentication agent to store a request on-disk and then some time and several processing steps later restart the original request processing again. GATEWAY_BG ---------- The CGI.C module provides a "GATEWAY_BG" CGI variable that contains the BG: (socket) device connected to the client. This device is created shareable. Opening a channel to it allows a script to directly output to the TCP/IP socket, bypassing the server completely. NEEDLESS TO SAY THIS REDUCES OVERHEAD CONSIDERABLY and for a certain class of services may be appropriate. Note that this is a completely RAW stream, the script must supply all carriage-control, etc. Also, because it is raw, it is also completely unencrypted and so cannot be used with an SSL request or WATCHed for trouble-shooting purposes. The script must supply a full NPH response header to the client, and a GATEWAY-BEGIN:nnn callout to the server, supplying (for logging, etc.) the HTTP status code of the response. When the response body transmission is complete the script must supply a GATEWAY-END:nnn callout, providing the server with the data count transfered (again for logging, etc.). If a channel to the BG: device is opened it should always be closed when it is finished with. Failure to do so could lead to resource starvation for the server. When complete the script just concludes as normal. The following is an example. fflush (stdout); fprintf (stdout, "%s\n", getenv("CGIPLUSESC")); fflush (stdout); fprintf (stdout, "GATEWAY-BEGIN: %d\n", 200); fflush (stdout); byteCount = fprintf (BgOut, "All sorts of rubbish to the raw socket!\n"); fprintf (stdout, "GATEWAY-END: %d\n", bytesCount); fflush (stdout); fprintf (stdout, "%s\n", getenv("CGIPLUSEOT")); fflush (stdout); ZOMBIES ------- The reuse of DCL script processes for CGI scripting provides very significant performance gains with very little _real_ possibility of undesirable interaction between uses (where scripts are "well-behaved", which should be all enviornments). When a non-zero zombie lifetime is specified DCL script processes implicitly persist between uses for standard CGI and DCL (SSI) commands as well as explicitly with CGIplus scripts. When not being used to process a request these script processes are termed "zombies" ;^) they are neither "alive" (executing a script and processing a request) nor are they "dead" (script process deleted and task structure free). Instead the script process is in a LEF state waiting for more input via CGIPLUSIN. A great deal of care is taken to ensure there is no interaction between uses (all symbols are deleted, output mailbox is emptied), but there can be no "iron-clad" guarantee. Use of zombies (persistent DCL processes) is disabled by setting the appropriate configuration parameter to zero. The same DCL EOF mechansism is used to signal end-of-output in all process-persistent environments. SCRIPTING PROCESSES ------------------- As of WASD 7.1 the creation of scripting processes has been moved from lib$spawn() to sys$creprc(). This was primarily to support detached processes executing under a different persona. There are two modes for scripting now. The first exclusively bases scripting on subprocesses (still created using sys$creprc()) executing using the server account). This is (should be ;^) completely compatible with versions prior to WASD 7.1 and can be supported on all previous VMS versions WASD compiled and executed under. The second mode uses detached processes. These are completely autonomous processes, with full, not pooled quotas, etc. This may be an advantage in itself, with resource exhaustion (by the server itself) less likely. These processes would usually be created using the same account as the server, but with the server using the sys$persona...() services (the basics available since VMS V6.2) can be executing under a different account opening up a whole raft of possibilities (a la U**x setuid()), see below. One of the real advantages in using subprocesses is their automatic cleanup during parent process deletion. With detached processes there is no such convenience. It is very much up to the application author to completely manage the life-cycle of these processes. Whilst the author wishes to only employ user-mode code this becomes an issue under some circumstances. The server maintains a list of all processes it manages and so during normal image run-down the exit handler can sys$delprc() these without any trouble. This will probably be 99.9% of the time. The other 0.1% might be represented by a site administrator doing a STOP/id= instead of the more usual and convenient HTTPD/DO=EXIT on the server process for some reason. The STOP results in the exit handler not gaining control and so any scripting processes not being deleted. To avoid having potentially a large number of now unmanaged processes left permanently on the system (or worse still, after a number of these accumulating on the system), the server during startup scans all candidate processes on the system and deletes those associated with it's previous incarnation. How can it tell processes it created from any others? Good question! Well, it may have created them under a different account so it can't just delete any others running under it's account besides itself, particularly if there may be multiple server executing on the one system. OK, how do we find them? These processes have a mailbox 'terminal', so scan for those with 'MBA'. So do lots of other processes! But only those created by the server have a specific ACL attached to the device, with a special, unique identifier in the first ACE. If this ACL is detected the process is deleted. The rights identifier must be server-process-unique and by default is generated from the process name. For instance "WASD:80" would require an identifier "WASD_PRC_WASD_80". Not too complex, especially considering the basics of the code to create such an ACL must exist anyway, allowing processes under non-server accounts to connect to them. Yet another issue! With detached processes created via LOGINOUT.EXE the full process life-cycle is undertaken, including SYLOGIN.COM and LOGIN.COM, which may write to SYS$OUTPUT during execution. This output is obviously undesirable ;^) and so is absorbed. A sentinal (similar to those used for script EOF and callout ESC and EOT) is output when the server supplied DCL commands being read via the SYS$COMMAND mailbox gain control. This is detected by the server, output absorbtion is turned off and normal CGI output processing begun. Scripting process priorities are set in the following way. Script processes created for execution under the server username, or a username specified via a "SET SCRIPT=AS=" are created one priority lower than the server process itself. Processes to be executed under a /~username, that is via a "SET SCRIPT=AS=~" rule, are created two priorities lower than the server. The rationale being that the server process itself should always have a slight edge (it will probably be I/O bound anyway), and "server" scripts should have a slight edge over "user" scripts. This way the server should respond quickly, even if script processing on a busy system then takes a little time to complete the request. For example, if the server executes at 4 then scripts created under the server account will execute at 3 and /~username scripts at 2. These may be changed in DCL.H and via recompilation. Setting a script to have a maximum CPU consumption (set /path script=CPU=5) Results in a "watchdog" routine being invoked each time the DCL supervisor ticks. This asynchronous $GETJPI compares the current CPU consumption with that at the beginning of the script execution. Note it's the *script* not process, and is not the same as CPULM process quota. This provides somewhat more versatility than a CPULM-style (which won't work on LOGINOUT.EXE created processes anyway). It does however rely on the DCL supervisor and so is subject to the timer granularity of that subsystem. When the CPU is being controlled in this way the supervisor ticks at a more appropriate period, so that although not accurate to the second in terminating a excessive-CPU script it should not be too far off the mark! "suEXEC"/"SETUID" SCRIPTING --------------------------- The detached scripting mechanism described above is coupled with the VMS V6.0 and later sys$persona...() system services to allow scripting under user accounts specified by the system administrator using mapping rules. This must be enabled using the command-line qualifier /PERSONA. As with all scripting this should be used with caution, although the detached script process, isolated from the main server by account differences, should not be able to affect the server directly. This only interaction with it should be via the IPC mailboxes, which are still owned by the server process, with the user script granted access via an ACL on the device. The /PERSONA qualifier takes an optional rights identifier parameter. If this is supplied access to the persona services (as as a consequence all scripting) is controlled by account possession of the identifier. Note that this includes *all* accounts, including the HTTP server account. The format of the qualifier use then becomes something like /PERSONA=WASD_SCRIPTING. By default only non-privileged accounts can be used to script. If privileged accounts are required for scripting the /PERSONA=RELAXED keyword must be supplied. Persona scripting can be further restricted to authenticated and authorized requests. The /PERSONA=AUTHORIZED keyword will enable this. Unless the request has been subject to HTTP authorization the request just results in an error. A variation on this allows privileged accounts to be used for scripting only within authorized requests using /PERSONA=RELAXED=AUTHORIZED. The 'SET /path/* SCRIPT=AS=username' mapping rule allows user names (accounts) to be specified for (a) script(s) with a particular path. For instance, the script "/database/query" could be set up to execute under the user name DATABASE using rules similar to the following: set /database/* script=as=DATABASE exec /database/* /database_root/cgi-bin/* General user scripting (that is, access to accounts via the "/~username" style syntax) may also be enabled using rules such as the following: set /~*/cgi-bin/* script=as=~ # the following is NOT a typo, the rule is UXEC (User eXEC) uxec /~*/cgi-bin/* /*/www/cgi-bin/* user /~*/* /*/www/* redirect /~* ///~*/ For requests that have been authenticated using the SYSUAF, the username may provide the scripting account. Use a SET script=as=$ rule, where the dollar indicates that before activating the script the server should substitute the authenticated VMS username ... CAUTION! If the request was not SYSUAF authenticated it fails. set /cgi-bin/showme* script=as=$ To optionally execute scripts user a SYSUAF authenticated username use the SET script=as=$? rule. If not SYSUAF authenticated it is executed under the default scripting account. set /cgi-bin/showme* script=as=$? It is also possible to direct the server to execute *all* of it's own scripts under some non-server account by prefixing the entire rule file using something like the following rule. set /* script=as=NOBODY NOBODY SCRIPTING ---------------- Version 8.1 establishes a new strategy in scripting account - it always attempts to enable detached scripting with a non-server account to perform the scripting. This is the algorithm: 1) If /DEMO subprocess scripting is forced. 2) If /SCRIPT=AS=SUBPROCESS is used subprocess scripting is forced. 3) If /SCRIPT=AS=username is used detached scripting is forced. 4) If the account HTTP$NOBODY exists detached scripting is forced. 5) If /PERSONA is used detached scripting is forced. 6) The scripting process mode is set by [DclDetachProcess]. The advantages of generally scripting under a totally non-server account, non-user account cannot be overstated. This /SCRIPT=AS= and HTTP$NOBODY approach allows this to be available without enabling /PERSONA scripting in general (and thereby having it not available via mapping rules). Presto! It all just happens. Note that this CANNOT be a username with anything other than the average Joe privileges. This may also be used with PERSONA enabled. SCRIPT RUN-DOWN --------------- This excellent approach was suggested by Jean-François Piéronne (jfp@altavista.net). It makes a significant contribution to improving performance and reducing overhead. As of WASD 7.2 a change in behaviour for client connection drops. Prior to this version the first network write error caused the termination of the script and process. Now [DclBitBucketTimeout] or mapping set rule SCRIPT=BIT-BUCKET=hh:mm:ss control behaviour. If this is set (non-zero) the server now just absorbs any further output from the script until the timeout expires. The rationale being that most scripts execute relatively quickly, most connection drops are client impatience or changing of mind, script process creation and instantiation is relatively expensive and it is better to try and preserve these wherever possible, or at least allow them to complete their processing. Scripts can also set this timeout on a per-request basis using the TIMEOUT-BIT-BUCKET: callout. Do-Not-Disturb scripts, indicated by use of the "LIFETIME: do-not-disturb" callouts, are never automatically run-down or otherwise touched. Normal behaviour can be reverted to using a "LIFETIME: configuration". They can be administratively purged or force-deleted of course (i.e. from the Admin Menu and CLI /DO=DCL=). Do-Not-Disturb lifetimes may be used during critical sections of processing (ensuring it will not under any normal circumstances have it's processing disturbed), at the beginning and ending of entire requests (putting a critical section around the entire request), or even permanently, making them effectively immortal and like many gods a potential source of all sorts of subtle and gross affliction ;^) Also with WASD 7.2 the script process is now checked for an executing image (JPI$_IMAGNAME) and if it is a $FORCEX is issued. The rationale is of course to allow any image exit handlers a chance to do their job. Prior to v7.2 a $DELPRC was simply issued, which can cause some issues with some environments, for example RDB (and other such-like I should imagine), where database checkpoint/rollback can be induced. Generally it will be CGIplus/RTE scripts that require a $FORCEX on the image. In these cases when the image exits the queued SYS$COMMAND DCL will cause the process to perform a STOP/id=0 deleting itself and delivering the completion AST. On rare occasions (and with standard CGI scripts) this may not happen so every few seconds (under the control of the DCL supervisor) the process is agains checked for an executing image. When it isn't (or one minute passes, which-ever first) the process is $DELPRCed. HT_SCRATCH ---------- If defined, this logical locates a directory where scripts can place temporary files. Although these scripts should clean up after themselves, temporary or working files placed into this directory are automatically deleted if last modified earlier than [DclCleanupScratchMinutesOld] before the scan starts. The scan that searches for and deletes these files if present occurs either when there are no more script processes active or not greater than every [DclCleanupScratchMinutesMax] minutes. The CGI variable 'WWW_UNIQUE_ID' can be used to generate unique file names. To prevent a file being automatically cleaned up make the first character of it's name a dollar symbol. The following DCL code fragment creates unique server and script file names. $ NAME = F$PARSE(WWW_SCRIPT_NAME,,,"NAME") $ FILENAME = NAME + "." + WWW_UNIQUE_ID $ OPEN /WRITE TMPFILE 'FILENAME' LOGICAL NAMES ------------- WASD_FILE_DEV if defined, provides a command procedure early in the script life-cycle for integrating a WASD-specific logical name table in the process' LNM$FILE_DEV WASD_FILE_DEV_2 same as above but for a non-primary group 2..15 ... WASD_FILE_DEV_15 WASD_LOGIN if defined, provides a command procedure executed immediately before the script command/procedure/image HTTPD$LOGIN same as above but deprecated as of v10.0 WASD_VERIFY if defined, to an IP address turns on script/DCL-level verify only for the REMOTE_ADDR client if defined, to something else turns on script/DCL-level verify HTTPD$VERIFY same as above but *obsolete* as of v10.0 HT_SCRATCH if defined, directory for working/scratch files used by scripts (cleaned up every [DclZombieLifeTime] minutes max.) VERSION HISTORY --------------- 13-JAN-2014 MGD DclCountScriptProcess() 10-JUL-2013 MGD DclMailboxAcl() allow usernames without associated identifiers (i.e. shared UICs) by first trying with the username and on failure getting the UIC and using that 16-SEP-2012 MGD bugfix; distinguish between WebSocket and agent execution 26-NOV-2011 MGD DclRestartScript() refine WebSocket handling DclCgiPlusInAst() first status indicates script active bugfix; DclScriptProcessCompletionAST() don't WebSockClose() any WebSocket request currrently associated with the task 18-FEB-2011 MGD bugfix; associated with AST delivery changes for WebSockets 06-JAN-2011 MGD happy birthday Nomes! DclFindScriptSearchAst() minor refinement; only search for next if script file type not explicitly supplied 01-JUL-2010 MGD bugfix; DclUpdateScriptNameCache() run-time pointer 14-JUN-2010 MGD DclScriptProctor() DclSupervisor() also purge script name cache at cleanup 04-JUN-2010 MGD DclAllocateTask() default unconfigured CGIplus lifetime 09-FEB-2010 MGD path SETing script=lifetime= callout LIFETIME: can accept 26-JAN-2010 MGD Web Socket scripting callout SCRIPT-CONTROL: 11-JUL-2009 MGD DclCgiScriptSysCommand() and DclCgiPlusScriptSysCommand() WASD_FILE_DEV and WASD_FILE_DEV_n procedure WASD_LOGIN procedure (obsolescents HTTPD$LOGIN) WASD_VERIFY functionality supercedes HTTPD$VERIFY 18-MAY-2008 MGD bugfix; DclUpdateScriptNameCache() undo bug from fix of non-existant problem from 12-APR-2008 (talk about it!) 19-APR-2008 MGD callout WATCH:string for WATCHing script item 12-APR-2008 MGD bugfix; DclUpdateScriptNameCache() copy determined script invocation method ("@","$","=", etc.) into cache 20-NOV-2007 MGD callout REDACT: and REDACT-SIZE: callout NOTICED: callout OPCOM: callout BODY: obsolete (and non-working) 24-JUL-2007 MGD DclSysOutputAst() if WATCHing DCL and non-CGI-compliant response continue to end-of-script bit-bucketing output (DECNET.C code already provides this behaviour) 11-MAY-2007 MGD bugfix; DclBegin() agent runs under default account 22-AUG-2006 MGD add GATEWAY-CCL: callout DclTaskRunDown() ensure socket carriage-control is reset 06-OCT-2005 MGD bugfix; DclSysCommandAst() allow for the queued post-CGIplus script STOP/id=0 and EOF, bugfix; copy sentinals into request storage to prevent them (potentially) being overwritten by an early call to DclScriptProcessCompletionAST() 02-JUN-2005 MGD ensure soft limit is no less than 75% of hard limit 25-MAY-2005 MGD DclControlPurgeScriptProcesses() provide PURGE/DELETE selected on username, script name, script file name 20-APR-2005 MGD DclTaskRunDown() proactively handle task after SS$_NONEXPR 26-FEB-2005 MGD relax configured file type check if path SETing script=command=<..> provides a full activation command, HTTPD$VERIFY can now specify a REMOTE_ADDR IP address 24-NOV-2004 MGD bugfix; (authorization) agents should not begin to read a POSTed request body (Jean-Pierre Petit, jpp@esme.fr) 18-MAY-2004 MGD provide additional WATCH data when allocating persistent DCL task (after nasty script name parse issue in .ru) 26-FEB-2004 MGD script processes SET DEFAULT before activation CGI variable SCRIPT_DEFAULT (script=default=) 14-FEB-2004 MGD set script process parse extended/traditional if path ODS set 11-JAN-2004 MGD bugfix; DclAllocateTask() CGIplus with virtual services 18-SEP-2003 MGD bugfix; suppress output after "Script-Control: x-error..." 10-SEP-2003 MGD refine MAP-PATH to return 400 response if no reverse, bugfix; MAP-FILE: stripping leading character 19-JUL-2003 MGD provide network mode detached process creation revise detached process cleanup candidate identification revise script activation code (include .CLD) bugfix; DclScriptProcessPurge() 18-JUN-2003 MGD bugfix; (potential anyway) correct increment of queued I/O counters around delivery of error ASTs 19-APR-2003 MGD bugfix; DclSysOutputAst() do not rundown script process if the error generated came from "Script-Control:", bugfix; allow for '!' from (!$blah) mapping rule 15-MAR-2003 MGD script=as=$? to indicate optional use of SYSUAF username implement authorization "scriptas" keyword directive 16-FEB-2003 MGD with RTEs look first for one that was executing the same script name and path then if not found fall back to LRU idle RTE executing same script or just to LRU RTE, make DCL command buffer space dynamic 30-JAN-2003 MGD build up 'records' from single byte output streams (ask Alex Ivanov about GhostScript output), path set carriage-control on CGIPLUSIN stream (including end of callout stream) 08-OCT-2002 MGD refine default scripting 23-SEP-2002 MGD additional persona counters, 'CliScriptAs' allows a NOBODY scripting environment without enabling PERSONA in general 15-JUN-2002 MGD bugfix; BodyRead() QueuedClientRead++ in DclHttpInputAst() 27-APR-2002 MGD use sys$setprv(), bugfix; DclFindFileEnd() reset result file name 02-FEB-2002 MGD rework HTTP$INPUT due to request body processing changes 26-JAN-2002 MGD bugfix; DclTaskRunDown() reset script task type 29-OCT-2001 MGD PERSONA_MACRO reporting 21-OCT-2001 MGD kludge work around spawning authorized privs with $CREPRC 29-SEP-2001 MGD multiple instance support (minor changes) 25-AUG-2001 MGD bugfix; always generate callout sequences 04-AUG-2001 MGD support module WATCHing 25-APR-2001 MGD watchdog on CPU time consumed by scripts, use HttpdTick() to drive DclSupervisor(), bugfix; SCRIPT_FILENAME with CGIplus 13-APR-2001 MGD change client write error behaviour for CGIplus (CGIplus script 'bit-bucket' period), changes to script run-down ($FORCEX), DCL supervisor now more granular at fifteen seconds, callout BODY: to return request body on CGIPLUSIN stream, callout CGIPLUS: to support stream variables 06-MAR-2001 MGD CONTENT-TYPE: callout maps file suffix to MIME content-type ICON-TYPE: callout maps file suffix/content-type to icon URL 05-DEC-2000 MGD DclCleanupScratch(), modify HTTPD$VERIFY to allow for strict CGI output 19-NOV-2000 MGD bugfix; for $persona_assume() on VAX (sigh!) 01-OCT-2000 MGD scripting process creation using sys$creprc(), detached and persona-based scripting 13-SEP-2000 MGD suppress callout response using leading '!' or '#', APACHE_INPUT changed to APACHE$INPUT (1.3-12) add GATEWAY-BEGIN: and GATEWAY-END: callouts, add CLIENT-READ: callout reads direct from client to script 08-AUG-2000 MGD limit script output of ENDOFFILE, 24-JUN-2000 MGD persistent run-time environments, script cache now uses mapped script file name, fixed potential problem when setting 'DclSysOutputSize', bugfix; HEAD requests specifying content-length 27-MAY-2000 MGD add BYTLM check before creating mailboxes 08-APR-2000 MGD some (VMS) Apache compatibility, if(!cfptr->cfScript.Enabled) 04-MAR-2000 MGD use FaolToNet(), et.al. 13-JAN-2000 MGD add OPCOM messages 03-JAN-2000 MGD support ODS-2 and ODS-5 using ODS module for script find 28-NOV-1999 MGD provide HTTPD$LOGIN 10-OCT-1999 MGD make SYS$COMMAND and CGIPLUSIN mailbox sizes configurable, bugfix; DclSysOutputToClientAst() 28-AUG-1999 MGD callout/agent support, support Purveyor/Cern WWW_IN: and WWW_OUT:, bugfix; sizeof(StopId)-1 12-JUN-1999 MGD change some WatchData() to WatchDataDump() 12-FEB-1999 MGD refine WATCH information 07-NOV-1998 MGD WATCH facility 17-OCT-1998 MGD script name cache, error report support 19-SEP-1998 MGD improve granularity of script search, do not search for established CGIplus scripts (this reduces CGIplus script activation time by 50%!!) 15-AUG-1998 MGD replace per-script process timers with DclSupervisor() 27-MAY-1998 MGD generate CGI variables only once for any one request 02-APR-1998 MGD see "April 1998 Note" above, report status 500/501 if script returns no output 28-MAR-1998 MGD ensure script output is null-terminated (for CGI.C) 16-DEC-1997 MGD generalized CGI processing unbundled into CGI.c module 06-DEC-1997 MGD resolving a suspected inconsistent AST delivery situation by requiring all $QIO()s with an AST routine to ensure any queueing errors, etc. are reported via the AST routine 19-OCT-1997 MGD extensible script run-time environment, HTTP_ACCEPT_CHARSET, HTTP_FORWARDED and HTTP_HOST variables, change in behaviour: CGI "Content-Type:" response bodies now only have carriage-control checked/adjusted if "text/..." 10-SEP-1997 MGD add "!'F$VERIFY(0)" to start of DCL in case verify on account 09-AUG-1997 MGD ACCEPT_LANGUAGE variable 01-AUG-1997 MGD allow supplying request header AS WELL AS body, or only body, added AUTH_REALM, AUTH_GROUP, HTTP_ACCEPT, and REQUEST_TIME_GMT/LOCAL CGI variables 01-JUN-1997 MGD persistent DCL processes, CGIplus, new for HTTPd v4.2, DCL.C completely re-designed! 26-APR-1997 MGD bugfix; serious flaw POST content handling since v4.0 to REQUEST.C, PUT.C in version 4.0 (rewrite of HTTP$INPUT) 01-FEB-1997 MGD HTTPd version 4 14-NOV-1996 MGD bugfix; no status was being returned after "DELETE/SYMBOL X" in DclSysCommandStringSymbol() 06-APR-1996 MGD miscellaneous refinements 26-MAR-1996 MGD added WWW_HTTP_AUTHENTICATION, scripts can now authenticate 01-DEC-1995 MGD HTTPd version 3 19-SEP-1995 MGD changed carriage-control on records from (the strict HTTP requirement) to single newline (, de facto standard) This will be slightly more efficient, and "more compliant"! 21-APR-1995 MGD bugfix; DclSysOutputAst() 03-APR-1995 MGD added remote user authentication and CGI symbol 20-MAR-1995 MGD bugfix; DclQioHttpInput() 20-DEC-1994 MGD initial development as a module for multi-threaded daemon */ #endif /* COMMENTS_WITH_COMMENTS */ /*****************************************************************************/ #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 #include #include #include #include /* VMS related header files */ /* cmbdef.h is not defined for VAXC 3.n */ #define CMB$M_READONLY 0x01 #define CMB$M_WRITEONLY 0x02 /* let's just make sure these are available everywhere */ #define IO$M_NORSWAIT 0x400 #define SS$_MBFULL 0x000008d8 #include #include #include #include #include #include #include #include #include #include #include #include /* application header files */ #include "wasd.h" #include "websock.h" #define WASD_MODULE "DCL" /* provides code to support vanilla-CGI use of CGIplus callouts */ #define CGIPLUS_CALLOUT_FOR_CGI 1 /* provides APACHE$INPUT: stream for VMS Apache compatibility */ #define STREAMS_FOR_APACHE 1 /* provides WWW_IN: and WWW_OUT: streams for Purveyor/Cern compatibility */ #define STREAMS_FOR_PURVEYOR_AND_CERN 1 /* in seconds */ #define DCL_SUPERVISOR_TICK_MIN 2 #define DCL_SUPERVISOR_TICK_MAX 15 /* just a sentinal used to indicate when the DCL supervisor timer expires */ #define DCL_SUPERVISOR_TICK -1 /* maximum period tryig to force an image to exit */ #define DCL_FORCE_IMAGE_EXIT_SECONDS 60 /******************/ /* global storage */ /******************/ BOOL DclUseZombies; int DclCgiHeaderSize, DclCgiPlusLifeTimePurgeCount, DclCgiPlusInSize, DclCleanupMinutesMax, DclCleanupMinutesOld, DclDetachProcessPriorityServer, DclDetachProcessPriorityUser, DclHitHardLimitCount, DclMailboxBytLmRequired, DclPersonaServicesAvailable, DclProctorEnabled, DclPurgeCount, DclPurgeScriptProcessesCount, DclPurgeScriptNameCacheCount, DclScriptDetachProcess, DclSoftLimitPurgeCount, CurrentDclScriptProcess, DclScriptProcessHardLimit, DclScriptProcessSoftLimit, DclSysCommandSize, DclSysOutputSize, DclZombieLifeTimePurgeCount; char *DclHttpdScratch; /* two longwords so it can be used by sys$grantid() */ unsigned long ProcessRightsIdent [2]; LIST_HEAD DclTaskList; LIST_HEAD DclScriptNameCacheList; #define DEFAULT_CGI_VARIABLE_PREFIX "WWW_" char DclCgiVariablePrefix [32] = DEFAULT_CGI_VARIABLE_PREFIX; int DclCgiVariablePrefixLength = sizeof(DEFAULT_CGI_VARIABLE_PREFIX)-1; /********************/ /* external storage */ /********************/ #ifdef DBUG extern BOOL Debug; #else #define Debug 0 #endif extern BOOL CliDemo, ControlExitRequested, ControlRestartRequested, HttpdNetworkMode, OdsExtended, OperateWithSysPrv, ProtocolHttpsAvailable, PersonaMacro; extern int CliPersonaEnabled, EfnWait, EfnNoWait, HttpdTickSecond, InstanceEnvNumber, InstanceNumber, NetAcceptBytLmRequired, NetConcurrentProcessMax, NetListenBytLmRequired, NetReadBufferSize, OpcomMessages, OutputBufferSize, ProcessPriority, ServerPort, WebSockCurrent; extern int ToLowerCase[], ToUpperCase[]; extern unsigned long CrePrcMask[], DetachMask[], GrantIdMask[], HttpdBinTime[], MailboxMask[], SysPrvMask[], WorldMask[]; extern char CliScriptAs[], ErrorSanityCheck[], HttpProtocol[], HttpdScriptAsUserName[], ProcessIdentName[], ServerHostPort[], SoftwareID[]; extern LIST_HEAD PersonaCacheList; extern int PersonaCacheCount, PersonaCacheEntries; extern ACCOUNTING_STRUCT *AccountingPtr; extern CONFIG_STRUCT Config; extern HTTPD_PROCESS HttpdProcess; extern MSG_STRUCT Msgs; extern LIST_HEAD RequestList; extern LIST_HEAD WebSockList; extern WATCH_STRUCT Watch; /*****************************************************************************/ /* Set and ensure limits are reasonable at server startup. */ DclInit () { int status, SetPrvStatus; char *cptr; /*********/ /* begin */ /*********/ if (WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclInit()"); DclHttpdScratch = v10orPrev10(DCL_HTTPD_SCRATCH,-1); /* command line overrides configuration, default fallbacks */ if (!DclSysCommandSize) DclSysCommandSize = Config.cfBuffer.SizeDclCommand; if (!DclSysCommandSize) DclSysCommandSize = DEFAULT_DCL_SYSCOMMAND_SIZE; if (!DclSysOutputSize) DclSysOutputSize = Config.cfBuffer.SizeDclOutput; /* if not specified then make it the same as the network buffer */ if (!DclSysOutputSize) DclSysOutputSize = OutputBufferSize; if (!DclSysOutputSize) DclSysOutputSize = DEFAULT_DCL_SYSOUTPUT_SIZE; if (Config.cfBuffer.SizeNetMTU) { /* MTU has been specified, adjust to an even number of MTUs */ DclSysOutputSize /= Config.cfBuffer.SizeNetMTU; DclSysOutputSize++; DclSysOutputSize *= Config.cfBuffer.SizeNetMTU; /* Chunked output is so common for script output allow for the overhead. The trade-off is losing 8 bytes from non-chunked MTU. */ if (DclSysOutputSize > 8) DclSysOutputSize -= 8; } /* let's not get too silly */ if (DclSysOutputSize < 1024) DclSysOutputSize = DEFAULT_DCL_SYSOUTPUT_SIZE; if (!DclCgiHeaderSize) DclCgiHeaderSize = Config.cfBuffer.SizeDclCgiHeader; if (!DclCgiHeaderSize) DclCgiHeaderSize = DEFAULT_DCL_CGI_HEADER_SIZE; if (!DclCgiPlusInSize) DclCgiPlusInSize = Config.cfBuffer.SizeDclCgiPlusIn; if (!DclCgiPlusInSize) DclCgiPlusInSize = DEFAULT_DCL_CGIPLUSIN_SIZE; /* HTTP$INPUT size is determined by network read buffer size! */ DclScriptProcessSoftLimit = Config.cfScript.ScriptProcessSoftLimit; DclScriptProcessHardLimit = Config.cfScript.ScriptProcessHardLimit; if (DclScriptProcessHardLimit < 20) DclScriptProcessHardLimit = 20; if (DclScriptProcessHardLimit > NetConcurrentProcessMax) DclScriptProcessHardLimit = NetConcurrentProcessMax; /* soft limit should be no less than 75% of hard limit */ if (DclScriptProcessSoftLimit < DclScriptProcessHardLimit / 2 + DclScriptProcessHardLimit / 4) DclScriptProcessSoftLimit = DclScriptProcessHardLimit / 2 + DclScriptProcessHardLimit / 4; DclCleanupMinutesMax = Config.cfScript.CleanupScratchMinutesMax; DclCleanupMinutesOld = Config.cfScript.CleanupScratchMinutesOld; if (DclCleanupMinutesOld < DclCleanupMinutesMax) DclCleanupMinutesOld = DclCleanupMinutesMax; if (Config.cfScript.ZombieLifeTime) DclUseZombies = true; if (CliDemo) DclScriptDetachProcess = false; else if (strsame (CliScriptAs, "SUBPROCESS", -1)) DclScriptDetachProcess = false; else if (HttpdScriptAsUserName[0]) DclScriptDetachProcess = true; else if (CliPersonaEnabled) DclScriptDetachProcess = true; else DclScriptDetachProcess = Config.cfScript.DetachProcess; if (DclScriptDetachProcess) { FaoToStdout ("%HTTPD-I-DCL, detached process scripting\n"); DclCleanupScriptProcesses (); DclPersonaServicesAvailable = CliPersonaEnabled; FaoToStdout ("%HTTPD-I-DCL, persona !&?\rnot \renabled at command line\n", DclPersonaServicesAvailable); if (DclPersonaServicesAvailable || HttpdScriptAsUserName[0]) { status = PersonaInit (); if (VMSnok (status)) { FaoToStdout ("%HTTPD-F-DCL, persona not available\n-!&M\n", status); exit (status); } } if (Config.cfScript.DetachProcessPriority[0]) { /* get at most two integers from this parameter */ cptr = Config.cfScript.DetachProcessPriority; while (*cptr && !isdigit(*cptr)) cptr++; if (isdigit(*cptr)) { DclDetachProcessPriorityServer = atoi(cptr); while (*cptr && isdigit(*cptr)) cptr++; } while (*cptr && !isdigit(*cptr)) cptr++; if (isdigit(*cptr)) DclDetachProcessPriorityUser = atoi(cptr); /* can't set user script priorities above those of the server! */ if (DclDetachProcessPriorityUser > DclDetachProcessPriorityServer) DclDetachProcessPriorityUser = DclDetachProcessPriorityServer; } } else FaoToStdout ("%HTTPD-I-DCL, subprocess scripting\n"); if (DclProctorEnabled) SysDclAst (&DclScriptProctor, NULL); DclCountScriptProcess (); } /*****************************************************************************/ /* This function does not return a status value. If an error occurs the 'NextTaskFunction()' is executed. The calling routine may assume that this module will always execute the 'NextTaskFunction()' at some stage. No need to look for an established CGIplus script, we know it's there otherwise it never would have been allocated. For new CGIplus scripts, as well as for standard CGI scripts, first find the script file (as well as confirming it does exist!) Already established CGIplus scripts and DCL commands can begin I/O with the script process immediately. */ DclBegin ( REQUEST_STRUCT *rqptr, REQUEST_AST NextTaskFunction, char *DclCommand, char *ScriptName, char *CgiScriptFileName, char *CgiPlusScriptFileName, char *ScriptRunTime, REQUEST_AST CalloutFunction, PROCTOR_STRUCT *ProctorPtr ) { BOOL MappedScriptAs; int len, status, BasePriority, TaskType; char *ScriptAsPtr; DCL_TASK *tkptr; /*********/ /* begin */ /*********/ if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL)) { WatchThis (rqptr, FI_LI, WATCH_MOD_DCL, "DclBegin()"); WatchDataFormatted ( "DclCommand !&Z\n\ ScriptName !&Z\n\ CgiScriptFileName !&Z\n\ CgiPlusScriptFileName !&Z\n\ ScriptRunTime !&Z\n\ CalloutFunction !&A\n\ Md5HashPath: !16&H\n", DclCommand, ScriptName, CgiScriptFileName, CgiPlusScriptFileName, ScriptRunTime, CalloutFunction, &rqptr->Md5HashPath); } if (!ProtocolHttpsAvailable) { /* WebSockets require SHA-1 hash supplied by OpenSSL */ if (WEBSOCKET_REQUEST(rqptr)) { rqptr->rqResponse.HttpStatus = 502; ErrorGeneral (rqptr, MsgFor(rqptr,MSG_REQUEST_FORMAT), FI_LI); ErrorNoticed (rqptr, 0, "WebSocket requires SSL", FI_LI); SysDclAst (NextTaskFunction, rqptr); return; } } if (ERROR_REPORTED (rqptr)) { /* previous error, cause threaded processing to unravel */ SysDclAst (NextTaskFunction, rqptr); return; } if (!Config.cfScript.Enabled) { rqptr->rqResponse.HttpStatus = 403; ErrorGeneral (rqptr, MsgFor(rqptr,MSG_GENERAL_DISABLED), FI_LI); SysDclAst (NextTaskFunction, rqptr); return; } BasePriority = ProcessPriority - DclDetachProcessPriorityServer; if (DclScriptDetachProcess) { if (HttpdScriptAsUserName[0]) ScriptAsPtr = HttpdScriptAsUserName; else ScriptAsPtr = HttpdProcess.UserName; } else ScriptAsPtr = ""; MappedScriptAs = false; if ((void*)CalloutFunction == (void*)&AuthAgentCallout) { /* authorization agent task, ensure it runs under a suitable account */ if (rqptr->rqPathSet.ScriptAgentAsPtr) { ScriptAsPtr = rqptr->rqPathSet.ScriptAgentAsPtr; MappedScriptAs = true; } if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (rqptr, FI_LI, WATCH_DCL, "AGENT as !AZ", ScriptAsPtr); } else if (rqptr->rqAuth.VmsUserScriptAs) { /* authorization rule has precedence over mapping rule */ if (rqptr->RemoteUser[0] && rqptr->rqAuth.SysUafAuthenticated) { ScriptAsPtr = rqptr->RemoteUser; BasePriority = ProcessPriority - DclDetachProcessPriorityUser; MappedScriptAs = true; } else { rqptr->rqResponse.HttpStatus = 403; ErrorGeneral (rqptr, MsgFor(rqptr,MSG_AUTH_REQUIRED), FI_LI); SysDclAst (NextTaskFunction, rqptr); return; } } else if (rqptr->rqPathSet.ScriptAsPtr) { if (rqptr->rqPathSet.ScriptAsPtr[0] == '~') { /* from a user rule mapping */ ScriptAsPtr = rqptr->rqPathSet.ScriptAsPtr+1; BasePriority = ProcessPriority - DclDetachProcessPriorityUser; MappedScriptAs = true; } else if (SAME2(rqptr->rqPathSet.ScriptAsPtr,'$?')) { /* optionally use SYSUAF authenticated username */ if (rqptr->RemoteUser[0] && rqptr->rqAuth.SysUafAuthenticated) { ScriptAsPtr = rqptr->RemoteUser; BasePriority = ProcessPriority - DclDetachProcessPriorityUser; MappedScriptAs = true; } } else if (rqptr->rqPathSet.ScriptAsPtr[0] == '$') { /* must use a SYSUAF authenticated username */ if (rqptr->RemoteUser[0] && rqptr->rqAuth.SysUafAuthenticated) { ScriptAsPtr = rqptr->RemoteUser; BasePriority = ProcessPriority - DclDetachProcessPriorityUser; MappedScriptAs = true; } else { rqptr->rqResponse.HttpStatus = 403; ErrorGeneral (rqptr, MsgFor(rqptr,MSG_AUTH_REQUIRED), FI_LI); SysDclAst (NextTaskFunction, rqptr); return; } } else { /* an explicitly specified username */ ScriptAsPtr = rqptr->rqPathSet.ScriptAsPtr; MappedScriptAs = true; } } if (BasePriority < 0) BasePriority = 0; if (ScriptRunTime && ScriptRunTime[0] && ScriptRunTime[0] != '!') TaskType = DCL_TASK_TYPE_RTE_SCRIPT; else if (CgiPlusScriptFileName && CgiPlusScriptFileName[0]) TaskType = DCL_TASK_TYPE_CGIPLUS_SCRIPT; else if (CgiScriptFileName && CgiScriptFileName[0]) TaskType = DCL_TASK_TYPE_CGI_SCRIPT; else if (DclCommand && DclCommand[0]) TaskType = DCL_TASK_TYPE_CLI; else ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI); if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_RESPONSE)) { switch (TaskType) { case DCL_TASK_TYPE_CGI_SCRIPT : WatchThis (rqptr, FI_LI, WATCH_RESPONSE, "SCRIPT!&@ CGI !AZ !AZ (!AZ)", ScriptAsPtr[0] ? " as !AZ" : "!+", ScriptAsPtr, ScriptName, CgiScriptFileName, ScriptRunTime ? ScriptRunTime+1 : ""); break; case DCL_TASK_TYPE_CGIPLUS_SCRIPT : WatchThis (rqptr, FI_LI, WATCH_RESPONSE, "SCRIPT!&@ CGIplus !AZ !AZ (!AZ)", ScriptAsPtr[0] ? " as !AZ" : "!+", ScriptAsPtr, ScriptName, CgiPlusScriptFileName, ScriptRunTime ? ScriptRunTime+1 : ""); break; case DCL_TASK_TYPE_RTE_SCRIPT : WatchThis (rqptr, FI_LI, WATCH_RESPONSE, "SCRIPT!&@ RTE !AZ !AZ (!AZ)", ScriptAsPtr[0] ? " as !AZ" : "!+", ScriptAsPtr, ScriptName, CgiScriptFileName, ScriptRunTime); break; case DCL_TASK_TYPE_CLI : WatchThis (rqptr, FI_LI, WATCH_RESPONSE, "CLI!&@ !AZ", ScriptAsPtr[0] ? " as !AZ" : "!+", ScriptAsPtr, DclCommand); break; default : ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI); } } if (MappedScriptAs && !DclPersonaServicesAvailable && /* these latter two allow Server Admin process reports */ ScriptAsPtr != HttpdScriptAsUserName && ScriptAsPtr != HttpdProcess.UserName) { rqptr->rqResponse.HttpStatus = 403; ErrorGeneral (rqptr, MsgFor(rqptr,MSG_GENERAL_DISABLED), FI_LI); SysDclAst (NextTaskFunction, rqptr); return; } status = DclAllocateTask (rqptr, TaskType, ScriptAsPtr, BasePriority, ScriptName, CgiPlusScriptFileName, ScriptRunTime); if (VMSnok (status)) { SysDclAst (NextTaskFunction, rqptr); return; } /* get a local pointer to the newly allocated DCL task structure */ tkptr = rqptr->DclTaskPtr; tkptr->NextTaskFunction = NextTaskFunction; PUT_QUAD_QUAD (rqptr->rqTime.Vms64bit, tkptr->LastUsedBinaryTime); tkptr->LastUsedSecond = HttpdTickSecond; tkptr->ProctorPtr = ProctorPtr; tkptr->WatchItem = rqptr->WatchItem; if (ProctorPtr) { /* must be stable for this many timer ticks (or reset by real request) */ tkptr->ProctorProcess = 5; /* add PRN seconds so group of unused proctored expiries don't cluster */ if (DclUseZombies && (Config.cfScript.ZombieLifeTime || (rqptr->rqPathSet.ScriptLifeTime && rqptr->rqPathSet.ScriptLifeTime != -1))) tkptr->LifeTimeSecond += tkptr->ScriptProcessPid % 15 * 5; } if (!ISAGENT(tkptr) && WEBSOCKET_REQUEST(rqptr)) InstanceGblSecIncrLong (&AccountingPtr->DclWebSocketCount); switch (tkptr->TaskType) { case DCL_TASK_TYPE_CGI_SCRIPT : if (CalloutFunction) tkptr->CalloutFunction = CalloutFunction; else tkptr->CalloutFunction = &DclCalloutDefault; strcpy (tkptr->ScriptName, ScriptName); strcpy (tkptr->ScriptFileName, CgiScriptFileName); if (ScriptRunTime) { strcpy (tkptr->ScriptRunTime, ScriptRunTime); tkptr->ScriptRunTimePtr = tkptr->ScriptRunTime; } /* reset CGI output processing */ CgiOutput (rqptr, NULL, 0); if (!rqptr->AccountingDone++) InstanceGblSecIncrLong (&AccountingPtr->DoScriptCount); break; case DCL_TASK_TYPE_CGIPLUS_SCRIPT : if (CalloutFunction) tkptr->CalloutFunction = CalloutFunction; else tkptr->CalloutFunction = &DclCalloutDefault; /* reset CGI output processing */ CgiOutput (rqptr, NULL, 0); if (!tkptr->ScriptName[0]) { /* no need to reset these for established CGIplus scripts! */ strcpy (tkptr->ScriptName, ScriptName); strcpy (tkptr->ScriptFileName, CgiPlusScriptFileName); if (ScriptRunTime) { strcpy (tkptr->ScriptRunTime, ScriptRunTime); tkptr->ScriptRunTimePtr = tkptr->ScriptRunTime; } } if (!rqptr->AccountingDone++) { InstanceGblSecIncrLong (&AccountingPtr->DoCgiPlusScriptCount); if (tkptr->CgiPlusUsageCount > 1) InstanceGblSecIncrLong (&AccountingPtr->DclCgiPlusReusedCount); } break; case DCL_TASK_TYPE_RTE_SCRIPT : if (CalloutFunction) tkptr->CalloutFunction = CalloutFunction; else tkptr->CalloutFunction = &DclCalloutDefault; /* reset CGI output processing */ CgiOutput (rqptr, NULL, 0); strcpy (tkptr->ScriptName, ScriptName); strcpy (tkptr->ScriptFileName, CgiScriptFileName); /* RTEs must have a run-time otherwise they're not RTEs */ strcpy (tkptr->ScriptRunTime, ScriptRunTime); tkptr->ScriptRunTimePtr = tkptr->ScriptRunTime; memcpy (&tkptr->Md5HashPath, &rqptr->Md5HashPath, sizeof(tkptr->Md5HashPath)); if (!rqptr->AccountingDone++) { InstanceGblSecIncrLong (&AccountingPtr->DoRteScriptCount); if (tkptr->CgiPlusUsageCount > 1) InstanceGblSecIncrLong (&AccountingPtr->DclRteReusedCount); } break; case DCL_TASK_TYPE_CLI : tkptr->CalloutFunction = NULL; len = strzcpy (tkptr->DclCommandPtr, DclCommand, tkptr->DclCommandSize); if (len > tkptr->DclCommandSize) { len = tkptr->DclCommandLength = strlen(DclCommand); len = ((len / DCL_COMMAND_MIN_SIZE) + 1) * DCL_COMMAND_MIN_SIZE; if (len > DCL_COMMAND_MAX_SIZE) { tkptr->DclCommandLength = 0; rqptr->rqResponse.HttpStatus = 500; ErrorGeneralOverflow (rqptr, FI_LI); SysDclAst (NextTaskFunction, rqptr); return; } VmFree (tkptr->DclCommandPtr, FI_LI); tkptr->DclCommandPtr = VmGet (len); tkptr->DclCommandSize = len; strcpy (tkptr->DclCommandPtr, DclCommand); } /* reset CGI output processing */ CgiOutput (rqptr, NULL, 0); /* As CLI commands are always used during some other request processing count them independent of any other AccountingPtr-> */ InstanceGblSecIncrLong (&AccountingPtr->DoDclCommandCount); break; default : ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI); } if (tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT && (rqptr->rqPathSet.ScriptNoFind || tkptr->NextTaskFunction == &DclScriptProctorAst)) { /* the RTE will handle all script locating, error reporting, etc. */ rqptr->rqCgi.ScriptFileNamePtr = tkptr->ScriptFileName; strcpy (tkptr->SearchOds.ResFileName, tkptr->ScriptFileName); } else if (tkptr->TaskType != DCL_TASK_TYPE_CLI) { /* look for a script file */ if (tkptr->SearchOds.ResFileName[0]) { rqptr->rqCgi.ScriptFileNamePtr = tkptr->ScriptFileName; strcpy (tkptr->SearchOds.ResFileName, tkptr->ScriptFileName); } else { if (DclUseZombies) DclSearchScriptNameCache (tkptr, rqptr); /* if not found in the name cache then look in the file system! */ if (!(tkptr->SearchOds.ResFileName[0] && tkptr->ScriptRunTimePtr)) { /* script is being requested, first look for the script file */ tkptr->FindScriptState = DCL_FIND_SCRIPT_BEGIN; DclFindScript (tkptr); return; } } } /* must be an established CGIplus script or DCL command (from SSI module) */ DclBeginScript (tkptr); } /*****************************************************************************/ /* Allocate a DCL task structure to the request. All task structures are linked together in a single list, function and state indicated by the various flags and counters associated with each. If a CGIplus task script is to be executed then check for an already established, idle CGIplus task structure executing that particular script. If none found, or CGIplus script not required, and zombies in use (persistent-script processes) then look through the list for an idle zombie script process. If no zombie available (or not enabled) then check if we have reached the script process creation hard-limit. If not reached look through the list for an existing but no-script process-executing DCL task structure. If none found create an additional DCL task structure and add it to the list. Initialize the task structure (no matter from which scan it originated) and if necessary create a script process for it. (An obvious improvement to processing would be to have multiple lists, but that will have to wait for another time :^) If an error is encountered an error message is generated and the error status returned. It is up to the calling routine to abort the processing. */ int DclAllocateTask ( REQUEST_STRUCT *rqptr, int TaskType, char *ScriptAsPtr, int BasePriority, char *ScriptName, char *CgiPlusScriptFileName, char *ScriptRunTime ) { BOOL WatchThisOne; int status, CgiPlusScriptFileNameLength; int LruSecond [2]; char *cptr; DCL_TASK *tkptr; DCL_TASK *lrutkptr [2]; LIST_ENTRY *leptr; /*********/ /* begin */ /*********/ if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (rqptr, FI_LI, WATCH_MOD_DCL, "DclAllocateTask() !UL !&Z !&Z !&Z !&Z", TaskType, ScriptName, CgiPlusScriptFileName, ScriptRunTime, ScriptAsPtr); tkptr = NULL; if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThisOne = true; else WatchThisOne = false; /* request scheme is not present when proctoring scripting processes */ if (rqptr->ServicePtr->RequestScheme) { if (TaskType == DCL_TASK_TYPE_CGIPLUS_SCRIPT) { /******************************************************/ /* look for an unused instance of this CGIplus script */ /******************************************************/ for (cptr = CgiPlusScriptFileName; *cptr; cptr++); CgiPlusScriptFileNameLength = cptr - CgiPlusScriptFileName; /* does it have a trailing file type? */ while (cptr > CgiPlusScriptFileName && *cptr != ']' && *cptr != '.') cptr--; if (*cptr == ']') cptr = "."; else cptr = ""; for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr) { tkptr = (DCL_TASK*)leptr; if (tkptr->TaskType != TaskType) { tkptr = NULL; continue; } if (WatchThisOne) { if (strsame (ScriptName, tkptr->ScriptName, -1) && !strsame (CgiPlusScriptFileName, tkptr->ScriptFileName, CgiPlusScriptFileNameLength)) WatchThis (rqptr, FI_LI, WATCH_DCL, "DEVICE-LOGICAL-NAME-ISSUE? !AZ !AZ", CgiPlusScriptFileName, tkptr->ScriptFileName); } if (!tkptr->ScriptProcessPid || tkptr->QueuedSysCommand > tkptr->QueuedSysCommandAllowed || tkptr->QueuedSysOutput || tkptr->QueuedCgiPlusIn || tkptr->QueuedHttpInput || tkptr->QueuedClientRead || tkptr->RequestPtr || tkptr->FindScript || tkptr->DeleteProcess || !strsame (ScriptName, tkptr->ScriptName, -1) || !strsame (CgiPlusScriptFileName, tkptr->ScriptFileName, CgiPlusScriptFileNameLength) || tkptr->ScriptFileName[CgiPlusScriptFileNameLength] != *cptr || (DclScriptDetachProcess && !strsame (ScriptAsPtr, tkptr->CrePrcUserName, -1))) { tkptr = NULL; continue; } break; } if (tkptr && WatchThisOne) WatchThis (rqptr, FI_LI, WATCH_DCL, "CGIPLUS idle pid:!8XL!&@", tkptr->ScriptProcessPid, tkptr->CrePrcUserName[0] ? " of !AZ" : "!+", tkptr->CrePrcUserName); } if (TaskType == DCL_TASK_TYPE_RTE_SCRIPT) { /************************************************/ /* look for an unused instance of this run-time */ /************************************************/ /* initialize least-recently-used storage */ lrutkptr[0] = lrutkptr[1] = NULL; LruSecond[0] = LruSecond[1] = 0; for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr) { tkptr = (DCL_TASK*)leptr; if (!tkptr->ScriptProcessPid || tkptr->TaskType != TaskType || tkptr->QueuedSysCommand > tkptr->QueuedSysCommandAllowed || tkptr->QueuedSysOutput || tkptr->QueuedCgiPlusIn || tkptr->QueuedHttpInput || tkptr->QueuedClientRead || tkptr->RequestPtr || tkptr->FindScript || tkptr->DeleteProcess || !strsame (ScriptRunTime, tkptr->ScriptRunTime, -1) || (DclScriptDetachProcess && !strsame (ScriptAsPtr, tkptr->CrePrcUserName, -1))) { tkptr = NULL; continue; } if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (rqptr, FI_LI, WATCH_MOD_DCL, "RTE !&Z !&Z !&B !16&H !16&H !&B !SL !SL !&B !SL !&B !&X !&X !&X", ScriptName, tkptr->ScriptName, strsame (ScriptName, tkptr->ScriptName, -1), &tkptr->Md5HashPath, &rqptr->Md5HashPath, !MATCH0 (&tkptr->Md5HashPath, &rqptr->Md5HashPath, sizeof(rqptr->Md5HashPath)), tkptr->LastUsedSecond, LruSecond[0], tkptr->LastUsedSecond < LruSecond[0], tkptr->LastUsedSecond, LruSecond[1], tkptr->LastUsedSecond < LruSecond[1], tkptr, lrutkptr[0], lrutkptr[1] /* whew! */); if (!strsame (ScriptName, tkptr->ScriptName, -1)) { /* not the same script being executed by the RTE */ if (tkptr->LastUsedSecond < LruSecond[0] || !LruSecond[0]) { LruSecond[0] = tkptr->LastUsedSecond; lrutkptr[0] = tkptr; } tkptr = NULL; continue; } if (!MATCH0 (&tkptr->Md5HashPath, &rqptr->Md5HashPath, sizeof(rqptr->Md5HashPath))) { /* not the same path being supplied to the script */ if (tkptr->LastUsedSecond < LruSecond[1] || !LruSecond[1]) { LruSecond[1] = tkptr->LastUsedSecond; lrutkptr[1] = tkptr; } tkptr = NULL; continue; } break; } if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (rqptr, FI_LI, WATCH_MOD_DCL, "!&X !SL !&X !SL !&X", tkptr, LruSecond[0], lrutkptr[0], LruSecond[1], lrutkptr[1]); if (!tkptr) { /* none was found having the same script and path */ if (lrutkptr[1]) /* use the one with the same script in preference to ... */ tkptr = lrutkptr[1]; else if (lrutkptr[0]) /* the one just executing the same RTE */ tkptr = lrutkptr[0]; } if (tkptr) { if (WatchThisOne) WatchThis (rqptr, FI_LI, WATCH_DCL, "RTE idle pid:!8XL!&@(!AZ)", tkptr->ScriptProcessPid, tkptr->CrePrcUserName[0] ? " of !AZ " : "!+", tkptr->CrePrcUserName, tkptr->ScriptName); /* ensure the previous script information is not carried over */ tkptr->ScriptName[0] = tkptr->ScriptFileName[0] = tkptr->SearchOds.ResFileName[0] = '\0'; memset (&tkptr->Md5HashPath, 0, sizeof(tkptr->Md5HashPath)); } } if (!tkptr && DclUseZombies) { /************************/ /* look for idle zombie */ /************************/ for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr) { tkptr = (DCL_TASK*)leptr; if (!tkptr->ScriptProcessPid || tkptr->TaskType == DCL_TASK_TYPE_CGIPLUS_SCRIPT || tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT || tkptr->QueuedSysCommand || tkptr->QueuedSysOutput || tkptr->QueuedCgiPlusIn || tkptr->QueuedHttpInput || tkptr->QueuedClientRead || tkptr->FindScript || tkptr->DeleteProcess || tkptr->RequestPtr || (DclScriptDetachProcess && !strsame (ScriptAsPtr, tkptr->CrePrcUserName, -1))) { tkptr = NULL; continue; } tkptr->BuildRecords = tkptr->CgiPlusVarStruct = false; tkptr->DclCommandLength = tkptr->CgiPlusUsageCount = tkptr->LifeTimeSecond = tkptr->SysOutputBuildCount = 0; tkptr->DclCommandPtr[0] = tkptr->ScriptRunTime[0] = tkptr->ScriptName[0] = tkptr->ScriptFileName[0] = tkptr->SearchOds.ResFileName[0] = '\0'; tkptr->ScriptRunTimePtr = NULL; memset (&tkptr->Md5HashPath, 0, sizeof(tkptr->Md5HashPath)); break; } if (tkptr && WatchThisOne) WatchThis (rqptr, FI_LI, WATCH_DCL, "ZOMBIE idle pid:!8XL!&@", tkptr->ScriptProcessPid, tkptr->CrePrcUserName[0] ? " of !AZ" : "!+", tkptr->CrePrcUserName); } } if (!tkptr && CurrentDclScriptProcess >= DclScriptProcessHardLimit) { if (WatchThisOne) WatchThis (rqptr, FI_LI, WATCH_DCL, "SCRIPT-PROCESS hard-limit !UL", CurrentDclScriptProcess); /* let's see if we can do something about it! */ DclScriptProcessPurge (); DclHitHardLimitCount++; InstanceGblSecIncrLong (&AccountingPtr->DclHitHardLimitCount); rqptr->rqResponse.HttpStatus = 503; ErrorGeneral (rqptr, MsgFor(rqptr,MSG_SCRIPT_HARD_LIMIT), FI_LI); return (STS$K_ERROR); } if (!tkptr) { /********************************/ /* look for free task structure */ /********************************/ for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr) { tkptr = (DCL_TASK*)leptr; if (tkptr->ScriptProcessPid || tkptr->QueuedSysCommand || tkptr->QueuedSysOutput || tkptr->QueuedCgiPlusIn || tkptr->QueuedHttpInput || tkptr->QueuedClientRead || tkptr->FindScript || tkptr->DeleteProcess || tkptr->RequestPtr) { tkptr = NULL; continue; } tkptr->BuildRecords = tkptr->CgiPlusVarStruct = false; tkptr->DclCommandLength = tkptr->CgiPlusUsageCount = tkptr->LifeTimeSecond = tkptr->SysOutputBuildCount = 0; tkptr->CrePrcUserName[0] = tkptr->DclCommandPtr[0] = tkptr->ScriptRunTime[0] = tkptr->ScriptName[0] = tkptr->ScriptFileName[0] = tkptr->SearchOds.ResFileName[0] = '\0'; tkptr->ScriptRunTimePtr = NULL; memset (&tkptr->Md5HashPath, 0, sizeof(tkptr->Md5HashPath)); break; } } if (!tkptr) { /* if we're getting short of script processes then start purging */ if (CurrentDclScriptProcess >= DclScriptProcessSoftLimit) { if (WatchThisOne) WatchThis (rqptr, FI_LI, WATCH_DCL, "SCRIPT-PROCESS soft-limit purge !UL", CurrentDclScriptProcess); DclScriptProcessPurge (); } } if (!tkptr) { /*********************/ /* create a new task */ /*********************/ tkptr = VmGet (sizeof(DCL_TASK)); /* allocate an ambit minimum size DCL command buffer */ tkptr->DclCommandPtr = VmGet (DCL_COMMAND_MIN_SIZE); tkptr->DclCommandSize = DCL_COMMAND_MIN_SIZE; tkptr->DclCommandLength = 0; /* Allocate memory in the DCL task for SYS$OUTPUT buffer. Allow two bytes for carriage control and terminating null. */ tkptr->SysOutputPtr = VmGet (DclSysOutputSize+3); tkptr->SysOutputSize = DclSysOutputSize; if (VMSnok (status = DclCreateMailboxes (tkptr))) { VmFree (tkptr->SysOutputPtr, FI_LI); VmFree (tkptr, FI_LI); rqptr->rqResponse.ErrorTextPtr = MsgFor(rqptr,MSG_SCRIPT_IPC); ErrorVmsStatus (rqptr, status, FI_LI); return (status); } ListAddTail (&DclTaskList, tkptr); } /*******************/ /* initialize task */ /*******************/ /* associate the DCL task and the request */ rqptr->DclTaskPtr = tkptr; tkptr->RequestPtr = rqptr; tkptr->TaskType = TaskType; tkptr->TotalUsageCount++; tkptr->ForceImageExit = true; tkptr->DeleteProcess = tkptr->TaskRunDown = tkptr->WatchNonCgiCompliant = false; tkptr->ClientWriteErrorCount = tkptr->ForceImageExitSecond = tkptr->ProctorProcess = tkptr->ScriptCpuTimMax = tkptr->SysOutputEndOfFileCount = 0; tkptr->ProctorPtr = NULL; if (rqptr->rqPathSet.ScriptBitBucketTimeout) tkptr->BitBucketTimeout = rqptr->rqPathSet.ScriptBitBucketTimeout; else tkptr->BitBucketTimeout = Config.cfScript.BitBucketTimeout; tkptr->ScriptCpuMax = rqptr->rqPathSet.ScriptCpuMax; memset (&tkptr->Md5HashPath, 0, sizeof(tkptr->Md5HashPath)); switch (TaskType) { case DCL_TASK_TYPE_CGI_SCRIPT : rqptr->rqCgi.IsCliDcl = tkptr->BuildRecords = tkptr->CgiPlusVarStruct = tkptr->ScriptProcessActivated = tkptr->ScriptProcessResponded = false; tkptr->CgiPlusUsageCount = tkptr->CgiBelLength = tkptr->CgiEofLength = tkptr->CgiEotLength = tkptr->CgiEscLength = tkptr->LifeTimeSecond = tkptr->SysOutputBuildCount = 0; tkptr->CgiBel[0] = tkptr->CgiEof[0] = tkptr->CgiEot[0] = tkptr->CgiEsc[0] = '\0'; /* limited life in the twilight zone */ if (DclUseZombies && (Config.cfScript.ZombieLifeTime || (rqptr->rqPathSet.ScriptLifeTime && rqptr->rqPathSet.ScriptLifeTime != -1))) { DclSupervisor (0); if (rqptr->rqPathSet.ScriptLifeTime) tkptr->LifeTimeSecond = HttpdTickSecond + rqptr->rqPathSet.ScriptLifeTime; else tkptr->LifeTimeSecond = HttpdTickSecond + Config.cfScript.ZombieLifeTime; } /* always generate new strings for standard CGI scripts */ CgiSequenceBel (tkptr->CgiBel, &tkptr->CgiBelLength); CgiSequenceEof (tkptr->CgiEof, &tkptr->CgiEofLength); CgiSequenceEot (tkptr->CgiEot, &tkptr->CgiEotLength); CgiSequenceEsc (tkptr->CgiEsc, &tkptr->CgiEscLength); /* note: CgiBel is for DCL module internal use only */ strcpy (rqptr->rqCgi.EofStr, tkptr->CgiEof); rqptr->rqCgi.EofLength = tkptr->CgiEofLength; strcpy (rqptr->rqCgi.EotStr, tkptr->CgiEot); rqptr->rqCgi.EotLength = tkptr->CgiEotLength; strcpy (rqptr->rqCgi.EscStr, tkptr->CgiEsc); rqptr->rqCgi.EscLength = tkptr->CgiEscLength; break; case DCL_TASK_TYPE_CGIPLUS_SCRIPT : case DCL_TASK_TYPE_RTE_SCRIPT : rqptr->rqCgi.IsCliDcl = tkptr->ScriptProcessActivated = tkptr->ScriptProcessResponded = false; tkptr->CgiPlusUsageCount++; tkptr->ZombieCount = 0; /* give it three-score years and ten if life-time is specified */ if (Config.cfScript.CgiPlusLifeTime || (rqptr->rqPathSet.ScriptLifeTime && rqptr->rqPathSet.ScriptLifeTime != -1)) { /* if set do-not-disturb carries across CGIplus requests */ if (tkptr->LifeTimeSecond != DCL_DO_NOT_DISTURB) { DclSupervisor (0); if (rqptr->rqPathSet.ScriptLifeTime) tkptr->LifeTimeSecond = HttpdTickSecond + rqptr->rqPathSet.ScriptLifeTime; else tkptr->LifeTimeSecond = HttpdTickSecond + Config.cfScript.CgiPlusLifeTime; } } else if (tkptr->LifeTimeSecond != DCL_DO_NOT_DISTURB) { DclSupervisor (0); tkptr->LifeTimeSecond = HttpdTickSecond + DCL_CGIPLUS_LIFETIME; } /* CGIplus MUST retain original EOF/EOT/ESC until process dies */ if (!tkptr->CgiBelLength) CgiSequenceBel (tkptr->CgiBel, &tkptr->CgiBelLength); if (!tkptr->CgiEofLength) CgiSequenceEof (tkptr->CgiEof, &tkptr->CgiEofLength); if (!tkptr->CgiEotLength) CgiSequenceEot (tkptr->CgiEot, &tkptr->CgiEotLength); if (!tkptr->CgiEscLength) CgiSequenceEsc (tkptr->CgiEsc, &tkptr->CgiEscLength); /* note: CgiBel is for DCL module internal use only */ strcpy (rqptr->rqCgi.EofStr, tkptr->CgiEof); rqptr->rqCgi.EofLength = tkptr->CgiEofLength; strcpy (rqptr->rqCgi.EotStr, tkptr->CgiEot); rqptr->rqCgi.EotLength = tkptr->CgiEotLength; strcpy (rqptr->rqCgi.EscStr, tkptr->CgiEsc); rqptr->rqCgi.EscLength = tkptr->CgiEscLength; break; case DCL_TASK_TYPE_CLI : rqptr->rqCgi.IsCliDcl = true; tkptr->BuildRecords = tkptr->CgiPlusVarStruct = false; tkptr->CgiPlusUsageCount = tkptr->CgiEofLength = tkptr->CgiEotLength = tkptr->CgiEscLength = tkptr->LifeTimeSecond = tkptr->SysOutputBuildCount = 0; tkptr->CgiEof[0] = tkptr->CgiEot[0] = tkptr->CgiEsc[0] = '\0'; CgiSequenceBel (tkptr->CgiBel, &tkptr->CgiBelLength); /* limited life in the twilight zone */ if (DclUseZombies && (Config.cfScript.ZombieLifeTime || (rqptr->rqPathSet.ScriptLifeTime && rqptr->rqPathSet.ScriptLifeTime != -1))) { DclSupervisor (0); if (rqptr->rqPathSet.ScriptLifeTime) tkptr->LifeTimeSecond = HttpdTickSecond + rqptr->rqPathSet.ScriptLifeTime; else tkptr->LifeTimeSecond = HttpdTickSecond + Config.cfScript.ZombieLifeTime; } if (DclUseZombies) { /* always generate a new EOF string for DCL commands */ CgiSequenceEof (tkptr->CgiEof, &tkptr->CgiEofLength); strcpy (rqptr->rqCgi.EofStr, tkptr->CgiEof); rqptr->rqCgi.EofLength = tkptr->CgiEofLength; } break; default : ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI); } if (Watch.Category && WatchThisOne) { WatchThis (rqptr, FI_LI, WATCH_DCL, "MBX SYS$COMMAND !AZ size:!UL", tkptr->SysCommandDevName, DclSysCommandSize); WatchThis (rqptr, FI_LI, WATCH_DCL, "MBX SYS$OUTPUT !AZ size:!UL", tkptr->SysOutputDevName, DclSysOutputSize); WatchThis (rqptr, FI_LI, WATCH_DCL, "MBX CGIPLUSIN !AZ size:!UL", tkptr->CgiPlusInDevName, DclCgiPlusInSize); WatchThis (rqptr, FI_LI, WATCH_DCL, "MBX HTTP$INPUT !AZ size:!UL", tkptr->HttpInputDevName, NetReadBufferSize); WatchThis (rqptr, FI_LI, WATCH_DCL, "MBX termination !AZ", tkptr->CrePrcTermMbxDevName); } if (tkptr->ScriptProcessPid) { /******************/ /* process exists */ /******************/ /* kick off the first of the CPU consumption watchdogs */ if (tkptr->ScriptCpuMax) DclScriptCpuTim (tkptr); /* if existing (CGI) process being pressed into CGIplus or RTE service */ if (TaskType == DCL_TASK_TYPE_CGIPLUS_SCRIPT || TaskType == DCL_TASK_TYPE_RTE_SCRIPT) DclCountScriptProcess (); return (SS$_NORMAL); } /******************/ /* create process */ /******************/ status = DclCreateScriptProcess (tkptr, ScriptAsPtr, BasePriority); if (VMSok (status)) { tkptr->ZombieCount = 0; CurrentDclScriptProcess++; DclCountScriptProcess (); /* in this case we know the CPU consumption is starting at zero ;^) */ if (tkptr->ScriptCpuMax) /* multiply by one hundred turning seconds into 10mS ticks */ tkptr->ScriptCpuTimMax = tkptr->ScriptCpuMax * 100; return (status); } else { /* disassociate the DCL task and request structures */ rqptr->DclTaskPtr = tkptr->RequestPtr = NULL; tkptr->WatchItem = 0; return (status); } } /*****************************************************************************/ /* Search the script name cache using a task structure to get information about the script's environment. */ DclSearchScriptNameCache ( DCL_TASK *tkptr, REQUEST_STRUCT *rqptr ) { DCL_SCRIPT_NAME_ENTRY *captr; LIST_ENTRY *leptr; /*********/ /* begin */ /*********/ if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (rqptr, FI_LI, WATCH_MOD_DCL, "DclSearchScriptNameCache() !&Z !&Z", tkptr->ScriptFileName, tkptr->ScriptRunTime); for (leptr = DclScriptNameCacheList.HeadPtr; leptr; leptr = leptr->NextPtr) { captr = (DCL_SCRIPT_NAME_ENTRY*)leptr; if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (rqptr, FI_LI, WATCH_MOD_DCL, "!&Z !&Z !&B !&Z", tkptr->ScriptFileName, captr->ScriptFileName, strsame (tkptr->ScriptFileName, captr->ScriptFileName, -1), captr->ResFileName); if (!captr->ResFileName[0]) continue; if (!strsame (tkptr->ScriptFileName, captr->ScriptFileName, -1)) continue; if (!rqptr->NotFromCache) { /* found it */ if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (rqptr, FI_LI, WATCH_DCL, "SCRIPT name cache !UL hit!%s !AZ as !AZ (!AZ)", captr->HitCount+1, tkptr->ScriptFileName, captr->ResFileName, captr->ScriptRunTime); /* emulate what happens at DclScriptFindEnd() */ strcpy (tkptr->ScriptFileName, captr->ResFileName); rqptr->rqCgi.ScriptFileNamePtr = tkptr->ScriptFileName; strcpy (tkptr->SearchOds.ResFileName, captr->ResFileName); if (captr->ScriptRunTime[0]) { strcpy (tkptr->ScriptRunTime, captr->ScriptRunTime); tkptr->ScriptRunTimePtr = tkptr->ScriptRunTime; } else if (captr->ScriptRunTime[1]) { /* ("bit too clever" but) redeploy this storage */ strcpy (tkptr->ScriptRunTime+1, captr->ScriptRunTime+1); tkptr->ScriptRunTimePtr = tkptr->ScriptRunTime+1; tkptr->ScriptRunTime[0] = '\0'; } else { tkptr->ScriptRunTime[0] = '\0'; tkptr->ScriptRunTimePtr = NULL; } captr->HitCount++; PUT_QUAD_QUAD (rqptr->rqTime.Vms64bit, captr->LastBinaryTime); return; } /* "reload" is used to purge the script name cache entry */ captr->ResFileName[0] = captr->ScriptRunTime[0] = '\0'; tkptr->ScriptRunTimePtr = NULL; return; } if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (rqptr, FI_LI, WATCH_DCL, "SCRIPT name cache !AZ not found", tkptr->ScriptFileName); } /*****************************************************************************/ /* Add the name details of a script to the cache. First check that no other request has provided this same entry while this request was finding the script details. Then update an empty entry if it can be found in the list, or create a new entry and add it to the list. */ DclUpdateScriptNameCache (DCL_TASK *tkptr) { DCL_SCRIPT_NAME_ENTRY *captr; LIST_ENTRY *leptr; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclUpdateScriptNameCache() !&Z !&Z !&Z", tkptr->ScriptFileName, tkptr->SearchOds.ResFileName, tkptr->ScriptRunTime); /* check that no one has beaten us to it */ for (leptr = DclScriptNameCacheList.HeadPtr; leptr; leptr = leptr->NextPtr) { captr = (DCL_SCRIPT_NAME_ENTRY*)leptr; if (strsame (tkptr->ScriptFileName, captr->ScriptFileName, -1) && captr->ResFileName[0]) return; } /* now look for an empty entry */ for (leptr = DclScriptNameCacheList.HeadPtr; leptr; leptr = leptr->NextPtr) { captr = (DCL_SCRIPT_NAME_ENTRY*)leptr; if (!captr->ResFileName[0]) break; } if (!leptr) { /* didn't find an instance of the script create a new entry */ captr = VmGet (sizeof(DCL_SCRIPT_NAME_ENTRY)); ListAddTail (&DclScriptNameCacheList, captr); } /* cache the script name information */ strcpy (captr->ScriptFileName, tkptr->ScriptFileName); strcpy (captr->ResFileName, tkptr->SearchOds.ResFileName); if (tkptr->ScriptRunTime[0]) strcpy (captr->ScriptRunTime, tkptr->ScriptRunTime); else if (tkptr->ScriptRunTimePtr) { strcpy (captr->ScriptRunTime+1, tkptr->ScriptRunTimePtr); captr->ScriptRunTime[0] = '\0'; } else captr->ScriptRunTime[0] = captr->ScriptRunTime[1] = '\0'; captr->HitCount = 0; PUT_QUAD_QUAD (tkptr->RequestPtr->rqTime.Vms64bit, captr->LastBinaryTime); if (WATCHTK(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "SCRIPT name cache update !AZ as !AZ", captr->ScriptFileName, captr->ResFileName); } /*****************************************************************************/ /* Set all expanded file name entries in the script name cache to empty. This function is called when the DCLSupervisor() determines there are no more zombies or CGIplus scripts active, and also when script processes are purged. */ DclPurgeScriptNameCache () { DCL_SCRIPT_NAME_ENTRY *captr; LIST_ENTRY *leptr; /*********/ /* begin */ /*********/ if (WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclPurgeScriptNameCache()"); DclPurgeScriptNameCacheCount++; for (leptr = DclScriptNameCacheList.HeadPtr; leptr; leptr = leptr->NextPtr) { captr = (DCL_SCRIPT_NAME_ENTRY*)leptr; captr->ResFileName[0] = captr->ScriptRunTime[0] = '\0'; captr->HitCount = 0; } } /*****************************************************************************/ /* Implements the [DclScriptProctor] global directive. Script proctoring proactively creates and maintains specific persistent scripts and scripting environments (RTEs). It is intended for those environments that have some significant startup latency. It could be used with non-persistent scripts but there isn't any point (the only thing that remains instatiated is a zombie script process). For each proctor specification it scans the DCL task list for matching run-times and/or script paths, counting the number of matches. If fewer than the item requires then a dummy request structure is generated and the script creation function directly called (analagous to what happens with a genuine request). It is possible (and probably likely) that proctored script specification will fail to activate the script (activation specification error, script unavailable for some reason, etc., etc., etc.) which would lead to a runaway series of attempts to proctor with each process exit. To help mitigate this scenario an algorithm is applied in DclScriptProcessCompletionAST() which for repeated failures no longer reproctors that particular item for a given period. The algorithm is weighted to quickly put the brakes on a failing item then more slowly remove that weight over a period of time until it again begins to proctor it again. This is accomplished by starting with 3 and then multiplying that value by itself for each failure. Once it reaches 25 (3 * 3 := 9 * 9 := 81, i.e. three failures) it no longer reproctors. This value is then decremented by the number of elapsed seconds until it falls below 25 (about a minute) at which time the proctoring is attempted again. If the value is something like 24 then another failure results in a value of 576, or about ten minutes before another attempt. These are all reset to zero with a /DO=DCL=PURGE or /DO=DCL=DELETE. Proctored scripts contain *nothing* of the usual request-related environment. No CGI variables to speak of, no service, no request method, nothing! The easiest method for a script to detect if its been proctored into existence is to look for the absence of this or these. No REQUEST_METHOD is a fair indicator as it should exist with all 'real' requests. Of course a proctored script is really just there to instatiate itself not do anything directly productive and so a script/RTE can just recognise this and conclude with perhaps a 204 HTTP status (no content) and then remain quiescent. For an RTE the activation script specification in [DclScriptProctor] does not need to actually exist. It must contain a minimum path to activate the desired environment but the script itself is not checked to exist by WASD and does not need to exist. If it does then it should do whatever is required to instantiate its required environment and return a 204 (no content) response. If it does not exist then the RTE itself should detect it's a proctored activation and return a default 204 response itself, instantiating only the RTE environment. Specific information *can* be passed to the proctored script using the 'script=param=name=...' mapping rule. This appears as a [WWW_]NAME CGI variable containing the value specified. Proctored scripts could then act according to any such data. Proctored scripts can be detected during mapping using "if (request-method:)" or "if (!request-method:%)" and information passed from proctor to mapping using "if (notepad:blah)". The combination of these allows some control of proctored scripting. # WASD_CONFIG_GLOBAL [DclScriptProctor] 2 /cgi-bin/mgd* /cgi-bin/mgd proctor=daniel 2+1 /cgi-bin/script* /cgi-bin/script anyoldname=dothis # WASD_CONFIG_MAP if (request-method:) if (notepad:proctor=daniel) set /cgi-bin/mgd script=as=daniel if (notepad:anyoldname=dothis) set /cgi-bin/script script=param=DOTHIS=one endif */ DclScriptProctor () { static char ProblemProctor [] = "[DclScriptProctor] problem"; int idx, BeginCount, IdleCount, ActiveCount; char *cptr; char MappedFile [ODS_MAX_FILE_NAME_LENGTH+1], ScriptName [ODS_MAX_FILE_NAME_LENGTH+1], MappedScript [ODS_MAX_FILE_NAME_LENGTH+1], MappedRunTime [ODS_MAX_FILE_NAME_LENGTH+1]; DCL_TASK *tkptr; LIST_ENTRY *leptr; REQUEST_STRUCT *rqptr; PROCTOR_STRUCT *psptr; /*********/ /* begin */ /*********/ if (WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclScriptProctor()"); if (ControlExitRequested || ControlRestartRequested) return; for (idx = 0; idx < Config.cfScript.ProctorCount; idx++) { psptr = &Config.cfScript.Proctor[idx]; /* if problem or place-holder then just continue */ if (psptr->Problem) continue; if (!psptr->NumberMin && !psptr->NumberIdle) continue; if (psptr->FailWeight >= PROCTOR_FAIL_AT) { if (WATCH_CATEGORY(WATCH_DCL)) WatchThis (NULL, FI_LI, WATCH_DCL, "PROCTOR FAILURE (!UL>=!UL) !UL+!UL !AZ!AZ!AZ!AZ !AZ!AZ!AZ", psptr->FailWeight, PROCTOR_FAIL_AT, psptr->NumberMin, psptr->NumberIdle, *psptr->RunTimePtr ? "(" : "", psptr->RunTimePtr, *psptr->RunTimePtr ? ")" : "", psptr->ScriptPtr, psptr->ActivatePtr, *psptr->NotePadPtr ? " " : "", psptr->NotePadPtr); continue; } ActiveCount = IdleCount = 0; for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr) { tkptr = (DCL_TASK*)leptr; if (!tkptr->ScriptProcessPid) continue; if (*psptr->RunTimePtr) { if (!tkptr->ScriptRunTime[0]) continue; if (!StringMatch (NULL, tkptr->ScriptRunTime, psptr->RunTimePtr)) continue; } if (*psptr->ScriptPtr) { if (!tkptr->ScriptName[0]) continue; if (!StringMatch (NULL, tkptr->ScriptName, psptr->ScriptPtr)) continue; } /* if not yet concluded the proctoring consider it idle */ if (tkptr->NextTaskFunction == &DclScriptProctorAst) IdleCount++; else if (tkptr->RequestPtr) ActiveCount++; else IdleCount++; } BeginCount = 0; if (ActiveCount + IdleCount < psptr->NumberMin) { BeginCount = psptr->NumberMin - ActiveCount - IdleCount; psptr->TotalMin += BeginCount; } if (IdleCount < psptr->NumberIdle && BeginCount < psptr->NumberIdle) { psptr->TotalIdle += psptr->NumberIdle - BeginCount - IdleCount; BeginCount += psptr->NumberIdle - BeginCount - IdleCount; } if (WATCH_CATEGORY(WATCH_DCL)) WatchThis (NULL, FI_LI, WATCH_DCL, "PROCTOR !&B !ULNumberMin, IdleCount, psptr->NumberIdle, BeginCount, *psptr->RunTimePtr ? "(" : "", psptr->RunTimePtr, *psptr->RunTimePtr ? ")" : "", psptr->ScriptPtr, psptr->ActivatePtr, *psptr->NotePadPtr ? " " : "", psptr->NotePadPtr); while (BeginCount-- > 0) { /* build a dummy request structure */ rqptr = VmGetRequest (); if (WATCH_CATEGORY(WATCH_DCL)) rqptr->WatchItem = ++Watch.Count; /* conditionals, etc., make frequent reference to the service */ rqptr->ServicePtr = VmGetHeap (rqptr, sizeof(SERVICE_META)); /* prevent writing a response header to no network! */ rqptr->rqResponse.HeaderSent = true; if (psptr->NotePadLength) { rqptr->NotePadPtr = VmGetHeap (rqptr, psptr->NotePadLength+1); strcpy (rqptr->NotePadPtr, psptr->NotePadPtr); } /* initialize with some nulls */ *(ULONGPTR)MappedFile = *(ULONGPTR)ScriptName = *(ULONGPTR)MappedScript = *(ULONGPTR)MappedRunTime = 0; cptr = MapUrl_Map (psptr->ActivatePtr, 0, MappedFile, sizeof(MappedFile), ScriptName, sizeof(ScriptName), MappedScript, sizeof(MappedScript), MappedRunTime, sizeof(MappedRunTime), NULL, rqptr, &rqptr->rqPathSet); if (!cptr[0] && cptr[1]) { if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (rqptr, FI_LI, WATCH_DCL, "PROCTOR !AZ", cptr+1); ErrorNoticed (NULL, 0, ProblemProctor, FI_LI); VmFreeRequest (rqptr, FI_LI); /* disable the proctoring entry immediately */ psptr->FailWeight = PROCTOR_FAIL_NOW; DclScriptProctorReportFail (psptr, "!AZ", cptr+1); continue; } if (!ScriptName[0]) { if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (rqptr, FI_LI, WATCH_DCL, "PROCTOR not mapped"); ErrorNoticed (NULL, 0, ProblemProctor, FI_LI); VmFreeRequest (rqptr, FI_LI); /* disable the proctoring entry immediately */ psptr->FailWeight = PROCTOR_FAIL_NOW; DclScriptProctorReportFail (psptr, "mapping failed"); continue; } if (ScriptName[0] == '+') { ScriptName[0] = '/'; DclBegin (rqptr, &DclScriptProctorAst, NULL, ScriptName, NULL, MappedScript, MappedRunTime, NULL, psptr); } else DclBegin (rqptr, &DclScriptProctorAst, NULL, ScriptName, MappedScript, NULL, MappedRunTime, NULL, psptr); PUT_QUAD_QUAD (HttpdBinTime, psptr->LastBinTime); InstanceGblSecIncrLong (&AccountingPtr->DclProctorCount); } } } /*****************************************************************************/ /* Proctor script has concluded. */ DclScriptProctorAst (REQUEST_STRUCT *rqptr) { /*********/ /* begin */ /*********/ if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (rqptr, FI_LI, WATCH_MOD_DCL, "DclScriptProctorAst() !&F !&X", &DclScriptProctorAst, rqptr); if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (rqptr, FI_LI, WATCH_DCL, "PROCTOR ready"); /* remove from any supervisory list */ HttpdSupervisorList (rqptr, -1); VmFreeRequest (rqptr, FI_LI); } /*****************************************************************************/ /* Report a proctoring failure. */ DclScriptProctorReportFail ( PROCTOR_STRUCT *psptr, char *ReportFao, ... ) { int argcnt; unsigned long *vecptr; unsigned long FaoVector [16]; va_list argptr; /*********/ /* begin */ /*********/ if (WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclScriptProctorReportFail()"); psptr->TotalFail++; PUT_QUAD_QUAD (HttpdBinTime, psptr->LastFailBinTime); va_count (argcnt); va_start (argptr, ReportFao); vecptr = FaoVector; for (argcnt -= 2; argcnt; argcnt--) *vecptr++ = va_arg (argptr, unsigned long); va_end (argptr); *vecptr++ = 0; FaolToBuffer (psptr->FailReason, sizeof(psptr->FailReason), NULL, ReportFao, &FaoVector); FaoToStdout ("%HTTPD-W-PROCTOR, !20%D, " "!UL+!UL !AZ!AZ!AZ!AZ !AZ !UL failure!%s, !AZ\n", 0, psptr->NumberMin, psptr->NumberIdle, *psptr->RunTimePtr ? "(" : "", psptr->RunTimePtr, *psptr->RunTimePtr ? ")" : "", psptr->ScriptPtr, psptr->ActivatePtr, psptr->TotalFail, psptr->FailReason); /* report this message via OPCOM */ if (OpcomMessages & OPCOM_HTTPD) FaoToOpcom ("%HTTPD-W-PROCTOR, " "!UL+!UL !AZ!AZ!AZ!AZ !AZ !UL failure!%s, !AZ", psptr->NumberMin, psptr->NumberIdle, *psptr->RunTimePtr ? "(" : "", psptr->RunTimePtr, *psptr->RunTimePtr ? ")" : "", psptr->ScriptPtr, psptr->ActivatePtr, psptr->TotalFail, psptr->FailReason); } /*****************************************************************************/ /* Perform an asynchronous search for the script file specified by 'tkptr->ScriptFileName'. When found return the actual script file in 'tkptr->SearchOds.ResFileName' and call DclBeginScript(). If not found set to empty and conclude the task. The search is performed first by checking for a file with the file type supplied with the script specification (usually not), then by defaulting to ".COM", then ".EXE", and finally to any configured runtime file types, in that order. The file search uses a DCL task structure but no script process I/O is actually underway. As the search is AST-driven it is possible for a cancelling client to disconnect from the task structure via DclTaskRunDown() while the search is in progress. Each find-script-file function checks for the request pointer and aborts the search if no longer present. The 'tkptr->FindScript' flag indicates the structure is in use for this purpose and so will not be reallocated until reset as the search is finally aborted. */ DclFindScript (DCL_TASK *tkptr) { int status, idx; REQUEST_STRUCT *rqptr; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclFindScript() !UL !&Z !&Z", tkptr->FindScriptState, tkptr->ScriptFileName, tkptr->ScriptRunTime); if (!(rqptr = tkptr->RequestPtr)) { /* request thread has disconnected during file search */ DclFindScriptEnd (tkptr, false); return; } switch (tkptr->FindScriptState) { case DCL_FIND_SCRIPT_BEGIN : tkptr->FindScript = true; tkptr->FindScriptFileNamePtr = tkptr->ScriptFileName; /* first look for DCL procedure (overridden if file type supplied) */ tkptr->FindScriptState = DCL_FIND_SCRIPT_COM; OdsParse (&tkptr->SearchOds, tkptr->FindScriptFileNamePtr, 0, ".COM;", 5, 0, &DclFindScriptParseAst, tkptr); return; case DCL_FIND_SCRIPT_COM : /* command procedure not found, look for a command definition */ tkptr->FindScriptState = DCL_FIND_SCRIPT_CLD; OdsParse (&tkptr->SearchOds, tkptr->FindScriptFileNamePtr, 0, ".CLD;", 5, 0, &DclFindScriptParseAst, tkptr); return; case DCL_FIND_SCRIPT_CLD : /* command procedure not found, look for an executable */ tkptr->FindScriptState = DCL_FIND_SCRIPT_EXE; OdsParse (&tkptr->SearchOds, tkptr->FindScriptFileNamePtr, 0, ".EXE;", 5, 0, &DclFindScriptParseAst, tkptr); return; case DCL_FIND_SCRIPT_EXE : /* command definition not found, look for a configured run-time */ tkptr->FindScriptRunTimeIdx = 0; tkptr->FindScriptState = DCL_FIND_SCRIPT_RUNTIME; case DCL_FIND_SCRIPT_RUNTIME : /* looking through any list of user-defined script file types */ idx = tkptr->FindScriptRunTimeIdx++; if (idx >= Config.cfScript.RunTimeCount) { /********************/ /* script not found */ /********************/ /* indicate the script was not found */ tkptr->SearchOds.ResFileName[0] = '\0'; if (ISAGENT(tkptr)) { /* not a standard script, an (authorization) agent task */ rqptr->rqResponse.HttpStatus = 500; ErrorGeneral (rqptr, MsgFor(rqptr,MSG_AUTH_AGENT_NOT_FOUND), FI_LI); } else { /* standard CGI/CGIplus script */ rqptr->rqResponse.HttpStatus = 404; ErrorGeneral (rqptr, MsgFor(rqptr,MSG_SCRIPT_NOT_FOUND), FI_LI); } DclFindScriptEnd (tkptr, false); return; } OdsParse (&tkptr->SearchOds, tkptr->FindScriptFileNamePtr, 0, Config.cfScript.RunTime[idx].StringPtr, Config.cfScript.RunTime[idx].FileTypeLength, 0, &DclFindScriptParseAst, tkptr); return; default : ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI); } } /*****************************************************************************/ /* AST called from DclFindScript() when asynchronous parse completes. Check for error status, then perform an asynchronous search with AST to DclFindScriptSearchAst() */ DclFindScriptParseAst (DCL_TASK *tkptr) { int status; REQUEST_STRUCT *rqptr; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclFindScriptParseAst() !&F sts:!&S stv:!&S", &DclFindScriptParseAst, tkptr->SearchOds.Fab.fab$l_sts, tkptr->SearchOds.Fab.fab$l_stv); if (!(rqptr = tkptr->RequestPtr)) { /* request thread has disconnected during file search */ DclFindScriptEnd (tkptr, false); return; } if (VMSnok (status = tkptr->SearchOds.Fab.fab$l_sts)) { rqptr->rqResponse.ErrorTextPtr = tkptr->ScriptName; rqptr->rqResponse.ErrorOtherTextPtr = tkptr->ScriptFileName; ErrorVmsStatus (rqptr, status, FI_LI); DclFindScriptEnd (tkptr, false); return; } if (tkptr->SearchOds.Nam_fnb & NAM$M_WILDCARD) { rqptr->rqResponse.HttpStatus = 403; rqptr->rqResponse.ErrorTextPtr = tkptr->ScriptName; rqptr->rqResponse.ErrorOtherTextPtr = tkptr->ScriptFileName; ErrorGeneral (rqptr, MsgFor(rqptr,MSG_GENERAL_NO_WILDCARD), FI_LI); DclFindScriptEnd (tkptr, false); return; } OdsSearch (&tkptr->SearchOds, &DclFindScriptSearchAst, tkptr); } /*****************************************************************************/ /* AST called from DclFindScriptParseAst() when asynchronous search completes. Check for a file-not-found status, if so then call DclFindScript() to search for the next possibility. Check for an error status. If the file has been found determine the runtime environment and initiate the script process execution. */ DclFindScriptSearchAst (DCL_TASK *tkptr) { int status, idx; char *cptr, *sptr, *zptr; REQUEST_STRUCT *rqptr; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclFindScriptSearchAst() !&F sts:!&S stv:!&S", &DclFindScriptSearchAst, tkptr->SearchOds.Fab.fab$l_sts, tkptr->SearchOds.Fab.fab$l_stv); if (!(rqptr = tkptr->RequestPtr)) { /* request thread has disconnected during file search */ DclFindScriptEnd (tkptr, false); return; } if (VMSnok (status = tkptr->SearchOds.Fab.fab$l_sts)) { if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_DCL)) { tkptr->SearchOds.NamVersionPtr[0] = '\0'; WatchThis (rqptr, FI_LI, WATCH_DCL, "SEARCH !AZ !&S", tkptr->SearchOds.NamDevicePtr, status); tkptr->SearchOds.NamVersionPtr[0] = ';'; } if (status == RMS$_FNF) { /* not found */ if (!(tkptr->SearchOds.Nam_fnb & NAM$M_EXP_TYPE)) { /* only if type not explicitly supplied then look for another */ DclFindScript (tkptr); return; } } /* some other error, report it and finish up */ rqptr->rqResponse.ErrorTextPtr = tkptr->ScriptName; rqptr->rqResponse.ErrorOtherTextPtr = tkptr->ScriptFileName; ErrorVmsStatus (rqptr, status, FI_LI); DclFindScriptEnd (tkptr, false); return; } if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_DCL)) { tkptr->SearchOds.NamVersionPtr[0] = '\0'; WatchThis (rqptr, FI_LI, WATCH_DCL, "SEARCH found !AZ", tkptr->SearchOds.NamDevicePtr); tkptr->SearchOds.NamVersionPtr[0] = ';'; } /*************/ /* found it! */ /*************/ if (tkptr->ScriptRunTime[0]) tkptr->ScriptRunTimePtr = tkptr->ScriptRunTime; else if (strsame (tkptr->SearchOds.NamTypePtr, ".COM;", 5)) tkptr->ScriptRunTimePtr = "@"; else if (strsame (tkptr->SearchOds.NamTypePtr, ".CLD;", 5)) tkptr->ScriptRunTimePtr = "="; else if (strsame (tkptr->SearchOds.NamTypePtr, ".EXE;", 5)) tkptr->ScriptRunTimePtr = "$"; else { /* look through the list of user-definable script file types */ for (idx = 0; idx < Config.cfScript.RunTimeCount; idx++) { if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchDataFormatted ("!&Z !&Z\n", tkptr->SearchOds.NamTypePtr, Config.cfScript.RunTime[idx].StringPtr); if (strsame (tkptr->SearchOds.NamTypePtr, Config.cfScript.RunTime[idx].StringPtr, Config.cfScript.RunTime[idx].FileTypeLength)) break; } if (idx < Config.cfScript.RunTimeCount) { /* found the file type (file extension) */ cptr = Config.cfScript.RunTime[idx].StringPtr; while (*cptr && *cptr != ' ') cptr++; if (*cptr) cptr++; tkptr->ScriptRunTimePtr = cptr; } else if (tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT) tkptr->ScriptRunTimePtr = NULL; else if (rqptr->rqPathSet.ScriptCommandPtr && rqptr->rqPathSet.ScriptCommandPtr[0] != '*') tkptr->ScriptRunTimePtr = ""; else { /********************************************/ /* don't know how to execute this file type */ /********************************************/ rqptr->rqResponse.HttpStatus = 500; tkptr->SearchOds.NamVersionPtr[0] = '\0'; ErrorGeneral (rqptr, "Execution of !AZ script types not configured.", tkptr->SearchOds.NamTypePtr, FI_LI); DclFindScriptEnd (tkptr, false); return; } } /**********************/ /* execute the script */ /**********************/ /* terminate the expanded CGI file name */ tkptr->SearchOds.NamVersionPtr[0] = '\0'; DclFindScriptEnd (tkptr, true); } /*****************************************************************************/ /* The parse structures only really need to be explicitly released if the script is actually found, otherwise they are always implicitly released on the sys$search() file-not-found! Here we'll do it all the time as we are dealing with possible search abort as well as general search conclusion. When doing so use scratch expanded file name space so as not to overwrite the CGI file name if the script file was found. */ DclFindScriptEnd ( DCL_TASK *tkptr, BOOL FileFound ) { /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclFindScriptEnd() !&F !&B", &DclFindScriptEnd, FileFound); tkptr->FindScript = false; /* ensure parse internal data structures are released */ if (tkptr->SearchOds.ParseInUse) OdsParseRelease (&tkptr->SearchOds); if (FileFound) { /* update the cache */ DclUpdateScriptNameCache (tkptr); /* NOW update the script file name with the one actually resolved */ strcpy (tkptr->ScriptFileName, tkptr->SearchOds.ResFileName); tkptr->RequestPtr->rqCgi.ScriptFileNamePtr = tkptr->ScriptFileName; DclBeginScript (tkptr); return; } else if (tkptr->NextTaskFunction == &DclScriptProctorAst) { /* disable the proctoring entry immediately */ tkptr->ProctorPtr->FailWeight = PROCTOR_FAIL_NOW; DclScriptProctorReportFail (tkptr->ProctorPtr, "activator not found"); } /* ensure it looks as if it was NOT found */ tkptr->SearchOds.ResFileName[0] = '\0'; DclTaskRunDown (tkptr); return; } /*****************************************************************************/ /* Abort current request script processing, freeing the request and DCL task from each other, then restart DCL processing appropriately. Is used to restart processing after CGIplus script failed to start (see "April 1998 Note:" above) or when a run-time configuration entry indicates either CGIplus or RTE should be used to handle scripting the file type. When restarting for RTE two sources of the RTE executable must be considered. If from the [DclScriptRunTime] configuration structure then 'ScriptRunTimePtr' points to a file name, otherwise 'ScriptRunTimePtr' points to either "$" or "@" to indicate how the file should be handled. If the second character is a null then it's the latter and the 'ResFileName' should be used. */ DclRestartScript (DCL_TASK *tkptr) { static unsigned long OneSecondDelta [2] = { -10000000, -1 }; int status, TaskType; char *ScriptRunTimePtr; char DclCommand [DCL_COMMAND_MAX_SIZE], ScriptRunTime [ODS_MAX_FILE_NAME_LENGTH+1], ResFileName [ODS_MAX_FILE_NAME_LENGTH+1], ScriptFileName [ODS_MAX_FILE_NAME_LENGTH+1], ScriptName [SCRIPT_NAME_SIZE]; PROCTOR_STRUCT *ProctorPtr; REQUEST_AST NextTaskFunction; REQUEST_STRUCT *rqptr; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclRestartScript()"); rqptr = tkptr->RequestPtr; if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (rqptr, FI_LI, WATCH_DCL, "RESTART script !UL", tkptr->RequestPtr->rqCgi.ScriptRetryCount); if (!ISAGENT(tkptr) && WEBSOCKET_REQUEST(rqptr)) WebSockRemove (rqptr); /* retrieve necessary information from the current DCL task */ TaskType = tkptr->TaskType; NextTaskFunction = tkptr->NextTaskFunction; ProctorPtr = tkptr->ProctorPtr; strcpy (ResFileName, tkptr->SearchOds.ResFileName); strcpy (ScriptFileName, tkptr->ScriptFileName); strcpy (ScriptName, tkptr->ScriptName); strcpy (DclCommand, tkptr->DclCommandPtr); if (tkptr->ScriptRunTime[0]) { strcpy (ScriptRunTime, tkptr->ScriptRunTime); ScriptRunTimePtr = ScriptRunTime; } else ScriptRunTimePtr = NULL; /* disassociate the DCL task and request structures, then conclude */ tkptr->RequestPtr->DclTaskPtr = NULL; tkptr->RequestPtr = tkptr->NextTaskFunction = NULL; tkptr->WatchItem = 0; DclTaskRunDown (tkptr); /* restart using a new DCL task */ switch (TaskType) { case DCL_TASK_TYPE_CGIPLUS_SCRIPT : DclBegin (rqptr, NextTaskFunction, NULL, ScriptName, NULL, ScriptFileName, ScriptRunTimePtr, NULL, ProctorPtr); return; case DCL_TASK_TYPE_CGI_SCRIPT : DclBegin (rqptr, NextTaskFunction, NULL, ScriptName, ScriptFileName, NULL, ScriptRunTimePtr, NULL, ProctorPtr); return; case DCL_TASK_TYPE_RTE_SCRIPT : DclBegin (rqptr, NextTaskFunction, NULL, ScriptName, ScriptFileName, NULL, ScriptRunTime, NULL, ProctorPtr); return; case DCL_TASK_TYPE_CLI : DclBegin (rqptr, NextTaskFunction, DclCommand, NULL, NULL, NULL, NULL, NULL, ProctorPtr); return; default : ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI); } } /*****************************************************************************/ /* Called with an already-established CGIplus script, a DCL command, or when a new CGIplus or CGI script file name has been searched for and found. Begin the I/O with the script process. */ DclBeginScript (DCL_TASK *tkptr) { int status, Length; char *ContentPtr; REQUEST_STRUCT *rqptr; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclBeginScript()"); if (!(rqptr = tkptr->RequestPtr)) { /* request thread has disconnected during file search */ DclTaskRunDown (tkptr); return; } if (tkptr->TaskType != DCL_TASK_TYPE_CLI) { /* provide request stream (HTTP$INPUT) to script process */ if (Config.cfScript.FullRequest) { ErrorGeneral (rqptr, "[DclFullRequest] no longer supported!", FI_LI); DclTaskRunDown (tkptr); return; } if (!ISAGENT(tkptr) && !WEBSOCKET_REQUEST(rqptr)) { BodyReadBegin (rqptr, &DclHttpInput, NULL); tkptr->QueuedClientRead++; } } /* queue the initial read of the script process' SYS$OUTPUT */ DclQioSysOutput (tkptr); if (!ISAGENT(tkptr) && WEBSOCKET_REQUEST(rqptr)) { WebSockCreateMailboxes (rqptr); rqptr->rqWebSocket.ScriptProcessPid = tkptr->ScriptProcessPid; } switch (tkptr->TaskType) { case DCL_TASK_TYPE_CGI_SCRIPT : tkptr->QueuedSysCommandAllowed = 0; rqptr->rqResponse.ErrorTextPtr = MsgFor(rqptr,MSG_SCRIPT_DCL_ENVIRONMENT); if (VMSnok (DclCgiScriptSysCommand (tkptr))) { tkptr->DeleteProcess = true; DclTaskRunDown (tkptr); return; } break; case DCL_TASK_TYPE_CGIPLUS_SCRIPT : case DCL_TASK_TYPE_RTE_SCRIPT : /* allow for the outstanding queued "STOP/id=0" and EOF */ tkptr->QueuedSysCommandAllowed = 2; if (tkptr->QueuedSysCommand < tkptr->QueuedSysCommandAllowed) DclCgiPlusScriptSysCommand (tkptr); /* here comes the CGI variable stream */ if (VMSnok (DclCgiPlusScriptCgiPlusIn (tkptr))) { tkptr->DeleteProcess = true; DclTaskRunDown (tkptr); return; } break; case DCL_TASK_TYPE_CLI : tkptr->QueuedSysCommandAllowed = 0; if (VMSnok (DclCgiScriptSysCommand (tkptr))) { tkptr->DeleteProcess = true; DclTaskRunDown (tkptr); return; } break; default : ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI); } /* remove default error message */ rqptr->rqResponse.ErrorTextPtr = NULL; } /*****************************************************************************/ /* Delete any script (sub)processes. Called by the image user-mode exit handler. */ DclExit () { int status, SetPrvStatus; DCL_TASK *tkptr; LIST_ENTRY *leptr; /*********/ /* begin */ /*********/ if (WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclExit()"); for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr) { tkptr = (DCL_TASK*)leptr; if (!tkptr->ScriptProcessPid) continue; /* need WORLD privilege if process created under another username */ if (tkptr->CrePrcUserName[0]) if (VMSnok (SetPrvStatus = sys$setprv (1, &WorldMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); status = sys$delprc (&tkptr->ScriptProcessPid, 0); if (tkptr->CrePrcUserName[0]) if (VMSnok (SetPrvStatus = sys$setprv (0, &WorldMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); if (VMSnok (status)) ErrorNoticed (NULL, status, NULL, FI_LI); } } /*****************************************************************************/ /* Update the accounting accumulators. */ DclCountScriptProcess () { int ScriptCgiPlusCount, ScriptRteCount, ScriptProcessCount; DCL_TASK *tkptr; LIST_ENTRY *leptr; /*********/ /* begin */ /*********/ if (WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclCountScriptProcess()"); ScriptCgiPlusCount = ScriptRteCount = ScriptProcessCount = 0; for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr) { tkptr = (DCL_TASK*)leptr; if (!tkptr->ScriptProcessPid) continue; ScriptProcessCount++; if (tkptr->TaskType == DCL_TASK_TYPE_CGIPLUS_SCRIPT) ScriptCgiPlusCount++; else if (tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT) ScriptRteCount++; } InstanceMutexLock (INSTANCE_MUTEX_HTTPD); AccountingPtr->CurrentDclScriptCgiPlus[InstanceNumber] = ScriptCgiPlusCount; AccountingPtr->CurrentDclScriptRTE[InstanceNumber] = ScriptRteCount; AccountingPtr->CurrentDclScriptProcess[InstanceNumber] = ScriptProcessCount; InstanceMutexUnLock (INSTANCE_MUTEX_HTTPD); } /*****************************************************************************/ /* The maximum number of concurrent script processes has been reached. Look through the DCL task structure for a CGIplus script process not currently in use. Find the least used script process and delete it. A lifetime count of -1 or if it set as do-not-disturb indicates the script process has requested that it be immune to supervisor purging. */ DclScriptProcessPurge () { int status, MinUsageCount; DCL_TASK *mintkptr; DCL_TASK *tkptr; LIST_ENTRY *leptr; /*********/ /* begin */ /*********/ if (WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclScriptProcessPurge() !UL !UL", CurrentDclScriptProcess, DclScriptProcessSoftLimit); DclPurgeCount++; MinUsageCount = 999999999; mintkptr = NULL; for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr) { tkptr = (DCL_TASK*)leptr; if (!tkptr->ScriptProcessPid || tkptr->QueuedSysOutput || tkptr->QueuedCgiPlusIn || tkptr->QueuedHttpInput || tkptr->QueuedClientRead || (tkptr->TaskType != DCL_TASK_TYPE_CGIPLUS_SCRIPT && tkptr->TaskType != DCL_TASK_TYPE_RTE_SCRIPT) || tkptr->LifeTimeSecond == DCL_DO_NOT_DISTURB || tkptr->RequestPtr || tkptr->FindScript || tkptr->DeleteProcess) continue; if (WebSockCount (tkptr->ScriptProcessPid)) continue; if (tkptr->CgiPlusUsageCount < MinUsageCount) MinUsageCount = (mintkptr = tkptr)->CgiPlusUsageCount; } if (!mintkptr) return; mintkptr->DeleteProcess = true; DclTaskRunDown (mintkptr); DclSoftLimitPurgeCount++; } /*****************************************************************************/ /* This function may be called at any stage to rundown or abort a DCL task, including during the search for the script file (see note in DclFindScript()). If there is still outstanding I/O this is cancelled as appropriate to task rundown or abort. If no outstanding I/O then if there is an associated request that request's next task function is called. */ DclTaskRunDown (DCL_TASK *tkptr) { int status, SetPrvStatus; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclTaskRundown() !&X !&B !&B !UL !&B !UL !UL !UL !UL !UL !8XL", tkptr->RequestPtr, tkptr->DeleteProcess, tkptr->ForceImageExit, tkptr->ForceImageExitSecond, tkptr->ScriptProcessActivated, tkptr->QueuedSysCommand, tkptr->QueuedSysOutput, tkptr->QueuedCgiPlusIn, tkptr->QueuedHttpInput, tkptr->QueuedClientRead, tkptr->ScriptProcessPid); if (tkptr->RequestPtr) if (tkptr->RequestPtr->rqTmr.TerminatedCount) tkptr->DeleteProcess = true; tkptr->TaskRunDown = true; if (tkptr->DeleteProcess) tkptr->QueuedSysCommandAllowed = 0; if (tkptr->QueuedSysCommand > tkptr->QueuedSysCommandAllowed || tkptr->QueuedSysOutput || tkptr->QueuedCgiPlusIn || tkptr->QueuedHttpInput || tkptr->QueuedClientRead) { /****************/ /* rundown task */ /****************/ if (tkptr->DeleteProcess && tkptr->ForceImageExit) { DclForceImageExit (tkptr); return; } if (tkptr->DeleteProcess) { /* cancel ALL outstanding I/O */ sys$cancel (tkptr->SysCommandChannel); sys$cancel (tkptr->SysOutputChannel); sys$cancel (tkptr->CgiPlusInChannel); sys$cancel (tkptr->HttpInputChannel); if (tkptr->QueuedClientRead && tkptr->RequestPtr) NetCloseSocket (tkptr->RequestPtr); return; } /* cancel any outstanding I/O on input channels */ if (tkptr->QueuedCgiPlusIn) sys$cancel (tkptr->CgiPlusInChannel); if (tkptr->QueuedHttpInput) sys$cancel (tkptr->HttpInputChannel); if (tkptr->QueuedSysCommand > tkptr->QueuedSysCommandAllowed) sys$cancel (tkptr->SysCommandChannel); /* if reading directly from the client just close the socket */ if (tkptr->QueuedClientRead && tkptr->RequestPtr) NetCloseSocket (tkptr->RequestPtr); return; } /* if there's still an outstanding CPU watchdog $GETJPI wait for it */ if (tkptr->ScriptCpuTimGetJpi) return; /*********************/ /* task has finished */ /*********************/ if (tkptr->ScriptName[0] && !tkptr->SearchOds.ResFileName[0]) { /* search for script file was unsuccessful */ if (tkptr->RequestPtr) { /* still has an associated request, declare the next task */ SysDclAst (tkptr->NextTaskFunction, tkptr->RequestPtr); /* disassociate the DCL task and request structures */ tkptr->RequestPtr->DclTaskPtr = NULL; tkptr->RequestPtr = tkptr->NextTaskFunction = NULL; tkptr->WatchItem = 0; } if (tkptr->TaskType == DCL_TASK_TYPE_CGIPLUS_SCRIPT || tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT) tkptr->DeleteProcess = true; } else if (tkptr->RequestPtr) { if (!tkptr->ScriptProcessActivated && tkptr->RequestPtr->rqCgi.ScriptRetryCount++ < DCL_MAX_SCRIPT_RETRY && !tkptr->RequestPtr->rqResponse.ErrorReportPtr) { /* looks like the script exited before actually starting! */ tkptr->DeleteProcess = true; DclRestartScript (tkptr); } else { /* ensure carriage-control is (potentially) reset */ if (Config.cfScript.GatewayBg) NetClientSocketCcl (tkptr->RequestPtr, 0); if (tkptr->TaskType != DCL_TASK_TYPE_CLI && (!tkptr->ScriptProcessResponded || !tkptr->ScriptProcessActivated) && !tkptr->RequestPtr->rqResponse.ErrorReportPtr) { /* hmmm, script has not provided any output! */ if (tkptr->RequestPtr->rqHeader.Method == HTTP_METHOD_GET) { /* blame script for general GET method failures */ tkptr->RequestPtr->rqResponse.HttpStatus = 502; ErrorGeneral (tkptr->RequestPtr, MsgFor(tkptr->RequestPtr,MSG_SCRIPT_RESPONSE_ERROR), FI_LI); } else { /* other methods are probably not implemented by the script */ tkptr->RequestPtr->rqResponse.HttpStatus = 501; ErrorGeneral (tkptr->RequestPtr, MsgFor(tkptr->RequestPtr,MSG_REQUEST_METHOD), FI_LI); } } if (tkptr->RequestPtr->rqResponse.RedactBufferPtr && tkptr->RequestPtr->rqResponse.RedactBufferCount) { /* redacted request invoked immediately */ SysDclAst (RequestEnd, tkptr->RequestPtr); } else { /* explicitly flushed in case it's an SSI activity */ NetWriteFullFlush (tkptr->RequestPtr, tkptr->NextTaskFunction); } /* disassociate the DCL task and request structures */ tkptr->RequestPtr->DclTaskPtr = NULL; tkptr->RequestPtr = tkptr->NextTaskFunction = NULL; tkptr->WatchItem = 0; } } if (DclUseZombies || tkptr->TaskType == DCL_TASK_TYPE_CGIPLUS_SCRIPT || tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT) { /* empty any remains in sys$output! */ DclEmptySysOutput (tkptr); } /* if marked for process deletion */ if (tkptr->DeleteProcess) { if (tkptr->ScriptProcessPid) { /* need WORLD privilege if process created under another username */ if (tkptr->CrePrcUserName[0]) if (VMSnok (SetPrvStatus = sys$setprv (1, &WorldMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); status = sys$delprc (&tkptr->ScriptProcessPid, 0); if (VMSnok (status)) { ErrorNoticed (NULL, status, NULL, FI_LI); if (status == SS$_NONEXPR) tkptr->ScriptProcessPid = 0; } InstanceGblSecIncrLong (&AccountingPtr->DclDelPrcCount); if (tkptr->CrePrcUserName[0]) if (VMSnok (SetPrvStatus = sys$setprv (0, &WorldMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); if WATCH_CATEGORY(WATCH_DCL) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "DELPRC pid:!8XL", tkptr->ScriptProcessPid); } else { tkptr->DeleteProcess = false; tkptr->TaskType = DCL_TASK_TYPE_NONE; } } if (DclUseZombies && tkptr->TaskType != DCL_TASK_TYPE_CGIPLUS_SCRIPT && tkptr->TaskType != DCL_TASK_TYPE_RTE_SCRIPT) tkptr->ZombieCount++; } /*****************************************************************************/ /* $FORCEX is painful to use - It should have an AST like process deletion for when it concludes. You cannot issue a $DELPRC for the same process until you are sure the image has run-down. Hence, if a $FORCEX is issued for the target process this function (and it's associated AST routine) must be called again to determine if the image has exited. If it hasn't then the check must be performed again until it has (or until you are out of patience ;^). Once the image exits the $DELPRC can be issued. This function is called to check if a script is executing an image. An asynchronous $GETJPI delivers to DclForceImageExitAst() where the decisions are made. */ DclForceImageExit (DCL_TASK *tkptr) { static unsigned long GetJpiControlFlags = JPI$M_IGNORE_TARGET_STATUS; int status, SetPrvStatus; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclForceImageExit() !8XL", tkptr->ScriptProcessPid); /* if there's still an outstanding $GETJPI */ if (tkptr->ForceImageExitGetJpi) return; if (!tkptr->ForceImageExitSecond) { /* set the timer to control how long the force image is waited for */ tkptr->ForceImageExitSecond = HttpdTickSecond + DCL_FORCE_IMAGE_EXIT_SECONDS; tkptr->ForceImageExitIssued = tkptr->ForceImageExitGetJpi = false; } else if (HttpdTickSecond >= tkptr->ForceImageExitSecond) { /* exceeded maximum period trying to force the image to exit */ tkptr->ForceImageExit = false; tkptr->ForceImageExitSecond = 0; DclTaskRunDown (tkptr); return; } /* using an asynchronous sys$getjpi() get (any) process image name */ tkptr->JpiImagNameItem[0].buf_len = sizeof(GetJpiControlFlags); tkptr->JpiImagNameItem[0].item = JPI$_GETJPI_CONTROL_FLAGS; tkptr->JpiImagNameItem[0].buf_addr = &GetJpiControlFlags; tkptr->JpiImagNameItem[0].short_ret_len = 0; tkptr->JpiImagNameItem[1].buf_len = sizeof(tkptr->JpiImagName)-1; tkptr->JpiImagNameItem[1].item = JPI$_IMAGNAME; tkptr->JpiImagNameItem[1].buf_addr = tkptr->JpiImagName; tkptr->JpiImagNameItem[1].short_ret_len = &tkptr->JpiImagNameLength; tkptr->JpiImagNameItem[2].buf_len = tkptr->JpiImagNameItem[2].item = tkptr->JpiImagNameItem[2].buf_addr = tkptr->JpiImagNameItem[2].short_ret_len = 0; /* need WORLD privilege if process created under another username */ if (tkptr->CrePrcUserName[0]) if (VMSnok (SetPrvStatus = sys$setprv (1, &WorldMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); status = sys$getjpi (0, &tkptr->ScriptProcessPid, 0, &tkptr->JpiImagNameItem, &tkptr->JpiImagNameIOsb, &DclForceImageExitAst, tkptr); if (tkptr->CrePrcUserName[0]) if (VMSnok (SetPrvStatus = sys$setprv (0, &WorldMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); if (VMSok (status)) { tkptr->ForceImageExitGetJpi = true; /* if it's anything other than a CGIplus/RTE script look at it ASAP */ if (!(tkptr->TaskType == DCL_TASK_TYPE_CGIPLUS_SCRIPT || tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT)) DclSupervisor (DCL_SUPERVISOR_TICK_MIN); return; } tkptr->ForceImageExit = false; tkptr->ForceImageExitSecond = 0; /* commonly it can be gone but with termination AST not yet processed */ if (status == SS$_NONEXPR) return; ErrorNoticed (NULL, status, NULL, FI_LI); DclTaskRunDown (tkptr); } /*****************************************************************************/ /* Called as an AST routine by the asynchronous $GETJPI in DclForceImageExit(). If the $GETJPI was successful and an image is running issue a $FORCEX to run the image down. If not just call DclTaskRunDown() again to begin running the script process down. */ DclForceImageExitAst (DCL_TASK *tkptr) { int status, SetPrvStatus; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclForceImageExitAst() !&F !8XL !&S {!UL}!-!#AZ", &DclForceImageExitAst, tkptr->ScriptProcessPid, tkptr->JpiImagNameIOsb.Status, tkptr->JpiImagNameLength, tkptr->JpiImagName); tkptr->ForceImageExitGetJpi = false; if (VMSnok (tkptr->JpiImagNameIOsb.Status) || !tkptr->JpiImagNameLength) { /* sys$getjpi() unsuccessful or image not currently executing */ tkptr->ForceImageExit = false; tkptr->ForceImageExitSecond = 0; DclTaskRunDown (tkptr); return; } /* if not the first check then return rather than using another $FORCEX */ if (tkptr->ForceImageExitIssued) return; if WATCH_CATEGORY(WATCH_DCL) WatchThis (NULL, FI_LI, WATCH_DCL, "FORCEX pid:!8XL !#AZ", tkptr->ScriptProcessPid, tkptr->JpiImagNameLength, tkptr->JpiImagName); /* need WORLD privilege if process created under another username */ if (tkptr->CrePrcUserName[0]) if (VMSnok (SetPrvStatus = sys$setprv (1, &WorldMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); status = sys$forcex (&tkptr->ScriptProcessPid, 0, SS$_NORMAL); InstanceGblSecIncrLong (&AccountingPtr->DclForceXCount); if (tkptr->CrePrcUserName[0]) if (VMSnok (SetPrvStatus = sys$setprv (0, &WorldMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); if (VMSok (status)) { tkptr->ForceImageExitIssued = true; return; } tkptr->ForceImageExit = false; tkptr->ForceImageExitSecond = 0; /* commonly it can be gone but with termination AST not yet processed */ if (status == SS$_NONEXPR) return; ErrorNoticed (NULL, status, NULL, FI_LI); DclTaskRunDown (tkptr); } /*****************************************************************************/ /* Queue a $GETJPI to discover the CPU time consumed since start of script processing. */ DclScriptCpuTim (DCL_TASK *tkptr) { static unsigned long GetJpiControlFlags = JPI$M_IGNORE_TARGET_STATUS; int status, SetPrvStatus; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclScriptCpuTim() !8XL", tkptr->ScriptProcessPid); /* if there's still an outstanding $GETJPI */ if (tkptr->ScriptCpuTimGetJpi) return; /* using an asynchronous sys$getjpi() get (any) process image name */ tkptr->JpiCpuTimItem[0].buf_len = sizeof(GetJpiControlFlags); tkptr->JpiCpuTimItem[0].item = JPI$_GETJPI_CONTROL_FLAGS; tkptr->JpiCpuTimItem[0].buf_addr = &GetJpiControlFlags; tkptr->JpiCpuTimItem[0].short_ret_len = 0; tkptr->JpiCpuTimItem[1].buf_len = sizeof(tkptr->JpiCpuTim); tkptr->JpiCpuTimItem[1].item = JPI$_CPUTIM; tkptr->JpiCpuTimItem[1].buf_addr = &tkptr->JpiCpuTim; tkptr->JpiCpuTimItem[1].short_ret_len = 0; tkptr->JpiCpuTimItem[2].buf_len = tkptr->JpiCpuTimItem[2].item = tkptr->JpiCpuTimItem[2].buf_addr = tkptr->JpiCpuTimItem[2].short_ret_len = 0; /* need WORLD privilege if process created under another username */ if (tkptr->CrePrcUserName[0]) if (VMSnok (SetPrvStatus = sys$setprv (1, &WorldMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); status = sys$getjpi (0, &tkptr->ScriptProcessPid, 0, &tkptr->JpiCpuTimItem, &tkptr->JpiCpuTimIOsb, &DclScriptCpuTimAst, tkptr); if (tkptr->CrePrcUserName[0]) if (VMSnok (SetPrvStatus = sys$setprv (0, &WorldMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); if (VMSok (status)) { tkptr->ScriptCpuTimGetJpi = true; return; } /* commonly it can be gone but with termination AST not yet processed */ if (status == SS$_NONEXPR) return; ErrorNoticed (NULL, status, NULL, FI_LI); } /*****************************************************************************/ /* */ DclScriptCpuTimAst (DCL_TASK *tkptr) { int status, SetPrvStatus; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclScriptCpuTimAst() !&F !8XL !&S !UL !UL", &DclScriptCpuTimAst, tkptr->ScriptProcessPid, tkptr->JpiCpuTimIOsb.Status, tkptr->JpiCpuTim, tkptr->ScriptCpuTimMax); tkptr->ScriptCpuTimGetJpi = false; if (tkptr->TaskRunDown) { /* task began run-down during asynchronous $GETJPI */ DclTaskRunDown (tkptr); return; } /* sys$getjpi() unsuccessful (perhaps suspended), do nothing */ if (VMSnok (tkptr->JpiCpuTimIOsb.Status)) return; /* if first time through with zombie then set the maximum allowed */ if (!tkptr->ScriptCpuTimMax) /* multiply by one hundred turning seconds into 10mS ticks */ tkptr->ScriptCpuTimMax = tkptr->JpiCpuTim + tkptr->ScriptCpuMax * 100; /* return if what's consumed is less that what's allowed */ if (tkptr->JpiCpuTim < tkptr->ScriptCpuTimMax) return; if WATCH_CATEGORY(WATCH_DCL) WatchThis (NULL, FI_LI, WATCH_DCL, "CPUMAX pid:!8XL cputim:!UL max:!UL", tkptr->ScriptProcessPid, tkptr->JpiCpuTim, tkptr->ScriptCpuTimMax); tkptr->ScriptCpuMax = tkptr->ScriptCpuTimMax = 0; tkptr->DeleteProcess = true; DclTaskRunDown (tkptr); } /*****************************************************************************/ /* If an error is encountered an error message is generated and the error status returned. It is up to the calling routine to abort the processing. Queue a writer-wait I/O to the SYS$OUTPUT channel to stall I/O until the script process has started. */ DclCreateScriptProcess ( DCL_TASK *tkptr, char *ScriptAsPtr, int BasePriority ) { #if OPERATE_WITH_SYSPRV /* this mask does not get the SYSPRV bit reset during startup */ static unsigned long OperateSysPrvMask [2] = { PRV$M_SYSPRV, 0 }; #endif static int ScriptProcessNumber; static unsigned long JpiAuthPriv [2], PrevPrivMask [2]; static char CommandDevName [64], ScriptProcessName [16]; static $DESCRIPTOR (CommandDevNameDsc, CommandDevName); static $DESCRIPTOR (LoginOutDsc, "SYS$SYSTEM:LOGINOUT.EXE"); static $DESCRIPTOR (ScriptProcessNameFaoDsc, "!AZ!AZ!UL"); static $DESCRIPTOR (ScriptProcessNameDsc, ScriptProcessName); static struct { short flag; char data [1+UAF$S_USERNAME + 1+UAF$S_USERNAME + 1+UAF$S_PASSWORD + 1+UAF$S_ACCOUNT]; } LgiData; static $DESCRIPTOR (LgiDataDsc,""); static struct { unsigned short buf_len; unsigned short item; unsigned char *buf_addr; unsigned short *short_ret_len; } JpiItems [] = { { sizeof(JpiAuthPriv), JPI$_AUTHPRIV, &JpiAuthPriv, 0 }, { 0,0,0,0 } }; int idx, pronum, status, Count, BecomeStatus, SetPrvStatus; unsigned short Length; unsigned long CrePrcFlags; char *cptr, *sptr, *zptr, *ProcessTypePtr; IO_SB IOsb; REQUEST_STRUCT *rqptr; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclCreateScriptProcess() !&Z !UL", ScriptAsPtr, BasePriority); rqptr = tkptr->RequestPtr; /* start with a known quantity (yep, got caught ;^) */ status = SS$_NORMAL; /* sanity check */ if (BasePriority > 5) BasePriority = 5; #if OPERATE_WITH_SYSPRV /* if normally operating with SYSPRV *ensure* it's off before spawning */ if (OperateWithSysPrv) if (VMSnok (SetPrvStatus = sys$setprv (0, &OperateSysPrvMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); #endif if (DclScriptDetachProcess) { if (HttpdNetworkMode) ProcessTypePtr = "network"; else ProcessTypePtr = "detached"; InstanceGblSecIncrLong (&AccountingPtr->DclCrePrcDetachCount); CrePrcFlags = PRC$M_DETACH; tkptr->CrePrcDetachProcess = tkptr->CrePrcDetachStarting = true; if (VMSnok (SetPrvStatus = sys$setprv (1, &CrePrcMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); /* check if this task is for the same user as is required */ if (strcmp (ScriptAsPtr, tkptr->CrePrcUserName)) { /* nope, need to change the identity */ zptr = (sptr=tkptr->CrePrcUserName) + sizeof(tkptr->CrePrcUserName)-1; for (cptr = ScriptAsPtr; *cptr && sptr < zptr; *sptr++ = *cptr++); *sptr = '\0'; if (tkptr->CrePrcUserName[0] == '!') { /* used to disable default scripting account for some reason */ status = SS$_INVUSER; } else status = SS$_NORMAL; /* set mailbox ACLs to "tag" the mailbox, and allow user access */ if (VMSok (status)) status = DclMailboxAcl (tkptr->SysCommandDevName, tkptr->CrePrcUserName); if (VMSok (status)) status = DclMailboxAcl (tkptr->SysOutputDevName, tkptr->CrePrcUserName); if (VMSok (status)) status = DclMailboxAcl (tkptr->HttpInputDevName, tkptr->CrePrcUserName); if (VMSok (status)) status = DclMailboxAcl (tkptr->CgiPlusInDevName, tkptr->CrePrcUserName); if (VMSok (status)) status = DclMailboxAcl (tkptr->CrePrcTermMbxDevName, tkptr->CrePrcUserName); /* no such id is generated by DclMailboxAcl() if username unknown */ if (status == SS$_NOSUCHID) status = SS$_INVUSER; if (VMSok (status) && (DclPersonaServicesAvailable || ScriptAsPtr == HttpdScriptAsUserName)) { status = PersonaAssume (tkptr->CrePrcUserName); if (VMSok (status) && ScriptAsPtr != HttpdScriptAsUserName) { status = PersonaAllowed (rqptr, tkptr->CrePrcUserName); if (status == SS$_CREATED) { /* bogus success message indicates privileged account */ InstanceGblSecIncrLong (&AccountingPtr-> DclCrePrcPersonaPrvUserCount); FaoToStdout ("%HTTPD-W-PERSONA, !20%D, privileged !AZ\n", 0, tkptr->CrePrcUserName); /* report this message whenever any OPCOM is in use */ if (Config.cfOpcom.Messages) FaoToOpcom ("%HTTPD-W-PERSONA, privileged !AZ", tkptr->CrePrcUserName); } } if (VMSok (status)) { InstanceGblSecIncrLong (&AccountingPtr->DclCrePrcPersonaCount); if (ScriptAsPtr == HttpdProcess.UserName || ScriptAsPtr == HttpdScriptAsUserName) InstanceGblSecIncrLong (&AccountingPtr-> DclCrePrcPersonaDefaultCount); } } if WATCH_CATEGORY(WATCH_DCL) { if (VMSok (status)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "USERNAME !AZ", tkptr->CrePrcUserName); else WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "USERNAME !AZ !&S", tkptr->CrePrcUserName, status); } if (status == SS$_INVUSER) { InstanceGblSecIncrLong (&AccountingPtr-> DclCrePrcPersonaInvUserCount); FaoToStdout ("%HTTPD-W-PERSONA, !20%D, invalid user !AZ\n", 0, tkptr->CrePrcUserName); /* report this message whenever any OPCOM is in use */ if (Config.cfOpcom.Messages) FaoToOpcom ("%HTTPD-W-PERSONA, invalid user !AZ", tkptr->CrePrcUserName); /* report invalid user as "forbidden" */ rqptr->rqResponse.HttpStatus = 403; } } } else { ProcessTypePtr = "subprocess"; InstanceGblSecIncrLong (&AccountingPtr->DclCrePrcSubprocessCount); CrePrcFlags = 0; if (Config.cfScript.SpawnAuthPriv) { /* enable persona's authorized privileges prior to spawning */ status = sys$getjpiw (EfnWait, 0, 0, &JpiItems, &IOsb, 0, 0); if (VMSok (status)) status = IOsb.Status; if (VMSnok (status)) ErrorExitVmsStatus (status, NULL, FI_LI); if (VMSnok (SetPrvStatus = sys$setprv (1, &JpiAuthPriv, 0, &PrevPrivMask))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); } } if (VMSok (status)) { for (Count = 100; Count; Count--) { /* script processes are consecutively numbered from 1..999 */ pronum = ScriptProcessNumber++ % 1000; if (!pronum) pronum++; ScriptProcessNameDsc.dsc$w_length = sizeof(ScriptProcessName)-1; sys$fao (&ScriptProcessNameFaoDsc, &Length, &ScriptProcessNameDsc, HttpdProcess.PrcNam, HttpdProcess.PrcNamLength < 12 || pronum < 100 ? "-" : "", pronum); ScriptProcessName[ScriptProcessNameDsc.dsc$w_length = Length] = '\0'; if (HttpdNetworkMode) { /*********************************/ /* create "network" mode process */ /*********************************/ memset (&LgiData, 0, sizeof(LgiData)); LgiData.flag = LGI$M_NET_PROXY; idx = 0; cptr = tkptr->CrePrcUserName; LgiData.data[idx] = strlen(cptr); memcpy (&LgiData.data[idx+1], cptr, LgiData.data[idx]); idx += LgiData.data[idx] + 1; LgiData.data[idx++] = 0; LgiData.data[idx++] = 0; LgiData.data[idx++] = 0; LgiDataDsc.dsc$a_pointer = &LgiData; LgiDataDsc.dsc$w_length = sizeof(LgiData.flag) + idx; CrePrcFlags = PRC$M_DETACH | PRC$M_NETWRK | PRC$M_NOPASSWORD; /* create network log file name (e.g. "_MBX1234:NET$WASD.LOG") */ zptr = (sptr = CommandDevName) + sizeof(CommandDevName)-1; for (cptr = tkptr->SysCommandDevName; *cptr && sptr < zptr; *sptr++ = *cptr++); for (cptr = NETWORK_MODE_LOG_NAME; *cptr && sptr < zptr; *sptr++ = *cptr++); *sptr = '\0'; CommandDevNameDsc.dsc$w_length = sptr - CommandDevName; status = sys$creprc (&tkptr->ScriptProcessPid, &LoginOutDsc, /* composite SYS$INPUT and log file name */ &CommandDevNameDsc, /* proxy login data structure */ &LgiDataDsc, /* SYS$NET, which must be redirected to */ &tkptr->SysOutputDevNameDsc, 0, 0, &ScriptProcessNameDsc, BasePriority, 0, tkptr->CrePrcTermMbxUnit, CrePrcFlags, 0, 0); } else { /**************************************/ /* create "other" mode or sub process */ /**************************************/ status = sys$creprc (&tkptr->ScriptProcessPid, &LoginOutDsc, &tkptr->SysCommandDevNameDsc, &tkptr->SysOutputDevNameDsc, 0, 0, 0, &ScriptProcessNameDsc, BasePriority, 0, tkptr->CrePrcTermMbxUnit, CrePrcFlags, 0, 0); } if WATCH_CATEGORY(WATCH_DCL) { if (VMSok (status)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "CREATE !AZ pid:!8XL priority !UL", ProcessTypePtr, tkptr->ScriptProcessPid, BasePriority); else WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "CREATE !AZ !&S", ProcessTypePtr, status); } if (status != SS$_DUPLNAM) break; } } if (DclScriptDetachProcess) { tkptr->DetachedGrantId = true; if (DclPersonaServicesAvailable || ScriptAsPtr == HttpdScriptAsUserName) { /* return to the "natural" persona of the server account */ BecomeStatus = PersonaAssume (NULL); if (VMSnok (BecomeStatus)) status = BecomeStatus; } if (VMSnok (SetPrvStatus = sys$setprv (0, &CrePrcMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); } else if (Config.cfScript.SpawnAuthPriv) { /* spawned with authorized privileges, restore previous ones */ if (VMSnok (SetPrvStatus = sys$setprv (0, &JpiAuthPriv, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); if (VMSnok (SetPrvStatus = sys$setprv (1, &PrevPrivMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); } #if OPERATE_WITH_SYSPRV /* if normally operating with SYSPRV turn it back on */ if (OperateWithSysPrv) if (VMSnok (SetPrvStatus = sys$setprv (1, &OperateSysPrvMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); #endif if (VMSok (status)) { /* queue a read from the process termination mailbox */ status = sys$qio (EfnNoWait, tkptr->CrePrcTermMbxChannel, IO$_READLBLK, &tkptr->CrePrcTermMbxIOsb, &DclScriptProcessCompletionAST, tkptr, &tkptr->CrePrcTermRecord, sizeof(tkptr->CrePrcTermRecord), 0, 0, 0, 0); if (VMSnok (status)) { /* need WORLD privilege if process created under another username */ if (tkptr->CrePrcUserName[0]) if (VMSnok (SetPrvStatus = sys$setprv (1, &WorldMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); status = sys$delprc (&tkptr->ScriptProcessPid, 0); if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI); if (tkptr->CrePrcUserName[0]) if (VMSnok (SetPrvStatus = sys$setprv (0, &WorldMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); } } DclCountScriptProcess (); if (VMSok (status)) { InstanceGblSecIncrLong (&AccountingPtr->DclCrePrcCount); return (status); } rqptr->rqResponse.ErrorTextPtr = MsgFor(rqptr,MSG_SCRIPT_SPAWN); ErrorVmsStatus (rqptr, status, FI_LI); return (status); } /*****************************************************************************/ /* This AST is called when the script processes exits. */ DclScriptProcessCompletionAST (DCL_TASK *tkptr) { int status; REQUEST_STRUCT *rqeptr; LIST_ENTRY *leptr; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclScriptProcessCompletionAST() !&F !&S !8XL !4XL \'!12AZ\' !&S", &DclScriptProcessCompletionAST, tkptr->CrePrcTermMbxIOsb.Status, tkptr->ScriptProcessPid, tkptr->CrePrcTermRecord.acc$w_msgtyp, tkptr->CrePrcTermRecord.acc$t_username, tkptr->CrePrcTermRecord.acc$l_finalsts); if (VMSnok (tkptr->CrePrcTermMbxIOsb.Status)) { if WATCH_CATEGORY(WATCH_DCL) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "TERMINATION-MBX !8XL !&S", tkptr->ScriptProcessPid, tkptr->CrePrcTermMbxIOsb.Status); ErrorNoticed (NULL, tkptr->CrePrcTermMbxIOsb.Status, "DclScriptProcessCompletionAST", FI_LI); } if WATCH_CATEGORY(WATCH_DCL) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "!AZ completion pid:!8XL !&S", DclScriptDetachProcess ? "DETACHED" : "SUBPROCESS", tkptr->ScriptProcessPid, tkptr->CrePrcTermRecord.acc$l_finalsts); /* ensure SYS$COMMAND gets emptied! */ tkptr->QueuedSysCommandAllowed = 0; /* won't be getting anymore output from this process! */ status = sys$qio (EfnNoWait, tkptr->SysOutputChannel, IO$_WRITEOF | IO$M_NORSWAIT, 0, 0, 0, 0, 0, 0, 0, 0, 0); if (DclProctorEnabled) { if (tkptr->ProctorPtr) { /* the failure algorithm is faster to fail, slower to re-allow */ if (tkptr->ProctorPtr->FailWeight) { if (tkptr->ProctorPtr->FailWeight < PROCTOR_FAIL_AT) { /* not yet in failure mode */ tkptr->ProctorPtr->FailWeight = tkptr->ProctorPtr->FailWeight * tkptr->ProctorPtr->FailWeight; /* if just moved into failure mode */ if (tkptr->ProctorPtr->FailWeight >= PROCTOR_FAIL_AT) DclScriptProctorReportFail (tkptr->ProctorPtr, "process exit %X!8XL", tkptr->CrePrcTermMbxIOsb.Status); } else tkptr->ProctorPtr->FailWeight = tkptr->ProctorPtr->FailWeight * tkptr->ProctorPtr->FailWeight; } else tkptr->ProctorPtr->FailWeight = PROCTOR_FAIL_BASE; /* only immediately reproctor for the first few attempts */ if (tkptr->ProctorPtr->FailWeight < PROCTOR_FAIL_AT) SysDclAst (&DclScriptProctor, NULL); } else SysDclAst (&DclScriptProctor, NULL); } /* scan the web socket list for matching requests */ for (leptr = WebSockList.HeadPtr; leptr; leptr = leptr->NextPtr) { rqeptr = ((struct RequestWebSocketStruct*)leptr)->RequestPtr; /* if the WebSocket associated process is not this task */ if (rqeptr->rqWebSocket.ScriptProcessPid != tkptr->ScriptProcessPid) continue; /* if this request is currently directly associated with the task */ if (rqeptr == tkptr->RequestPtr) continue; if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "ws:!8XL", rqeptr); /* make the closure asynchronous to this list traversal */ SysDclAst (WebSockClose, rqeptr); } /* no longer marked for delete (if it was), set PID and lifetime to zero */ tkptr->BuildRecords = tkptr->ScriptCpuTimGetJpi = tkptr->DeleteProcess = tkptr->ForceImageExit = tkptr->ForceImageExitGetJpi = tkptr->ForceImageExitIssued = tkptr->TaskRunDown = false; tkptr->ForceImageExitSecond = tkptr->JpiCpuTimIOsb.Status = tkptr->JpiImagNameIOsb.Status = tkptr->JpiImagNameLength = tkptr->LifeTimeSecond = tkptr->ScriptCpuMax = tkptr->ScriptCpuTimMax = tkptr->ScriptProcessPid = tkptr->SysOutputBuildCount = 0; tkptr->CrePrcUserName[0] = '\0'; /* keep track of how many script processes are executing */ if (CurrentDclScriptProcess) CurrentDclScriptProcess--; DclCountScriptProcess (); /* ensure any old sequence strings are not reused */ tkptr->CgiBel[0] = tkptr->CgiEof[0] = tkptr->CgiEot[0] = tkptr->CgiEsc[0] = '\0'; tkptr->CgiBelLength = tkptr->CgiEofLength = tkptr->CgiEotLength = tkptr->CgiEscLength = 0; DclTaskRunDown (tkptr); } /*****************************************************************************/ /* If a script application writes any output before it was/is terminated that output will still be laying unread in the mailbox. Clear any such noise lest it be read by the next script process to use the mailbox. Does this synchronously (i.e. with QIO waits). */ DclEmptySysOutput (DCL_TASK *tkptr) { int status, LastMessageCount; struct MbxSenseIOsb SenseIOsb; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclEmptySysOutput()"); LastMessageCount = 999999999; SenseIOsb.MessageCount = 0; for (;;) { status = sys$qiow (EfnWait, tkptr->SysOutputChannel, IO$_SENSEMODE, &SenseIOsb, 0, 0, 0, 0, 0, 0, 0, 0); if (VMSok (status)) status = SenseIOsb.Status; if (VMSnok (status)) ErrorExitVmsStatus (status, NULL, FI_LI); if (!SenseIOsb.MessageCount) break; /* potential infinite loop, check message count is decreasing! */ if (LastMessageCount <= SenseIOsb.MessageCount) break; LastMessageCount = SenseIOsb.MessageCount; sys$qiow (EfnWait, tkptr->SysOutputChannel, IO$_READLBLK, &tkptr->SysOutputIOsb, 0, 0, tkptr->SysOutputPtr, tkptr->SysOutputSize, 0, 0, 0, 0); } } /*****************************************************************************/ /* If an error is encountered an error message is generated and the error status returned. It is up to the calling routine to abort the processing. Create four mailboxes that will be associated with the script process I/O streams. If an error occurs any mailbox created up to that point is deleted and the channel set back to zero. */ #define DVI$_DEVNAM 32 #define DVI$_UNIT 12 DclCreateMailboxes (DCL_TASK *tkptr) { static unsigned long DevNamItem = DVI$_DEVNAM, UnitItem = DVI$_UNIT; int status; unsigned short Length; unsigned long BytLmAfter, BytLmBefore, LongUnit; struct dsc$descriptor_s *dscptr; /*********/ /* begin */ /*********/ BytLmBefore = GetJpiBytLm (); if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclCreateMailboxes() !UL !UL", BytLmBefore, DclMailboxBytLmRequired); /* ensure we're leaving enough BYTLM for client socket creation at least */ if (DclMailboxBytLmRequired && BytLmBefore - DclMailboxBytLmRequired <= NetAcceptBytLmRequired * Config.cfServer.ProcessMax) { ErrorNoticed (NULL, 0, "BYTLM exhausted", FI_LI); return (SS$_EXQUOTA); } tkptr->CgiPlusInChannel = tkptr->CrePrcTermMbxChannel = tkptr->HttpInputChannel = tkptr->SysCommandChannel = tkptr->SysOutputChannel = 0; /***********************/ /* SYS$COMMAND mailbox */ /***********************/ if (VMSnok (status = sys$crembx (0, &tkptr->SysCommandChannel, DclSysCommandSize, DclSysCommandSize, DCL_PROCESS_MBX_PROT_MASK, 0, 0, CMB$M_WRITEONLY))) goto DclCreateMailBoxesError; dscptr = &tkptr->SysCommandDevNameDsc; dscptr->dsc$w_length = sizeof(tkptr->SysCommandDevName); dscptr->dsc$a_pointer = tkptr->SysCommandDevName; dscptr->dsc$b_class = DSC$K_CLASS_S; dscptr->dsc$b_dtype = DSC$K_DTYPE_T; if (VMSnok (status = lib$getdvi (&DevNamItem, &tkptr->SysCommandChannel, 0, 0, &tkptr->SysCommandDevNameDsc, &Length))) goto DclCreateMailBoxesError; tkptr->SysCommandDevName[dscptr->dsc$w_length = Length] = '\0'; if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "$CREMBX() SYS$COMMAND !AZ !UL", tkptr->SysCommandDevName, DclSysCommandSize); /**********************/ /* SYS$OUTPUT mailbox */ /**********************/ if (VMSnok (status = sys$crembx (0, &tkptr->SysOutputChannel, DclSysOutputSize, DclSysOutputSize, DCL_PROCESS_MBX_PROT_MASK, 0, 0, 0))) goto DclCreateMailBoxesError; dscptr = &tkptr->SysOutputDevNameDsc; dscptr->dsc$w_length = sizeof(tkptr->SysOutputDevName); dscptr->dsc$a_pointer = tkptr->SysOutputDevName; dscptr->dsc$b_class = DSC$K_CLASS_S; dscptr->dsc$b_dtype = DSC$K_DTYPE_T; if (VMSnok (status = lib$getdvi (&DevNamItem, &tkptr->SysOutputChannel, 0, 0, &tkptr->SysOutputDevNameDsc, &Length))) goto DclCreateMailBoxesError; tkptr->SysOutputDevName [dscptr->dsc$w_length = Length] = '\0'; if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "$CREMBX() SYS$OUTPUT !AZ !UL", tkptr->SysOutputDevName, DclSysOutputSize); /*********************/ /* CGIPLUSIN mailbox */ /*********************/ if (VMSnok (status = sys$crembx (0, &tkptr->CgiPlusInChannel, DclCgiPlusInSize, DclCgiPlusInSize, DCL_PROCESS_MBX_PROT_MASK, 0, 0, CMB$M_WRITEONLY))) goto DclCreateMailBoxesError; dscptr = &tkptr->CgiPlusInDevNameDsc; dscptr->dsc$w_length = sizeof(tkptr->CgiPlusInDevName); dscptr->dsc$a_pointer = tkptr->CgiPlusInDevName; dscptr->dsc$b_class = DSC$K_CLASS_S; dscptr->dsc$b_dtype = DSC$K_DTYPE_T; if (VMSnok (status = lib$getdvi (&DevNamItem, &tkptr->CgiPlusInChannel, 0, 0, &tkptr->CgiPlusInDevNameDsc, &Length))) goto DclCreateMailBoxesError; tkptr->CgiPlusInDevName[dscptr->dsc$w_length = Length] = '\0'; if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "$CREMBX() CGIPLUSIN !AZ !UL", tkptr->CgiPlusInDevName, DclCgiPlusInSize); /**********************/ /* HTTP$INPUT mailbox */ /**********************/ if (VMSnok (status = sys$crembx (0, &tkptr->HttpInputChannel, NetReadBufferSize, NetReadBufferSize, DCL_PROCESS_MBX_PROT_MASK, 0, 0, CMB$M_WRITEONLY))) goto DclCreateMailBoxesError; dscptr = &tkptr->HttpInputDevNameDsc; dscptr->dsc$w_length = sizeof(tkptr->HttpInputDevName); dscptr->dsc$a_pointer = tkptr->HttpInputDevName; dscptr->dsc$b_class = DSC$K_CLASS_S; dscptr->dsc$b_dtype = DSC$K_DTYPE_T; if (VMSnok (status = lib$getdvi (&DevNamItem, &tkptr->HttpInputChannel, 0, 0, &tkptr->HttpInputDevNameDsc, &Length))) goto DclCreateMailBoxesError; tkptr->HttpInputDevName[dscptr->dsc$w_length = Length] = '\0'; if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "$CREMBX() HTTP$INPUT !AZ !UL", tkptr->HttpInputDevName, NetReadBufferSize); /************************************/ /* SYS$CREPRC() termination mailbox */ /************************************/ if (VMSnok (status = sys$crembx (0, &tkptr->CrePrcTermMbxChannel, sizeof(DCL_CREPRC_TERM), sizeof(DCL_CREPRC_TERM), DCL_PROCESS_MBX_PROT_MASK, 0, 0, CMB$M_READONLY))) goto DclCreateMailBoxesError; dscptr = &tkptr->CrePrcTermMbxDevNameDsc; dscptr->dsc$w_length = sizeof(tkptr->CrePrcTermMbxDevName); dscptr->dsc$a_pointer = tkptr->CrePrcTermMbxDevName; dscptr->dsc$b_class = DSC$K_CLASS_S; dscptr->dsc$b_dtype = DSC$K_DTYPE_T; status = lib$getdvi (&DevNamItem, &tkptr->CrePrcTermMbxChannel, 0, 0, &tkptr->CrePrcTermMbxDevNameDsc, &Length); if (VMSok (status)) status = lib$getdvi (&UnitItem, &tkptr->CrePrcTermMbxChannel, 0, &LongUnit, 0, 0); if (VMSnok (status)) goto DclCreateMailBoxesError; /* lib$getdvi() requires 32 bit longs, the mailbox unit is only 16 bits */ tkptr->CrePrcTermMbxUnit = (unsigned short)LongUnit; tkptr->CrePrcTermMbxDevName[dscptr->dsc$w_length = Length] = '\0'; if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "$CREMBX() TERMINATION !AZ unit:!UL", tkptr->CrePrcTermMbxDevName, tkptr->CrePrcTermMbxUnit); /******/ /* OK */ /******/ if (!DclMailboxBytLmRequired) { BytLmAfter = GetJpiBytLm (); DclMailboxBytLmRequired = BytLmBefore - BytLmAfter; if (WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "BytLm: !UL", DclMailboxBytLmRequired); } return (SS$_NORMAL); /*********/ /* ERROR */ /*********/ DclCreateMailBoxesError: ErrorNoticed (NULL, status, "$CREMBX()", FI_LI); if (tkptr->CgiPlusInChannel) sys$dassgn (tkptr->CgiPlusInChannel); if (tkptr->CrePrcTermMbxChannel) sys$dassgn (tkptr->CrePrcTermMbxChannel); if (tkptr->HttpInputChannel) sys$dassgn (tkptr->HttpInputChannel); if (tkptr->SysCommandChannel) sys$dassgn (tkptr->SysCommandChannel); if (tkptr->SysOutputChannel) sys$dassgn (tkptr->SysOutputChannel); tkptr->CrePrcTermMbxChannel = tkptr->CgiPlusInChannel = tkptr->HttpInputChannel = tkptr->SysCommandChannel = tkptr->SysOutputChannel = 0; return (status); } /*****************************************************************************/ /* Queue up a read from the script process "SYS$OUTPUT" mailbox. When the read completes call function DclSysOutputAst(), do any post-processing required and write the data to the client over the network. The next read from the script process via the mailbox will be queued by the network write completion AST function. */ DclQioSysOutput (DCL_TASK *tkptr) { int status; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclQioSysOutput() !8XL", tkptr->ScriptProcessPid); tkptr->QueuedSysOutput++; status = sys$qio (EfnNoWait, tkptr->SysOutputChannel, IO$_READLBLK, &tkptr->SysOutputIOsb, &DclSysOutputAst, tkptr, tkptr->SysOutputPtr, tkptr->SysOutputSize, 0, 0, 0, 0); if (VMSok (status)) return; /* report error via the AST */ tkptr->SysOutputIOsb.Status = status; SysDclAst (&DclSysOutputAst, tkptr); } /*****************************************************************************/ /* A queued asynchronous read from the script process "SYS$OUTPUT" mailbox has completed. For 'build-records' mode see description in module prologue. */ DclSysOutputAst (DCL_TASK *tkptr) { int cnt, status, value; char *cptr; REQUEST_STRUCT *rqptr; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclSysOutputAst() !&F !8XL !UL !UL !UL !UL !UL !UL !&S", &DclSysOutputAst, tkptr->ScriptProcessPid, tkptr->QueuedSysCommand, tkptr->QueuedSysOutput, tkptr->QueuedCgiPlusIn, tkptr->QueuedHttpInput, tkptr->QueuedClientRead, tkptr->SysOutputIOsb.Count, tkptr->SysOutputIOsb.Status); if (tkptr->QueuedSysOutput) tkptr->QueuedSysOutput--; rqptr = tkptr->RequestPtr; if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) { WatchThis (rqptr, FI_LI, WATCH_DCL, "READ SYS$OUTPUT !&S !UL byte!%s", tkptr->SysOutputIOsb.Status, tkptr->SysOutputIOsb.Count); if (tkptr->SysOutputIOsb.Count) { if (tkptr->BuildRecords) WatchDataDump (tkptr->SysOutputPtr+tkptr->SysOutputBuildCount, tkptr->SysOutputIOsb.Count); else WatchDataDump (tkptr->SysOutputPtr, tkptr->SysOutputIOsb.Count); } } if (ERROR_REPORTED(rqptr) && !ERROR_REPORTED_BY_SCRIPT(rqptr)) { if (!tkptr->WatchNonCgiCompliant) { /* an opportune point to report any error generated elsewhere */ tkptr->DeleteProcess = true; DclTaskRunDown (tkptr); return; } } if (tkptr->SysOutputIOsb.Status == SS$_ENDOFFILE) { if (!tkptr->ScriptProcessPid) { /* script process has already concluded, must be the last gasp! */ DclTaskRunDown (tkptr); return; } /* If a script spawns multiple script processes each will terminate by queueing an end-of-file. Ignore these. Queue the next read of the script process' SYS$OUTPUT. The CRTL outputs an end-of-file for a zero-length record. Put a count on the maximum number of these before the script is considered to be misbehaving. */ if (tkptr->SysOutputEndOfFileCount++ > DCL_SCRIPT_MAX_ENDOFFILE) { tkptr->RequestPtr->rqResponse.HttpStatus = 502; ErrorGeneral (tkptr->RequestPtr, MsgFor(tkptr->RequestPtr,MSG_SCRIPT_RESPONSE_ERROR), FI_LI); tkptr->DeleteProcess = true; DclTaskRunDown (tkptr); return; } DclQioSysOutput (tkptr); return; } if (tkptr->ViaSysOutputStatus) tkptr->SysOutputIOsb.Status = tkptr->ViaSysOutputStatus; if (VMSnok (tkptr->SysOutputIOsb.Status)) { if (tkptr->SysOutputIOsb.Status == SS$_ABORT || tkptr->SysOutputIOsb.Status == SS$_CANCEL) { tkptr->DeleteProcess = true; DclTaskRunDown (tkptr); return; } rqptr->rqResponse.ErrorTextPtr = MsgFor(rqptr,MSG_SCRIPT_IPC); ErrorVmsStatus (rqptr, tkptr->SysOutputIOsb.Status, FI_LI); tkptr->DeleteProcess = true; DclTaskRunDown (tkptr); return; } /*************/ /* status OK */ /*************/ if (tkptr->CrePrcDetachStarting) { cptr = tkptr->SysOutputPtr; cnt = tkptr->SysOutputIOsb.Count; cptr[cnt] = '\0'; if (cnt >= tkptr->CgiBelLength && cnt <= tkptr->CgiBelLength+2 && MATCH0 (cptr, tkptr->CgiBel, tkptr->CgiBelLength)) { tkptr->CrePrcDetachStarting = false; /* reset CGI output processing */ CgiOutput (rqptr, NULL, 0); if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (rqptr, FI_LI, WATCH_DCL, "DETACHED process ready"); } /* absorb this, just queue the next read */ DclQioSysOutput (tkptr); return; } if (!tkptr->ScriptProcessResponded) { /*********************/ /* finally it's true */ /*********************/ tkptr->ScriptProcessResponded = true; if (tkptr->SysOutputIOsb.Count == 1) { /* hmmm, one byte only - start 'building records'! */ tkptr->BuildRecords = true; if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (rqptr, FI_LI, WATCH_DCL, "BUILD records"); } } if (tkptr->BuildRecords) { /*****************************************/ /* building 'records' from single bytes! */ /*****************************************/ cptr = tkptr->SysOutputPtr + tkptr->SysOutputBuildCount; if (tkptr->SysOutputIOsb.Count) { tkptr->SysOutputBuildCount += tkptr->SysOutputIOsb.Count; cnt = tkptr->SysOutputSize - tkptr->SysOutputBuildCount; if (tkptr->SysOutputIOsb.Count == 1 && *cptr != '\n' && cnt > 0) { /* not a newline and still space in the buffer */ tkptr->QueuedSysOutput++; status = sys$qio (EfnNoWait, tkptr->SysOutputChannel, IO$_READLBLK, &tkptr->SysOutputIOsb, &DclSysOutputAst, tkptr, cptr+1, cnt, 0, 0, 0, 0); if (VMSok (status)) return; /* report error via the AST */ tkptr->SysOutputIOsb.Status = status; SysDclAst (&DclSysOutputAst, tkptr); return; } } else { *cptr = '\n'; tkptr->SysOutputBuildCount++; } /* newline, zero bytes, multiple bytes, or out of buffer space */ tkptr->SysOutputIOsb.Count = tkptr->SysOutputBuildCount; tkptr->SysOutputBuildCount = 0; if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) { WatchThis (rqptr, FI_LI, WATCH_DCL, "BUILT record !UL byte!%s", tkptr->SysOutputIOsb.Count); WatchDataDump (tkptr->SysOutputPtr, tkptr->SysOutputIOsb.Count); } } /******************/ /* process record */ /******************/ cptr = tkptr->SysOutputPtr; cnt = tkptr->SysOutputIOsb.Count; cptr[cnt] = '\0'; if (tkptr->WatchNonCgiCompliant) { if (rqptr->rqCgi.EofLength && cnt >= rqptr->rqCgi.EofLength && cnt <= rqptr->rqCgi.EofLength+2 && MATCH0 (cptr, rqptr->rqCgi.EofStr, rqptr->rqCgi.EofLength)) { /* end of output from script! */ tkptr->DeleteProcess = true; value = CGI_OUTPUT_END; } else { /* just queue the next read */ DclQioSysOutput (tkptr); return; } } else value = CgiOutput (rqptr, tkptr->SysOutputPtr, tkptr->SysOutputIOsb.Count); if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "!SL", value); switch (value) { case CGI_OUTPUT_END : if (!ISAGENT(tkptr) && WEBSOCKET_REQUEST (rqptr)) { /* disassociate the DCL task and request structures */ tkptr->RequestPtr->DclTaskPtr = NULL; tkptr->RequestPtr = tkptr->NextTaskFunction = NULL; WebSockIfEnd (rqptr); /* WebSocket throttling is a request startup activity only */ if (rqptr->rqPathSet.ThrottleSet) ThrottleEnd (rqptr); } /* terminate processing */ DclTaskRunDown (tkptr); if (rqptr->rqCgi.CalloutInProgress) { if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (rqptr, FI_LI, WATCH_DCL, "CALLOUT end"); /* script didn't send an EOT, let callable function know now! */ rqptr->rqCgi.CalloutInProgress = false; /* the NULL and zero bytes indicates transaction end */ rqptr->rqCgi.CalloutOutputPtr = NULL; rqptr->rqCgi.CalloutOutputCount = 0; /* execute the callout function */ (*tkptr->CalloutFunction)(rqptr); } if (ISAGENT(tkptr)) { /* (authorization) agent task */ if (rqptr->rqCgi.BufferLength) { /* release the CGI variables used for this task */ if (rqptr->rqCgi.BufferPtr) VmFreeFromHeap (rqptr, rqptr->rqCgi.BufferPtr, FI_LI); rqptr->rqCgi.BufferLength = 0; rqptr->rqCgi.BufferPtr = rqptr->rqCgi.BufferCurrentPtr = NULL; } } return; case CGI_OUTPUT_NOT_STRICT : /* not strictly CGI compliant, report and terminate processing */ tkptr->RequestPtr->rqResponse.HttpStatus = 502; ErrorGeneral (tkptr->RequestPtr, MsgFor(tkptr->RequestPtr,MSG_SCRIPT_RESPONSE_ERROR), FI_LI); if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) { /* continue to conclusion while bit-bucketing the output */ tkptr->WatchNonCgiCompliant = true; /* reset CGI output processing */ CgiOutput (rqptr, NULL, 0); /* just queue the next read */ DclQioSysOutput (tkptr); return; } tkptr->DeleteProcess = true; DclTaskRunDown (tkptr); return; case CGI_OUTPUT_ESCAPE_BEGIN : /* start talking direct to the server */ if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (rqptr, FI_LI, WATCH_DCL, "CALLOUT begin"); rqptr->rqCgi.CalloutInProgress = true; /* the NULL and minus one bytes indicates transaction begin */ rqptr->rqCgi.CalloutOutputPtr = NULL; rqptr->rqCgi.CalloutOutputCount = -1; /* execute the callout function */ (*tkptr->CalloutFunction)(rqptr); DclQioSysOutput (tkptr); return; case CGI_OUTPUT_ESCAPE : /* the script is talking direct to the server */ rqptr->rqCgi.CalloutOutputPtr = tkptr->SysOutputPtr; rqptr->rqCgi.CalloutOutputCount = tkptr->SysOutputIOsb.Count; if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) { WatchThis (rqptr, FI_LI, WATCH_DCL, "CALLOUT !UL bytes", rqptr->rqCgi.CalloutOutputCount); if (rqptr->rqCgi.CalloutOutputCount) WatchDataDump (rqptr->rqCgi.CalloutOutputPtr, rqptr->rqCgi.CalloutOutputCount); } /* execute the callout function */ (*tkptr->CalloutFunction)(rqptr); DclQioSysOutput (tkptr); return; case CGI_OUTPUT_ESCAPE_END : if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (rqptr, FI_LI, WATCH_DCL, "CALLOUT end"); /* end talking direct to the server */ rqptr->rqCgi.CalloutInProgress = false; /* the NULL and zero bytes indicates transaction end */ rqptr->rqCgi.CalloutOutputPtr = NULL; rqptr->rqCgi.CalloutOutputCount = 0; /* execute the callout function */ (*tkptr->CalloutFunction)(rqptr); if (rqptr->rqPathSet.CgiPlusInWriteof) DclQioCgiPlusIn (tkptr, NULL, 0); DclQioSysOutput (tkptr); return; default : if (value) { if (tkptr->NextTaskFunction == &DclScriptProctorAst) { /* absorb proctored output (saves the invalid network I/O) */ value = 0; } else if (!ISAGENT(tkptr) && WEBSOCKET_REQUEST(rqptr)) { /* WebSocket scripts should provide nothing via */ if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "WEBSOCKET any SYS$OUTPUT is an ERROR!!"); value = 0; } else if (ERROR_REPORTED_BY_SCRIPT(rqptr)) { /* when "Script-Control: x-error..." output nothing */ value = 0; } } if (tkptr->ClientWriteErrorCount) { /* no need to REALLY write it if there's been an error! */ rqptr->rqNet.WriteIOsb.Status = rqptr->rqNet.WriteErrorStatus; SysDclAst (&DclSysOutputToClientAst, rqptr); tkptr->QueuedSysOutput++; return; } if (!value) { /* output all absorbed, just queue the next read */ DclQioSysOutput (tkptr); return; } if (rqptr->rqCgi.BufferRecords || rqptr->rqCgi.IsCliDcl) { /* buffer the record */ NetWriteBuffered (rqptr, &DclSysOutputToClientAst, cptr, value); tkptr->QueuedSysOutput++; return; } /* write the record */ NetWrite (rqptr, &DclSysOutputToClientAst, cptr, value); tkptr->QueuedSysOutput++; return; } } /*****************************************************************************/ /* ************ *** NOTE *** This function takes a pointer to a request!!! ************ Due to is being an AST from a general network write function. A queued asynchronous write of script process SYS$OUTPUT (mailbox) to the client over the network has completed. When the bit-bucket timeout is set or do-not-disturb is set this is ignored (at least for the present) and the script is allowed to continue. For others just abort the script. */ DclSysOutputToClientAst (REQUEST_STRUCT *rqptr) { int status; DCL_TASK *tkptr; /*********/ /* begin */ /*********/ /* get a pointer to the DCL task from the request structure */ tkptr = rqptr->DclTaskPtr; if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclSysOutputToClientAst() !&F !8XL !UL !UL !UL !UL !UL !&S !&S", &DclSysOutputToClientAst, tkptr->ScriptProcessPid, tkptr->QueuedSysCommand, tkptr->QueuedSysOutput, tkptr->QueuedCgiPlusIn, tkptr->QueuedHttpInput, tkptr->QueuedClientRead, tkptr->SysOutputIOsb.Status, rqptr->rqNet.WriteIOsb.Status); if (tkptr->QueuedSysOutput) tkptr->QueuedSysOutput--; if (VMSnok (rqptr->rqNet.WriteIOsb.Status)) { /* NETWORK ERROR when writing TO CLIENT */ if (tkptr->LifeTimeSecond == DCL_DO_NOT_DISTURB) { /* do not disturb script means DO NOT DISTURB SCRIPT!! */ if (!tkptr->ClientWriteErrorCount) if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "DO-NOT-DISTURB in effect"); } else if (tkptr->BitBucketTimeout) { if (!tkptr->ClientWriteErrorCount) { if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "BIT-BUCKET !UL seconds", tkptr->BitBucketTimeout); /* ignore client error, give the script just a little longer */ HttpdTimerSet (rqptr, TIMER_OUTPUT, tkptr->BitBucketTimeout); } } else { /* otherwise OK to abort on client issues */ tkptr->DeleteProcess = true; DclTaskRunDown (tkptr); return; } tkptr->ClientWriteErrorCount++; } /* queue the next read of the script process' SYS$OUTPUT */ DclQioSysOutput (tkptr); } /*****************************************************************************/ /* Queue up a write of data to the script process "SYS$COMMAND" mailbox. This is the script processes' "SYS$COMMAND", supplying the DCL commands to execute, CGI information, etc. */ DclQioSysCommand ( DCL_TASK *tkptr, char *DataPtr, int DataLength ) { int status; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclQioSysCommand() !8XL", tkptr->ScriptProcessPid); if (!DataPtr) { /* NULL pointer means write an end-of-file to the channel */ if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "WRITE SYS$COMMAND EOF"); tkptr->QueuedSysCommand++; status = sys$qio (EfnNoWait, tkptr->SysCommandChannel, IO$_WRITEOF | IO$M_NORSWAIT, &tkptr->SysCommandIOsb, &DclSysCommandAst, tkptr, 0, 0, 0, 0, 0, 0); if (VMSok (status)) return; } else { if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) { WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "WRITE SYS$COMMAND !UL", DataLength); if (DataLength) WatchData (DataPtr, DataLength); } tkptr->QueuedSysCommand++; status = sys$qio (EfnNoWait, tkptr->SysCommandChannel, IO$_WRITELBLK | IO$M_NORSWAIT, &tkptr->SysCommandIOsb, &DclSysCommandAst, tkptr, DataPtr, DataLength, 0, 0, 0, 0); if (VMSok (status)) return; } /* report error via the AST */ if (status == SS$_MBFULL) { tkptr->RequestPtr->rqResponse.ErrorTextPtr = "SYS$COMMAND"; ErrorVmsStatus (tkptr->RequestPtr, status, FI_LI); } tkptr->SysCommandIOsb.Status = status; SysDclAst (&DclSysCommandAst, tkptr); } /*****************************************************************************/ /* A queued write to the script process "SYS$COMMAND" mailbox has completed. This is the script processes' "SYS$COMMAND", supplying the DCL commands to execute. The first read of the process' CLI command stream indicates it has completed the full process creation and login cycle. We can now add the identifier that marks it as a WASD detached scripting process. Adding it too early in the process life cycle can result in LOGINOUT.EXE overriding it with it's own set of rights identifiers. */ DclSysCommandAst (DCL_TASK *tkptr) { int status, SetPrvStatus; unsigned long ScriptProcessPid; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclSysCommandAst() !&F !8XL !UL/!UL !UL !UL !UL !UL !&S", &DclSysCommandAst, tkptr->ScriptProcessPid, tkptr->QueuedSysCommand, tkptr->QueuedSysCommandAllowed, tkptr->QueuedSysOutput, tkptr->QueuedCgiPlusIn, tkptr->QueuedHttpInput, tkptr->QueuedClientRead, tkptr->SysCommandIOsb.Status); if (tkptr->QueuedSysCommand) tkptr->QueuedSysCommand--; /* first AST is delivered %x00000000, make %X00000001 */ if (!tkptr->SysCommandIOsb.Status) tkptr->SysCommandIOsb.Status = 1; if (tkptr->DetachedGrantId) { /****************************************/ /* grant the detached script process ID */ /****************************************/ tkptr->DetachedGrantId = false; if (VMSnok (SetPrvStatus = sys$setprv (1, &GrantIdMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); /* PID needs to be in some sort of scratch space? (most peculiar!) */ ScriptProcessPid = tkptr->ScriptProcessPid; /* note: not sure of what the sixth parameter is - 'segment'? */ status = sys$grantid (&ScriptProcessPid, 0, &ProcessRightsIdent, 0, 0, 0); if (VMSnok (SetPrvStatus = sys$setprv (0, &GrantIdMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "sys$grantid() !AZ !&X !&S", ProcessIdentName, ProcessRightsIdent[0], status); if (VMSnok (status)) { /* make it a little more obvious */ if (status == SS$_NOPRIV) status = SS$_NOCMKRNL; tkptr->RequestPtr->rqResponse.ErrorTextPtr = MsgFor(tkptr->RequestPtr,MSG_SCRIPT_DCL_ENVIRONMENT); ErrorVmsStatus (tkptr->RequestPtr, status, FI_LI); tkptr->DeleteProcess = true; DclTaskRunDown (tkptr); return; } } if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "WRITE SYS$COMMAND !&S", tkptr->SysCommandIOsb.Status); /* if (effectively) no outstanding I/O then conclude the DCL task */ if (tkptr->QueuedSysCommand <= tkptr->QueuedSysCommandAllowed && !tkptr->QueuedSysOutput && !tkptr->QueuedCgiPlusIn && !tkptr->QueuedHttpInput && !tkptr->QueuedClientRead) { DclTaskRunDown (tkptr); return; } /* if I/O cancelled then just return */ if (tkptr->SysCommandIOsb.Status == SS$_ABORT || tkptr->SysCommandIOsb.Status == SS$_CANCEL) return; /* abort if an error writing SYS$COMMAND stream to script process */ if (VMSnok (tkptr->SysCommandIOsb.Status)) { tkptr->RequestPtr->rqResponse.ErrorTextPtr = MsgFor(tkptr->RequestPtr,MSG_SCRIPT_IPC); ErrorVmsStatus (tkptr->RequestPtr, tkptr->SysCommandIOsb.Status, FI_LI); tkptr->DeleteProcess = true; DclTaskRunDown (tkptr); return; } /* allow for the queued post-CGIplus script STOP/id=0 and EOF */ if (tkptr->QueuedSysCommand > tkptr->QueuedSysCommandAllowed) tkptr->ScriptProcessActivated = true; } /*****************************************************************************/ /* Queue up a write of data to the script process "CGIPLUSIN" mailbox. This is a CGIplus script processes' CGI variable stream mailbox. */ DclQioCgiPlusIn ( DCL_TASK *tkptr, char *DataPtr, int DataLength ) { int status; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclQioCgiPlusIn()"); if (!DataPtr) { /* NULL pointer means write an end-of-file to the channel */ if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "WRITE CGIPLUSIN EOF"); tkptr->QueuedCgiPlusIn++; status = sys$qio (EfnNoWait, tkptr->CgiPlusInChannel, IO$_WRITEOF | IO$M_NORSWAIT, &tkptr->CgiPlusInIOsb, &DclCgiPlusInAst, tkptr, 0, 0, 0, 0, 0, 0); if (VMSok (status)) return; } else { if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) { WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "WRITE CGIPLUSIN !UL bytes", DataLength); if (DataLength) WatchDataDump (DataPtr, DataLength); } tkptr->QueuedCgiPlusIn++; status = sys$qio (EfnNoWait, tkptr->CgiPlusInChannel, IO$_WRITELBLK | IO$M_NORSWAIT, &tkptr->CgiPlusInIOsb, &DclCgiPlusInAst, tkptr, DataPtr, DataLength, 0, 0, 0, 0); if (VMSok (status)) return; } /* report error via the AST */ if (status == SS$_MBFULL) { tkptr->RequestPtr->rqResponse.ErrorTextPtr = "CGIPLUSIN"; ErrorVmsStatus (tkptr->RequestPtr, status, FI_LI); } tkptr->CgiPlusInIOsb.Status = status; SysDclAst (&DclCgiPlusInAst, tkptr); } /*****************************************************************************/ /* A queued write to the script process "CGIPLUSIN" mailbox has completed. This is a CGIplus script processes' CGI variable stream mailbox. */ DclCgiPlusInAst (DCL_TASK *tkptr) { /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclCgiPlusInAst() !&F !8XL !UL !UL !UL !UL !UL !&S", &DclCgiPlusInAst, tkptr->ScriptProcessPid, tkptr->QueuedSysCommand, tkptr->QueuedSysOutput, tkptr->QueuedCgiPlusIn, tkptr->QueuedHttpInput, tkptr->QueuedClientRead, tkptr->CgiPlusInIOsb.Status); if (tkptr->QueuedCgiPlusIn) tkptr->QueuedCgiPlusIn--; /* at least one CGIPLUSIN variable was read indicating script activation */ if (tkptr->CgiPlusInIOsb.Status && VMSok(tkptr->CgiPlusInIOsb.Status)) tkptr->ScriptProcessActivated = true; /* first AST is delivered %x00000000, make %X00000001 */ if (!tkptr->CgiPlusInIOsb.Status) tkptr->CgiPlusInIOsb.Status = SS$_NORMAL; if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "WRITE CGIPLUSIN !&S", tkptr->CgiPlusInIOsb.Status); /* if (effectively) no outstanding I/O then conclude the DCL task */ if (tkptr->QueuedSysCommand <= tkptr->QueuedSysCommandAllowed && !tkptr->QueuedSysOutput && !tkptr->QueuedCgiPlusIn && !tkptr->QueuedHttpInput && !tkptr->QueuedClientRead) { DclTaskRunDown (tkptr); return; } /* if I/O cancelled then just return */ if (tkptr->CgiPlusInIOsb.Status == SS$_ABORT || tkptr->CgiPlusInIOsb.Status == SS$_CANCEL) return; /* abort if an error writing CGIPLUSIN stream to script process */ if (VMSnok (tkptr->CgiPlusInIOsb.Status)) { tkptr->RequestPtr->rqResponse.ErrorTextPtr = MsgFor(tkptr->RequestPtr,MSG_SCRIPT_IPC); ErrorVmsStatus (tkptr->RequestPtr, tkptr->CgiPlusInIOsb.Status, FI_LI); tkptr->DeleteProcess = true; DclTaskRunDown (tkptr); return; } } /*****************************************************************************/ /* A network read of the request body has completed and BodyReadAst() has called this function as an AST. Write it to HTTP$INPUT with a completion AST to DclHttpInputAst(). */ DclHttpInput (REQUEST_STRUCT *rqptr) { int status, DataCount; char *DataPtr; DCL_TASK *tkptr; /*********/ /* begin */ /*********/ tkptr = rqptr->DclTaskPtr; if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (rqptr, FI_LI, WATCH_MOD_DCL, "DclHttpInput() !&F !8XL !UL !UL !UL !UL !UL !&S !&X !UL", &DclHttpInput, tkptr->ScriptProcessPid, tkptr->QueuedSysCommand, tkptr->QueuedSysOutput, tkptr->QueuedCgiPlusIn, tkptr->QueuedHttpInput, tkptr->QueuedClientRead, rqptr->rqBody.DataStatus, rqptr->rqBody.DataPtr, rqptr->rqBody.DataCount); if (tkptr->QueuedClientRead) tkptr->QueuedClientRead--; /* if (effectively) no outstanding I/O then conclude the DCL task */ if (tkptr->QueuedSysCommand <= tkptr->QueuedSysCommandAllowed && !tkptr->QueuedSysOutput && !tkptr->QueuedCgiPlusIn && !tkptr->QueuedHttpInput && !tkptr->QueuedClientRead) { DclTaskRunDown (tkptr); return; } /* if I/O cancelled then just return */ if (rqptr->rqBody.DataStatus == SS$_ABORT || rqptr->rqBody.DataStatus == SS$_CANCEL) return; if (rqptr->rqBody.DataStatus == SS$_ENDOFFILE) { /* end of body */ tkptr->QueuedHttpInput++; status = sys$qio (EfnNoWait, tkptr->HttpInputChannel, IO$_WRITEOF, &tkptr->HttpInputIOsb, &DclHttpInputAst, tkptr, 0, 0, 0, 0, 0, 0); if (VMSok (status)) return; /* report error via the AST */ tkptr->HttpInputIOsb.Status = status; SysDclAst (&DclHttpInputAst, tkptr); return; } if (VMSnok (rqptr->rqBody.DataStatus)) { DclTaskRunDown (tkptr); return; } if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) { WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "WRITE HTTP$INPUT !UL bytes", rqptr->rqBody.DataCount); if (rqptr->rqBody.DataCount) WatchDataDump (rqptr->rqBody.DataPtr, rqptr->rqBody.DataCount); } tkptr->QueuedHttpInput++; status = sys$qio (EfnNoWait, tkptr->HttpInputChannel, IO$_WRITELBLK, &tkptr->HttpInputIOsb, &DclHttpInputAst, tkptr, rqptr->rqBody.DataPtr, rqptr->rqBody.DataCount, 0, 0, 0, 0); if (VMSok (status)) return; /* report error via the AST */ tkptr->HttpInputIOsb.Status = status; SysDclAst (&DclHttpInputAst, tkptr); } /*****************************************************************************/ /* A queued write to the script process "HTTP$INPUT" mailbox has completed. Provide more (possibly first) of the request body, or EOF. */ DclHttpInputAst (DCL_TASK *tkptr) { int status, Length; char *ContentPtr; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclHttpInputAst() !&F !8XL !UL !UL !UL !UL !UL !&S !UL", &DclHttpInputAst, tkptr->ScriptProcessPid, tkptr->QueuedSysCommand, tkptr->QueuedSysOutput, tkptr->QueuedCgiPlusIn, tkptr->QueuedHttpInput, tkptr->QueuedClientRead, tkptr->HttpInputIOsb.Status, tkptr->HttpInputIOsb.Count); if (tkptr->QueuedHttpInput) tkptr->QueuedHttpInput--; if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "WRITE HTTP$INPUT !&S", tkptr->HttpInputIOsb.Status); /* if (effectively) no outstanding I/O then conclude the DCL task */ if (tkptr->QueuedSysCommand <= tkptr->QueuedSysCommandAllowed && !tkptr->QueuedSysOutput && !tkptr->QueuedCgiPlusIn && !tkptr->QueuedHttpInput && !tkptr->QueuedClientRead) { DclTaskRunDown (tkptr); return; } /* if I/O cancelled then just return */ if (tkptr->HttpInputIOsb.Status == SS$_ABORT || tkptr->HttpInputIOsb.Status == SS$_CANCEL) return; /* abort if an error writing HTTP stream to script process */ if (VMSnok (tkptr->HttpInputIOsb.Status)) { tkptr->RequestPtr->rqResponse.ErrorTextPtr = MsgFor(tkptr->RequestPtr,MSG_SCRIPT_IPC); ErrorVmsStatus (tkptr->RequestPtr, tkptr->HttpInputIOsb.Status, FI_LI); tkptr->DeleteProcess = true; DclTaskRunDown (tkptr); return; } /* get more from the client */ BodyRead (tkptr->RequestPtr); tkptr->QueuedClientRead++; } /*****************************************************************************/ /* A CLIENT-READ: callout network read from the client has concluded. If an error then just conclude the task. If OK then queue it to the HTTP$INPUT device so the script can read it. */ DclClientReadAst (REQUEST_STRUCT *rqptr) { int status; DCL_TASK *tkptr; /*********/ /* begin */ /*********/ /* get a pointer to the DCL task from the request structure */ tkptr = rqptr->DclTaskPtr; if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (rqptr, FI_LI, WATCH_MOD_DCL, "DclClientReadAst() !&F !8XL !UL !UL !UL !UL !UL !&S !UL", &DclClientReadAst, tkptr->ScriptProcessPid, tkptr->QueuedSysCommand, tkptr->QueuedSysOutput, tkptr->QueuedCgiPlusIn, tkptr->QueuedHttpInput, tkptr->QueuedClientRead, rqptr->rqNet.ReadIOsb.Status, rqptr->rqNet.ReadIOsb.Count); if (tkptr->QueuedClientRead) tkptr->QueuedClientRead--; /* if (effectively) no outstanding I/O then conclude the DCL task */ if (tkptr->QueuedSysCommand <= tkptr->QueuedSysCommandAllowed && !tkptr->QueuedSysOutput && !tkptr->QueuedCgiPlusIn && !tkptr->QueuedHttpInput && !tkptr->QueuedClientRead) { DclTaskRunDown (tkptr); return; } if (VMSnok (rqptr->rqNet.ReadIOsb.Status)) { DclTaskRunDown (tkptr); return; } if (tkptr->ClientReadStripCrLf) { if (rqptr->rqNet.ReadIOsb.Count >= 2 && tkptr->ClientReadBufferPtr[rqptr->rqNet.ReadIOsb.Count-2] == '\r' && tkptr->ClientReadBufferPtr[rqptr->rqNet.ReadIOsb.Count-1] == '\n') rqptr->rqNet.ReadIOsb.Count -= 2; else if (rqptr->rqNet.ReadIOsb.Count >= 1 && tkptr->ClientReadBufferPtr[rqptr->rqNet.ReadIOsb.Count-1] == '\n') rqptr->rqNet.ReadIOsb.Count--; } tkptr->QueuedHttpInput++; status = sys$qio (EfnNoWait, tkptr->HttpInputChannel, IO$_WRITELBLK, &tkptr->HttpInputIOsb, &DclClientReadHttpInputAst, tkptr, tkptr->ClientReadBufferPtr, rqptr->rqNet.ReadIOsb.Count, 0, 0, 0, 0); if (VMSok (status)) return; /* report error via the AST */ tkptr->HttpInputIOsb.Status = status; SysDclAst (&DclClientReadAst, tkptr); } /*****************************************************************************/ /* A CLIENT-READ: callout write of client data to the HTTP$DEVICE has concluded. If there was an error writing this to the script then just conclude the task. If OK then queue another network read from the client. */ DclClientReadHttpInputAst (DCL_TASK *tkptr) { int status, Length; char *ContentPtr; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclClientReadHttpInputAst() !&F !8XL !8XL !UL !UL !UL !UL !UL !&S", &DclClientReadHttpInputAst, tkptr->ScriptProcessPid, tkptr->QueuedSysCommand, tkptr->QueuedSysOutput, tkptr->QueuedCgiPlusIn, tkptr->QueuedHttpInput, tkptr->QueuedClientRead, tkptr->HttpInputIOsb.Status); if (tkptr->QueuedHttpInput) tkptr->QueuedHttpInput--; if (WATCHING(tkptr) && WATCH_CATEGORY(WATCH_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_DCL, "CLIENT-READ !&S", tkptr->HttpInputIOsb.Status); /* if (effectively) no outstanding I/O then conclude the DCL task */ if (tkptr->QueuedSysCommand <= tkptr->QueuedSysCommandAllowed && !tkptr->QueuedSysOutput && !tkptr->QueuedCgiPlusIn && !tkptr->QueuedHttpInput && !tkptr->QueuedClientRead) { DclTaskRunDown (tkptr); return; } /* if I/O cancelled then just return */ if (tkptr->HttpInputIOsb.Status == SS$_ABORT || tkptr->HttpInputIOsb.Status == SS$_CANCEL) return; /* abort if an error writing HTTP stream to script process */ if (VMSnok (tkptr->HttpInputIOsb.Status)) { tkptr->RequestPtr->rqResponse.ErrorTextPtr = MsgFor(tkptr->RequestPtr,MSG_SCRIPT_IPC); ErrorVmsStatus (tkptr->RequestPtr, tkptr->HttpInputIOsb.Status, FI_LI); tkptr->DeleteProcess = true; DclTaskRunDown (tkptr); return; } /* asynchronous read another record from the client */ NetRead (tkptr->RequestPtr, &DclClientReadAst, tkptr->ClientReadBufferPtr, tkptr->ClientReadBufferSize); tkptr->QueuedClientRead++; } /*****************************************************************************/ /* Send DCL commands to the CGI script or DCL command script process' SYS$COMMAND. This sets up the DCL environment (defines logical names, assigns symbols) executes the procedure or image. */ int DclCgiScriptSysCommand (DCL_TASK *tkptr) { static char DefSysErrNl [] = "DEFINE/USER SYS$ERROR NL:"; static char DefSysOutNl [] = "DEFINE/USER SYS$OUTPUT NL:"; static char DelSymAll [] = "DELSYMALL=\"DELETE/SYMBOL/ALL\""; static char DelSymAllGlobal[] = "DELSYMALL/GLOBAL"; static char DelSymAllLocal[] = "DELSYMALL/LOCAL"; static char WasdFileDev [] = "IF F$TRNLNM(\"WASD_FILE_DEV\").NES.\"\" THEN @WASD_FILE_DEV"; static $DESCRIPTOR (WasdFileDevFaoDsc, "IF F$TRNLNM(\"WASD_FILE_DEV_!UL\").NES.\"\" THEN @WASD_FILE_DEV_!UL !UL"); static char WasdLogin [] = "IF F$TRNLNM(\"WASD_LOGIN\").NES.\"\" THEN @WASD_LOGIN"; static char HttpdLogin [] = "IF F$TRNLNM(\"HTTPD$LOGIN\").NES.\"\" THEN @HTTPD$LOGIN"; static char WasdVerify1 [] = "DEFINE/NOLOG WASD__VERIFY \"0\""; static char WasdVerify2 [] = "IF F$TRNLNM(\"WASD_VERIFY\").NES.\"\" THEN DEFINE/NOLOG WASD__VERIFY \"1\""; static $DESCRIPTOR (WasdVerify3FaoDsc, "IF F$LENGTH(F$TRNLNM(\"WASD_VERIFY\")).GE.7.AND.\ F$TRNLNM(\"WASD_VERIFY\").NES.\"!AZ\" THEN DEFINE/NOLOG WASD__VERIFY \"0\""); static char WasdVerify4 [] = "IF F$TRNLNM(\"WASD__VERIFY\",\"LNM$PROCESS\") THEN \ WRITE SYS$OUTPUT \"Content-Type: text/plain\015\012\015\012\""; static char WasdVerify5 [] = "!\'F$VERIFY(F$TRNLNM(\"WASD__VERIFY\",\"LNM$PROCESS\"))"; static char NetDefSysOut [] = "DEFINE SYS$OUTPUT SYS$NET"; static char NetPurgeLog [] = "PURGE/NOLOG/KEEP=3 SYS$LOGIN:" NETWORK_MODE_LOG_NAME; static char NoVerify [] = "!\'F$VERIFY(0)"; static char SetNoOn[] = "SET NOON"; #ifdef ODS_EXTENDED static char SetProcParseExt [] = "SET PROCESS/PARSE=EXTENDED"; static char SetProcParseTrad [] = "SET PROCESS/PARSE=TRADITIONAL"; #endif /* ODS_EXTENDED */ static char SetProcPriv[] = "SET PROCESS/PRIVILEGE=(NOALL,NETMBX,TMPMBX)"; static char StopId [] = "STOP/id=0"; static char WriteIsWrite [] = "WRITE=\"WRITE\""; static $DESCRIPTOR (WriteDclQuoteFaoDsc, "WRITE SYS$OUTPUT \"!AZ\""); static $DESCRIPTOR (DefineHttpInputFaoDsc, "DEFINE/NOLOG/SUPER HTTP$INPUT !AZ"); static $DESCRIPTOR (DefineSysInputFaoDsc, "DEFINE/NOLOG/SUPER SYS$INPUT !AZ"); #if CGIPLUS_CALLOUT_FOR_CGI static $DESCRIPTOR (DefineCgiPlusInFaoDsc, "DEFINE/NOLOG/SUPER CGIPLUSIN !AZ"); static $DESCRIPTOR (DefineCgiPlusEotFaoDsc, "DEFINE/NOLOG/SUPER CGIPLUSEOT \"!AZ\""); static $DESCRIPTOR (DefineCgiPlusEscFaoDsc, "DEFINE/NOLOG/SUPER CGIPLUSESC \"!AZ\""); #endif /* CGIPLUS_CALLOUT_FOR_CGI */ #if STREAMS_FOR_APACHE static $DESCRIPTOR (DefineApacheInputFaoDsc, "DEFINE/NOLOG/SUPER APACHE$INPUT !AZ"); #endif /* STREAMS_FOR_APACHE */ #if STREAMS_FOR_PURVEYOR_AND_CERN static $DESCRIPTOR (DefineWwwInFaoDsc, "DEFINE/NOLOG/SUPER WWW_IN !AZ"); static char DefineWwwOut[] = "DEFINE/NOLOG/SUPER WWW_OUT SYS$OUTPUT:"; #endif /* STREAMS_FOR_PURVEYOR_AND_CERN */ int status, Count; unsigned short Length; char c; char *cptr, *sptr, *zptr, *StringPtr; char DclLine [256], String [256]; REQUEST_STRUCT *rqptr; $DESCRIPTOR (DclLineDsc, DclLine); /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclCgiScriptSysCommand() !&Z !&Z !&Z", tkptr->DclCommandPtr, tkptr->ScriptFileName, tkptr->ScriptRunTimePtr); /* get the pointer to the request structure */ rqptr = tkptr->RequestPtr; DclQioSysCommand (tkptr, NoVerify, sizeof(NoVerify)-1); DclQioSysCommand (tkptr, DelSymAll, sizeof(DelSymAll)-1); DclQioSysCommand (tkptr, DelSymAllGlobal, sizeof(DelSymAllGlobal)-1); DclQioSysCommand (tkptr, DelSymAllLocal, sizeof(DelSymAllLocal)-1); DclQioSysCommand (tkptr, SetNoOn, sizeof(SetNoOn)-1); if (InstanceEnvNumber == 1) DclQioSysCommand (tkptr, WasdFileDev, sizeof(WasdFileDev)-1); else { sys$fao (&WasdFileDevFaoDsc, &Length, &DclLineDsc, InstanceEnvNumber, InstanceEnvNumber, InstanceEnvNumber); DclLine[Length] = '\0'; DclQioSysCommand (tkptr, DclLine, Length); } if (HttpdNetworkMode) { DclQioSysCommand (tkptr, NetDefSysOut, sizeof(NetDefSysOut)-1); DclQioSysCommand (tkptr, DefSysOutNl, sizeof(DefSysOutNl)-1); DclQioSysCommand (tkptr, DefSysErrNl, sizeof(DefSysErrNl)-1); DclQioSysCommand (tkptr, NetPurgeLog, sizeof(NetPurgeLog)-1); } if (tkptr->CrePrcDetachStarting) { /* indicate any login message, etc. are finished, process is ready */ sys$fao (&WriteDclQuoteFaoDsc, &Length, &DclLineDsc, tkptr->CgiBel); DclLine[Length] = '\0'; DclQioSysCommand (tkptr, DclLine, Length); } DclQioSysCommand (tkptr, WasdVerify1, sizeof(WasdVerify1)-1); DclQioSysCommand (tkptr, WasdVerify2, sizeof(WasdVerify2)-1); sys$fao (&WasdVerify3FaoDsc, &Length, &DclLineDsc, rqptr->rqClient.IpAddressString); DclLine[Length] = '\0'; DclQioSysCommand (tkptr, DclLine, Length); DclQioSysCommand (tkptr, WasdVerify4, sizeof(WasdVerify4)-1); DclQioSysCommand (tkptr, WasdVerify5, sizeof(WasdVerify5)-1); if (!DclScriptDetachProcess && Config.cfScript.SpawnAuthPriv) /* kludge to work around spawning authorized privileges with $CREPRC */ DclQioSysCommand (tkptr, SetProcPriv, sizeof(SetProcPriv)-1); if (tkptr->TaskType == DCL_TASK_TYPE_CGI_SCRIPT) { sys$fao (&DefineSysInputFaoDsc, &Length, &DclLineDsc, tkptr->HttpInputDevName); DclLine[Length] = '\0'; DclQioSysCommand (tkptr, DclLine, Length); /* for backward compatibility */ sys$fao (&DefineHttpInputFaoDsc, &Length, &DclLineDsc, tkptr->HttpInputDevName); DclLine[Length] = '\0'; DclQioSysCommand (tkptr, DclLine, Length); #if STREAMS_FOR_PURVEYOR_AND_CERN /* for Purveyor, Cern backward compatibility */ sys$fao (&DefineWwwInFaoDsc, &Length, &DclLineDsc, tkptr->HttpInputDevName); DclLine[Length] = '\0'; DclQioSysCommand (tkptr, DclLine, Length); DclQioSysCommand (tkptr, DefineWwwOut, sizeof(DefineWwwOut)-1); #endif /* STREAMS_FOR_PURVEYOR_AND_CERN */ #if STREAMS_FOR_APACHE /* for VMS Apache forward compatibility :^) */ sys$fao (&DefineApacheInputFaoDsc, &Length, &DclLineDsc, tkptr->HttpInputDevName); DclLine[Length] = '\0'; DclQioSysCommand (tkptr, DclLine, Length); #endif /* STREAMS_FOR_APACHE */ #if CGIPLUS_CALLOUT_FOR_CGI sys$fao (&DefineCgiPlusInFaoDsc, &Length, &DclLineDsc, tkptr->CgiPlusInDevName); DclLine[Length] = '\0'; status = DclQioSysCommand (tkptr, DclLine, Length); sys$fao (&DefineCgiPlusEotFaoDsc, &Length, &DclLineDsc, tkptr->CgiEot); DclLine[Length] = '\0'; status = DclQioSysCommand (tkptr, DclLine, Length); sys$fao (&DefineCgiPlusEscFaoDsc, &Length, &DclLineDsc, tkptr->CgiEsc); DclLine[Length] = '\0'; status = DclQioSysCommand (tkptr, DclLine, Length); #endif /* CGIPLUS_CALLOUT_FOR_CGI */ } /*****************/ /* CGI variables */ /*****************/ /* CGI script requests can only call this once. DCL commands from SSI documents can call this multiple times. Once the CGI information is generated is is essentially static for the life of the request ... so only generate it the once! */ if (!rqptr->rqCgi.BufferPtr) if (VMSnok (status = CgiGenerateVariables (rqptr, CGI_VARIABLE_DCL))) return (status); cptr = rqptr->rqCgi.BufferPtr; for (;;) { if (!(Length = *(USHORTPTR)cptr)) break; DclQioSysCommand (tkptr, cptr+sizeof(short), Length-1); cptr += Length + sizeof(short); } #ifdef ODS_EXTENDED if (OdsExtended) { if (rqptr->PathOds == MAPURL_PATH_ODS_5) { DclQioSysCommand (tkptr, SetProcParseExt, sizeof(SetProcParseExt)-1); /* note that for this script activation the parse has been extended */ tkptr->ProcessParseExtended = true; } else if (rqptr->PathOds == MAPURL_PATH_ODS_2) DclQioSysCommand (tkptr, SetProcParseTrad, sizeof(SetProcParseTrad)-1); else if (tkptr->ProcessParseExtended) { /* restore previously extended parse */ DclQioSysCommand (tkptr, SetProcParseTrad, sizeof(SetProcParseTrad)-1); tkptr->ProcessParseExtended = false; } } #endif /* ODS_EXTENDED */ /* httpd$login for backward-compatibility from v10.0 */ DclQioSysCommand (tkptr, HttpdLogin, sizeof(HttpdLogin)-1); DclQioSysCommand (tkptr, WasdLogin, sizeof(WasdLogin)-1); /* set default to the script location */ zptr = (sptr = DclLine) + sizeof(DclLine)-1; for (cptr = "SET DEFAULT "; *cptr; *sptr++ = *cptr++); if (rqptr->rqPathSet.ScriptDefaultPtr) { if (rqptr->rqPathSet.ScriptDefaultPtr[0] == '#' || rqptr->rqPathSet.ScriptDefaultPtr[0] == '/') { /* backward compatible or U**x syntax, do not set default */ Length = 0; } else { /* specified by the mapping rules */ for (cptr = rqptr->rqPathSet.ScriptDefaultPtr; *cptr && sptr < zptr; *sptr++ = *cptr++); *sptr = '\0'; Length = sptr - DclLine; } } else { /* whichever directory the script is located in */ for (cptr = tkptr->SearchOds.ResFileName; *cptr && sptr < zptr; *sptr++ = *cptr++); sptr--; while (sptr > DclLine && *sptr != ']') sptr--; if (*sptr == ']') sptr++; *sptr = '\0'; Length = sptr - DclLine; } if (Length) DclQioSysCommand (tkptr, DclLine, Length); /*******************************/ /* DCL command/procedure/image */ /*******************************/ if (tkptr->ScriptFileName[0]) { /**************/ /* CGI script */ /**************/ zptr = (sptr = DclLine) + sizeof(DclLine)-1; cptr = tkptr->ScriptRunTimePtr; /* this exclamation symbols can be used within RTE-style syntax */ if (*cptr == '!') cptr++; if (SAME2(cptr,'@\0')) { /* searched-for DCL procedure */ *sptr++ = '@'; cptr = tkptr->SearchOds.ResFileName; while (*cptr && sptr < zptr) *sptr++ = *cptr++; *sptr = '\0'; } else if (SAME2(cptr,'=\0')) { /* searched-for command definition */ memcpy (sptr, "SET COMMAND ", 12); sptr += 12; cptr = tkptr->SearchOds.ResFileName; while (*cptr && sptr < zptr) *sptr++ = *cptr++; *sptr = '\0'; DclQioSysCommand (tkptr, DclLine, sptr-DclLine); /* now use the command defintion file name as the verb */ while (sptr > DclLine && *sptr != ']') sptr--; if (*sptr == ']') sptr++; cptr = sptr; zptr = (sptr = DclLine) + sizeof(DclLine)-1; while (*cptr && *cptr != '.' && sptr < zptr) *sptr++ = *cptr++; *sptr = '\0'; } else if (SAME2(cptr,'$\0')) { /* searched-for executable */ memcpy (sptr, "WASDVERB:=$", 11); sptr += 11; cptr = tkptr->SearchOds.ResFileName; while (*cptr && sptr < zptr) *sptr++ = *cptr++; *sptr = '\0'; DclQioSysCommand (tkptr, DclLine, sptr-DclLine); /* now use it as a foreign-command */ zptr = (sptr = DclLine) + sizeof(DclLine)-1; memcpy (sptr, "WASDVERB", 8); sptr += 8; *sptr = '\0'; } else if (*cptr == '@' || *cptr == '$') { /* configured run-time string */ memcpy (sptr, "WASDVERB:=", 10); sptr += 10; while (*cptr && sptr < zptr) *sptr++ = *cptr++; *sptr = '\0'; DclQioSysCommand (tkptr, DclLine, sptr-DclLine); /* now place it as the verb before the script file */ zptr = (sptr = DclLine) + sizeof(DclLine)-1; memcpy (sptr, "WASDVERB ", 9); sptr += 9; cptr = tkptr->SearchOds.ResFileName; while (*cptr && sptr < zptr) *sptr++ = *cptr++; *sptr = '\0'; } else { /* verb must already exist on site, place before the script file */ while (*cptr && sptr < zptr) *sptr++ = *cptr++; if (sptr < zptr) *sptr++ = ' '; cptr = tkptr->SearchOds.ResFileName; while (*cptr && sptr < zptr) *sptr++ = *cptr++; *sptr = '\0'; } if (rqptr->rqPathSet.ScriptCommandPtr) { /* add script activation command elements from path SETing */ StringPtr = rqptr->rqPathSet.ScriptCommandPtr; for (;;) { status = StringParseValue (&StringPtr, String, sizeof(String)); if (VMSnok (status)) break; cptr = String; if (*cptr != '*') zptr = (sptr = DclLine) + sizeof(DclLine)-1; while (*cptr == '*') cptr++; while (*cptr && sptr < zptr) *sptr++ = *cptr++; *sptr = '\0'; DclQioSysCommand (tkptr, DclLine, sptr-DclLine); } if (status != SS$_ENDOFFILE) ErrorVmsStatus (rqptr, status, FI_LI); DclLine[0] = '\0'; } if (DclLine[0]) DclQioSysCommand (tkptr, DclLine, sptr-DclLine); } else { /*******/ /* CLI */ /*******/ /* multiple commands may be separated by newlines */ sptr = tkptr->DclCommandPtr; while (*sptr) { cptr = sptr; while (*sptr && *sptr != '\n') sptr++; Length = sptr - cptr; if (*sptr == '\n') { zptr = sptr; *sptr++ = '\0'; } else zptr = NULL; DclQioSysCommand (tkptr, cptr, Length); if (zptr) *zptr = '\n'; } } /*********************/ /* after script runs */ /*********************/ if (DclUseZombies && !rqptr->rqPathSet.ScriptCpuMax) { DclQioSysCommand (tkptr, NoVerify, sizeof(NoVerify)-1); DclQioSysCommand (tkptr, WriteIsWrite, sizeof(WriteIsWrite)-1); sys$fao (&WriteDclQuoteFaoDsc, &Length, &DclLineDsc, tkptr->CgiEof); DclLine[Length] = '\0'; DclQioSysCommand (tkptr, DclLine, Length); /* do not send an end-of-file! */ return (SS$_NORMAL); } else { /* ensure script process terminates! */ DclQioSysCommand (tkptr, StopId, sizeof(StopId)-1); /* send end-of-file */ DclQioSysCommand (tkptr, NULL, 0); } return (SS$_NORMAL); } /*****************************************************************************/ /* Send DCL commands to the CGIplus script process' SYS$COMMAND. This sets up the DCL environment (defines logical names, assigns symbols) executes the procedure or image. */ DclCgiPlusScriptSysCommand (DCL_TASK *tkptr) { static char DefSysErrNl [] = "DEFINE/USER SYS$ERROR NL:"; static char DefSysOutNl [] = "DEFINE/USER SYS$OUTPUT NL:"; static char DelSymAll [] = "DELSYMALL=\"DELETE/SYMBOL/ALL\""; static char DelSymAllGlobal[] = "DELSYMALL/GLOBAL"; static char DelSymAllLocal[] = "DELSYMALL/LOCAL"; static char WasdFileDev [] = "IF F$TRNLNM(\"WASD_FILE_DEV\").NES.\"\" THEN @WASD_FILE_DEV"; static $DESCRIPTOR (WasdFileDevFaoDsc, "IF F$TRNLNM(\"WASD_FILE_DEV_!UL\").NES.\"\" THEN @WASD_FILE_DEV_!UL !UL"); static char WasdLogin [] = "IF F$TRNLNM(\"WASD_LOGIN\").NES.\"\" THEN @WASD_LOGIN"; static char HttpdLogin [] = "IF F$TRNLNM(\"HTTPD$LOGIN\").NES.\"\" THEN @HTTPD$LOGIN"; static char WasdVerify1 [] = "DEFINE/NOLOG WASD__VERIFY \"0\""; static char WasdVerify2 [] = "IF F$TRNLNM(\"WASD_VERIFY\").NES.\"\" THEN DEFINE/NOLOG WASD__VERIFY \"1\""; static $DESCRIPTOR (WasdVerify3FaoDsc, "IF F$LENGTH(F$TRNLNM(\"WASD_VERIFY\")).GE.7.AND.\ F$TRNLNM(\"WASD_VERIFY\").NES.\"!AZ\" THEN DEFINE/NOLOG WASD__VERIFY \"0\""); static char WasdVerify4 [] = "IF F$TRNLNM(\"WASD__VERIFY\",\"LNM$PROCESS\") THEN \ WRITE SYS$OUTPUT \"Content-Type: text/plain\015\012\015\012\""; static char WasdVerify5 [] = "!\'F$VERIFY(F$TRNLNM(\"WASD__VERIFY\",\"LNM$PROCESS\"))"; static char NetDefSysOut [] = "DEFINE SYS$OUTPUT SYS$NET"; static char NetPurgeLog [] = "PURGE/NOLOG/KEEP=3 SYS$LOGIN:" NETWORK_MODE_LOG_NAME; static char NoVerify [] = "!\'F$VERIFY(0)"; static char SetNoOn [] = "SET NOON"; #ifdef ODS_EXTENDED static char SetProcParseExt [] = "SET PROCESS/PARSE=EXTENDED"; static char SetProcParseTrad [] = "SET PROCESS/PARSE=TRADITIONAL"; #endif /* ODS_EXTENDED */ static char SetProcPriv[] = "SET PROCESS/PRIVILEGE=(NOALL,NETMBX,TMPMBX)"; static char StopId [] = "STOP/id=0"; static $DESCRIPTOR (DefineCgiPlusInFaoDsc, "DEFINE/NOLOG/SUPER CGIPLUSIN !AZ"); static $DESCRIPTOR (DefineCgiPlusEofFaoDsc, "DEFINE/NOLOG/SUPER CGIPLUSEOF \"!AZ\""); static $DESCRIPTOR (DefineCgiPlusEotFaoDsc, "DEFINE/NOLOG/SUPER CGIPLUSEOT \"!AZ\""); static $DESCRIPTOR (DefineCgiPlusEscFaoDsc, "DEFINE/NOLOG/SUPER CGIPLUSESC \"!AZ\""); static $DESCRIPTOR (DefineHttpInputFaoDsc, "DEFINE/NOLOG/SUPER HTTP$INPUT !AZ"); static $DESCRIPTOR (DefineSysInputFaoDsc, "DEFINE/NOLOG/SUPER SYS$INPUT !AZ"); static $DESCRIPTOR (WriteDclQuoteFaoDsc, "WRITE SYS$OUTPUT \"!AZ\""); int status; unsigned short Length; char *cptr, *sptr, *zptr, *StringPtr; char DclLine [256], String [256]; REQUEST_STRUCT *rqptr; $DESCRIPTOR (DclLineDsc, DclLine); /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclCgiPlusScriptSysCommand() !&Z", tkptr->ScriptRunTimePtr); /* get the pointer to the request structure */ rqptr = tkptr->RequestPtr; DclQioSysCommand (tkptr, NoVerify, sizeof(NoVerify)-1); DclQioSysCommand (tkptr, DelSymAll, sizeof(DelSymAll)-1); DclQioSysCommand (tkptr, DelSymAllGlobal, sizeof(DelSymAllGlobal)-1); DclQioSysCommand (tkptr, DelSymAllLocal, sizeof(DelSymAllLocal)-1); DclQioSysCommand (tkptr, SetNoOn, sizeof(SetNoOn)-1); if (InstanceEnvNumber == 1) DclQioSysCommand (tkptr, WasdFileDev, sizeof(WasdFileDev)-1); else { sys$fao (&WasdFileDevFaoDsc, &Length, &DclLineDsc, InstanceEnvNumber, InstanceEnvNumber, InstanceEnvNumber); DclLine[Length] = '\0'; DclQioSysCommand (tkptr, DclLine, Length); } if (HttpdNetworkMode) { DclQioSysCommand (tkptr, NetDefSysOut, sizeof(NetDefSysOut)-1); DclQioSysCommand (tkptr, DefSysOutNl, sizeof(DefSysOutNl)-1); DclQioSysCommand (tkptr, DefSysErrNl, sizeof(DefSysErrNl)-1); DclQioSysCommand (tkptr, NetPurgeLog, sizeof(NetPurgeLog)-1); } if (tkptr->CrePrcDetachStarting) { /* indicate any login message, etc. are finished, process is ready */ sys$fao (&WriteDclQuoteFaoDsc, &Length, &DclLineDsc, tkptr->CgiBel); DclLine[Length] = '\0'; DclQioSysCommand (tkptr, DclLine, Length); } DclQioSysCommand (tkptr, WasdVerify1, sizeof(WasdVerify1)-1); DclQioSysCommand (tkptr, WasdVerify2, sizeof(WasdVerify2)-1); sys$fao (&WasdVerify3FaoDsc, &Length, &DclLineDsc, rqptr->rqClient.IpAddressString); DclLine[Length] = '\0'; DclQioSysCommand (tkptr, DclLine, Length); DclQioSysCommand (tkptr, WasdVerify4, sizeof(WasdVerify4)-1); DclQioSysCommand (tkptr, WasdVerify5, sizeof(WasdVerify5)-1); if (!DclScriptDetachProcess && Config.cfScript.SpawnAuthPriv) /* kludge to work around spawning authorized privileges with $CREPRC */ DclQioSysCommand (tkptr, SetProcPriv, sizeof(SetProcPriv)-1); sys$fao (&DefineSysInputFaoDsc, &Length, &DclLineDsc, tkptr->HttpInputDevName); DclLine[Length] = '\0'; DclQioSysCommand (tkptr, DclLine, Length); /* for backward compatibility */ sys$fao (&DefineHttpInputFaoDsc, &Length, &DclLineDsc, tkptr->HttpInputDevName); DclLine[Length] = '\0'; DclQioSysCommand (tkptr, DclLine, Length); sys$fao (&DefineCgiPlusInFaoDsc, &Length, &DclLineDsc, tkptr->CgiPlusInDevName); DclLine[Length] = '\0'; status = DclQioSysCommand (tkptr, DclLine, Length); sys$fao (&DefineCgiPlusEofFaoDsc, &Length, &DclLineDsc, tkptr->CgiEof); DclLine[Length] = '\0'; status = DclQioSysCommand (tkptr, DclLine, Length); sys$fao (&DefineCgiPlusEotFaoDsc, &Length, &DclLineDsc, tkptr->CgiEot); DclLine[Length] = '\0'; status = DclQioSysCommand (tkptr, DclLine, Length); sys$fao (&DefineCgiPlusEscFaoDsc, &Length, &DclLineDsc, tkptr->CgiEsc); DclLine[Length] = '\0'; status = DclQioSysCommand (tkptr, DclLine, Length); #ifdef ODS_EXTENDED /* no need to keep track of the parse style, only activated once! */ if (rqptr->PathOds == MAPURL_PATH_ODS_5) DclQioSysCommand (tkptr, SetProcParseExt, sizeof(SetProcParseExt)-1); else if (rqptr->PathOds == MAPURL_PATH_ODS_2) DclQioSysCommand (tkptr, SetProcParseTrad, sizeof(SetProcParseTrad)-1); #endif /* ODS_EXTENDED */ /* httpd$login for backward-compatibility from v10.0 */ DclQioSysCommand (tkptr, HttpdLogin, sizeof(HttpdLogin)-1); DclQioSysCommand (tkptr, WasdLogin, sizeof(WasdLogin)-1); /* set default to the script location */ zptr = (sptr = DclLine) + sizeof(DclLine)-1; for (cptr = "SET DEFAULT "; *cptr; *sptr++ = *cptr++); if (rqptr->rqPathSet.ScriptDefaultPtr) { if (rqptr->rqPathSet.ScriptDefaultPtr[0] == '#' || rqptr->rqPathSet.ScriptDefaultPtr[0] == '/') { /* backward compatible or U**x syntax, do not set default */ Length = 0; } else { /* specified by the mapping rules */ for (cptr = rqptr->rqPathSet.ScriptDefaultPtr; *cptr && sptr < zptr; *sptr++ = *cptr++); *sptr = '\0'; Length = sptr - DclLine; } } else { /* whichever directory the script is located in */ for (cptr = tkptr->SearchOds.ResFileName; *cptr && sptr < zptr; *sptr++ = *cptr++); sptr--; while (sptr > DclLine && *sptr != ']') sptr--; if (*sptr == ']') sptr++; *sptr = '\0'; Length = sptr - DclLine; } if (Length) DclQioSysCommand (tkptr, DclLine, Length); /***********************/ /* DCL procedure/image */ /***********************/ if (tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT) { /*******/ /* RTE */ /*******/ zptr = (sptr = DclLine) + sizeof(DclLine)-1; cptr = tkptr->ScriptRunTimePtr; if (*cptr != '@') { if (*cptr == '$') cptr++; memcpy (sptr, "RUN ", 4); sptr += 4; } while (*cptr && sptr < zptr) *sptr++ = *cptr++; *sptr = '\0'; } else { /******************/ /* CGIplus script */ /******************/ zptr = (sptr = DclLine) + sizeof(DclLine)-1; cptr = tkptr->ScriptRunTimePtr; if (SAME2(cptr,'@\0')) { /* searched-for DCL procedure */ *sptr++ = '@'; cptr = tkptr->SearchOds.ResFileName; while (*cptr && sptr < zptr) *sptr++ = *cptr++; *sptr = '\0'; } else if (SAME2(cptr,'=\0')) { /* searched-for command definition */ memcpy (sptr, "SET COMMAND ", 12); sptr += 12; cptr = tkptr->SearchOds.ResFileName; while (*cptr && sptr < zptr) *sptr++ = *cptr++; *sptr = '\0'; DclQioSysCommand (tkptr, DclLine, sptr-DclLine); /* now use the command defintion file name as the verb */ while (sptr > DclLine && *sptr != ']') sptr--; if (*sptr == ']') sptr++; cptr = sptr; zptr = (sptr = DclLine) + sizeof(DclLine)-1; while (*cptr && *cptr != '.' && sptr < zptr) *sptr++ = *cptr++; *sptr = '\0'; } else if (SAME2(cptr,'$\0')) { /* searched-for executable */ memcpy (sptr, "WASDVERB:=$", 11); sptr += 11; cptr = tkptr->SearchOds.ResFileName; while (*cptr && sptr < zptr) *sptr++ = *cptr++; *sptr = '\0'; DclQioSysCommand (tkptr, DclLine, sptr-DclLine); /* now use it as a foreign-command */ zptr = (sptr = DclLine) + sizeof(DclLine)-1; memcpy (sptr, "WASDVERB", 8); sptr += 8; *sptr = '\0'; } else if (*cptr == '@' || *cptr == '$') { /* configured run-time string */ memcpy (sptr, "WASDVERB:=", 10); sptr += 10; while (*cptr && sptr < zptr) *sptr++ = *cptr++; *sptr = '\0'; DclQioSysCommand (tkptr, DclLine, sptr-DclLine); /* now place it as the verb before the script file */ zptr = (sptr = DclLine) + sizeof(DclLine)-1; memcpy (sptr, "WASDVERB ", 9); sptr += 9; cptr = tkptr->SearchOds.ResFileName; while (*cptr && sptr < zptr) *sptr++ = *cptr++; *sptr = '\0'; } else { /* verb must already exist on site, place before the script file */ while (*cptr && sptr < zptr) *sptr++ = *cptr++; if (sptr < zptr) *sptr++ = ' '; cptr = tkptr->SearchOds.ResFileName; while (*cptr && sptr < zptr) *sptr++ = *cptr++; *sptr = '\0'; } if (rqptr->rqPathSet.ScriptCommandPtr) { /* add script activation command elements from path SETing */ StringPtr = rqptr->rqPathSet.ScriptCommandPtr; for (;;) { status = StringParseValue (&StringPtr, String, sizeof(String)); if (VMSnok (status)) break; cptr = String; if (*cptr != '*') zptr = (sptr = DclLine) + sizeof(DclLine)-1; while (*cptr == '*') cptr++; while (*cptr && sptr < zptr) *sptr++ = *cptr++; *sptr = '\0'; DclQioSysCommand (tkptr, DclLine, sptr-DclLine); } if (status != SS$_ENDOFFILE) ErrorVmsStatus (rqptr, status, FI_LI); DclLine[0] = '\0'; } } if (DclLine[0]) DclQioSysCommand (tkptr, DclLine, sptr-DclLine); /* ensure script process terminates! */ DclQioSysCommand (tkptr, StopId, sizeof(StopId)-1); /* send end-of-file */ DclQioSysCommand (tkptr, NULL, 0); } /*****************************************************************************/ /* Send CGI variables to the script process' CGIPLUSIN input stream. This is either done with each CGI variable "name=value" as an individual record, or with the entire CGI variable being provided in a single I/O. See CGI.C for an explanation on the structure of this data. Transfering the CGIplus variables as a single structure (rather than as per-variable records) can double the throughput!! Demonstrated using the [SRC.CGIPLUS]CGIPLUSTEST.C program. This indicates that there is much less than half the overhead for performing this using the 'struct' method! */ int DclCgiPlusScriptCgiPlusIn (DCL_TASK *tkptr) { static char CCString [] = "!\0\0"; static char StructString [32]; static $DESCRIPTOR (StructFaoDsc, "!!!!!UL!AZ"); static $DESCRIPTOR (StructStringDsc, StructString); int status, StructLength; unsigned short Length; char *cptr; REQUEST_STRUCT *rqptr; /*********/ /* begin */ /*********/ if (WATCHING(tkptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (WATCHTK(tkptr), FI_LI, WATCH_MOD_DCL, "DclCgiPlusScriptCgiPlusIn()"); /* get the pointer to the request structure */ rqptr = tkptr->RequestPtr; if (VMSnok (status = CgiGenerateVariables (rqptr, CGI_VARIABLE_STREAM))) return (status); if (tkptr->CgiPlusVarStruct) { StructLength = rqptr->rqCgi.BufferCurrentPtr - rqptr->rqCgi.BufferPtr; sys$fao (&StructFaoDsc, &Length, &StructStringDsc, StructLength, rqptr->rqPathSet.CgiPlusInCC); StructString[Length] = '\0'; /* just a line for "start-of-request" that can always be discarded */ DclQioCgiPlusIn (tkptr, StructString, Length); /* provide all the CGI variables in one structure and I/O */ DclQioCgiPlusIn (tkptr, rqptr->rqCgi.BufferPtr, StructLength); } else { /* just a line for "start-of-request" that can always be discarded */ if (rqptr->rqPathSet.CgiPlusInCC[0]) { CCString[1] = rqptr->rqPathSet.CgiPlusInCC[0]; if (rqptr->rqPathSet.CgiPlusInCC[1]) { CCString[2] = rqptr->rqPathSet.CgiPlusInCC[1]; DclQioCgiPlusIn (tkptr, CCString, 3); } else DclQioCgiPlusIn (tkptr, CCString, 2); } else DclQioCgiPlusIn (tkptr, CCString, 1); /* provide each variable as a separate record */ cptr = rqptr->rqCgi.BufferPtr; for (;;) { if (!(Length = *(USHORTPTR)cptr)) break; DclQioCgiPlusIn (tkptr, cptr+sizeof(short), Length-1); cptr += Length + sizeof(short); } /* empty record/line terminates CGI variables */ if (rqptr->rqPathSet.CgiPlusInCC[0]) if (rqptr->rqPathSet.CgiPlusInCC[1]) DclQioCgiPlusIn (tkptr, rqptr->rqPathSet.CgiPlusInCC, 2); else DclQioCgiPlusIn (tkptr, rqptr->rqPathSet.CgiPlusInCC, 1); else DclQioCgiPlusIn (tkptr, "", 0); } if (rqptr->rqPathSet.CgiPlusInWriteof) DclQioCgiPlusIn (tkptr, NULL, 0); return (SS$_NORMAL); } /*****************************************************************************/ /* This function is available for an agent callout to write output to the agent's CGIplus input mailbox. It may be called one or more times from a single callout (the only thing to be mindful of is BYTLM and the capacity of the CGIPLUSIN mailbox. */ DclCalloutQio ( REQUEST_STRUCT *rqptr, char *DataPtr, int DataLength ) { /*********/ /* begin */ /*********/ if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (rqptr, FI_LI, WATCH_MOD_DCL, "DclCalloutQio() !&Z", DataPtr); if (!rqptr->DclTaskPtr) ErrorExitVmsStatus (SS$_BUGCHECK, ErrorSanityCheck, FI_LI); DclQioCgiPlusIn (rqptr->DclTaskPtr, DataPtr, DataLength); } /*****************************************************************************/ /* Default callout for CGIplus scripting. In other words; ask the the server to do something for a CGIplus script. See prologue to this module for description of currently support functionality. */ DclCalloutDefault (REQUEST_STRUCT *rqptr) { static char RspBadParam [] = "400 Bad parameter", RspUnauthorized [] = "401 Unauthorized", RspForbidden [] = "403 Forbidden", RspSuccess [] = "200 Success", RspUnknown [] = "400 Unknown request"; BOOL ProvideResponse; int status, Length, Number, OutputCount; char *cptr, *sptr, *zptr, *ContentPtr, *FileNamePtr, *OutputPtr; char Scratch [1024+4]; DCL_TASK *tkptr; /*********/ /* begin */ /*********/ if (WATCHING(rqptr) && WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (rqptr, FI_LI, WATCH_MOD_DCL, "DclCalloutDefault() !&Z", rqptr->rqCgi.CalloutOutputPtr); /* get a local pointer to the DCL task structure */ tkptr = rqptr->DclTaskPtr; OutputPtr = rqptr->rqCgi.CalloutOutputPtr; OutputCount = rqptr->rqCgi.CalloutOutputCount; if (!OutputPtr && (OutputCount == 0 || OutputCount== -1)) { /* indicates the script has sent a begin or end escape sequence */ return; } if (OutputPtr[0] == '!' || OutputPtr[0] == '#') { ProvideResponse = false; OutputPtr++; OutputCount--; } else ProvideResponse = true; if (TOUP(OutputPtr[0]) == 'R' && strsame (OutputPtr, "REDACT:", 7)) { /***********/ /* REDACT: */ /***********/ /* process redact data *before* expunging 'nasties' */ RequestRedact (rqptr, OutputPtr, OutputCount, ProvideResponse); return; } /* for the rest make sure there are no potential nasties lurking */ for (cptr = OutputPtr; *cptr && !iscntrl(*(unsigned char*)cptr); cptr++); *cptr = '\0'; if (TOUP(OutputPtr[0]) == '1' && TOUP(OutputPtr[4]) == 'A' && TOUP(OutputPtr[14]) == 'C' && strsame (OutputPtr, "100 AUTHAGENT-CALLOUT", 21)) { /*********************/ /* AUTHAGENT-CALLOUT */ /*********************/ rqptr->rqResponse.HttpStatus = 403; tkptr->DeleteProcess = true; DclTaskRunDown (tkptr); return; } else if (TOUP(OutputPtr[0]) == 'A' && TOUP(OutputPtr[5]) == 'F' && strsame (OutputPtr, "AUTH-FILE:", 10)) { /**************/ /* AUTH-FILE: */ /**************/ /* authorize access to a particular file */ for (cptr = OutputPtr+10; *cptr && isspace(*cptr); cptr++); if (!*cptr) { if (ProvideResponse) DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1); return; } FileNamePtr = cptr; while (*cptr && !isspace(*cptr)) cptr++; if (rqptr->rqAuth.VmsUserProfileLength) { status = AuthAccessReadCheck (rqptr, FileNamePtr, cptr-FileNamePtr); if (ProvideResponse) { if (status == SS$_NOPRIV) DclCalloutQio (rqptr, RspForbidden, sizeof(RspForbidden)-1); else if (VMSok (status)) DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1); else { /* error reported by access check */ FaoToBuffer (Scratch, sizeof(Scratch), NULL, "400 %!&M", status); DclCalloutQio (rqptr, Scratch, strlen(Scratch)); } } } else if (ProvideResponse) { /* i.e. request does not have a VMS profile associated */ DclCalloutQio (rqptr, RspUnauthorized, sizeof(RspUnauthorized)-1); } return; } if (TOUP(OutputPtr[0]) == 'C' && TOUP(OutputPtr[3]) == 'P' && strsame (OutputPtr, "CGIPLUS:", 8)) { /************/ /* CGIPLUS: */ /************/ for (cptr = OutputPtr+8; *cptr && isspace(*cptr); cptr++); if (strsame (cptr, "STRUCT", 6)) tkptr->CgiPlusVarStruct = true; else if (strsame (cptr, "RECORD", 6)) tkptr->CgiPlusVarStruct = false; else { if (ProvideResponse) DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1); return; } if (ProvideResponse) DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1); return; } if (TOUP(OutputPtr[0]) == 'C' && TOUP(OutputPtr[8]) == 'R' && strsame (OutputPtr, "CLIENT-READ:", 12)) { /***************/ /* CLIENT-READ */ /***************/ tkptr->ClientReadStripCrLf = false; for (cptr = OutputPtr+12; *cptr && isspace(*cptr); cptr++); if (strsame (cptr, "STRIPCRLF", 9)) tkptr->ClientReadStripCrLf = true; else { if (ProvideResponse) DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1); return; } /* first cancel the normal end-of-request-body EOF on the channel */ sys$cancel (tkptr->HttpInputChannel); /* allocate some storage for buffering this I/O */ tkptr->ClientReadBufferPtr = VmGetHeap (rqptr, tkptr->ClientReadBufferSize = NetReadBufferSize); /* once we start reading into the buffer the request header is kaput */ rqptr->rqHeader.RequestHeaderPtrInvalid = true; /* queue the first read from the client */ NetRead (rqptr, &DclClientReadAst, tkptr->ClientReadBufferPtr, tkptr->ClientReadBufferSize); tkptr->QueuedClientRead++; if (ProvideResponse) DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1); return; } if (TOUP(OutputPtr[0]) == 'C' && TOUP(OutputPtr[8]) == 'T' && strsame (OutputPtr, "CONTENT-TYPE:", 13)) { /*****************/ /* CONTENT-TYPE: */ /*****************/ for (cptr = OutputPtr+13; *cptr && isspace(*cptr); cptr++); if (!*cptr) { if (ProvideResponse) DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1); return; } while (*cptr) cptr++; while (cptr > OutputPtr+13 && *cptr != '.' && *cptr != ']') cptr--; cptr = ConfigContentType (NULL, cptr); zptr = (sptr = Scratch) + sizeof(Scratch)-1; memcpy (sptr, "200 ", 4); sptr += 4; while (*cptr && sptr < zptr) *sptr++ = *cptr++; *sptr = '\0'; if (ProvideResponse) DclCalloutQio (rqptr, Scratch, sptr - Scratch); return; } if (Config.cfScript.GatewayBg) { if (TOUP(OutputPtr[0]) == 'G' && strsame (OutputPtr, "GATEWAY-BEGIN:", 14)) { /* HTTP status code of response directly to the BG (socket) device */ for (cptr = OutputPtr+14; *cptr && isspace(*cptr); cptr++); if (isdigit(*cptr)) { Number = atoi(cptr); rqptr->rqResponse.HttpStatus = Number; if (ProvideResponse) DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1); } else if (ProvideResponse) DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1); return; } else if (TOUP(OutputPtr[0]) == 'G' && strsame (OutputPtr, "GATEWAY-CCL:", 12)) { /* directly control the BG device carriage-control bit */ for (cptr = OutputPtr+12; *cptr && isspace(*cptr); cptr++); if (isdigit(*cptr)) { Number = atoi(cptr); if (Number == 1) status = NetClientSocketCcl (rqptr, 1); else if (Number == 0) status = NetClientSocketCcl (rqptr, 0); else status = SS$_BADPARAM; } else status = SS$_BADPARAM; if (ProvideResponse) if (VMSok(status)) DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1); else DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1); return; } else if (TOUP(OutputPtr[0]) == 'G' && strsame (OutputPtr, "GATEWAY-END:", 12)) { /* count of bytes output directly to the BG (socket) device */ for (cptr = OutputPtr+12; *cptr && isspace(*cptr); cptr++); if (isdigit(*cptr)) { Number = atoi(cptr); ADD_LONG_QUAD (Number, rqptr->BytesRawTx) if (ProvideResponse) DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1); } else if (ProvideResponse) DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1); return; } } if (TOUP(OutputPtr[0]) == 'I' && strsame (OutputPtr, "ICON-TYPE:", 10)) { /**************/ /* ICON-TYPE: */ /**************/ for (cptr = OutputPtr+10; *cptr && isspace(*cptr); cptr++); if (!*cptr) { if (ProvideResponse) DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1); return; } sptr = cptr; while (*cptr) cptr++; while (cptr > OutputPtr+10 && *cptr != '.' && *cptr != ']' && *cptr != '/') cptr--; if (*cptr == '.') cptr = ConfigContentType (NULL, cptr); else cptr = sptr; cptr = ConfigIconFor (cptr, NULL, NULL); zptr = (sptr = Scratch) + sizeof(Scratch)-1; memcpy (sptr, "200 ", 4); sptr += 4; while (*cptr && sptr < zptr) *sptr++ = *cptr++; *sptr = '\0'; if (ProvideResponse) DclCalloutQio (rqptr, Scratch, sptr - Scratch); return; } if (TOUP(OutputPtr[0]) == 'L' && strsame (OutputPtr, "LIFETIME:", 9)) { /*************/ /* LIFETIME: */ /*************/ /* let a CGIplus script set/reset its own lifetime */ for (cptr = OutputPtr+9; *cptr && isspace(*cptr); cptr++); if ((TOUP(*cptr) == 'D' && strsame (cptr, "DO-NOT-DISTURB", 4)) || (TOUP(*cptr) == 'N' && strsame (cptr, "NONE", 4))) tkptr->LifeTimeSecond = DCL_DO_NOT_DISTURB; else if (!isdigit(*cptr)) { /* anything other than a valid number reverts to config values */ if (tkptr->TaskType == DCL_TASK_TYPE_CGI_SCRIPT) tkptr->LifeTimeSecond = HttpdTickSecond + Config.cfScript.ZombieLifeTime; else tkptr->LifeTimeSecond = HttpdTickSecond + Config.cfScript.CgiPlusLifeTime; } else tkptr->LifeTimeSecond = HttpdTickSecond + MetaConSetSeconds (NULL, cptr, 60); if (ProvideResponse) DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1); return; } if (TOUP(OutputPtr[0]) == 'M' && TOUP(OutputPtr[4]) == 'F' && strsame (OutputPtr, "MAP-FILE:", 9)) { /*************/ /* MAP-FILE: */ /*************/ Scratch[4] = '\0'; for (cptr = OutputPtr+9; *cptr && isspace(*cptr); cptr++); if (!*cptr) { if (ProvideResponse) DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1); return; } cptr = MapUrl_Map (Scratch+4, sizeof(Scratch)-4, cptr, 0, NULL, 0, NULL, 0, NULL, 0, NULL, rqptr, NULL); if (!cptr[0] && cptr[1]) { memcpy (Scratch, "400 ", 4); strcpy (Scratch+4, cptr+1); if (ProvideResponse) DclCalloutQio (rqptr, Scratch, strlen(Scratch)); } else { memcpy (Scratch, "200 ", 4); /* for backward comptibility (pre8.1) URL-encode the supplied path */ Length = StringUrlEncode (cptr, Scratch+4, sizeof(Scratch)-4); if (ProvideResponse) DclCalloutQio (rqptr, Scratch, Length+4); } return; } if (TOUP(OutputPtr[0]) == 'M' && TOUP(OutputPtr[4]) == 'P' && strsame (OutputPtr, "MAP-PATH:", 9)) { /*************/ /* MAP-PATH: */ /*************/ Scratch[4] = '\0'; for (cptr = OutputPtr+9; *cptr && isspace(*cptr); cptr++); if (!*cptr) { if (ProvideResponse) DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1); return; } cptr = MapUrl_Map (cptr, 0, Scratch+4, sizeof(Scratch)-4, NULL, 0, NULL, 0, NULL, 0, NULL, rqptr, NULL); if (!cptr[0] && cptr[1]) { memcpy (Scratch, "400 ", 4); strcpy (Scratch+4, cptr+1); if (ProvideResponse) DclCalloutQio (rqptr, Scratch, strlen(Scratch)); } else { if (strsame (Scratch+4, MAPURL_NO_REVERSE_PATH, -1)) memcpy (Scratch, "400 ", 4); else memcpy (Scratch, "200 ", 4); if (ProvideResponse) DclCalloutQio (rqptr, Scratch, strlen(Scratch)); } return; } if (TOUP(OutputPtr[0]) == 'N') { if (strsame (OutputPtr, "NOTICED:", 8)) { /************/ /* NOTICED: */ /************/ /* 'error' noticed by agent */ for (cptr = OutputPtr+8; *cptr && ISLWS(*cptr); cptr++); for (sptr = cptr; *sptr && NOTEOL(*sptr); sptr++); *sptr = '\0'; ErrorNoticed (rqptr, 0, cptr, FI_LI); return; } if (strsame (OutputPtr, "NOOP:", 5)) { /*********/ /* NOOP: */ /*********/ /* used for WATCHable debugging information, comments, etc. */ if (ProvideResponse) DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1); return; } } if (TOUP(OutputPtr[0]) == 'O' && strsame (OutputPtr, "OPCOM:", 6)) { for (cptr = OutputPtr+6; *cptr && ISLWS(*cptr); cptr++); for (sptr = cptr; *sptr && NOTEOL(*sptr); sptr++); *sptr = '\0'; FaoToStdout ( "%HTTPD-W-DCLOPCOM, !20%D, !AZ\n\ -DCLOPCOM-I-SERVICE, !AZ//!AZ\n\ -DCLOPCOM-I-CLIENT, !AZ\n\ -DCLOPCOM-I-USERNAME, \"!AZ\" in \"!AZ\"\n\ -DCLOPCOM-I-URI, !AZ !AZ\n", 0, cptr, rqptr->ServicePtr->RequestSchemeNamePtr, rqptr->ServicePtr->ServerHostPort, ClientHostString(rqptr), rqptr->RemoteUser, rqptr->rqAuth.RealmDescrPtr, rqptr->rqHeader.MethodName, rqptr->rqHeader.RequestUriPtr); if (OpcomMessages & OPCOM_HTTPD) FaoToOpcom ( "%HTTPD-W-DCLOPCOM, !AZ\r\n\ -DCLOPCOM-I-SERVICE, !AZ//!AZ\r\n\ -DCLOPCOM-I-CLIENT, !AZ\r\n\ -DCLOPCOM-I-USERNAME, \"!AZ\" in \"!AZ\"\r\n\ -DCLOPCOM-I-URI, !AZ !AZ", cptr, rqptr->ServicePtr->RequestSchemeNamePtr, rqptr->ServicePtr->ServerHostPort, ClientHostString(rqptr), rqptr->RemoteUser, rqptr->rqAuth.RealmDescrPtr, rqptr->rqHeader.MethodName, rqptr->rqHeader.RequestUriPtr); return; } if (TOUP(OutputPtr[0]) == 'R' && TOUP(OutputPtr[7]) == 'S' && strsame (OutputPtr, "REDACT-SIZE:", 12)) { /****************/ /* REDACT-SIZE: */ /****************/ RequestRedact (rqptr, OutputPtr, OutputCount, ProvideResponse); return; } if (TOUP(OutputPtr[0]) == 'S' && TOUP(OutputPtr[7]) == 'C' && strsame (OutputPtr, "SCRIPT-CONTROL:", 15)) { /*******************/ /* SCRIPT-CONTROL: */ /*******************/ for (cptr = OutputPtr+15; *cptr && ISLWS(*cptr); cptr++); Length = CgiScriptControlField (rqptr, cptr); if (ProvideResponse) if (Length) DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1); else DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1); return; } if (TOUP(OutputPtr[0]) == 'T' && TOUP(OutputPtr[8]) == 'B' && strsame (OutputPtr, "TIMEOUT-BIT-BUCKET:", 19)) { /***********************/ /* TIMEOUT-BIT-BUCKET: */ /***********************/ /* let a script SPECIFY it's own per-task bit-bucket timeout */ for (cptr = OutputPtr+19; *cptr && isspace(*cptr); cptr++); if (isdigit(*cptr)) { if (strsame (cptr, "none", 4)) Number = 0; else Number = atoi(cptr); tkptr->BitBucketTimeout = Number; if (ProvideResponse) DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1); } else if (ProvideResponse) DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1); return; } if (TOUP(OutputPtr[0]) == 'T' && TOUP(OutputPtr[8]) == 'N' && strsame (OutputPtr, "TIMEOUT-NOPROGRESS:", 19)) { /***********************/ /* TIMEOUT-NOPROGRESS: */ /***********************/ /* let a script set/reset it's own per-request no-progress timeout */ for (cptr = OutputPtr+19; *cptr && isspace(*cptr); cptr++); if (isdigit(*cptr)) { if (strsame (cptr, "none", 4)) Number = -1; else Number = atoi(cptr); HttpdTimerSet (rqptr, TIMER_NOPROGRESS, Number); if (ProvideResponse) DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1); } else if (ProvideResponse) DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1); return; } if (TOUP(OutputPtr[0]) == 'T' && TOUP(OutputPtr[8]) == 'O' && strsame (OutputPtr, "TIMEOUT-OUTPUT:", 15)) { /*******************/ /* TIMEOUT-OUTPUT: */ /*******************/ /* let a script set/reset its own per-request output timeout */ for (cptr = OutputPtr+15; *cptr && isspace(*cptr); cptr++); if (strsame (cptr, "none", 4)) { HttpdTimerSet (rqptr, TIMER_OUTPUT, -1); if (ProvideResponse) DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1); } else if (isdigit(*cptr)) { Number = atoi(cptr); HttpdTimerSet (rqptr, TIMER_OUTPUT, Number); if (ProvideResponse) DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1); } else if (ProvideResponse) DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1); return; } if (TOUP(OutputPtr[0]) == 'W') { if (strsame (OutputPtr, "WATCH:", 6)) { /**********/ /* WATCH: */ /**********/ /* WATCHing script */ if (WATCHING(rqptr) && WATCH_CATEGORY(WATCH_SCRIPT)) { for (cptr = OutputPtr+6; *cptr && isspace(*cptr); cptr++); WatchThis (rqptr, FI_LI, WATCH_SCRIPT, "!AZ", cptr); if (ProvideResponse) DclCalloutQio (rqptr, RspSuccess, sizeof(RspSuccess)-1); } else if (ProvideResponse) DclCalloutQio (rqptr, RspBadParam, sizeof(RspBadParam)-1); return; } } if (ProvideResponse) DclCalloutQio (rqptr, RspUnknown, sizeof(RspUnknown)-1); } /*****************************************************************************/ /* Whenever there is an active script process (not necessarily processing a request) this function is called every second by HttpdTick(). It only scans the list of script tasks every so-many seconds. This can be varied to provide greater or lesser granularity depending on requirements (some events benfit from closer observation). Periodically scan the list of DCL script processes looking for those whose lifetimes have expired. Run those script processes down! A lifetime count of DCL_DO_NOT_DISTURB (-1) indicates the script process has requested that it be immune to supervisor purging (and some other other proactive administration). Return true to indicate that the HTTPd should continue to tick. */ BOOL DclSupervisor (int PeriodSeconds) { static int CleanupSecond = 0, TaskScanSeconds = 0; BOOL ContinueTicking; int idx, status, MinSeconds; LIST_ENTRY *leptr, *rleptr; REQUEST_STRUCT *rqeptr; DCL_TASK *tkptr; /*********/ /* begin */ /*********/ if (WATCH_MODULE(WATCH_MOD_DCL) && PeriodSeconds != -1) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclSupervisor() !SL !UL", PeriodSeconds, HttpdTickSecond); if (PeriodSeconds >= 0) { /* initiate or reset the task supervisor ticking */ if (PeriodSeconds) { if (HttpdTickSecond + PeriodSeconds < TaskScanSeconds && PeriodSeconds >= DCL_SUPERVISOR_TICK_MIN && PeriodSeconds <= DCL_SUPERVISOR_TICK_MAX) TaskScanSeconds = HttpdTickSecond + PeriodSeconds; } else if (!TaskScanSeconds) TaskScanSeconds = HttpdTickSecond + DCL_SUPERVISOR_TICK_MAX; return (false); } /*******************/ /* task supervisor */ /*******************/ /* no script process is currently executing */ if (!TaskScanSeconds) return (false); /* no need to do a scan just yet */ if (TaskScanSeconds > HttpdTickSecond) return (true); /* if there is no cleanup expiry set then generate one */ if (DclCleanupMinutesMax && !CleanupSecond) CleanupSecond = HttpdTickSecond + DclCleanupMinutesMax * 60; ContinueTicking = false; MinSeconds = DCL_SUPERVISOR_TICK_MAX; for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr) { tkptr = (DCL_TASK*)leptr; if (!tkptr->ScriptProcessPid) continue; ContinueTicking = true; /* if no attached requests then put a lifetime back on it */ if (tkptr->LifeTimeSecond == DCL_WEBSOCKET_DND) if (!WebSockCount (tkptr->ScriptProcessPid)) tkptr->LifeTimeSecond = HttpdTickSecond + Config.cfScript.CgiPlusLifeTime; /* proctored process must be independently stable for a short period */ if (tkptr->ProctorProcess && !tkptr->RequestPtr) { if (!--tkptr->ProctorProcess) tkptr->ProctorPtr = NULL; MinSeconds = 1; } if ((tkptr->RequestPtr || tkptr->LifeTimeSecond > HttpdTickSecond || tkptr->LifeTimeSecond == DCL_DO_NOT_DISTURB || tkptr->LifeTimeSecond == DCL_WEBSOCKET_DND) && !(tkptr->ForceImageExitGetJpi || tkptr->ForceImageExitIssued)) { if (tkptr->ScriptCpuMax) { /* we're keeping an eye on CPU consumption */ DclScriptCpuTim (tkptr); if (tkptr->ScriptCpuMax < MinSeconds) MinSeconds = tkptr->ScriptCpuMax; } else if (tkptr->LifeTimeSecond - HttpdTickSecond < MinSeconds) MinSeconds = tkptr->LifeTimeSecond - HttpdTickSecond; continue; } /* process timer has expired, exterminate ... exxterrminnaattte */ tkptr->LifeTimeSecond = 0; tkptr->DeleteProcess = true; DclTaskRunDown (tkptr); /* if we're still waiting for image exit then it's not over yet */ if (tkptr->ForceImageExit) continue; if (tkptr->TaskType == DCL_TASK_TYPE_CGIPLUS_SCRIPT || tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT) DclCgiPlusLifeTimePurgeCount++; else DclZombieLifeTimePurgeCount++; } /* see algorithm description with function DclScriptProctor() */ for (idx = 0; idx < Config.cfScript.ProctorCount; idx++) if (Config.cfScript.Proctor[idx].FailWeight) if ((Config.cfScript.Proctor[idx].FailWeight -= MinSeconds) < 0) Config.cfScript.Proctor[idx].FailWeight = 0; if (CleanupSecond && (CleanupSecond <= HttpdTickSecond || !ContinueTicking)) { /***********/ /* cleanup */ /***********/ /* either the cleanup timer expired or no more scripts */ if (WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "CLEANUP !AZ", DclHttpdScratch); /* kick off an independent thread of cleanup I/O */ SysDclAst (&DclCleanupScratch, NULL); /* periodically cleanup the script name cache */ DclPurgeScriptNameCache (); CleanupSecond = 0; } if (WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "SUPERVISOR !&B !UL", ContinueTicking, MinSeconds); if (ContinueTicking) { /* at least one item in the connect list is still counting down */ if (MinSeconds < 0) MinSeconds = 0; TaskScanSeconds = HttpdTickSecond + MinSeconds; return (true); } /* purge the script name cache when there are no more zombies/CGIplus */ DclPurgeScriptNameCache (); /* reinitialize the supervisor timings */ CleanupSecond = TaskScanSeconds = 0; return (false); } /*****************************************************************************/ /* In an independent thread of execution search the script working/scratch directory (HT_SCRATCH) checking for files that are older than the limit (based on their RDT). This thread is initiated by being called with a NULL as the parameter. This initializes the RMS structures and begins an AST-driven search, calling this function for each search call with the search FAB as the parameter. Files found have the revision date/time compared to a date/time the required number of minutes earlier than the current time. Those exceeding that are deleted. File names beginning with a dollar are never deleted in this way. */ void DclCleanupScratch (struct FAB *FabPtr) { static unsigned long OneMinuteDelta [2] = { -600000000, -1 }; BOOL CleanupUnderway = false; static int FileCount, FileDeletedCount, FileDollarCount, FileHiddenCount; static unsigned long CurrentBinTime [2], OlderThanBinTime [2], ScratchBinTime [2]; static ODS_STRUCT SearchOds; int status; /*********/ /* begin */ /*********/ if (WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclCleanupScratch() !&F", &DclCleanupScratch); if (!FabPtr) { if (CleanupUnderway) return; CleanupUnderway = true; FileCount = FileDeletedCount = FileDollarCount = FileHiddenCount = 0; memcpy (&ScratchBinTime, &OneMinuteDelta, sizeof(ScratchBinTime)); status = lib$mult_delta_time (&DclCleanupMinutesOld, &ScratchBinTime); if (VMSnok (status)) { ErrorNoticed (NULL, status, NULL, FI_LI); CleanupUnderway = false; return; } /* add the (negative) delta to the current getting an earlier time */ sys$gettim (&CurrentBinTime); status = lib$sub_times (&CurrentBinTime, &ScratchBinTime, &OlderThanBinTime); if (VMSnok (status)) { ErrorNoticed (NULL, status, NULL, FI_LI); CleanupUnderway = false; return; } status = OdsParse (&SearchOds, DclHttpdScratch, strlen(DclHttpdScratch), "[...]*.*;*", 10, 0, NULL, 0); if (VMSnok (status)) { ErrorNoticed (NULL, status, NULL, FI_LI); CleanupUnderway = false; return; } } else { if (VMSnok (status = SearchOds.Fab.fab$l_sts)) { if (status == RMS$_FNF || status == RMS$_NMF) { if (FileDeletedCount) FaoToStdout ( "%HTTPD-I-DCL, !20%D, cleanup !AZ, !UL file!%s, !UL deleted ($!UL/.!UL)\n", 0, DclHttpdScratch, FileCount, FileDeletedCount, FileDollarCount, FileHiddenCount); } else ErrorNoticed (NULL, status, NULL, FI_LI); CleanupUnderway = false; if (SearchOds.ParseInUse) OdsParseRelease (&SearchOds); return; } FileCount++; if (SearchOds.NamNamePtr[0] == '$') FileDollarCount++; else if (SearchOds.NamNamePtr[0] == '.') FileHiddenCount++; else { status = OdsFileAcpInfo (&SearchOds, NULL, 0); if (VMSnok (status)) { ErrorNoticed (NULL, status, NULL, FI_LI); CleanupUnderway = false; if (SearchOds.ParseInUse) OdsParseRelease (&SearchOds); return; } /* if a negative time the file is older than the specified period */ status = lib$sub_times (&SearchOds.FileQio.RdtBinTime, &OlderThanBinTime, &ScratchBinTime); if (status == LIB$_NEGTIM) { /* use SYSPRV to ensure the file is deleted */ sys$setprv (1, &SysPrvMask, 0, 0); SearchOds.Fab.fab$l_fop = FAB$M_NAM; status = sys$erase (&SearchOds.Fab, 0, 0); sys$setprv (0, &SysPrvMask, 0, 0); if (VMSok (status)) FileDeletedCount++; } else if (VMSnok (status)) { ErrorNoticed (NULL, status, NULL, FI_LI); CleanupUnderway = false; if (SearchOds.ParseInUse) OdsParseRelease (&SearchOds); return; } } } OdsSearch (&SearchOds, &DclCleanupScratch, &SearchOds.Fab); } /*****************************************************************************/ /* Scan all detached processes on the system looking for those with a mailbox 'terminal' with the server's 'special' identifier in an ACL. Delete these processes. This function is called to clean-up detached script processes that may have been left on the system if a server is sys$delprc()ed in some way (e.g. STOP/id=). Normally the image exit handler will delete these during user-mode image rundown. This function obviously must be called during server startup prior to actually beginning to process requests. */ /* seems a lot but I recall some site having a HUGE number of IDs */ #define JPI_PROCESS_RIGHTS_MAX 1024 #define PSCAN$_GETJPI_BUFFER_SIZE 24 #define PSCAN$_TERMINAL 21 #define PSCAN$M_PREFIX_MATCH 0x80 #define PSCAN$M_EQL 0x400 DclCleanupScriptProcesses () { static $DESCRIPTOR (ProcessIdentNameDsc, ""); static unsigned long GetJpiControlFlags = JPI$M_IGNORE_TARGET_STATUS; static unsigned long JpiPid, JpiRightsSize; static char JpiPrcNam [16], JpiUserName [13]; static struct { unsigned short buf_len; unsigned short item; unsigned char *buf_addr; unsigned long *short_ret_len; } JpiItems [] = { { sizeof(GetJpiControlFlags), JPI$_GETJPI_CONTROL_FLAGS, &GetJpiControlFlags, 0 }, { sizeof(JpiPid), JPI$_PID, &JpiPid, 0 }, { sizeof(JpiPrcNam), JPI$_PRCNAM, &JpiPrcNam, 0 }, { sizeof(JpiUserName), JPI$_USERNAME, &JpiUserName, 0 }, { sizeof(JpiRightsSize), JPI$_RIGHTS_SIZE, &JpiRightsSize, 0 }, #define JPI_PROCESS_RIGHTS_ITEM 5 { 0, JPI$_PROCESS_RIGHTS, 0, 0 }, { 0,0,0,0 } }, ScanItems [] = { { 0, PSCAN$_GETJPI_BUFFER_SIZE, 2048, 0 }, { 0,0,0,0 } }; int idx, status, Context, IdentCount, ProcessCount, SetPrvStatus; unsigned long ProcessContext; unsigned long JpiProcessRights [JPI_PROCESS_RIGHTS_MAX*2]; char *cptr; IO_SB IOsb; /*********/ /* begin */ /*********/ if (WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclCleanupScriptProcesses()"); /* create the identifier if it does not already exist */ ProcessIdentNameDsc.dsc$a_pointer = ProcessIdentName; ProcessIdentNameDsc.dsc$w_length = strlen(ProcessIdentName); status = sys$asctoid (&ProcessIdentNameDsc, &ProcessRightsIdent, 0); if (VMSnok (status)) { /* use SYSPRV to allow access to the rights database */ sys$setprv (1, &SysPrvMask, 0, 0); status = sys$add_ident (&ProcessIdentNameDsc, 0, 0, &ProcessRightsIdent); sys$setprv (0, &SysPrvMask, 0, 0); if (VMSok (status)) FaoToStdout ( "%HTTPD-I-RDBADDMSG, identifier !AZ value !&S added to rights database\n", ProcessIdentName, ProcessRightsIdent[0]); else { FaoToStdout ( "%HTTPD-W-RDBADDERRU, unable to add !AZ to rights database\n-!&M\n", ProcessIdentName, status); ErrorExitVmsStatus (status, "sys$add_ident", FI_LI); } } ProcessRightsIdent[1] = KGB$M_NOACCESS; JpiItems[JPI_PROCESS_RIGHTS_ITEM].buf_len = sizeof(JpiProcessRights); JpiItems[JPI_PROCESS_RIGHTS_ITEM].buf_addr = &JpiProcessRights; ProcessContext = 0; status = sys$process_scan (&ProcessContext, &ScanItems); if (VMSnok (status)) { ErrorNoticed (NULL, status, NULL, FI_LI); return; } /* enable WORLD so we can access at *all* processes */ if (VMSnok (SetPrvStatus = sys$setprv (1, &MailboxMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); ProcessCount = 0; for (;;) { status = sys$getjpiw (EfnWait, &ProcessContext, 0, &JpiItems, &IOsb, 0, 0); if (VMSok (status)) status = IOsb.Status; if (VMSnok (status)) break; ProcessCount++; JpiUserName[12] = '\0'; for (cptr = JpiUserName; *cptr && *cptr != ' '; cptr++); *cptr = '\0'; JpiPrcNam[15] = '\0'; for (cptr = JpiPrcNam; *cptr && *cptr != ' '; cptr++); *cptr = '\0'; if (WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "!8XL !&Z !&Z !UL", JpiPid, JpiUserName, JpiPrcNam, JpiRightsSize); if (JpiRightsSize > sizeof(JpiProcessRights)) { char Buffer [32]; sprintf (Buffer, "sys$getjpiw() %08.08X", JpiPid); ErrorNoticed (NULL, SS$_BUFFEROVF, Buffer, FI_LI); } /* look through each of the identifiers in the list */ idx = 0; for (IdentCount = JpiRightsSize / 8; IdentCount && JpiProcessRights[idx] != ProcessRightsIdent[0]; IdentCount--) idx += 2; /* if we didn't find the identifier then continue */ if (!IdentCount) continue; /* I've seen this happen once and couldn't work out why!! */ if (JpiPid == HttpdProcess.Pid) continue; FaoToStdout ( "%HTTPD-I-DCL, cleanup detached script process; !8XL !AZ \'!AZ\'\n", JpiPid, JpiUserName, JpiPrcNam); status = sys$delprc (&JpiPid, 0); if (VMSnok (status)) ErrorNoticed (NULL, status, NULL, FI_LI); } if (VMSnok (SetPrvStatus = sys$setprv (0, &MailboxMask, 0, 0))) ErrorExitVmsStatus (SetPrvStatus, "sys$setprv()", FI_LI); if (status != SS$_NOMOREPROC) { ErrorNoticed (NULL, status, NULL, FI_LI); return; } } /*****************************************************************************/ /* Create an ACL comprising an ACE allowing full access for the 'AllowName' identifier and apply it to the specified mailbox. If $PARSE_ACL fails on SS$_NOSUCHID then try an ACE using the UIC of the supplied name. This will support scenarios where multiple usernames (accounts) share the same UIC and only the one account rights identifier is available. */ #define OSS$M_RELCTX 0x2 #define OSS$_ACL_ADD_ENTRY 3 #define OSS$_ACL_POSITION_TOP 14 #define OSS$_ACL_READ_ENTRY 16 #define PSL$C_USER 3 #ifdef GET_SET_SECURITY_STUB int DclMailboxAcl ( char *MailboxName, char *AllowName ) { /* sys$get/set_security() not supported for this VMS version */ ErrorNoticed (rqptr, 0, "feature not supported on this platform", FI_LI); return (SS$_ABORT); } #else /* GET_SET_SECURITY_STUB */ int DclMailboxAcl ( char *MailboxName, char *AllowName ) { static $DESCRIPTOR (AclAllowFaoDsc, "(IDENT=!AZ,ACCESS=R+W+E+D)\0"); static $DESCRIPTOR (AclAllowUicFaoDsc, "(IDENT=!%U,ACCESS=R+W+E+D)\0"); static $DESCRIPTOR (ClassNameDsc, "DEVICE"); static unsigned long AccessMode = PSL$C_USER, SecFlags = OSS$M_RELCTX, UaiContext = -1, UaiUic; static unsigned short Length; static unsigned char AclAllowEntry [32], AclReadEntry [32]; static char AclString [64], PrevAllowName [32]; static $DESCRIPTOR (AclAllowEntryDsc, AclAllowEntry); static $DESCRIPTOR (AclStringDsc, AclString); static $DESCRIPTOR (AllowNameDsc, ""); static $DESCRIPTOR (MailboxNameDsc, ""); static struct { unsigned short buf_len; unsigned short item; unsigned char *buf_addr; unsigned long *long_ret_len; } SetSecItems [] = { { 0, OSS$_ACL_ADD_ENTRY, AclAllowEntry, 0 }, {0,0,0,0} }, GetSecItems [] = { { 0, OSS$_ACL_POSITION_TOP, 0, 0 }, { sizeof(AclReadEntry), OSS$_ACL_READ_ENTRY, AclReadEntry, &Length }, {0,0,0,0} }, UaiItems [] = { { sizeof(UaiUic), UAI$_UIC, &UaiUic, 0 }, { 0,0,0,0 } }; int status; unsigned long Context; unsigned short ErrorPos; /*********/ /* begin */ /*********/ if (WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclMailboxAcl() !&Z !&Z !&Z", MailboxName, AllowName, PrevAllowName); MailboxNameDsc.dsc$a_pointer = MailboxName; MailboxNameDsc.dsc$w_length = strlen(MailboxName); if (strcmp (AllowName, PrevAllowName)) { /****************************/ /* new name to allow access */ /****************************/ PrevAllowName[0] = '\0'; status = sys$fao (&AclAllowFaoDsc, 0, &AclStringDsc, AllowName); if (VMSnok (status)) return (status); strzcpy (PrevAllowName, AllowName, sizeof(PrevAllowName)); /* parse the ACE */ AclStringDsc.dsc$a_pointer = AclString; AclStringDsc.dsc$w_length = strlen(AclString); status = sys$parse_acl (&AclStringDsc, &AclAllowEntryDsc, &ErrorPos, 0, 0); AclStringDsc.dsc$w_length = sizeof(AclString)-1; } else status = SS$_NORMAL; UaiUic = 0; for (;;) { if (VMSok (status)) { /*******************************/ /* apply ACL to mailbox device */ /*******************************/ if (WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "!AZ", AclString); SetSecItems[0].buf_len = AclAllowEntry[0]; Context = 0; status = sys$set_security (&ClassNameDsc, &MailboxNameDsc, 0, SecFlags, &SetSecItems, &Context, &AccessMode); /* if successful */ if (VMSok(status)) return (status); } /* if some other error or already had a go at this */ if (status != SS$_NOSUCHID || UaiUic) break; /***************************/ /* try a UIC specification */ /***************************/ AllowNameDsc.dsc$a_pointer = AllowName; AllowNameDsc.dsc$w_length = strlen(AllowName); sys$setprv (1, &SysPrvMask, 0, 0); status = sys$getuai (0, &UaiContext, &AllowNameDsc, &UaiItems, 0, 0, 0); sys$setprv (0, &SysPrvMask, 0, 0); if (WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "sys$getuai() !&S", status); if (VMSnok(status)) break; status = sys$fao (&AclAllowUicFaoDsc, 0, &AclStringDsc, UaiUic); if (VMSnok (status)) break; /* parse the ACE */ AclStringDsc.dsc$a_pointer = AclString; AclStringDsc.dsc$w_length = strlen(AclString); status = sys$parse_acl (&AclStringDsc, &AclAllowEntryDsc, &ErrorPos, 0, 0); AclStringDsc.dsc$w_length = sizeof(AclString)-1; } /* failure */ PrevAllowName[0] = '\0'; return (status); } #endif /* GET_SET_SECURITY_STUB */ /*****************************************************************************/ /* ************ *** NOTE *** This function takes a pointer to a request!!! ************ Due to it being a general report processing function. Return a report on the DCL task structure. This function blocks while executing. */ DclScriptingReport ( REQUEST_STRUCT *rqptr, REQUEST_AST NextTaskFunction ) { static char PageBeginFao [] = " \n\ \n\ \n\ \n\ \ \n\ Statistics\n\ \n\ CGI: !&L\n\ CGIplus /All: !&L\n\ /Reused: !&L\n\ RTE /All: !&L\n\ /Reused: !&L\n\ Autoscript: !&L\n\ CLI: !&L\n\ Proctor: !&L\n\ WebSocket: !&L\n\ \n\ \ \n\ \ \n\ Processes\n\ \n\ Current: !&L\n\ $CREPRC: !&L\n\ $PERSONA!&?_MACRO\r\r\ /All: !&L\n\ /Default: !&L\n\ /Invalid: !&L\n\ /Privileged:\ !&L\n\ $FORCEX: !&L\n\ $DELPRC: !&L\n\ As: !AZ\n\ \n\ \ \n\ \ \n\ Limits\n\ \n\ Soft \ /Value: !&L \n\ /Purged-at: !&L\n\ Hard \ /Value: !&L\n\ /Purged-at: !&L\n\ Purged \ /Soft-Limit: !&L\n\ /Explicit: !&L\n\ Zombie \ /Lifetime: !AZ\n\ /Purged-at: !&L\n\ CGIplus \ /Lifetime: !AZ\n\ /Purged-at: !&L\n\ \n\ \ \n\ \n\ \n\ \n\ \ DCL Task List\n\ \n\ \ \n\ Script / Client \ PID / Request \ User \ WebSock \ Type \ Lifetime \ Zombie \ CGIplus \ RTE \ Total \ Last\ \ \n\ \n"; /* the empty 99% column just forces the rest left with long request URIs */ static char TaskFao [] = " !&@ \ !&@\ !8XL \ !AZ \ !UL \ !AZ \ !AZ \ !&@ \ !&@ \ !&@ \ !&L \ !20%D\ !AZ\ \n\ !&@"; static char EmptyTaskListFao [] = " 000 \ empty \n"; static char ProctorListFao [] = "\n\ Proctor List\n\ \n\ \ \ Min+Idle \ Identification \ Activation \ Notepad \ Min \ Idle \ Last\ Fail \ Last\ \n\ \n"; static char ProctorItemFao [] = "!&@ !3ZL \ !UL+!UL \ !AZ!AZ!AZ!AZ \ !AZ \ !AZ \ !UL \ !UL \ !20%D\ !UL \ !&@\ !&@\ \n"; static char EmptyProctorListFao [] = " 000 \ empty \n"; static char ScriptNameCacheFao [] = "\n\ Script Name Cache\n\ \n\ \ \ Mapped File \ File Name \ Hits \ Last\ \ \n\ \n"; static char NameCacheFao [] = " !3ZL \ !AZ \ !AZ \ !&L \ !20%D\ !AZ\ \n"; static char EmptyScriptNameCacheFao [] = " 000 \ empty \n"; static char PersonaCacheFao [] = "\n\ Persona Cache\n\ !3ZL \n\ \ \ User \ Hits \ Last \ Reuse\n\ \ \n\ \n"; static char PersonaEntryFao [] = " <\ TD align=\"right\"> \ !AZ \ !&L \ !20%D \ !&L\n\ !AZ\ \n"; static char EmptyPersonaCacheFao [] = " 000 \ empty \n"; static char ButtonsFao [] = "\n\ \n\ \n\ \n\ \n\ \n\ \n\ \n\ \n\ \n\ \n\ \n\ \n\ \n\ \n"; int idx, status, Count; unsigned long FaoVector [64]; unsigned long *vecptr; char *cptr; DCL_SCRIPT_NAME_ENTRY *captr; DCL_TASK *tkptr; LIST_ENTRY *leptr; PERSONA_ENTRY *pcptr; struct ConfigProctorStruct *psptr; /*********/ /* begin */ /*********/ if (WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclScriptingReport() !&A", NextTaskFunction); if (DclScriptDetachProcess) AdminPageTitle (rqptr, "Detached Process CGI/DCL Scripting"); else AdminPageTitle (rqptr, "Subprocess CGI/DCL Scripting"); vecptr = FaoVector; InstanceMutexLock (INSTANCE_MUTEX_HTTPD); *vecptr++ = AccountingPtr->DoScriptCount; *vecptr++ = AccountingPtr->DoCgiPlusScriptCount; *vecptr++ = AccountingPtr->DclCgiPlusReusedCount; *vecptr++ = AccountingPtr->DoRteScriptCount; *vecptr++ = AccountingPtr->DclRteReusedCount; *vecptr++ = AccountingPtr->DoAutoScriptCount; *vecptr++ = AccountingPtr->DoDclCommandCount; *vecptr++ = AccountingPtr->DclProctorCount; *vecptr++ = AccountingPtr->DclWebSocketCount; *vecptr++ = CurrentDclScriptProcess; *vecptr++ = AccountingPtr->DclCrePrcCount; *vecptr++ = PersonaMacro; *vecptr++ = AccountingPtr->DclCrePrcPersonaCount; *vecptr++ = AccountingPtr->DclCrePrcPersonaDefaultCount; *vecptr++ = AccountingPtr->DclCrePrcPersonaInvUserCount; *vecptr++ = AccountingPtr->DclCrePrcPersonaPrvUserCount; *vecptr++ = AccountingPtr->DclForceXCount; *vecptr++ = AccountingPtr->DclDelPrcCount; if (HttpdScriptAsUserName[0]) *vecptr++ = HttpdScriptAsUserName; else *vecptr++ = HttpdProcess.UserName; *vecptr++ = DclScriptProcessSoftLimit; *vecptr++ = DclSoftLimitPurgeCount; *vecptr++ = DclScriptProcessHardLimit; *vecptr++ = DclHitHardLimitCount; *vecptr++ = DclPurgeCount; *vecptr++ = DclPurgeScriptProcessesCount; if (DclUseZombies && Config.cfScript.ZombieLifeTime) *vecptr++ = MetaConShowSeconds (rqptr, Config.cfScript.ZombieLifeTime); else *vecptr++ = "[disabled]"; *vecptr++ = DclZombieLifeTimePurgeCount; if (Config.cfScript.CgiPlusLifeTime) *vecptr++ = MetaConShowSeconds (rqptr, Config.cfScript.CgiPlusLifeTime); else *vecptr++ = "none"; *vecptr++ = DclCgiPlusLifeTimePurgeCount; InstanceMutexUnLock (INSTANCE_MUTEX_HTTPD); status = FaolToNet (rqptr, PageBeginFao, &FaoVector); if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI); /*********************/ /* task list entries */ /*********************/ Count = 0; for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr) { tkptr = (DCL_TASK*)leptr; vecptr = FaoVector; if (tkptr->ScriptProcessPid) { *vecptr++ = "!3ZL"; *vecptr++ = ADMIN_REPORT_SHOW_PROCESS; *vecptr++ = tkptr->ScriptProcessPid; *vecptr++ = tkptr->CrePrcUserName; *vecptr++ = ++Count; } else { *vecptr++ = "!3ZL"; *vecptr++ = ++Count; } if (tkptr->TaskType == DCL_TASK_TYPE_CLI) { for (cptr = tkptr->DclCommandPtr; *cptr && *cptr != '\n'; cptr++); if (*cptr) *vecptr++ = " !AZ"; else *vecptr++ = "!AZ "; *vecptr++ = tkptr->DclCommandPtr; } else { if (tkptr->ScriptRunTime[0]) { *vecptr++ = "(!AZ)!AZ "; *vecptr++ = tkptr->ScriptRunTime; } else *vecptr++ = "!AZ "; *vecptr++ = tkptr->ScriptName; } *vecptr++ = tkptr->ScriptProcessPid; if (tkptr->CrePrcUserName[0]) *vecptr++ = tkptr->CrePrcUserName; else *vecptr++ = "none"; *vecptr++ = WebSockCount (tkptr->ScriptProcessPid); switch (tkptr->TaskType) { case DCL_TASK_TYPE_CGI_SCRIPT : *vecptr++ = "CGI"; break; case DCL_TASK_TYPE_CGIPLUS_SCRIPT : *vecptr++ = "CGIplus"; break; case DCL_TASK_TYPE_RTE_SCRIPT : *vecptr++ = "RTE"; break; case DCL_TASK_TYPE_CLI : *vecptr++ = "CLI"; break; default : *vecptr++ = "?"; } *vecptr++ = MetaConShowSeconds (rqptr, tkptr->LifeTimeSecond - HttpdTickSecond); if (tkptr->ZombieCount) { *vecptr++ = "!&L"; *vecptr++ = tkptr->ZombieCount; } else *vecptr++ = ""; if (tkptr->TaskType == DCL_TASK_TYPE_CGIPLUS_SCRIPT) { *vecptr++ = "!&L"; *vecptr++ = tkptr->CgiPlusUsageCount; } else *vecptr++ = ""; if (tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT) { *vecptr++ = "!&L"; *vecptr++ = tkptr->CgiPlusUsageCount; } else *vecptr++ = ""; *vecptr++ = tkptr->TotalUsageCount; *vecptr++ = &tkptr->LastUsedBinaryTime; if (rqptr->rqHeader.VmsNavigatorGold) *vecptr++ = ""; else *vecptr++ = ""; if (tkptr->RequestPtr) { *vecptr++ = "\ !&@!AZ\ !&;AZ\ \n"; if (tkptr->RequestPtr->RemoteUser[0]) { *vecptr++ = "!&;AZ@"; *vecptr++ = tkptr->RequestPtr->RemoteUser; } else *vecptr++ = ""; *vecptr++ = tkptr->RequestPtr->rqClient.Lookup.HostName; *vecptr++ = tkptr->RequestPtr->rqHeader.RequestUriPtr; } else if (tkptr->ScriptProcessPid) *vecptr++ = "idle"; else *vecptr++ = "none"; status = FaolToNet (rqptr, TaskFao, &FaoVector); if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI); } if (!Count) { status = FaolToNet (rqptr, EmptyTaskListFao, NULL); if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI); } /****************/ /* proctor list */ /****************/ status = FaolToNet (rqptr, ProctorListFao, NULL); if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI); Count = 0; for (idx = 0; idx < Config.cfScript.ProctorCount; idx++) { psptr = &Config.cfScript.Proctor[idx]; if (psptr->Problem) continue; if (Count++ % 2) cptr = " " ADMIN_REPORT_ALTHI; else cptr = ""; vecptr = FaoVector; if (psptr->FailWeight) { *vecptr++ = ""; *vecptr++ = psptr->FailWeight; } else *vecptr++ = ""; *vecptr++ = cptr; *vecptr++ = Count; *vecptr++ = cptr; *vecptr++ = psptr->NumberMin; *vecptr++ = psptr->NumberIdle; *vecptr++ = cptr; *vecptr++ = *psptr->RunTimePtr ? "(" : ""; *vecptr++ = *psptr->RunTimePtr ? psptr->RunTimePtr : ""; *vecptr++ = *psptr->RunTimePtr ? ")" : ""; *vecptr++ = psptr->ScriptPtr; *vecptr++ = cptr; *vecptr++ = psptr->ActivatePtr; *vecptr++ = cptr; *vecptr++ = *psptr->NotePadPtr ? psptr->NotePadPtr : ""; *vecptr++ = cptr; *vecptr++ = psptr->TotalMin; *vecptr++ = cptr; *vecptr++ = psptr->TotalIdle; *vecptr++ = cptr; *vecptr++ = &psptr->LastBinTime; *vecptr++ = cptr; *vecptr++ = psptr->TotalFail; *vecptr++ = cptr; *vecptr++ = psptr->FailWeight >= PROCTOR_FAIL_AT ? "!20%D" : "!20%D"; *vecptr++ = &psptr->LastFailBinTime; *vecptr++ = psptr->FailReason[0] ? " !AZ" : ""; *vecptr++ = psptr->FailReason; status = FaolToNet (rqptr, ProctorItemFao, &FaoVector); if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI); } if (!Count) { status = FaolToNet (rqptr, EmptyProctorListFao, NULL); if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI); } /*****************************/ /* script name cache entries */ /*****************************/ status = FaolToNet (rqptr, ScriptNameCacheFao, NULL); if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI); Count = 0; for (leptr = DclScriptNameCacheList.HeadPtr; leptr; leptr = leptr->NextPtr) { captr = (DCL_SCRIPT_NAME_ENTRY*)leptr; if (!captr->ResFileName[0]) continue; if (Count++ % 2) cptr = " " ADMIN_REPORT_ALTHI; else cptr = ""; vecptr = FaoVector; *vecptr++ = Count; *vecptr++ = cptr; *vecptr++ = captr->ScriptFileName; *vecptr++ = cptr; *vecptr++ = captr->ResFileName; *vecptr++ = cptr; *vecptr++ = captr->HitCount; *vecptr++ = cptr; *vecptr++ = &captr->LastBinaryTime; if (rqptr->rqHeader.VmsNavigatorGold) *vecptr++ = ""; else *vecptr++ = ""; status = FaolToNet (rqptr, NameCacheFao, &FaoVector); if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI); } if (!Count) { status = FaolToNet (rqptr, EmptyScriptNameCacheFao, NULL); if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI); } /*************************/ /* persona cache entries */ /*************************/ status = FaoToNet (rqptr, PersonaCacheFao, PersonaCacheEntries); if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI); Count = 0; for (leptr = PersonaCacheList.HeadPtr; leptr; leptr = leptr->NextPtr) { pcptr = (PERSONA_ENTRY*)leptr; if (Count++ % 2) cptr = " " ADMIN_REPORT_ALTHI; else cptr = ""; vecptr = FaoVector; *vecptr++ = Count; *vecptr++ = cptr; *vecptr++ = pcptr->UserName; *vecptr++ = cptr; *vecptr++ = pcptr->HitCount; *vecptr++ = cptr; *vecptr++ = &pcptr->LastBinaryTime; *vecptr++ = cptr; *vecptr++ = pcptr->ReuseCount; if (rqptr->rqHeader.VmsNavigatorGold) *vecptr++ = ""; else *vecptr++ = ""; status = FaolToNet (rqptr, PersonaEntryFao, &FaoVector); if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI); } if (!Count) { status = FaolToNet (rqptr, EmptyPersonaCacheFao, NULL); if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI); } vecptr = FaoVector; *vecptr++ = ADMIN_CONTROL_DCL_PURGE; *vecptr++ = ADMIN_CONTROL_DCL_DELETE; status = FaolToNet (rqptr, ButtonsFao, &FaoVector); if (VMSnok (status)) ErrorNoticed (rqptr, status, NULL, FI_LI); rqptr->rqResponse.PreExpired = PRE_EXPIRE_ADMIN; ResponseHeader200 (rqptr, "text/html", &rqptr->NetWriteBufferDsc); SysDclAst (NextTaskFunction, rqptr); } /*****************************************************************************/ /* Purge the DCL process task list, either allowing request processing completion (if applicable) or immediately ('with extreme prejudice'). The 'UserName' parameter, if supplied' slects only those scripting as that account. 'ScriptName' is a wildcard pattern (if necessary) that selects only those tasks having a script path that matches. 'ScriptFileName' is the same except matches on the VMS file specification of the script. */ char* DclControlPurgeScriptProcesses ( BOOL WithExtremePrejudice, char *UserName, char *ScriptName, char *ScriptFileName ) { static char Response [64]; static $DESCRIPTOR (ResponseFaoDsc, "!UL deleted, !UL marked for delete"); static $DESCRIPTOR (ResponseDsc, Response); int idx, status, DeletedCount, MarkedCount; unsigned short Length; LIST_ENTRY *leptr; DCL_TASK *tkptr; /*********/ /* begin */ /*********/ if (WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclControlPurgeScriptProcesses() !&B !&Z !&Z !&Z", WithExtremePrejudice, UserName, ScriptName, ScriptFileName); /* purge any proctored script failures */ for (idx = 0; idx < Config.cfScript.ProctorCount; idx++) Config.cfScript.Proctor[idx].FailWeight = 0; PersonaCache (NULL, 0); DclPurgeScriptNameCache (); DclPurgeScriptProcessesCount++; DeletedCount = MarkedCount = 0; for (leptr = DclTaskList.HeadPtr; leptr; leptr = leptr->NextPtr) { tkptr = (DCL_TASK*)leptr; if (!tkptr->ScriptProcessPid) continue; /* if only purging scripts running as a specific VMS user */ if (UserName && UserName[0]) if (!strsame (tkptr->CrePrcUserName, UserName, -1)) continue; /* if only purging matching scripts */ if (ScriptName && ScriptName[0]) if (!StringMatch (NULL, tkptr->ScriptName, ScriptName)) continue; /* if only purging matching script file names */ if (ScriptFileName && ScriptFileName[0]) if (!StringMatch (NULL, tkptr->ScriptFileName, ScriptFileName)) continue; if (WithExtremePrejudice || (tkptr->QueuedSysCommand <= tkptr->QueuedSysCommandAllowed && !tkptr->QueuedSysOutput && !tkptr->QueuedCgiPlusIn && !tkptr->QueuedHttpInput && !tkptr->QueuedClientRead && !tkptr->FindScript && !tkptr->RequestPtr) && !((tkptr->TaskType == DCL_TASK_TYPE_CGIPLUS_SCRIPT || tkptr->TaskType == DCL_TASK_TYPE_RTE_SCRIPT) && WebSockCount(tkptr->ScriptProcessPid))) { /* forced delete or script process not currently active, abort task */ tkptr->DeleteProcess = true; /* don't bother running down any image if it's a delete */ if (WithExtremePrejudice) tkptr->ForceImageExit = false; DclTaskRunDown (tkptr); DeletedCount++; } else { /* script process is currently active, just leave marked for delete */ tkptr->DeleteProcess = true; MarkedCount++; } } sys$fao (&ResponseFaoDsc, &Length, &ResponseDsc, DeletedCount, MarkedCount); Response[Length] = '\0'; return (Response); } /*****************************************************************************/ /* A mapping rule reload is a particularly "dangerous" time for scripting as confusion could ensure about which CGIplus script is which and which script name in the cache is which. Hence at a mapping rule reload purge DCL suprocess tasks and the script name cache. */ DclLoadedMappingRules () { /*********/ /* begin */ /*********/ if (WATCH_MODULE(WATCH_MOD_DCL)) WatchThis (NULL, FI_LI, WATCH_MOD_DCL, "DclLoadedMappingRules()"); DclPurgeScriptNameCache (); DclControlPurgeScriptProcesses (false, NULL, NULL, NULL); } /*****************************************************************************/
