|
|
The following example script is a simple emulation of the WebSite WinCGI interface.
This example can be found in the examples/tcl/wincgi.tcl file.
#
# Example 7: simple emulation of the WebSite WinCGI interface
#
# This Tcl script emulates the WinCGI interface of the WebSite server.
# To use, move this file to your Tcl library directory (normally the
# modules/tcl directory of the AOLserver directory), set the
# following nsd.ini variables in the [ns\server\<server-name>\wincgi]
# section, and restart the server.
#
# key default description
# --- ------- -----------
# prefix /cgi-win URL prefix for WinCGI.
# debug off Set to on to keep temp files for debugging.
# gmtoff 0 Minutes West of GMT for the "GMT Offset" variable.
# dir c:\wincgi Directory of WinCGI programs.
#
#
# Note: This script is unsupported and not a complete emulation of the
# WebSite WinCGI interface. In particular, not all the WinCGI variables
# are set. Full support for WinCGI will be incorporated into the nscgi
# module in a future AOLserver release.
#
#
# Fetch the variables from the configuration file.
#
global WinCGI
set WinCGI(section) "ns\\server\\[ns_info server]\\wincgi"
if {[set WinCGI(prefix) [ns_config $WinCGI(section) prefix]] == ""} {
set WinCGI(prefix) /cgi-win
}
if {[set WinCGI(dir) [ns_config $WinCGI(section) dir]] == ""} {
set WinCGI(dir) [ns_info home]/$WinCGI(prefix)
}
if {[set WinCGI(gmtoff) [ns_config $WinCGI(section) gmtoff]] == ""} {
set WinCGI(gmtoff) 0
}
if {[set WinCGI(debug) [ns_config -bool $WinCGI(section) debug]] == ""} {
set WinCGI(debug) 0
}
#
# Register the win-cgi procedure to handle requests for WinCGI executables.
#
ns_register_proc POST $WinCGI(prefix)/*.exe win-cgi
ns_register_proc GET $WinCGI(prefix)/*.exe win-cgi
#
# win-cgi - The Tcl request procedure which emulates WinCGI.
#
proc win-cgi {conn ignored} {
global WinCGI
# The program is the second part of the WinCGI URL.
set args [join [split [ns_conn query $conn] &]]
set pgm [lindex [ns_conn urlv $conn] 1]
regsub -all {\+} $args " " args
foreach e [split $WinCGI(dir)/$pgm /] {
if {$e != ""} {lappend exec $e}
}
set exec [join $exec \\]
if ![file executable $exec] {
return [ns_returnnotfound $conn]
}
# WinCGI requires a few temporary files.
set ini [ns_tmpnam]
set inp [ns_tmpnam]
set out [ns_tmpnam]
# Copy the request content to the input file.
set fp [open $inp w]
ns_writecontent $conn $fp
set len [tell $fp]
close $fp
# Create the WinCGI variables .ini file.
set fp [open $ini w]
puts $fp {[CGI]}
puts $fp \
"Request Protocol=HTTP/1.0
Request Method=[ns_conn method $conn]
Executable Path=$WinCGI(prefix)/$pgm
Server Software=[ns_info name]/[ns_info version]
Server Name=[ns_info name]
Server Port=[ns_info version]
Server Admin=[ns_config AOLserver WebMaster]
CGI Version=CGI/1.2 (Win)
Remote Address=[ns_conn peeraddr $conn]
Authentication Method=Basic
Authentication Realm=[ns_conn location $conn]
Content Type=application/x-www-form-urlencoded
Content Length=$len"
puts $fp ""
puts $fp {[System]}
puts $fp \
"GMT Offset=$WinCGI(gmtoff)
Debug Mode=Yes
Output File=$out
Content File=$inp"
# Set any POST or query form variables.
puts $fp ""
puts $fp {[Form Literal]}
set form [ns_conn form $conn]
if {$form != ""} {
for {set i 0} {$i < [ns_set size $form]} {incr i} {
set key [ns_set key $form $i]
set value [ns_set value $form $i]
puts $fp "$key=$value"
}
}
# Set the accept headers and accumulate the extra headers.
puts $fp ""
puts $fp {[Accept]}
set headers [ns_conn headers $conn]
set extras ""
for {set i 0} {$i < [ns_set size $headers]} {incr i} {
set key [ns_set key $headers $i]
set ukey [string toupper $key]
set value [ns_set value $headers $i]
if {$ukey == "ACCEPT"} {
puts $fp "$value=Yes"
} elseif {$key != "CONTENT-LENGTH" && $key != "CONTENT-TYPE"} {
append extras "$key=$value\n"
}
}
puts $fp ""
puts $fp {[Extra Headers]}
puts $fp $extras
close $fp
# Execute the WinCGI program.
# NB: "catch" the exec and open because a WinCGI
# program can be misbehaved, returning a non-zero
# exit status or not creating the output file.
catch {exec "$exec $ini $inp $out $args"}
if [catch {set fp [open $out]}] {
ns_returnerror $conn 500 "WinCGI exec failed"
} else {
set type text/html
set status 200
while {[gets $fp line] > 0} {
set line [string trim $line]
if {$line == ""} break
set head [split $line :]
set key [string tolower [string trim [lindex $head 0]]]
set value [string trim [lindex $head 1]]
if {$key == "content-type"} {
set type $value
} elseif {$key == "location"} {
set location $value
} elseif {$key == "status"} {
set status $status
}
}
set page [read $fp]
close $fp
if [info exists location] {
ns_returnredirect $conn $location
} else {
ns_return $conn $status $type $page
}
}
if $WinCGI(debug) {
ns_log Notice "CGI $pgm: ini: $ini, inp: $inp, out: $out"
} else {
ns_unlink -nocomplain $ini
ns_unlink -nocomplain $inp
ns_unlink -nocomplain $out
}
}