From b839aa909c61ef2ee68ea652e6e0095afc3f2f24 Mon Sep 17 00:00:00 2001
From: Daniel Hartwig <address@hidden>
Date: Sat, 31 Dec 2011 00:16:42 +0800
Subject: [PATCH 2/2] enhance IPv6 support

* module/web/uri.scm (valid-host?): Support dotted-quad notation
  in IPv6 addresses.
  (parse-authority): Support IPv6 literals.
* test-suite/tests/web-uri.test: Add and fix tests.
---
 module/web/uri.scm            |    4 ++--
 test-suite/tests/web-uri.test |   16 ++++++++++++----
 2 files changed, 14 insertions(+), 6 deletions(-)

diff --git a/module/web/uri.scm b/module/web/uri.scm
index ff13847..b8a6951 100644
--- a/module/web/uri.scm
+++ b/module/web/uri.scm
@@ -91,7 +91,7 @@ consistency checks to make sure that the constructed URI is valid."
 (define ipv4-regexp
   (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
@@ -116,7 +116,7 @@ consistency checks to make sure that the constructed URI is valid."
 (define userinfo-pat
   "[a-zA-Z0-9_.!~*'();:&=+$,-]+")
 (define host-pat
-  "[a-zA-Z0-9.-]+")
+  "[a-zA-Z0-9.-]+|\\[[0-9a-FA-F:.]+\\]")
 (define port-pat
   "[0-9]*")
 (define authority-regexp
diff --git a/test-suite/tests/web-uri.test b/test-suite/tests/web-uri.test
index 4f859e0..cd6a944 100644
--- a/test-suite/tests/web-uri.test
+++ b/test-suite/tests/web-uri.test
@@ -102,6 +102,10 @@
     (uri=? (build-uri 'http #:host "[2001:db8::1]")
            #:scheme 'http #:host "[2001:db8::1]" #:path ""))
 
+  (pass-if "http://[::ffff:192.0.2.1]"
+    (uri=? (build-uri 'http #:host "[::ffff:192.0.2.1]")
+           #:scheme 'http #:host "[::ffff:192.0.2.1]" #:path ""))
+
   (pass-if-uri-exception "http://foo:not-a-port"
                          "Expected.*port"
                          (build-uri 'http #:host "foo" #:port "not-a-port"))
@@ -160,12 +164,16 @@
            #:scheme 'http #:host "[2001:db8::1]" #:path ""))
 
   (pass-if "http://[2001:db8::1]:80"
-    (uri=? (string->uri "http://[2001:db8::1]")
+    (uri=? (string->uri "http://[2001:db8::1]:80")
            #:scheme 'http
            #:host "[2001:db8::1]"
            #:port 80
            #:path ""))
 
+  (pass-if "http://[::ffff:192.0.2.1]"
+    (uri=? (string->uri "http://[::ffff:192.0.2.1]")
+           #:scheme 'http #:host "[::ffff:192.0.2.1]" #:path ""))
+
   (pass-if "http://foo:"
     (uri=? (string->uri "http://foo:")
            #:scheme 'http #:host "foo" #:path ""))
@@ -223,9 +231,9 @@
     (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://[::ffff:192.0.2.1]"
+    (equal? "http://[::ffff:192.0.2.1]"
+            (uri->string (string->uri "http://[::ffff:192.0.2.1]"))))
 
   (pass-if "http://foo:"
     (equal? "http://foo"
-- 
1.7.5.4