summaryrefslogtreecommitdiffstats
path: root/library/http/http.tcl
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2016-10-08 16:38:42 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2016-10-08 16:38:42 (GMT)
commitb7a3af751c2791b0659d8fde644ea66d90f58791 (patch)
tree70683ef36e8e3ea9146b2333fd823a9740eb5118 /library/http/http.tcl
parentdaea02d5448a5b21b217c522a799bbcbb2c28def (diff)
downloadtcl-b7a3af751c2791b0659d8fde644ea66d90f58791.zip
tcl-b7a3af751c2791b0659d8fde644ea66d90f58791.tar.gz
tcl-b7a3af751c2791b0659d8fde644ea66d90f58791.tar.bz2
[838e99a76d] Ensure that encodings are handled with application/xml and friends.
Diffstat (limited to 'library/http/http.tcl')
-rw-r--r--library/http/http.tcl34
1 files changed, 33 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