mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-05-20 11:40:18 +02:00
Code Activity

web: Accept URI host names consisting only of hex digits.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2020-06-18 17:02:07 +02:00
parent dfca16fd23
commit 1ab2105339
3 changed files with 13 additions and 3 deletions
Download patch file Download diff file Expand all files Collapse all files

3
NEWS
View file

@ -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

4
module/web/uri.scm
View file

@ -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 "]"

9
test-suite/tests/web-uri.test
View file

@ -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")))