Posted to tcl by evilotto at Wed Jan 29 02:19:45 GMT 2014view raw
- 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