Posted to tcl by mjanssen at Mon Jul 02 14:55:55 GMT 2007view raw
- 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