Posted to tcl by evilotto at Wed Jan 29 02:19:45 GMT 2014view raw

  1. set f /tmp/rdata
  2.  
  3. proc respond_with {copy s rh rp} {
  4. gets $s
  5. chan configure $s -blocking false -translation binary
  6. read $s
  7. set rf [open $::f r]
  8. fconfigure $rf -translation binary
  9. puts $s "HTTP/1.0 200 OK"
  10. puts $s "Content-type: text/plain"
  11. puts $s "Content-length: [file size $::f]"
  12. puts $s ""
  13. $copy $rf $s -command [list CopyDone $s $rf]
  14. }
  15.  
  16. proc myfcopy {ichan ochan -command cmd} {
  17. chan event $ochan writable [list docopy $ichan $ochan $cmd]
  18. }
  19.  
  20. proc docopy {ichan ochan cmd} {
  21. set d [read $ichan 40960]
  22. puts -nonewline $ochan $d
  23. if {[eof $ichan]} {
  24. {*}$cmd 0
  25. }
  26. }
  27.  
  28. proc CopyDone {s f b {e ""}} {
  29. if {$e ne ""} {puts $e}
  30. flush $s
  31. close $s
  32. close $f
  33. }
  34.  
  35. socket -server {respond_with fcopy} 4545
  36. socket -server {respond_with myfcopy} 4546
  37.