summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
authorhobbs <hobbs>2006-10-06 05:57:21 (GMT)
committerhobbs <hobbs>2006-10-06 05:57:21 (GMT)
commit45cf9721cab41cd7896f3c519c2b076405bbda67 (patch)
tree108495a84b0047174c2a083ea44dfdadcbf5d5c8 /library
parent97b84d183aac17ef445cd59c956d0bb88328dbfe (diff)
downloadtcl-45cf9721cab41cd7896f3c519c2b076405bbda67.zip
tcl-45cf9721cab41cd7896f3c519c2b076405bbda67.tar.gz
tcl-45cf9721cab41cd7896f3c519c2b076405bbda67.tar.bz2
* library/http/http.tcl (http::geturl): only do geturl url rfc
3986 validity checking if $::http::strict is true (default true for 8.5). [Bug 1560506]
Diffstat (limited to 'library')
-rw-r--r--library/http/http.tcl12
1 files changed, 8 insertions, 4 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl
index 1e5818a..a685c8c 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.58 2006/09/16 00:19:41 hobbs Exp $
+# RCS: @(#) $Id: http.tcl,v 1.59 2006/10/06 05:57:21 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?
+ variable strict 1
+
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