Package: guile
Version: 2.0.3
Tags: patch
X-Debbugs-CC: guile-devel@gnu.org
Hello
I have noticed that the (web uri) module does not handle domain names
that start with numbers:
scheme@(guile-user)> (string->uri "http://123.com";)
$1 = #f
scheme@(guile-user)> (build-uri 'http #:host "123.com")
web/uri.scm:85:6: In procedure build-uri:
web/uri.scm:85:6: Throw to key `uri-error' with args `("Expected valid
host: ~s" ("123.com"))'.
Also, `string->uri' does not handle ipv6 addresses:
scheme@(guile-user)> (string->uri "http://[2001:db8::1]";)
$2 = #f
Attached patch implements support for domain names that start with
numbers by correcting the
regular expressions used by `valid-host?' as well as some related tests.
`string->uri' requires similar changes to support the ipv6 address
literals. I'm yet to found a very elegant way to do this though it is
easy enough to simply butcher `authority-pat'.
From 9fced395b4afb4e022414a4b451a50b31ceacedd Mon Sep 17 00:00:00 2001
From: Daniel Hartwig <mand...@gmail.com>
Date: Fri, 30 Dec 2011 17:49:37 +0800
Subject: [PATCH] support URIs with domain names starting with numbers
* module/web/uri.scm (valid-host?): Fix regexp to support
domain names starting with numbers.
* test-suite/tests/web-uri.scm: Add tests for above and
IP literals.
---
module/web/uri.scm | 4 +-
test-suite/tests/web-uri.test | 49 ++++++++++++++++++++++++++++++++++++++++-
2 files changed, 50 insertions(+), 3 deletions(-)
diff --git a/module/web/uri.scm b/module/web/uri.scm
index 67ecbae..ff13847 100644
--- a/module/web/uri.scm
+++ b/module/web/uri.scm
@@ -89,9 +89,9 @@ consistency checks to make sure that the constructed URI is valid."
;; 3490), and non-ASCII host names.
;;
(define ipv4-regexp
- (make-regexp "^([0-9.]+)"))
+ (make-regexp "^([0-9.]+)$"))
(define ipv6-regexp
- (make-regexp "^\\[([0-9a-fA-F:]+)\\]+"))
+ (make-regexp "^\\[([0-9a-fA-F:]+)\\]$"))
(define domain-label-regexp
(make-regexp "^[a-zA-Z0-9]([a-zA-Z0-9-]*[a-zA-Z0-9])?$"))
(define top-label-regexp
diff --git a/test-suite/tests/web-uri.test b/test-suite/tests/web-uri.test
index 9118eea..4f859e0 100644
--- a/test-suite/tests/web-uri.test
+++ b/test-suite/tests/web-uri.test
@@ -90,6 +90,18 @@
(uri=? (build-uri 'http #:host "bad.host.1" #:validate? #f)
#:scheme 'http #:host "bad.host.1" #:path ""))
+ (pass-if "http://1.good.host";
+ (uri=? (build-uri 'http #:host "1.good.host")
+ #:scheme 'http #:host "1.good.host" #:path ""))
+
+ (pass-if "http://192.0.2.1";
+ (uri=? (build-uri 'http #:host "192.0.2.1")
+ #:scheme 'http #:host "192.0.2.1" #:path ""))
+
+ (pass-if "http://[2001:db8::1]";
+ (uri=? (build-uri 'http #:host "[2001:db8::1]")
+ #:scheme 'http #:host "[2001:db8::1]" #:path ""))
+
(pass-if-uri-exception "http://foo:not-a-port";
"Expected.*port"
(build-uri 'http #:host "foo" #:port "not-a-port"))
@@ -135,6 +147,25 @@
(pass-if "http://bad.host.1";
(not (string->uri "http://bad.host.1";)))
+ (pass-if "http://1.good.host";
+ (uri=? (string->uri "http://1.good.host";)
+ #:scheme 'http #:host "1.good.host" #:path ""))
+
+ (pass-if "http://192.0.2.1";
+ (uri=? (string->uri "http://192.0.2.1";)
+ #:scheme 'http #:host "192.0.2.1" #:path ""))
+
+ (pass-if "http://[2001:db8::1]";
+ (uri=? (string->uri "http://[2001:db8::1]";)
+ #:scheme 'http #:host "[2001:db8::1]" #:path ""))
+
+ (pass-if "http://[2001:db8::1]:80";
+ (uri=? (string->uri "http://[2001:db8::1]";)
+ #:scheme 'http
+ #:host "[2001:db8::1]"
+ #:port 80
+ #:path ""))
+
(pass-if "http://foo:";
(uri=? (string->uri "http://foo:";)
#:scheme 'http #:host "foo" #:path ""))
@@ -184,6 +215,18 @@
(equal? "ftp://foo@bar:22/baz";
(uri->string (string->uri "ftp://foo@bar:22/baz";))))
+ (pass-if "http://192.0.2.1";
+ (equal? "http://192.0.2.1";
+ (uri->string (string->uri "http://192.0.2.1";))))
+
+ (pass-if "http://[2001:db8::1]";
+ (equal? "http://[2001:db8::1]";
+ (uri->string (string->uri "http://[2001:db8::1]";))))
+
+ (pass-if "http://[2001:db8::1]:80";
+ (equal? "http://[2001:db8::1]:80";
+ (uri->string (string->uri "http://[2001:db8::1]:80";))))
+
(pass-if "http://foo:";
(equal? "http://foo";
(uri->string (string->uri "http://foo:";))))
@@ -193,7 +236,11 @@
(uri->string (string->uri "http://foo:/";)))))
(with-test-prefix "decode"
- (pass-if (equal? "foo bar" (uri-decode "foo%20bar"))))
+ (pass-if "foo%20bar"
+ (equal? "foo bar" (uri-decode "foo%20bar")))
+
+ (pass-if "foo+bar"
+ (equal? "foo bar" (uri-decode "foo+bar"))))
(with-test-prefix "encode"
(pass-if (equal? "foo%20bar" (uri-encode "foo bar"))))
--
1.7.5.4
