diff options
| author | jan.nijtmans <nijtmans@users.sourceforge.net> | 2016-11-16 15:59:40 (GMT) |
|---|---|---|
| committer | jan.nijtmans <nijtmans@users.sourceforge.net> | 2016-11-16 15:59:40 (GMT) |
| commit | fe8f0c596ee02b8811d1d2f4d23b8fdbb166a2ed (patch) | |
| tree | c97e96389c58ac76d16b27fe19ddb3689118e093 /library/http | |
| parent | 74cee16544d00f49288f1819fb71e1c5c74ce5ad (diff) | |
| parent | 29606e4a7b43adb9f923fb5781d3b9a93d9ba1c8 (diff) | |
| download | tcl-gahr_ticket_e6f27aa56f.zip tcl-gahr_ticket_e6f27aa56f.tar.gz tcl-gahr_ticket_e6f27aa56f.tar.bz2 | |
merge trunkgahr_ticket_e6f27aa56f
Diffstat (limited to 'library/http')
| -rw-r--r-- | library/http/http.tcl | 38 | ||||
| -rw-r--r-- | library/http/pkgIndex.tcl | 4 |
2 files changed, 37 insertions, 5 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl index 5a05fa0..d105886 100644 --- a/library/http/http.tcl +++ b/library/http/http.tcl @@ -8,10 +8,10 @@ # See the file "license.terms" for information on usage and redistribution of # this file, and for a DISCLAIMER OF ALL WARRANTIES. -package require Tcl 8.6 +package require Tcl 8.6- # Keep this in sync with pkgIndex.tcl and with the install directories in # Makefiles -package provide http 2.8.9 +package provide http 2.8.10 namespace eval http { # Allow resourcing to not clobber existing data @@ -1047,7 +1047,7 @@ proc http::Event {sock token} { fconfigure $sock -translation binary if { - $state(-binary) || ![string match -nocase text* $state(type)] + $state(-binary) || [IsBinaryContentType $state(type)] } { # Turn off conversions for non-text data set state(binary) 1 @@ -1183,6 +1183,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/library/http/pkgIndex.tcl b/library/http/pkgIndex.tcl index 6e0301a..841b4eb 100644 --- a/library/http/pkgIndex.tcl +++ b/library/http/pkgIndex.tcl @@ -1,2 +1,2 @@ -if {![package vsatisfies [package provide Tcl] 8.6]} {return} -package ifneeded http 2.8.9 [list tclPkgSetup $dir http 2.8.9 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] +if {![package vsatisfies [package provide Tcl] 8.6-]} {return} +package ifneeded http 2.8.10 [list tclPkgSetup $dir http 2.8.10 {{http.tcl source {::http::config ::http::formatQuery ::http::geturl ::http::reset ::http::wait ::http::register ::http::unregister ::http::mapReply}}}] |