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