Posted to tcl by mjanssen at Mon Jul 02 15:39:13 GMT 2007view raw
- package require html
- namespace eval scgi {
- proc listen {port} {
- socket -server [namespace code connect] $port
- }
- proc connect {sock ip port} {
- fconfigure $sock -blocking 0 -translation {binary crlf}
- fileevent $sock readable [namespace code [list read_length $sock]]
- }
- proc read_length {sock} {
- set length {}
- while 1 {
- set c [read $sock 1]
- if {[eof $sock]} {
- close $sock
- return
- }
- if {$c eq ":"} {
- fileevent $sock readable [namespace code [list read_headers $sock $length {}]]
- return
- }
- append length $c
- }
- }
- proc read_headers {sock length read_data} {
- append read_data [read $sock]
- # do we have enough data for the headers yet?
- if {[string length $read_data] < $length+1} {
- fileevent $sock readable [namespace code [list read_headers $sock $length $read_data]]
- return
- } else {
- set headers [string range $read_data 0 $length-1]
- set headers [lrange [split $headers \0] 0 end-1]
- set body [string range $read_data $length+1 end]
- set content_length [dict get $headers CONTENT_LENGTH]
- if {[string length $body] < $content_length} {
- fileevent $sock readable [namespace code [list read_body $sock $headers $content_length $body]]
- return
- } else {
- handle_request $sock $headers $body
- }
- }
- }
- proc read_body {sock headers content_length body} {
- append body [read $sock]
- if {[string length $body] < $content_length} {
- fileevent $sock readable [namespace code [list read_body $sock $headers $content_length $body]]
- return
- } else {
- handle_request $sock $headers $body
- }
- }
- proc handle_request {sock headers body} {
- array set Headers $headers
- parray Headers
- puts $sock "Status: 200 OK"
- puts $sock "Content-Type: text/html"
- puts $sock ""
- puts $sock "<HTML>"
- puts $sock "<BODY>"
- puts $sock [::html::tableFromArray Headers]
- puts $sock "</BODY>"
- puts $sock "<H3>Body</H3>"
- puts $sock "<PRE>$body</PRE>"
- puts $sock "</HTML>"
- close $sock
- }
- }
- scgi::listen 9999
- vwait forever