From c5c73ec317fce63210aedd53ebda27ebef52bcc3 Mon Sep 17 00:00:00 2001
From: dkf <donal.k.fellows@manchester.ac.uk>
Date: Mon, 29 Sep 2003 10:01:31 +0000
Subject: Correctly check the types of boolean options to http::geturl [Bug
 811170]

---
 ChangeLog             |  3 +++
 library/http/http.tcl | 21 ++++++++++++++-------
 2 files changed, 17 insertions(+), 7 deletions(-)

diff --git a/ChangeLog b/ChangeLog
index c955d1c..c148f91 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,5 +1,8 @@
 2003-09-29  Donal K. Fellows  <fellowsd@cs.man.ac.uk>
 
+	* library/http/http.tcl (geturl): Correctly check the type of
+	boolean-valued options. [Bug 811170]
+
 	* unix/tcl.m4 (SC_ENABLE_FRAMEWORK): Added note to make it clearer
 	that this is an OSX feature, not a general Unix feature. [Bug 619440]
 
diff --git a/library/http/http.tcl b/library/http/http.tcl
index 3854fce..2744eb6 100644
--- a/library/http/http.tcl
+++ b/library/http/http.tcl
@@ -9,7 +9,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.46 2003/09/15 14:24:50 patthoyts Exp $
+# RCS: @(#) $Id: http.tcl,v 1.47 2003/09/29 10:01:33 dkf Exp $
 
 # Rough version history:
 # 1.0	Old http_get interface
@@ -238,7 +238,7 @@ proc http::geturl { url args } {
 	-binary		false
 	-blocksize 	8192
 	-queryblocksize 8192
-	-validate 	0
+	-validate 	false
 	-headers 	{}
 	-timeout 	0
 	-type           application/x-www-form-urlencoded
@@ -255,6 +255,14 @@ proc http::geturl { url args } {
 	status		""
 	http            ""
     }
+    # These flags have their types verified [Bug 811170]
+    array set type {
+	-binary		boolean
+	-blocksize	integer
+	-queryblocksize integer
+	-validate	boolean
+	-timeout	integer
+    }	
     set state(charset)	$defaultCharset
     set options {-binary -blocksize -channel -command -handler -headers \
 	    -progress -query -queryblocksize -querychannel -queryprogress\
@@ -264,12 +272,11 @@ proc http::geturl { url args } {
     set pat ^-([join $options |])$
     foreach {flag value} $args {
 	if {[regexp $pat $flag]} {
-	    # Validate numbers
-	    if {[info exists state($flag)] && \
-		    [string is integer -strict $state($flag)] && \
-		    ![string is integer -strict $value]} {
+	    # Validate numbers and booleans
+	    if {[info exists type($flag)] && \
+		    ![string is $type($flag) -strict $value]} {
 		unset $token
-		return -code error "Bad value for $flag ($value), must be integer"
+		return -code error "Bad value for $flag ($value), must be $type($flag)"
 	    }
 	    set state($flag) $value
 	} else {
-- 
cgit v0.12