[0001] [0002] [0003] [0004] [0005] [0006] [0007] [0008] [0009] [0010] [0011] [0012] [0013] [0014] [0015] [0016] [0017] [0018] [0019] [0020] [0021] [0022] [0023] [0024] [0025] [0026] [0027] [0028] [0029] [0030] [0031] [0032] [0033] [0034] [0035] [0036] [0037] [0038] [0039] [0040] [0041] [0042] [0043] [0044] [0045] [0046] [0047] [0048] [0049] [0050] [0051] [0052] [0053] [0054] [0055] [0056] [0057] [0058] [0059] [0060] [0061] [0062] [0063] [0064] [0065] [0066] [0067] [0068] [0069] [0070] [0071] [0072] [0073] [0074] [0075] [0076] [0077] [0078] [0079] [0080] [0081] [0082] [0083] [0084] [0085] [0086] [0087] [0088] [0089] [0090] [0091] [0092] [0093] [0094] [0095] [0096] [0097] [0098] [0099] [0100] [0101] [0102] [0103] [0104] [0105] [0106] [0107] [0108] [0109] [0110] [0111] [0112] [0113] [0114] [0115] [0116] [0117] [0118] [0119] [0120] [0121] [0122] [0123] [0124] [0125] [0126] [0127] [0128] [0129] [0130] [0131] [0132] [0133] [0134] [0135] [0136] [0137] [0138] [0139] [0140] [0141] [0142] [0143] [0144] [0145] [0146] [0147] [0148] [0149] [0150] [0151] [0152] [0153] [0154] [0155] [0156] [0157] [0158] [0159] [0160] [0161] [0162] [0163] [0164] [0165] [0166] [0167] [0168] [0169] [0170] [0171] [0172] [0173] [0174] [0175] [0176] [0177] [0178] [0179] [0180] [0181] [0182] [0183] [0184] [0185] [0186] [0187] [0188] [0189] [0190] [0191] [0192] [0193] [0194] [0195] [0196] [0197] [0198] [0199] [0200] [0201] [0202] [0203] [0204] [0205] [0206] [0207] [0208] [0209] [0210] [0211] [0212] [0213] [0214] [0215] [0216] [0217] [0218] [0219] [0220] [0221] [0222] [0223] [0224] [0225] [0226] [0227] [0228] [0229] [0230] [0231] [0232] [0233] [0234] [0235] [0236] [0237] [0238] [0239] [0240] [0241] [0242] [0243] [0244] [0245] [0246] [0247] [0248] [0249] [0250] [0251] [0252] [0253] [0254] [0255] [0256] [0257] [0258] [0259] [0260] [0261] [0262] [0263] [0264] [0265] [0266] [0267] [0268] [0269] [0270] [0271] [0272] [0273] [0274] [0275] [0276] [0277] [0278] [0279] [0280] [0281] [0282]
$! $! This command procedure handles the netserver side of the WWWEXEC decnet $! object. See bottom of file for DECnet protocol description. $ if f$environment("DEPTH") .lt. 2 then set nover $! $! Define www_root as procedure's directory if not defined otherwise. $ if f$trnlnm("WWW_ROOT") .eqs. "" $ then $ root_dir = f$parse("1.;",f$environment("PROCEDURE"),,, - "NO_CONCEAL,SYNTAX_ONLY") - "][" - "]1.;" + ".]" $ define www_root 'root_dir'/translation=(terminal,concealed) $ endif $ if f$trnlnm("WWW_SYSTEM") .eqs. "" then define www_system www_root:[system] $ read_net = "read/end=done net_link" $ write_net = "write net_link" $! pname = f$fao("WWW script !XW",f$getjpi("0","PROC_INDEX")) $! set noon $! set process/name="''pname'" $! set on $ max_reuse = f$integer("0"+f$trnlnm("WWW_SCRIPT_MAX_REUSE")) $ reuse_count = 0 $ wwwexec_rundown_string == "" $! $! Connect to partner (HTTP server) and read input parameters. $! $ open/read/write net_link sys$net $ request_begin: $ read_net subfunc ! Sub-function (SEARCH, HTBIN) $ if subfunc .eqs. "<DNETREUSE>" then goto request_begin $ read_net method ! HTTP request method field $ read_net protocol ! Protocol field in HTTP request $ read_net url ! 'file' part of URL in HTTP request. $ if f$locate("""",url) .lt. f$length(url) then gosub dquote_url $ if reuse_count .lt. max_reuse then write_net "<DNETREUSE>" $! $! Dispatch on subfunc value. We expect HTBIN to be most common case, so $! check for it first. $! $ offset = f$locate(subfunc+",","HTBIN,SEARCH,CONVERT,POST,") $ on warning then goto done ! Make DCL symbol errors abort us. $ if offset .LT. 26 then goto do_'subfunc' $ do_error: $! Generate error response for unknown sub function. $ call send_sts "500 server error" "Internal error in server, unsupported function." $ goto done_1 $!------------------------------------------------------------------------ $! Script execution. Parse script name out of URL and search for it in $! htbin directory, constructing execution symbol in process. $! $ do_htbin: $ write_net "<DNETPATH>" $ read_net script_path $ script_name = f$element(0,"/",url-script_path) $ write_net "<DNETBINDIR>" $ read_net http_bindir $! $! Construct symbol to execute script, either as foreign command or DCL proc. $! $ script_exec = "$" + f$element(0,";",f$search(f$parse(http_bindir+script_name,".com"))) $ if script_exec .eqs. "$" then script_exec = "$" + - f$element(0,";",f$search(f$parse(http_bindir+script_name,".exe"))) $ stype = f$edit(f$parse(script_exec-"$",,,"TYPE"),"UPCASE") $ if stype .eqs. ".COM" then script_exec[0,1] := "@" $ if stype .eqs. ".PL" then goto Perl_script $ if ( script_exec .nes. "$" ) $ then $ cgi_symbols = "$"+http_bindir+"cgi_symbols.exe"-"..." $ on warning then goto done $ script_exec "''method'" "''url'" "''protocol'" $ else $ call send_sts "404 script not found" - "''f$fao("Requested script (!AS) not found in htbin directory (!AS)",- script_name,http_bindir)'" $ endif $ goto done_1 $ perl_script: $ tfile = "sys$scratch:perlcgi_" + f$string(f$getjpi("0","PID")) + ".tmp" $ write_net "<DNETRECMODE>" $ on warning then goto perl_done $ create/name_table cgi_env ! holds environment logicals. $ p1 = method $ p2 = url $ p3 = protocol $ http_bindir = http_bindir-"..." $ mcr 'http_bindir'cgi_symbols.exe cgi_env "''tfile'" $ if f$integer("0"+f$trnlnm("CONTENT_LENGTH","CGI_ENV")) .le. 0 then tfile = "_NL:" $ if f$type(perl) .eqs. "" .and. - f$search("dcl$path:perl.exe") .eqs. "" then perl = "$www_system:miniperl" $ define/user/table=lnm$process_directory lnm$file_dev cgi_env, - lnm$process, lnm$job, lnm$group, lnm$system, decw$logical_names $ perl 'f$extract(1,255,script_exec)' "''method'" "''protocol'" >net_link: <'tfile' $ perl_done: $ set noon $ deassign/table=lnm$process_directory CGI_ENV $ if tfile .nes. "_NL:" then delete 'tfile';* $ goto done_1 $! $!------------------------------------------------------------------------ $! Mime types defined by presentation rules in config file will cause $! convert sub-function to be used, search arguments cause search subfunction. $! The bindir argument is assumed to be the name of the script to execute. $ do_convert: $ do_search: $ do_post: $ write_net "<DNETBINDIR>" $ read_net script_name $ sho symbol script_name $ script_exec = "$" + f$element(0,";",f$search(f$parse(script_name,"WWW_SYSTEM:.com"))) $ if script_exec .eqs. "$" then script_exec = "$" + - f$element(0,";",f$search(f$parse(script_name,"WWW_SYSTEM:.exe"))) $ stype = f$edit(f$parse(script_exec-"$",,,"TYPE"),"UPCASE") $ if stype .eqs. ".COM" then script_exec[0,1] := "@" $! $ if ( script_exec .nes. "$" ) $ then $! $! Run the script as foriegn command or command procedure. $! $ cgi_symbols = "$"+f$parse("cgi_symbols.exe;",f$extract(1,256,script_exec))-";" $ on warning then goto done $ script_exec "''method'" "''url'" "''protocol'" $ else $ call send_sts "404 presentation script not found" - "''f$fao("!AS program (!AS) not found.",subfunc,script_name) $ endif $ goto done_1 $! $!------------------------------------------------------------------------ $! Common exit point. Clean up connection. $! $ done_1: $ if wwwexec_rundown_string .nes. "" then write_net wwwexec_rundown_string $ read_net /time_out=10/err=done line ! let server break connection first. $ deass sys$output $ reuse_count = reuse_count + 1 $ wwwexec_rundown_string == "" $ if line .eqs. "<DNETREUSE>" .and. reuse_count .le. max_reuse then goto request_begin $ done: $ deass sys$output $ close net_link $ exit $status $!-------------------------------------------------------------------------- $! Common procedure to send messages to. $! Parameters are: P1: status, P2: text. $! $ send_sts: SUBROUTINE $ set noon $ write_net "<DNETTEXT>" $ write_net P1 $ write_net P2 $ write_net "</DNETTEXT>" $ endsubroutine $!----------------------------------------------------------------------------- $! reconstruct url symbols with quotes doubled. $! $ dquote_url: $ i = 0 $ orig_url = url $ url = f$element(0,"""",orig_url) $ next_dquote: $ i = i + 1 $ part = f$element(i,"""",orig_url) $ if ( part .eqs. """" ) then return $ url = url + """""" + part $ goto next_dquote $!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! $! $! Protocol information: $! Script execution involves 3 processes: a client process running a $! WWW browser; the HTTP server process, and a DECnet netserver process $! which executes this command procedure. These processes be referred to $! as the Client, the Server, and the Scriptserver in the following $! description. $! $! For a script to execute, the Client first connects to the Server $! and makes an HTTP request (e.g. POST) that triggers script execution $! in the Server. The Server creates a DECnet logical link to the $! WWWEXEC object, which creates the Scriptserver process. $! $! After the logical link is established, the Server always sends the $! following 4 data messages to the Scriptserver: $! $! module This string is a token representing the server $! module making the DECnet request, either "SEARCH" $! "HTBIN", "POST", or "CONVERT". $! $! method This string is the METHOD field parsed from the $! HTTP request, usually GET. This field is truncated $! to 255 characters before being sent. $! $! protocol This string is the HTTP protocol (e.g. HTTP/V1.0) $! parsed from the request. If the request is from a $! 0.9 client, this string is null. This field is $! truncated to 255 characters before being sent. $! $! URL-ident File identifier parsed from the URL in the request $! (ident is portion before ? or # in URL). Only first $! 255 characters of this field are sent. $! $! The HTTP server then lets the script execution process control the $! session by reading and responding to commands sent over the DECnet link $! by the Scriptserver: $! $! <DNETARG> Requests Server to send Scriptserver the search $! argument parsed from URL of request. If the argument $! was generated by an HTML form, the response message $! may be quite long. (Not readable by DCL). $! $! <DNETARG2> Same as <DNETARG> except that argument is truncated $! to 255 characters to allow reading by DCL. $! $! <DNETPATH> Requests Server to send Scriptserver the matching $! portion of the translated URL that caused the $! the script to be invoked (e.g. "/HTBIN/"). The path $! in truncated to 255 characters and converted to upper $! case. $! $! <DNETHDR> Requests Server to send Scriptserver the HTTP request $! header lines sent by the Client to the Server. $! Last line sent will be a zero-length line. $! $! <DNETINPUT> Requests Server to read data from Client TCP connection $! and relay to the Scriptserver. Only one DECnet message $! is sent. If more data is still needed, another input $! request must by made by the Scriptserver. $! $! <DNETTEXT> Requests Server to send Client an HTTP protocol $! response with a content-type of "text/plain" and $! follow with data read from the Scriptserver. $! The Scriptserver will first send an HTTP status line $! (e.g. 200 sending doc) follow it with text that is $! to appear in the user's output window. $! $! Data is sent assuming implied carriage control, the $! Server appends a newline (CRLF) to each DECnet message $! it recieves over the logical link. The Scriptserver $! marks the end of the text data by sending a line $! consisting solely of the string "</DNETTEXT>". $! Server will close the connection after processing $! this tag. $! $! <DNETRAW> Requests Server to read DECnet data 'raw' from $! scriptserver and send to Client. The Scriptserver is $! responsible for formatting the entire response in $! conformance with the HTTP protocol (including carriage $! control characters). End of data is flagged by a $! DECnet message consisting of solely of "</DNETRAW>", $! which will cause Server to close connection. $! $! <DNETCGI> Request Server to read DECnet data 'raw' and interpret $! data sent by Scriptserver as CGI (Common Gateway $! Interface) script output. If first line is $! "location: <URL>", a redirect is performed. $! End of data is flagged by "</DNETCGI>". $! $! <DNETRECMODE> Request server to process any subsequent <DNETRAW> or $! <DNETCGI> using 'record' mode rather than 'stream' $! mode. In record mode, an implied CRLF is added $! to the end of every DECnet record. The maximum $! record length is reduced to 4094 bytes. $! $! <DNETRQURL> Requests Server to send Scriptserver the actual $! URL (prior to rule file transformations) specified in $! the Client's request. A single DECnet message is sent. $! $! <DNETBINDIR> Requests Server to send Scriptserver the htbin $! directory string as defined in the rule file. $! $! <DNETHOST> Requests Server to send Scriptserver the $! http_default_host environment variable (host name $! to use in constructing URLS). $! $! <DNETID> Request Server to send Scriptserver the server version, $! the http_default_host environment variable, the local $! port for the connection and the remote port and host $! address. A single message is sent with the items $! separated by spaces. Note that the remote address is $! sent as a signed value. $! $! <DNETXLATE> Requests Server to read a URL from Scriptserver, $! translate according to the rules file, and send the $! result back to the Scriptserver.