bug#40582: Valid URIs are rejected
Ludovic Courtès <[email protected]>
| Newsgroups | gmane.lisp.guile.bugs |
|---|---|
| Message-ID | <[email protected]> |
Hi Julien, Julien Lepiller <[email protected]> skribis: > Using (web uri), I was trying to parse "uri://a/c". Reading RFC3986, it should be a valid URI (see rule for reg-name in 3.2.2). However, passing it to string->uri results in #f. I've tracked this down to valid-host? which returns #f for "a". > > The reason is that the regexp checking if the host is an ipv6 matches "a", which shouldn't happen because a is not an ipv6 address. Indeed, when I try (string->uri "uri://g/b"), I get the expected result. Right. ‘authority-regexp’ is fine, but ‘ipv6-regexp’, used by ‘valid-host?’, was too lax and would match “a” because it’s an hex digit sequence. The regexp below is still an approximation, but I think a better one. Can you confirm? Thanks, Ludo’.
(unnamed)
(text/x-patch, 1.5 KB)
diff --git a/module/web/uri.scm b/module/web/uri.scm
index b4b89b9cc..d76432737 100644
--- a/module/web/uri.scm
+++ b/module/web/uri.scm
@@ -188,7 +188,7 @@ for ‘build-uri’ except there is no scheme."
(define ipv4-regexp
(make-regexp (string-append "^([" digits ".]+)$")))
(define ipv6-regexp
- (make-regexp (string-append "^([" hex-digits ":.]+)$")))
+ (make-regexp (string-append "^([" hex-digits "]*:[" hex-digits ":.]+)$")))
(define domain-label-regexp
(make-regexp
(string-append "^[" letters digits "]"
diff --git a/test-suite/tests/web-uri.test b/test-suite/tests/web-uri.test
index 94778acac..95fd82f16 100644
--- a/test-suite/tests/web-uri.test
+++ b/test-suite/tests/web-uri.test
@@ -1,6 +1,6 @@
;;;; web-uri.test --- URI library -*- mode: scheme; coding: utf-8; -*-
;;;;
-;;;; Copyright (C) 2010-2012, 2014, 2017, 2019 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010-2012, 2014, 2017, 2019, 2020 Free Software Foundation, Inc.
;;;;
;;;; This library is free software; you can redistribute it and/or
;;;; modify it under the terms of the GNU Lesser General Public
@@ -179,6 +179,13 @@
#:port 22
#:path "/baz"))
+ (pass-if-equal "xyz://abc/x/y/z" ;<https://bugs.gnu.org/40582>
+ (list 'xyz "abc" "/x/y/z")
+ (let ((uri (string->uri "xyz://abc/x/y/z")))
+ (list (uri-scheme uri)
+ (uri-host uri)
+ (uri-path uri))))
+
(pass-if "http://bad.host.1"
(not (string->uri "http://bad.host.1")))