diff options
| author | dkf <donal.k.fellows@manchester.ac.uk> | 2003-09-29 10:04:52 (GMT) |
|---|---|---|
| committer | dkf <donal.k.fellows@manchester.ac.uk> | 2003-09-29 10:04:52 (GMT) |
| commit | d6fa269907f590d521bdbc7aa2c2225f3beb3526 (patch) | |
| tree | 5a35b39f14f59e2f042fd45002687604c699f20d /library/http | |
| parent | 8cc43294204e947957e5d02b2886ef3b90f47926 (diff) | |
| download | tcl-d6fa269907f590d521bdbc7aa2c2225f3beb3526.zip tcl-d6fa269907f590d521bdbc7aa2c2225f3beb3526.tar.gz tcl-d6fa269907f590d521bdbc7aa2c2225f3beb3526.tar.bz2 | |
Correctly check the types of boolean options to http::geturl [Bug 811170]
Diffstat (limited to 'library/http')
| -rw-r--r-- | library/http/http.tcl | 17 |
1 files changed, 12 insertions, 5 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl index 2a9c8b5..50ecdef 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.43.2.1 2003/07/18 19:41:16 hobbs Exp $ +# RCS: @(#) $Id: http.tcl,v 1.43.2.2 2003/09/29 10:04:53 dkf Exp $ # Rough version history: # 1.0 Old http_get interface @@ -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\ @@ -265,11 +273,10 @@ proc http::geturl { url args } { 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]} { + 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 { |