summaryrefslogtreecommitdiffstats
path: root/library
diff options
context:
space:
mode:
authordkf <donal.k.fellows@manchester.ac.uk>2005-11-18 14:51:02 (GMT)
committerdkf <donal.k.fellows@manchester.ac.uk>2005-11-18 14:51:02 (GMT)
commit4d8ccb4db88d7ce2ba04cdf1425f5373177a132f (patch)
tree72cd7d5ad98def9f7b362e5471feeb2ec2d34a1e /library
parent16253c9b715db75cb94e8d56dd04fee6d2da73a9 (diff)
downloadtcl-4d8ccb4db88d7ce2ba04cdf1425f5373177a132f.zip
tcl-4d8ccb4db88d7ce2ba04cdf1425f5373177a132f.tar.gz
tcl-4d8ccb4db88d7ce2ba04cdf1425f5373177a132f.tar.bz2
Fix silly errors in REs, in variables, and in tests that were working with
invalid URLs.
Diffstat (limited to 'library')
-rw-r--r--library/http/http.tcl16
1 files changed, 8 insertions, 8 deletions
diff --git a/library/http/http.tcl b/library/http/http.tcl
index c8dbe9b..f43dd1b 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.54 2005/11/18 13:57:53 dkf Exp $
+# RCS: @(#) $Id: http.tcl,v 1.55 2005/11/18 14:51:02 dkf Exp $
# Rough version history:
# 1.0 Old http_get interface.
@@ -333,7 +333,7 @@ proc http::geturl { url args } {
set URLmatcher {(?x) # this is _expanded_ syntax
^
- (?: (\w+) : ) # <protocol scheme>
+ (?: (\w+) : ) ? # <protocol scheme>
(?: //
(?:
(
@@ -343,7 +343,7 @@ proc http::geturl { url args } {
( [^/:\#?]+ ) # <host part of authority>
(?: : (\d+) )? # <port part of authority>
)?
- ( / [^\#?]* (?: \? [^\#?]* ) )? # <path> (including query)
+ ( / [^\#?]* (?: \? [^\#?]* )?)? # <path> (including query)
(?: \# (.*) )? # <fragment>
$
}
@@ -372,13 +372,13 @@ proc http::geturl { url args } {
# Check for validity according to RFC 3986, Appendix A
set validityRE {(?xi)
^
- (?: [\w-.~!$&'()*+,;=:] | %[0-9a-f][0-9a-f] )+
+ (?: [-\w.~!$&'()*+,;=:] | %[0-9a-f][0-9a-f] )+
$
}
if {![regexp -- $validityRE $user]} {
unset $token
# Provide a better error message in this error case
- if {[regexp {(?i)%(?![0-9a-f][0-9a-f]).?.?} $path bad]} {
+ if {[regexp {(?i)%(?![0-9a-f][0-9a-f]).?.?} $user bad]} {
return -code error \
"Illegal encoding character usage \"$bad\" in URL user"
}
@@ -390,15 +390,15 @@ proc http::geturl { url args } {
set validityRE {(?xi)
^
# Path part (already must start with / character)
- (?: [\w-.~!$&'()*+,;=:@/] | %[0-9a-f][0-9a-f] )*
+ (?: [-\w.~!$&'()*+,;=:@/] | %[0-9a-f][0-9a-f] )*
# Query part (optional, permits ? characters)
- (?: ? (?: [\w-.~!$&'()*+,;=:@/?] | %[0-9a-f][0-9a-f] )* )?
+ (?: \? (?: [-\w.~!$&'()*+,;=:@/?] | %[0-9a-f][0-9a-f] )* )?
$
}
if {![regexp -- $validityRE $srvurl]} {
unset $token
# Provide a better error message in this error case
- if {[regexp {(?i)%(?![0-9a-f][0-9a-f])..} $path bad]} {
+ if {[regexp {(?i)%(?![0-9a-f][0-9a-f])..} $srvurl bad]} {
return -code error \
"Illegal encoding character usage \"$bad\" in URL path"
}