more uri-related ipv6 fixes

* module/web/uri.scm (ipv6-regexp): IPv6 numeric addresses do not have
  brackets.  It's only in URIs that they have them.
  (ipv6-host-pat, authority-regexp, parse-authority): Refactor ipv6
  detection to fix a bug with |, and to extract IPv6 hosts from their
  brackets.  This way we can pass the uri-host directly to inet-pton.
  (uri->string): If the host contains a `:', assume it is ipv6 and add
  brackets.

* test-suite/tests/web-uri.test ("build-uri"): Adapt tests to assume
  that the address returned by uri-host and passed to build-uri #:host
  does not have brackets.

diff --git a/module/web/uri.scm b/module/web/uri.scm
index ba36a38..109118b 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,13 +115,15 @@ 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.-]+|\\[[0-9a-FA-F:.]+\\]")
+  "[a-zA-Z0-9.-]+")
+(define ipv6-host-pat
+  "[0-9a-fA-F:.]+")
 (define port-pat
   "[0-9]*")
 (define authority-regexp
   (make-regexp
-   (format #f "^//((~a)@)?(~a)(:(~a))?$"
-           userinfo-pat host-pat port-pat)))
+   (format #f "^//((~a)@)?((~a)|(\\[(~a)\\]))(:(~a))?$"
+           userinfo-pat host-pat ipv6-host-pat port-pat)))
 
 (define (parse-authority authority fail)
   (if (equal? authority "//")
@@ -129,10 +131,12 @@ consistency checks to make sure that the constructed URI is valid."
       ;; file:/etc/hosts.
       (values #f #f #f)
       (let ((m (regexp-exec authority-regexp authority)))
-        (if (and m (valid-host? (match:substring m 3)))
+        (if (and m (valid-host? (or (match:substring m 4)
+                                    (match:substring m 6))))
             (values (match:substring m 2)
-                    (match:substring m 3)
-                    (let ((port (match:substring m 5)))
+                    (or (match:substring m 4)
+                        (match:substring m 6))
+                    (let ((port (match:substring m 8)))
                       (and port (not (string-null? port))
                            (string->number port))))
             (fail)))))
@@ -216,7 +220,9 @@ printed."
          (string-append "//"
                         (if userinfo (string-append userinfo "@")
                             "")
-                        host
+                        (if (string-index host #\:)
+                            (string-append "[" host "]")
+                            host)
                         (if (default-port? (uri-scheme uri) port)
                             ""
                             (string-append ":" (number->string port))))

diff --git a/test-suite/tests/web-uri.test b/test-suite/tests/web-uri.test
index 38929fe..7431025 100644 (file)
--- a/test-suite/tests/web-uri.test
+++ b/test-suite/tests/web-uri.test
@@ -99,12 +99,12 @@
            #: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 ""))
+    (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 ""))
+    (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"
@@ -161,18 +161,18 @@
 
   (pass-if "http://[2001:db8::1]"
     (uri=? (string->uri "http://[2001:db8::1]")
-           #:scheme 'http #:host "[2001:db8::1]" #:path ""))
+           #:scheme 'http #:host "2001:db8::1" #:path ""))
 
   (pass-if "http://[2001:db8::1]:80"
     (uri=? (string->uri "http://[2001:db8::1]:80")
            #:scheme 'http
-           #:host "[2001:db8::1]"
+           #: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 ""))
+           #:scheme 'http #:host "::ffff:192.0.2.1" #:path ""))
 
   (pass-if "http://foo:"
     (uri=? (string->uri "http://foo:")