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

  1. namespace eval scgi {
  2. proc listen {port} {
  3. socket -server [namespace code connect] $port
  4. }
  5.  
  6. proc connect {sock ip port} {
  7. fconfigure $sock -blocking 0 -translation binary
  8. fileevent $sock readable [namespace code [list read_length $sock]]
  9. }
  10.  
  11. proc read_length {sock} {
  12. set length {}
  13. while 1 {
  14. set c [read $sock 1]
  15. if {[eof $sock]} {
  16. close $sock
  17. return
  18. }
  19. if {$c eq ":"} {
  20. fileevent $sock readable [namespace code [list read_headers $sock $length {}]]
  21. return
  22. }
  23. append length $c
  24. }
  25. }
  26. proc read_headers {sock length read_data} {
  27. append read_data [read $sock]
  28. if {[string length $read_data] < $length+1} {
  29. fileevent $sock readable [namespace code [list read_headers $sock $length $read_data]]
  30. return
  31. } else {
  32. puts $read_data
  33. close $sock
  34. }
  35. }
  36. }
  37.  
  38. scgi::listen 9999
  39. vwait forever