Posted to tcl by mjanssen at Mon Jul 02 14:55:55 GMT 2007view pretty

namespace eval scgi {
    proc listen {port} {
        socket -server [namespace code connect] $port
    }

    proc connect {sock ip port} {
        fconfigure $sock -blocking 0 -translation binary
        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]
        if {[string length $read_data] < $length+1} {
            fileevent $sock readable [namespace code [list read_headers $sock $length $read_data]]
            return
        } else {
            puts $read_data
            close $sock
        }
    }
}

scgi::listen 9999
vwait forever