Posted to tcl by patthoyts at Wed Jan 14 15:04:15 GMT 2009view raw
- # Convert data into HTTP/1.1 chunked transfer-encoding
- package require Tcl 8.6
- proc make-chunk-generator {data {size 4096}} {
- variable _chunk_gen_uid
- if {![info exists _chunk_gen_uid]} {set _chunk_gen_uid 0}
- set lambda {{data size} {
- set pos 0
- yield
- while {1} {
- set payload [string range $data $pos [incr pos $size]]
- incr pos
- set chunk [format %x [string length $payload]]\r\n$payload\r\n
- yield $chunk
- if {![string length $payload]} {return}
- }
- }}
- set name chunker[incr _chunk_gen_uid]
- coroutine $name ::apply $lambda $data $size
- return $name
- }
- proc blow-chunks-test {} {
- set data "abcdefghijklmnopqrstuvwxyzABCDEFGHIJKLMNOPQRSTUVWXYZ"
- set data [string repeat $data 4]
- set chunker [make-chunk-generator $data 60]
- while {[string length [set chunk [$chunker]]]} {
- puts -nonewline $chunk
- }
- return
- }
- # Read a file and emit it on stdout using chunked transfer-coding.
- #
- proc blow-chunks {filename {ochan stdout} {compression gzip}} {
- set f [open $filename rb]
- set data [read $f]
- close $f
- switch -exact -- $compression {
- gzip { set data [zlib gzip $data] }
- deflate { set data [zlib deflate $data] }
- }
- set chunker [make-chunk-generator $data 512]
- set orig [list \
- -translation [chan configure $ochan -translation] \
- -encoding [chan configure $ochan -encoding] \
- -eofchar [chan configure $ochan -eofchar]]
- chan configure $ochan -translation crlf -buffering line
- puts $ochan "HTTP/1.1 200 OK"
- puts $ochan "content-type: text/plain"
- puts $ochan "content-length: [string length $data]"
- puts $ochan "content-encoding: $compression"
- puts $ochan "transfer-encoding: chunked"
- puts $ochan ""
- chan configure $ochan -translation binary -buffering full
- while {[string length [set chunk [$chunker]]]} {
- puts -nonewline $ochan $chunk
- }
- flush $ochan
- puts "flushed [string length $data]"
- chan configure $ochan {*}$orig
- return
- }