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.

diff --git a/module/web/uri.scm b/module/web/uri.scm
index 6954429..ba36a38 100644 (file)
--- 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
@@ -115,7 +115,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 62ec295..38929fe 100644 (file)
--- 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 ""))
@@ -227,9 +235,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"