diff options
| -rw-r--r-- | library/http/http.tcl | 34 | ||||
| -rw-r--r-- | tests/http.test | 7 | ||||
| -rw-r--r-- | tests/httpd | 4 |
3 files changed, 44 insertions, 1 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl index 4c99f62..2975f82 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -1019,7 +1019,7 @@ proc http::Event {sock token} { fconfigure $sock -translation binary if { - $state(-binary) || ![string match -nocase text* $state(type)] + $state(-binary) || [IsBinaryContentType $state(type)] } then { # Turn off conversions for non-text data set state(binary) 1 @@ -1161,6 +1161,38 @@ proc http::Event {sock token} { } } +# http::IsBinaryContentType -- +# +# Determine if the content-type means that we should definitely transfer +# the data as binary. [Bug 838e99a76d] +# +# Arguments +# type The content-type of the data. +# +# Results: +# Boolean, true if we definitely should be binary. + +proc http::IsBinaryContentType {type} { + lassign [split [string tolower $type] "/;"] major minor + if {$major eq "text"} { + return false + } + # There's a bunch of XML-as-application-format things about. See RFC 3023 + # and so on. + if {$major eq "application"} { + set minor [string trimright $minor] + if {$minor in {"xml" "xml-external-parsed-entity" "xml-dtd"}} { + return false + } + } + # Not just application/foobar+xml but also image/svg+xml, so let us not + # restrict things for now... + if {[string match "*+xml" $minor]} { + return false + } + return true +} + # http::getTextLine -- # # Get one line with the stream in blocking crlf mode diff --git a/tests/http.test b/tests/http.test index 2fc0a51..322fb36 100644 --- a/tests/http.test +++ b/tests/http.test @@ -132,6 +132,7 @@ set tail /a/b/c set url //[info hostname]:$port/a/b/c set fullurl HTTP://user:pass@[info hostname]:$port/a/b/c set binurl //[info hostname]:$port/binary +set xmlurl //[info hostname]:$port/xml set posturl //[info hostname]:$port/post set badposturl //[info hostname]:$port/droppost set authorityurl //[info hostname]:$port @@ -364,6 +365,12 @@ test http-3.31 {http::geturl fragment without path} -body { } -cleanup { catch { http::cleanup $token } } -result 200 +test http-3.32 {http::geturl application/xml is text} -body { + set token [http::geturl "$xmlurl"] + scan [http::data $token] "<%\[^>]>%c<%\[^>]>" +} -cleanup { + catch { http::cleanup $token } +} -result {test 4660 /test} test http-4.1 {http::Event} { set token [http::geturl $url -keepalive 0] diff --git a/tests/httpd b/tests/httpd index 232e80a..8753912 100644 --- a/tests/httpd +++ b/tests/httpd @@ -171,6 +171,10 @@ proc httpdRespond { sock } { set html "$bindata[info hostname]:$port$data(url)" set type application/octet-stream } + *xml* { + set html [encoding convertto utf-8 "<test>\u1234</test>"] + set type "application/xml;charset=UTF-8" + } *post* { set html "Got [string length $data(query)] bytes" set type text/plain |