Posted to tcl by evilotto at Wed Jan 29 02:19:45 GMT 2014view pretty
set f /tmp/rdata proc respond_with {copy s rh rp} { gets $s chan configure $s -blocking false -translation binary read $s set rf [open $::f r] fconfigure $rf -translation binary puts $s "HTTP/1.0 200 OK" puts $s "Content-type: text/plain" puts $s "Content-length: [file size $::f]" puts $s "" $copy $rf $s -command [list CopyDone $s $rf] } proc myfcopy {ichan ochan -command cmd} { chan event $ochan writable [list docopy $ichan $ochan $cmd] } proc docopy {ichan ochan cmd} { set d [read $ichan 40960] puts -nonewline $ochan $d if {[eof $ichan]} { {*}$cmd 0 } } proc CopyDone {s f b {e ""}} { if {$e ne ""} {puts $e} flush $s close $s close $f } socket -server {respond_with fcopy} 4545 socket -server {respond_with myfcopy} 4546