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 forever
And 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 name [list |tclsh $name] } set inchan [open $name] fconfigure $inchan -translation binary fconfigure $sock -translation binary fcopy $inchan $sock -command [list done $inchan $sock] } }