Attachment "uri-patch-against-34996bb8c0.patch" to
ticket [7b5c6cb477]
added by
kjnash
2016-12-14 13:45:46.
Index: modules/uri/uri.tcl
==================================================================
--- modules/uri/uri.tcl
+++ modules/uri/uri.tcl
@@ -62,11 +62,11 @@
variable xCharN {[a-zA-Z0-9$_.+!*'(,);/?:@&=-]}
variable xChar "(${xCharN}|${escape})"
variable digits "${digit}+"
variable toplabel \
- "(${alpha}${alphaDigitMinus}*${alphaDigit}|${alpha})"
+ "(${alphaDigit}${alphaDigitMinus}*${alphaDigit}\\.?|${alphaDigit}\\.?)"
variable domainlabel \
"(${alphaDigit}${alphaDigitMinus}*${alphaDigit}|${alphaDigit})"
variable hostname \
"((${domainlabel}\\.)*${toplabel})"
@@ -165,12 +165,12 @@
proc ::uri::split {url {defaultscheme http}} {
set url [string trim $url]
set scheme {}
- # RFC 1738: scheme = 1*[ lowalpha | digit | "+" | "-" | "." ]
- regexp -- {^([A-Za-z0-9+.-][A-Za-z0-9+.-]*):} $url dummy scheme
+ # RFC 3986 Sec 3.1: scheme = ALPHA *( ALPHA / DIGIT / "+" / "-" / "." )
+ regexp -- {^([A-Za-z][A-Za-z0-9+.-]*):} $url dummy scheme
if {$scheme == {}} {
set scheme $defaultscheme
switch -- $scheme {
http - https - ftp {
@@ -297,11 +297,11 @@
upvar #0 [namespace current]::http::segment segment
array set parts {host {} port {} path {} query {} fragment {}}
set searchPattern "\\?(${search})\$"
- set fragmentPattern "#(${segment})\$"
+ set fragmentPattern "#(.*)\$"
# slash off possible fragment.
# NOTE: This must be done before the query, because a fragment can
# follow a query, and slashing off the query first will take the
@@ -711,11 +711,11 @@
#
# Results:
# Returns 1 if the URL is relative, 0 otherwise
proc ::uri::isrelative url {
- return [expr {![regexp -- {^[a-z0-9+-.][a-z0-9+-.]*:} $url]}]
+ return [expr {![regexp -- {^[A-Za-z][A-Za-z0-9+.-]*:} $url]}]
}
# ::uri::geturl --
#
# Fetch the data from an arbitrary URL.
Index: modules/uri/uri.test
==================================================================
--- modules/uri/uri.test
+++ modules/uri/uri.test
@@ -474,14 +474,13 @@
eval uri::join $ls
} {http://tcl.apache.org/websh/faq.ws3#generic?foo=bar}
# -------------------------------------------------------------------------
-test uri-8.0 {uri::split bug #676976, ill. char in scheme} {
- set ls [uri::split ht,tp://tcl.apache.org/websh]
- eval uri::join $ls
-} {http://ht/,tp://tcl.apache.org/websh}
+test uri-8.0 {uri::split bug #676976, ill. char in scheme} -body {
+ uri::split ht,tp://tcl.apache.org/websh
+} -returnCodes error -result {{invalid url} ,tp://tcl.apache.org/websh ht,tp://tcl.apache.org/websh}
# -------------------------------------------------------------------------
test uri-9.0 {uri::split bug #936064, user information} {
dictsort [uri::split http://foo:[email protected]:80/bla/]
