[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 the environment variable QUERY_STRING * URLs ending in .tcl are executed by a [tclsh], its [stdout] 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 set encoding iso8859-1 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] if {[file readable $name]} { 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] } else { puts $sock "Content-Type: text/html;charset=$::encoding\n" } set inchan [open $name] fconfigure $inchan -translation binary fconfigure $sock -translation binary fcopy $inchan $sock -command [list done $inchan $sock] } else { puts $sock "HTTP/1.0 404 Not found\n" close $sock } } proc done {file sock bytes {msg {}}} { close $file close $sock } 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). - [RS]: thanks - integrated in the above code :^) ---- [DDG] I prefere to use namespaces and I was adding some more MimeTypes because I like and need [CSS] and [JavaScript]. # DustMotePlusPlus - now about 120 lines of code # with a subset of CGI support # namespace dmhttpd and more MimeTypes # I borrowed some code from jcw (from the nice wiki webserver) # and implemented url2procedure mappings as well # try something like /monitor?arg1=1&arg2=2 # ddg namespace eval dmhttpd { variable root /home/dgroth/html variable default index.htm variable port 8088 variable encoding iso8859-1 variable MimeTypes array set MimeTypes { {} "text/plain" .txt "text/plain" .css "text/css" .js "text/javascript" .htm "text/html;charset=$encoding" .html "text/html;charset=$encoding" .tml "text/html;charset=$encoding" .gif "image/gif" .jpg "image/jpeg" .ico "image/ico" .png "image/png" } } proc dmhttpd::answer {socketChannel host2 port2} { fileevent $socketChannel readable [list ::[namespace current]::serve $socketChannel] } proc dmhttpd::serve {sock} { variable root variable MimeTypes variable default 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] if {[info proc $tail] eq "$tail" && $tail ne ""} { # Service URL-procedure if {[catch {set res [eval {$tail} [QueryMap [string range $args 1 end]]]} err]} { puts [format "Error: %s: %s" $tail $err] } else { # Emit headers # puts $sock "HTTP/1.0 200 OK" puts $sock "Content-Type: text/html\n" puts $sock $res close $sock #cleanupChannel $channel } } elseif {[file readable $name]} { 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] } else { set ext [string tolower [file extension $name]] puts $sock "Content-Type: $MimeTypes($ext)\n" } set inchan [open $name] fconfigure $inchan -translation binary fconfigure $sock -translation binary fcopy $inchan $sock -command [list ::[namespace current]::done $inchan $sock] } else { puts $sock "HTTP/1.0 404 Not found\n" close $sock } } proc dmhttpd::done {file sock bytes {msg {}}} { close $file close $sock } proc dmhttpd::/monitor {args} { # Emit body # append res [subst {

[clock format [clock seconds]]

}] after 1 ; # Simulate blocking call append res "Args: $args [llength $args]" append res { } return $res } proc dmhttpd::CgiMap {data} { # jcw wiki webserver # @c Decode url-encoded strings regsub -all {\+} $data { } data regsub -all {([][$\\])} $data {\\\1} data regsub -all {%([0-9a-fA-F][0-9a-fA-F])} $data {[format %c 0x\1]} data return [subst $data] } proc dmhttpd::QueryMap {query} { # jcw wiki webserver # @c Decode url-encoded query into key/value pairs set res [list] regsub -all {[&=]} $query { } query regsub -all { } $query { {} } query; # Othewise we lose empty values foreach {key val} $query { lappend res [CgiMap $key] [CgiMap $val] } return $res } if {[info script] eq $argv0} { proc bgerror msg {puts stdout "bgerror: $msg\n$::errorInfo"} if {[llength $argv] == 1} { set port [lindex $argv 0] } else { set port 8088 } socket -server ::dmhttpd::answer $port puts "Server ready on port $port ..." vwait forever } ---- [Category Webserver] [Category Internet]