bug#10410: guile: uri module confused by domain names starting with numbers, ipv6 addresses

[Daniel Hartwig <mandyke@gmail.com>]

[-- Attachment #1: Type: text/plain, Size: 895 bytes --]

On 30 December 2011 18:14, Daniel Hartwig <mandyke@gmail.com> wrote:
>
> `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'.

So the issue was really with `parse-authority'.

The attached patch cleans this up with support for IPv6 (including
dotted-quad notation), fixes some typos in the tests, and adds new
tests.

With both patches applied the web-uri.test now passes for all tests
and I can finally do:

scheme@(guile-user)> (string->uri "http://[::ffff:192.0.2.1]/foo")
$2 = #<<uri> scheme: http userinfo: #f host: "[::ffff:192.0.2.1]"
port: #f path: "/foo" query: #f fragment: #f>
scheme@(guile-user)> (string->uri "http://123.com")
$3 = #<<uri> scheme: http userinfo: #f host: "123.com" port: #f path:
"" query: #f fragment: #f>

[-- Attachment #2: 0002-enhance-IPv6-support.patch --]
[-- Type: text/x-patch, Size: 3067 bytes --]

From b839aa909c61ef2ee68ea652e6e0095afc3f2f24 Mon Sep 17 00:00:00 2001
From: Daniel Hartwig <mandyke@gmail.com>
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