MJ - SCGI (Simple Common Gateway Interface) [L1 ] is a replacement for CGI which has the benefit that all requests can be handled by a single instance of the SCGI server (the Tcl script in this case) eliminating the overhead of starting a new process for every request. Its goals are similar to FastCGI but the protocol between client (the webserver) and server (the script) is much simpler.
An advantage over Tcl modules embedded in Apache (websh, rivet, mod_tcl) is that it separates the Tcl part from the webserver, allowing a restart of the Tcl script without restarting the webserver or vice-versa.
The code below implements a simple SCGI server in Tcl which will display the information of the request as a result. This can easily be extended to fit your own purpose by overriding [scgi::handle_request sock headers body] The code below has some 8.5-isms but it should not be too difficult to make it 8.4 compatible.
I am not completely happy with the redefinition of the fileevent handlers that's going on (I am not sure if it's very elegant or a terrible hack), but I can't see another way to prevent the use of global variables containing the data already read. Comments are welcome.
MJ - Instead of reading the length byte by byte, changed to reading as much as possible. This may or may not be better performing, but at least it fixes a DOS attack when the part before the first : is sent very slowly.
package require html
namespace eval scgi {
proc listen {port} {
socket -server [namespace code connect] $port
}
proc connect {sock ip port} {
fconfigure $sock -blocking 0 -translation {binary crlf}
fileevent $sock readable [namespace code [list read_length $sock {}]]
}
proc read_length {sock data} {
append data [read $sock]
if {[eof $sock]} {
close $sock
return
}
set colonIdx [string first : $data]
if {$colonIdx == -1} {
# we don't have the headers length yet
fileevent $sock readable [namespace code [list read_length $sock $data]]
return
} else {
set length [string range $data 0 $colonIdx-1]
set data [string range $data $colonIdx+1 end]
read_headers $sock $length $data
}
}
proc read_headers {sock length data} {
append data [read $sock]
if {[string length $data] < $length+1} {
# we don't have the complete headers yet, wait for more
fileevent $sock readable [namespace code [list read_headers $sock $length $data]]
return
} else {
set headers [string range $data 0 $length-1]
set headers [lrange [split $headers \0] 0 end-1]
set body [string range $data $length+1 end]
set content_length [dict get $headers CONTENT_LENGTH]
read_body $sock $headers $content_length $body
}
}
proc read_body {sock headers content_length body} {
append body [read $sock]
if {[string length $body] < $content_length} {
# we don't have the complete body yet, wait for more
fileevent $sock readable [namespace code [list read_body $sock $headers $content_length $body]]
return
} else {
handle_request $sock $headers $body
}
}
}
proc handle_request {sock headers body} {
array set Headers $headers
parray Headers
puts $sock "Status: 200 OK"
puts $sock "Content-Type: text/html"
puts $sock ""
puts $sock "<HTML>"
puts $sock "<BODY>"
puts $sock [::html::tableFromArray Headers]
puts $sock "</BODY>"
puts $sock "<H3>Body</H3>"
puts $sock "<PRE>$body</PRE>"
if {$Headers(REQUEST_METHOD) eq "GET"} {
puts $sock {<FORM METHOD="post" ACTION="/scgi">}
foreach pair [split $Headers(QUERY_STRING) &] {
lassign [split $pair =] key val
puts $sock "$key: [::html::textInput $key $val]<BR>"
}
puts $sock "<BR>"
puts $sock {<INPUT TYPE="submit" VALUE="Try POST">}
} else {
puts $sock {<FORM METHOD="get" ACTION="/scgi">}
foreach pair [split $body &] {
lassign [split $pair =] key val
puts $sock "$key: [::html::textInput $key $val]<BR>"
}
puts $sock "<BR>"
puts $sock {<INPUT TYPE="submit" VALUE="Try GET">}
}
puts $sock "</FORM>"
puts $sock "</HTML>"
close $sock
}
}
scgi::listen 9999
vwait forever