[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: * Content-type: text/html was added, so that my phone could receive the pages :) * %20 in URLs was mapped to " " to allow spaces in path names * URL suffixes of the pattern ?a=1&b=2 are parsed off and dumped into environment variables * URLs ending in .tcl are executed by a [tclsh], its result being served 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 "Tiny CGI time server

Time server

Time now is: [clock format [clock seconds]]
Query was: $env(QUERY_STRING)
Index " ---- [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 if {$msg ne {}} { bgerror $msg } } 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] } fcopy $inchan $sock -command [list done $inchan $sock] } } ---- [Category Webserver]