[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]
[0283]
[0284]
[0285]
[0286]
[0287]
[0288]
[0289]
[0290]
[0291]
[0292]
[0293]
$! 18-JUL-2009 MGD modified to support WASD v10 logical naming schema
$!
$! 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.
$ !(required for WASD v10.0 and later)
$ if f$trnlnm("WASD_DECNET_OSU_OBJECT") .eqs. ""
$ then
$ 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
$ 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:
$ !(required for WASD v10.0 and later)
$ if f$trnlnm("WASD_DECNET_OSU_OBJECT") .nes. ""
$ then
$ read_net wasd_file_dev
$ 'wasd_file_dev'
$ endif
$ 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.