Posted to tcl by mjanssen at Sun Jul 01 16:59:44 GMT 2007view raw

  1. package require sqlite3
  2.  
  3. sqlite3 db c:/temp/ts.sqlite
  4.  
  5. socket -server OnConnect 9999
  6.  
  7. proc OnConnect {sock ip port} {
  8. puts "------------------------------------"
  9. puts "Connection on $sock"
  10. fconfigure $sock -blocking 0 -buffering none -translation binary
  11. fileevent $sock readable [list GetData $sock]
  12. }
  13.  
  14.  
  15. proc GetData {sock} {
  16. set data [read $sock]
  17. after idle [list after 0 [list HandleRequest $sock $data]]
  18. }
  19.  
  20. proc HandleRequest {sock data_read} {
  21. set end_of_length [string first : $data_read]
  22.  
  23. # If we don't know the length yet continue reading
  24. if {$end_of_length == -1} {
  25. set data [read $sock]
  26. after idle [list after 0 [list HandleRequest $sock $data_read$data]]
  27. return
  28. }
  29. set length [string range $data_read 0 $end_of_length-1]
  30. puts "Length: $length"
  31. set rest [string range $data_read $end_of_length+1 end]
  32. if { [string length $rest] < $length } {
  33. # we dont have all the headers yet
  34. set data [read $sock]
  35. after idle [list after 0 [list HandleRequest $sock $data_read$data]]
  36. return
  37. } else {
  38. array set headers [lrange [split [string range $rest 0 $length-1] \0] 0 end-1] ; # drop the final {}
  39. }
  40. parray headers
  41. puts $sock "Status: 200 OK"
  42. puts $sock "Content-Type: text/html"
  43. puts $sock ""
  44. puts $sock "<HTML><table>"
  45. foreach key [array names headers] {
  46. puts $sock "<tr><td>$key</td><td>$headers($key)</td></tr>"
  47. }
  48. puts $sock "</table></html>"
  49. close $sock
  50. }
  51.  
  52. vwait forever