[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]