Version 1 of Playing CGI

Updated 2006-09-17 12:35:15 by suchenwi

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 "<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)
 <a href=index.htm>Index</a>