diff options
| author | hobbs <hobbs> | 2006-10-06 05:56:47 (GMT) |
|---|---|---|
| committer | hobbs <hobbs> | 2006-10-06 05:56:47 (GMT) |
| commit | 68b8be49f5771f747c9b416de6b11f386fdbb8fa (patch) | |
| tree | aec791cea1553d2bdfd29bff41cdbb7b32825444 /library/http | |
| parent | c85fa02a0669f2ecbfb370f2a8babb29a2e007ac (diff) | |
| download | tcl-68b8be49f5771f747c9b416de6b11f386fdbb8fa.zip tcl-68b8be49f5771f747c9b416de6b11f386fdbb8fa.tar.gz tcl-68b8be49f5771f747c9b416de6b11f386fdbb8fa.tar.bz2 | |
* library/http/http.tcl (http::geturl): only do geturl url rfc
3986 validity checking if $::http::strict is true (default false
for 8.5). [Bug 1560506]
Diffstat (limited to 'library/http')
| -rw-r--r-- | library/http/http.tcl | 12 |
1 files changed, 8 insertions, 4 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl index 1a79ceb..c412f6e 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.43.2.12 2006/09/15 19:53:33 hobbs Exp $ +# RCS: @(#) $Id: http.tcl,v 1.43.2.13 2006/10/06 05:56:48 hobbs Exp $ # Rough version history: # 1.0 Old http_get interface. @@ -64,6 +64,9 @@ namespace eval http { # This can be changed, but iso8859-1 is the RFC standard. variable defaultCharset "iso8859-1" + # Force RFC 3986 strictness in geturl url verification? Not for 8.4.x + variable strict 0 + namespace export geturl config reset wait formatQuery register unregister # Useful, but not exported: data size status code } @@ -223,6 +226,7 @@ proc http::geturl { url args } { variable http variable urlTypes variable defaultCharset + variable strict # Initialize the state variable, an array. We'll return the name of this # array as the token for the transaction. @@ -330,6 +334,7 @@ proc http::geturl { url args } { # # From a validation perspective, we need to ensure that the parts of the # URL that are going to the server are correctly encoded. + # This is only done if $::http::strict is true (default 0 for compat). set URLmatcher {(?x) # this is _expanded_ syntax ^ @@ -375,7 +380,7 @@ proc http::geturl { url args } { (?: [-\w.~!$&'()*+,;=:] | %[0-9a-f][0-9a-f] )+ $ } - if {![regexp -- $validityRE $user]} { + if {$strict && ![regexp -- $validityRE $user]} { unset $token # Provide a better error message in this error case if {[regexp {(?i)%(?![0-9a-f][0-9a-f]).?.?} $user bad]} { @@ -395,7 +400,7 @@ proc http::geturl { url args } { (?: \? (?: [-\w.~!$&'()*+,;=:@/?] | %[0-9a-f][0-9a-f] )* )? $ } - if {![regexp -- $validityRE $srvurl]} { + if {$strict && ![regexp -- $validityRE $srvurl]} { unset $token # Provide a better error message in this error case if {[regexp {(?i)%(?![0-9a-f][0-9a-f])..} $srvurl bad]} { @@ -409,7 +414,6 @@ proc http::geturl { url args } { } if {[string length $proto] == 0} { set proto http - set url ${proto}:$url } if {![info exists urlTypes($proto)]} { unset $token |