merge trunkinitsubsystems

1 files changed, 36 insertions, 4 deletions

diff --git a/library/http/http.tcl b/library/http/http.tcl
index 5a05fa0..ccd4cd1 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
@@ -1415,7 +1447,7 @@ proc http::mapReply {string} {
     set converted [string map $formMap $string]
     if {[string match "*\[\u0100-\uffff\]*" $converted]} {
 	regexp "\[\u0100-\uffff\]" $converted badChar
-	# Return this error message for maximum compatability... :^/
+	# Return this error message for maximum compatibility... :^/
 	return -code error \
 	    "can't read \"formMap($badChar)\": no such element in array"
     }