Correct handling of quoted charset names. [Bug 2849860]

2 files changed, 34 insertions, 23 deletions

diff --git a/ChangeLog b/ChangeLog
index 98d7163..56f3fb5 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,8 @@
+2009-09-10  Donal K. Fellows  <dkf@users.sf.net>
+
+	* library/http/http.tcl (http::Event): [Bug 2849860]: Handle charset
+	names in double quotes; some servers like generating them like that.
+
 2009-09-01  Don Porter  <dgp@users.sourceforge.net>
 
 	* library/tcltest/tcltest.tcl:	Bump to tcltest 2.3.2 after revision
@@ -7,38 +12,38 @@
 
 2009-08-27  Don Porter  <dgp@users.sourceforge.net>
 
-	* generic/tclStringObj.c:	A few more string overflow cases in
-	[format].  [Bug 2845535]
+	* generic/tclStringObj.c:	[Bug 2845535]: A few more string
+	overflow cases in [format].
 
 2009-08-25  Andreas Kupries  <andreask@activestate.com>
 
-	* generic/tclBasic.c (Tcl_CreateInterp, Tcl_EvalTokensStandard,
-	EvalTokensStandard, Tcl_EvalEx, EvalEx, TclAdvanceContinuations,
-	TclEvalObjEx):
+	* generic/tclBasic.c (Tcl_CreateInterp, Tcl_EvalTokensStandard)
+	(EvalTokensStandard, Tcl_EvalEx, EvalEx, TclAdvanceContinuations)
+	(TclEvalObjEx):
 	* generic/tclCmdMZ.c (Tcl_SwitchObjCmd, TclListLines):
 	* generic/tclCompCmds.c (*):
-	* generic/tclCompile.c (TclSetByteCodeFromAny, TclInitCompileEnv,
-	TclFreeCompileEnv, TclCompileScript):
+	* generic/tclCompile.c (TclSetByteCodeFromAny, TclInitCompileEnv)
+	(TclFreeCompileEnv, TclCompileScript):
 	* generic/tclCompile.h (CompileEnv):
 	* generic/tclInt.h (ContLineLoc, Interp):
-	* generic/tclObj.c (ThreadSpecificData, ContLineLocFree,
-	TclThreadFinalizeObjects, TclInitObjSubsystem,
-	TclContinuationsEnter, TclContinuationsEnterDerived,
-	TclContinuationsCopy, TclContinuationsGet, TclFreeObj):
+	* generic/tclObj.c (ThreadSpecificData, ContLineLocFree)
+	(TclThreadFinalizeObjects, TclInitObjSubsystem, TclContinuationsEnter)
+	(TclContinuationsEnterDerived, TclContinuationsCopy)
+	(TclContinuationsGet, TclFreeObj):
 	* generic/tclParse.c (TclSubstTokens, Tcl_SubstObj):
 	* generic/tclProc.c (TclCreateProc):
 	* generic/tclVar.c (TclPtrSetVar):
 	* tests/info.test (info-30.0-24):
 
-	Extended parser, compiler, and execution with code and attendant
-	data structures tracking the positions of continuation lines which
-	are not visible in script Tcl_Obj*'s, to properly account for them
-	while counting lines for #280.
+	Extended parser, compiler, and execution with code and attendant data
+	structures tracking the positions of continuation lines which are not
+	visible in script Tcl_Obj*'s, to properly account for them while
+	counting lines for #280.
 
 2009-08-24  Daniel Steffen  <das@users.sourceforge.net>
 
-	* macosx/tclMacOSXNotify.c: fix multiple issues with nested event loops
-	when CoreFoundation notifier is running in embedded mode. (fixes
+	* macosx/tclMacOSXNotify.c: Fix multiple issues with nested event loops
+	when CoreFoundation notifier is running in embedded mode. (Fixes
 	problems in TkAqua Cocoa reported by Youness Alaoui on tcl-mac)
 
 2009-08-21  Don Porter  <dgp@users.sourceforge.net>
@@ -48,10 +53,10 @@
 
 2009-08-20  Don Porter  <dgp@users.sourceforge.net>
 
-	* generic/tclFileName.c: Correct result from [glob */test] when *
-	matches something like ~foo.  [Bug 2837800]
+	* generic/tclFileName.c: [Bug 2837800]: Get the correct result from
+	[glob */test] when * matches something like ~foo.
 
-	* generic/tclPathObj.c:	[Bug 2806250] Prevent the storage of strings
+	* generic/tclPathObj.c:	[Bug 2806250]: Prevent the storage of strings
 	starting with ~ in the "tail" part (normPathPtr field) of the path
 	intrep when PATHFLAGS != 0.  This establishes the assumptions relied
 	on elsewhere that the name stored there is a relative path.  Also
diff --git a/library/http/http.tcl b/library/http/http.tcl
index 5dbce3c..105f449 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -8,7 +8,7 @@
 # See the file "license.terms" for information on usage and redistribution of
 # this file, and for a DISCLAIMER OF ALL WARRANTIES.
 #
-# RCS: @(#) $Id: http.tcl,v 1.67.2.6 2009/04/09 17:05:39 dgp Exp $
+# RCS: @(#) $Id: http.tcl,v 1.67.2.7 2009/09/10 21:31:08 dkf Exp $
 
 package require Tcl 8.4
 # Keep this in sync with pkgIndex.tcl and with the install directories in
@@ -1033,8 +1033,14 @@ proc http::Event {sock token} {
 		    content-type {
 			set state(type) [string trim [string tolower $value]]
 			# grab the optional charset information
-			regexp -nocase {charset\s*=\s*(\S+?);?} \
-			    $state(type) -> state(charset)
+			if {[regexp -nocase \
+				 {charset\s*=\s*\"((?:[^""]|\\\")*)\"} \
+				 $state(type) -> cs]} {
+			    set state(charset) [string map {{\"} \"} $cs]
+			} else {
+			    regexp -nocase {charset\s*=\s*(\S+?);?} \
+				$state(type) -> state(charset)
+			}
 		    }
 		    content-length {
 			set state(totalsize) [string trim $value]