[Guile-commits] branch master updated: web: Accept URI host names consisting only of hex digits.

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script.

civodul pushed a commit to branch master
in repository guile.

The following commit(s) were added to refs/heads/master by this push:
     new 1ab2105  web: Accept URI host names consisting only of hex digits.
1ab2105 is described below

commit 1ab2105339f60dba20c8c9680e49110501f3a6a0
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Thu Jun 18 17:02:07 2020 +0200

    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.
---
 NEWS                          | 3 +++
 module/web/uri.scm            | 4 ++--
 test-suite/tests/web-uri.test | 9 ++++++++-
 3 files changed, 13 insertions(+), 3 deletions(-)

diff --git a/NEWS b/NEWS
index 6a86482..f489e3e 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 b4b89b9..728444a 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 94778ac..95fd82f 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";)))