- 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
# 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 foreverAnd 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). - 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 {
<html>
<body>
<h3>[clock format [clock seconds]]</h3>
}]
after 1 ; # Simulate blocking call
append res "Args: $args [llength $args]"
append res {
</body>
</html>
}
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
}2011-12-18 14:38:51 [Lectus]: This is a very interesting piece of code! It actually makes it easy to create simple web apps or add a web interface to an existing code. I tested it and here is my result:index.htm (HTML code to show a form where the user can input data):
<FORM action="http://127.0.0.1:8088/name.tcl" method="get">
<P>
Type your name: <INPUT type="text" name="firstname"><BR>
<INPUT type="submit" value="Send"> <INPUT type="reset">
</P>
</FORM>I tested it on localhost, so I used 127.0.0.1.name.tcl (receives the query string and do whatever with the data):if ![info exists env(QUERY_STRING)] {set env(QUERY_STRING) " "}
puts "Content-type: text/html\n"
puts "<html><head><title>Tiny CGI server</title></head>"
regexp {firstname=(.+)} $env(QUERY_STRING) -> name
puts "<body><h1>Hello $name!</h1>
<br>
<a href=index.htm>Index</a>
</body></html>"This demonstrates how to pass and process query strings. I can already see how useful is this. For example, one could pass the query string, process it and store data in a sqlite database.