Posted to tcl by mjanssen at Sun Jul 01 16:59:44 GMT 2007view raw
- package require sqlite3
- sqlite3 db c:/temp/ts.sqlite
- socket -server OnConnect 9999
- proc OnConnect {sock ip port} {
- puts "------------------------------------"
- puts "Connection on $sock"
- fconfigure $sock -blocking 0 -buffering none -translation binary
- fileevent $sock readable [list GetData $sock]
- }
- proc GetData {sock} {
- set data [read $sock]
- after idle [list after 0 [list HandleRequest $sock $data]]
- }
- proc HandleRequest {sock data_read} {
- set end_of_length [string first : $data_read]
- # If we don't know the length yet continue reading
- if {$end_of_length == -1} {
- set data [read $sock]
- after idle [list after 0 [list HandleRequest $sock $data_read$data]]
- return
- }
- set length [string range $data_read 0 $end_of_length-1]
- puts "Length: $length"
- set rest [string range $data_read $end_of_length+1 end]
- if { [string length $rest] < $length } {
- # we dont have all the headers yet
- set data [read $sock]
- after idle [list after 0 [list HandleRequest $sock $data_read$data]]
- return
- } else {
- array set headers [lrange [split [string range $rest 0 $length-1] \0] 0 end-1] ; # drop the final {}
- }
- parray headers
- puts $sock "Status: 200 OK"
- puts $sock "Content-Type: text/html"
- puts $sock ""
- puts $sock "<HTML><table>"
- foreach key [array names headers] {
- puts $sock "<tr><td>$key</td><td>$headers($key)</td></tr>"
- }
- puts $sock "</table></html>"
- close $sock
- }
- vwait forever