summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-06-18 17:02:07 +0200
committerLudovic Courtès <ludo@gnu.org>2020-06-18 17:06:29 +0200
commit1ab2105339f60dba20c8c9680e49110501f3a6a0 (patch)
tree737b10d3110eda349372d545f5a5cb8a776935cf
parentdfca16fd234c13ff76bbfca20ebc3b0895681bc2 (diff)
downloadguile-1ab2105339f60dba20c8c9680e49110501f3a6a0.tar.gz
web: Accept URI host names consisting only of hex digits.
Fixes <https://bugs.gnu.org/40582>. Reported by Julien Lepiller <julien@lepiller.eu>. Previously, a host part consisting of hex digits would be mistaken as an IPv6 address and rejected by 'valid-host?'. * module/web/uri.scm (ipv6-regexp): Add colon. * test-suite/tests/web-uri.test ("string->uri")["xyz://abc/x/y/z"]: New test. * NEWS: Update.
-rw-r--r--NEWS3
-rw-r--r--module/web/uri.scm4
-rw-r--r--test-suite/tests/web-uri.test9
3 files changed, 13 insertions, 3 deletions
diff --git a/NEWS b/NEWS
index 6a86482c7..f489e3e98 100644
--- a/NEWS
+++ b/NEWS
@@ -95,6 +95,9 @@ written in C.
** 'http-get', 'http-post', etc. now honor #:verify-certificates?
(<https://bugs.gnu.org/40486>)
+** web: Accept URI host names consisting only of hex digits
+ (<https://bugs.gnu.org/40582>)
+
** (web http) parser recognizes the CONNECT and PATCH methods
** Initial revealed count of file ports is now zero
diff --git a/module/web/uri.scm b/module/web/uri.scm
index b4b89b9cc..728444afc 100644
--- a/module/web/uri.scm
+++ b/module/web/uri.scm
@@ -1,6 +1,6 @@
;;;; (web uri) --- URI manipulation tools
;;;;
-;;;; Copyright (C) 1997,2001,2002,2010,2011,2012,2013,2014,2019 Free Software Foundation, Inc.
+;;;; Copyright (C) 1997,2001,2002,2010,2011,2012,2013,2014,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
@@ -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")))