diff options
-rw-r--r-- | library/http/http.tcl | 60 | ||||
-rw-r--r-- | tests/http-tip-452.test | 589 |
2 files changed, 606 insertions, 43 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl index f1435d3..5bd827e 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -1552,36 +1552,38 @@ proc http::ContentEncoding {token} { return $r } -proc http::make-transformation-chunked {chan command} { - set lambda {{chan command} { - set data "" - set size -1 - yield - while {1} { - chan configure $chan -translation {crlf binary} - while {[gets $chan line] < 1} { yield } - chan configure $chan -translation {binary binary} - if {[scan $line %x size] != 1} { return -code error "invalid size: \"$line\"" } - set chunk "" - while {$size && ![chan eof $chan]} { - set part [chan read $chan $size] - incr size -[string length $part] - append chunk $part - } - if {[catch { - uplevel #0 [linsert $command end $chunk] - }]} { - http::Log "Error in callback: $::errorInfo" - } - if {[string length $chunk] == 0} { - # channel might have been closed in the callback - catch {chan event $chan readable {}} - return - } +proc http::ReceiveChunked {chan command} { + set data "" + set size -1 + yield + while {1} { + fconfigure $chan -translation {crlf binary} + while {[gets $chan line] < 1} { yield } + fconfigure $chan -translation {binary binary} + if {[scan $line %x size] != 1} {return -code error "invalid size: \"$line\"" } + set chunk "" + while {$size && ![eof $chan]} { + set part [read $chan $size] + incr size -[string length $part] + append chunk $part + } + if {[catch { + uplevel #0 [linsert $command end $chunk] + }]} { + http::Log "Error in callback: $::errorInfo" + return + } + if {[string length $chunk] == 0} { + # channel might have been closed in the callback + catch {fileevent $chan readable {}} + return } - }} - coroutine dechunk$chan ::apply $lambda $chan $command - chan event $chan readable [namespace origin dechunk$chan] + } +} + +proc http::make-transformation-chunked {chan command} { + coroutine [namespace current]::dechunk$chan ::http::ReceiveChunked $chan $command + chan event $chan readable [namespace current]::dechunk$chan return } diff --git a/tests/http-tip-452.test b/tests/http-tip-452.test index 7060130..689cc64 100644 --- a/tests/http-tip-452.test +++ b/tests/http-tip-452.test @@ -5166,11 +5166,15 @@ namespace eval ::httpTest:: { ## ## Test http::ProxyRequire ## - ::tcltest::test http-28.1 {http::ProxyRequire} \ + ::tcltest::test http-28.1 {http::ProxyRequire -- no proxy set} \ -setup { + ::tcltest::saveVars { + ::http::http + } + array unset ::http::http -proxy* } \ -body { - list Test Not Yet Implemented + http::ProxyRequired test.host.it } \ -cleanup { ::tcltest::testCleanup @@ -5178,39 +5182,489 @@ namespace eval ::httpTest:: { -result {} + ::tcltest::test http-28.2 {http::ProxyRequire -- only proxy host set} \ + -setup { + ::tcltest::saveVars { + ::http::http + } + array unset ::http::http -proxy* + array set ::http::http { + -proxyhost {proxy.it} + } + } \ + -body { + http::ProxyRequired test.host.it + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {proxy.it 8080} + + + ::tcltest::test http-28.3 {http::ProxyRequire -- proxy fully set} \ + -setup { + ::tcltest::saveVars { + ::http::http + } + array unset ::http::http -proxy* + array set ::http::http { + -proxyhost {proxy.it} + -proxyport {1024} + } + } \ + -body { + http::ProxyRequired test.host.it + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {proxy.it 1024} + + ## ## Test http::CharsetToEncoding ## - ::tcltest::test http-29.1 {http::CharsetToEncoding} \ + ::tcltest::test http-29.1 {http::CharsetToEncoding - unknown encoding} \ -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {utf-8 utf-16} } \ -body { - list Test Not Yet Implemented + list [catch {http::CharsetToEncoding unknown-char} enc] $enc } \ -cleanup { ::tcltest::testCleanup } \ - -result {} + -result {0 binary} + + ::tcltest::test http-29.2 {http::CharsetToEncoding - known "normalized" encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {text utf-8 utf-16} + } \ + -body { + list [catch {http::CharsetToEncoding utf-8} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 utf-8} + + ::tcltest::test http-29.3a {http::CharsetToEncoding - iso8859-* encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {iso8859-4 iso8859-74 other} + } \ + -body { + list [catch {http::CharsetToEncoding iso-8859-4} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 iso8859-4} + + ::tcltest::test http-29.3b {http::CharsetToEncoding - iso8859-* encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {iso8859-4 iso8859-74 other} + } \ + -body { + list [catch {http::CharsetToEncoding iso-8859-74} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 iso8859-74} + + ::tcltest::test http-29.4a {http::CharsetToEncoding - iso2022-* encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {iso2022-jp iso2022-kr other} + } \ + -body { + list [catch {http::CharsetToEncoding iso-2022-jp} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 iso2022-jp} + + ::tcltest::test http-29.4b {http::CharsetToEncoding - iso2022-* encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {iso2022-jp iso2022-kr other} + } \ + -body { + list [catch {http::CharsetToEncoding iso-2022-kr} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 iso2022-kr} + + ::tcltest::test http-29.5a {http::CharsetToEncoding - shiftjis encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {shiftjis other} + } \ + -body { + list [catch {http::CharsetToEncoding shift_js} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 shiftjis} + + ::tcltest::test http-29.5b {http::CharsetToEncoding - shiftjis encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {shiftjis other} + } \ + -body { + list [catch {http::CharsetToEncoding shift-js} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 shiftjis} + + ::tcltest::test http-29.6a {http::CharsetToEncoding - windows/cp encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {cp5 cp57 other} + } \ + -body { + list [catch {http::CharsetToEncoding windows-5} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 cp5} + + ::tcltest::test http-29.6b {http::CharsetToEncoding - windows/cp encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {cp5 cp57 other} + } \ + -body { + list [catch {http::CharsetToEncoding windows-57} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 cp57} + + ::tcltest::test http-29.6c {http::CharsetToEncoding - windows/cp encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {cp5 cp57 other} + } \ + -body { + list [catch {http::CharsetToEncoding cp-5} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 cp5} + + ::tcltest::test http-29.6d {http::CharsetToEncoding - windows/cp encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {cp5 cp57 other} + } \ + -body { + list [catch {http::CharsetToEncoding cp-57} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 cp57} + + ::tcltest::test http-29.7 {http::CharsetToEncoding - ascii encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {text ascii other} + } \ + -body { + list [catch {http::CharsetToEncoding us-ascii} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 ascii} + + ::tcltest::test http-29.8a {http::CharsetToEncoding - iso-latin encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {text iso8859-1 iso8859-2 iso8859-3 iso8859-9 other} + } \ + -body { + list [catch {http::CharsetToEncoding iso-latin-1} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 iso8859-1} + + ::tcltest::test http-29.8b {http::CharsetToEncoding - iso-latin encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {text iso8859-1 iso8859-2 iso8859-3 iso8859-9 other} + } \ + -body { + list [catch {http::CharsetToEncoding iso-lat-1} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 iso8859-1} + + ::tcltest::test http-29.8c {http::CharsetToEncoding - iso-latin encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {text iso8859-1 iso8859-2 iso8859-3 iso8859-9 other} + } \ + -body { + list [catch {http::CharsetToEncoding iso-latin-2} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 iso8859-2} + + ::tcltest::test http-29.8d {http::CharsetToEncoding - iso-latin encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {text iso8859-1 iso8859-2 iso8859-3 iso8859-9 other} + } \ + -body { + list [catch {http::CharsetToEncoding iso-lat-2} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 iso8859-2} + + ::tcltest::test http-29.8e {http::CharsetToEncoding - iso-latin encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {text iso8859-1 iso8859-2 iso8859-3 iso8859-9 other} + } \ + -body { + list [catch {http::CharsetToEncoding iso-latin-3} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 iso8859-3} + + ::tcltest::test http-29.8e {http::CharsetToEncoding - iso-latin encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {text iso8859-1 iso8859-2 iso8859-3 iso8859-9 other} + } \ + -body { + list [catch {http::CharsetToEncoding iso-lat-3} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 iso8859-3} + + ::tcltest::test http-29.8f {http::CharsetToEncoding - iso-latin encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {text iso8859-1 iso8859-2 iso8859-3 iso8859-9 other} + } \ + -body { + list [catch {http::CharsetToEncoding iso-latin-5} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 iso8859-9} + + ::tcltest::test http-29.8g {http::CharsetToEncoding - iso-latin encoding} \ + -setup { + ::tcltest::saveVars { + ::http::encodings + } + set ::http::encodings {text iso8859-1 iso8859-2 iso8859-3 iso8859-9 other} + } \ + -body { + list [catch {http::CharsetToEncoding iso-lat-5} enc] $enc + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 iso8859-9} ## ## Test http::ContentEncoding ## - ::tcltest::test http-30.1 {http::ContentEncoding} \ + ::tcltest::test http-30.1 {http::ContentEncoding - unknown} \ -setup { + set ::httpTest::TestToken(coding) {unknown} } \ -body { - list Test Not Yet Implemented + list [catch {http::ContentEncoding ::httpTest::TestToken} result] $result } \ -cleanup { + unset ::httpTest::TestToken ::tcltest::testCleanup } \ - -result {} + -result {1 {unsupported content-encoding "unknown"}} + + ::tcltest::test http-30.2 {http::ContentEncoding - deflate} \ + -setup { + set ::httpTest::TestToken(coding) {deflate} + } \ + -body { + list [catch {http::ContentEncoding ::httpTest::TestToken} result] $result + } \ + -cleanup { + unset ::httpTest::TestToken + ::tcltest::testCleanup + } \ + -result {0 inflate} + + ::tcltest::test http-30.3 {http::ContentEncoding - gzip} \ + -setup { + set ::httpTest::TestToken(coding) {gzip} + } \ + -body { + list [catch {http::ContentEncoding ::httpTest::TestToken} result] $result + } \ + -cleanup { + unset ::httpTest::TestToken + ::tcltest::testCleanup + } \ + -result {0 gunzip} + + ::tcltest::test http-30.4 {http::ContentEncoding - x-gzip} \ + -setup { + set ::httpTest::TestToken(coding) {x-gzip} + } \ + -body { + list [catch {http::ContentEncoding ::httpTest::TestToken} result] $result + } \ + -cleanup { + unset ::httpTest::TestToken + ::tcltest::testCleanup + } \ + -result {0 gunzip} + + ::tcltest::test http-30.5 {http::ContentEncoding - compress} \ + -setup { + set ::httpTest::TestToken(coding) {compress} + } \ + -body { + list [catch {http::ContentEncoding ::httpTest::TestToken} result] $result + } \ + -cleanup { + unset ::httpTest::TestToken + ::tcltest::testCleanup + } \ + -result {0 decompress} + + ::tcltest::test http-30.6 {http::ContentEncoding - x-compress} \ + -setup { + set ::httpTest::TestToken(coding) {x-compress} + } \ + -body { + list [catch {http::ContentEncoding ::httpTest::TestToken} result] $result + } \ + -cleanup { + unset ::httpTest::TestToken + ::tcltest::testCleanup + } \ + -result {0 decompress} + + ::tcltest::test http-30.7 {http::ContentEncoding - identity} \ + -setup { + set ::httpTest::TestToken(coding) {identity} + } \ + -body { + list [catch {http::ContentEncoding ::httpTest::TestToken} result] $result + } \ + -cleanup { + unset ::httpTest::TestToken + ::tcltest::testCleanup + } \ + -result {0 {}} + + ::tcltest::test http-30.7 {http::ContentEncoding - multiple} \ + -setup { + set ::httpTest::TestToken(coding) {deflate,gzip,x-gzip,compress,x-compress,identity} + } \ + -body { + list [catch {http::ContentEncoding ::httpTest::TestToken} result] $result + } \ + -cleanup { + unset ::httpTest::TestToken + ::tcltest::testCleanup + } \ + -result {0 {inflate gunzip gunzip decompress decompress}} + + + ::tcltest::test http-30.8 {http::ContentEncoding - multiple with error} \ + -setup { + set ::httpTest::TestToken(coding) {deflate,gzip,x-gzip,compress,x-compress,identity,unknown} + } \ + -body { + list [catch {http::ContentEncoding ::httpTest::TestToken} result] $result + } \ + -cleanup { + unset ::httpTest::TestToken + ::tcltest::testCleanup + } \ + -result {1 {unsupported content-encoding "unknown"}} ## - ## Test http::make-transformation-chunked + ## Test http::Connected ## - ::tcltest::test http-31.1 {http::make-transformation-chunked} \ + ::tcltest::test http-31.1 {http::Connected} \ -setup { } \ -body { @@ -5221,20 +5675,127 @@ namespace eval ::httpTest:: { } \ -result {} + ## + ## Test http::ReceiveChunked + ## + proc ::httpTest::ReceiveChunkedHelper {args} { + return; + } + ::tcltest::test http-32.1 {http::ReceiveChunked} \ + -setup { + ::tcltest::testSetup { + ::fconfigure { + * { + returns {} + code {ok} + } + } + ::read { + 3 { + returns {} + code {error} + } + * { + returns {1234567890123456} + code {ok} + } + } + ::eof { + 1 { + returns {false} + code {ok} + } + 2 { + returns {false} + code {ok} + } + * { + returns {true} + code {ok} + } + } + ::fileevent { + * { + returns {} + code {ok} + } + } + ::gets { + 3 { + returns {2} + code {ok} + set { + line S 20 + } + } + 4 { + returns {1} + code {ok} + set { + line S 0 + } + } + * { + returns {0} + code {ok} + } + } + ::yield { + * { + returns {} + code {ok} + } + } + ::http::Log { + * { + returns {} + code {ok} + } + } + ::httpTest::ReceiveChunkedHelper { + * { + returns {} + code {ok} + } + } + } + } \ + -body { + set status [catch {http::ReceiveChunked TestSocket ::httpTest::ReceiveChunkedHelper} results] + list $status $results [::tcltest::callCount] + } \ + -cleanup { + ::tcltest::testCleanup + } \ + -result {0 {} {::eof,count 2 ::fconfigure,count 4 ::fileevent,count 1 ::gets,count 4 ::http::Log,count 0 ::httpTest::ReceiveChunkedHelper,count 2 ::read,count 2 ::yield,count 3}} ## - ## Test http::Connected + ## Test http::make-transformation-chunked ## - ::tcltest::test http-32.1 {http::Connected} \ + ::tcltest::test http-33.1 {http::make-transformation-chunked} \ -setup { + ::tcltest::testSetup { + ::chan { + * { + returns {} + code {ok} + } + } + ::http::ReceiveChunked { + * { + prefix {yield} + } + } + } } \ -body { - list Test Not Yet Implemented + list [catch {::http::make-transformation-chunked TestSocket Error} result] $result [::tcltest::callCount] } \ -cleanup { ::tcltest::testCleanup } \ - -result {} + -result {0 {} {::chan,count 1 ::http::ReceiveChunked,count 1}} + } |