Richard Suchenwirth 2006-09-17 - CGI is a mighty complex protocol for web servers to provide active content (i.e. the results of a script). The following is just a poor subset of CGI, but then again, it's not much code either. And testing it was great fun :^)
I started from DustMote, a web server for static content in 41 lines of code, and added the following features:
Here's my extended version of DustMote, still short at 42 lines of code:
# DustMotePlus - with a subset of CGI support
set root c:/html
set default index.htm
set port 80
proc bgerror msg {puts stdout "bgerror: $msg\n$::errorInfo"}
proc answer {socketChannel host2 port2} {
fileevent $socketChannel readable [list serve $socketChannel]
}
proc serve sock {
fconfigure $sock -blocking 0
gets $sock line
if [fblocked $sock] return
fileevent $sock readable ""
set tail /
regexp {(/[^ ?]*)(\?[^ ]*)?} $line -> tail args
if [string match */ $tail] {append tail $::default}
set name [string map {%20 " "} $::root$tail]
puts "name:$name args:$args"
if ![file exists $name] {
puts $sock "HTTP/1.0 404 Not found\n"
} else {
fconfigure $sock -translation binary -buffering full
puts $sock "HTTP/1.0 200 OK"
if {[file extension $name] eq ".tcl"} {
set ::env(QUERY_STRING) [string range $args 1 end]
catch {exec tclsh $name} page
} else {
set page [readbin $name]
puts $sock "Content-Type: text/html\n"
}
puts $sock $page
}
close $sock
}
proc readbin filename {
set fp [open $filename]
fconfigure $fp -translation binary
return [read $fp][close $fp]
}
socket -server answer $port
puts "Server ready..."
vwait foreverAnd here's a little "CGI" script I tested it with (save as time.tcl):
# time.tcl - tiny CGI script.
if ![info exists env(QUERY_STRING)] {set env(QUERY_STRING) " "}
puts "Content-type: text/html\n"
puts "<html><head><title>Tiny CGI time server</title></head>
<body><h1>Time server</h1>
Time now is: [clock format [clock seconds]]<br>
Query was: $env(QUERY_STRING)
<hr>
<a href=index.htm>Index</a>
</body></html>"MS prefers to use fcopy (so that the output proceeds in the background and the server is responsive to new queries while the cgi script is running):
proc done {file sock bytes {msg {}}} {
close $file
close $sock
}
proc serve sock {
fconfigure $sock -blocking 0
gets $sock line
if [fblocked $sock] return
fileevent $sock readable ""
set tail /
regexp {(/[^ ?]*)(\?[^ ]*)?} $line -> tail args
if [string match */ $tail] {append tail $::default}
set name [string map {%20 " "} $::root$tail]
puts "name:$name args:$args"
if ![file exists $name] {
puts $sock "HTTP/1.0 404 Not found\n"
close $sock
} else {
puts $sock "HTTP/1.0 200 OK"
if {[file extension $name] eq ".tcl"} {
set ::env(QUERY_STRING) [string range $args 1 end]
set inchan [open "|tclsh $name"]
} else {
set inchan [open $name]
}
fconfigure $sock -translation binary
fconfigure $inchan -translation binary
fcopy $inchan $sock -command [list done $inchan $sock]
}
}