From 9fced395b4afb4e022414a4b451a50b31ceacedd Mon Sep 17 00:00:00 2001
From: Daniel Hartwig <mandyke@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