SCGI with test for POST

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 {<FORM METHOD="post" ACTION="/scgi">}
        foreach pair [split [dict get $headers QUERY_STRING] &] {
            lassign [split $pair =] key val
            puts $sock "$key: [::html::textInput $key $val]<BR>" 
        }
        
        puts $sock "<BR>"
        puts $sock {<INPUT TYPE="submit" VALUE="Try with post">}
        puts $sock "</FORM>"
        puts $sock "</HTML>"
        close $sock 
    }
}

scgi::listen 9999
vwait forever