bug#53201: string->uri-reference rejects domain names with final ‘.’

bug#53201: string->uri-reference rejects domain names with final ‘.’

[Tobias Geerinckx-Rice via Bug reports for GUILE, GNU's Ubiquitous Extension Language]

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

Guilers,

What the subject says :-)  Omitting the final dot is optional (and 
common), not mandatory.

  scheme@(guile-user)> (string->uri-reference "http://x.org")
  $1 = #<<uri> … host: "x.org" …>

  scheme@(guile-user)> (string->uri-reference "http://x.org.")
  $2 = #f ; wrong!

This actually breaks redirects in the wild:

Starting download […]
From 
https://pyropus.ca/software/getmail/old-versions/getmail-5.16.tar.gz...
Bad uri-reference header component:
https://pyropus.ca./software/getmail/old-versions/getmail-5.16.tar.gz

Kind regards,

T G-R

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 247 bytes --]

bug#53201: string->uri-reference rejects domain names with final ‘.’

[dsmich]

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

Probably not the best fix. Seems to work. Includes a few tests.

-Dale

diff --git a/module/web/uri.scm b/module/web/uri.scm
index 8e0b9bee7..d6758fcc6 100644
--- a/module/web/uri.scm
+++ b/module/web/uri.scm
@@ -212,7 +212,9 @@ for ‘build-uri’ except there is no scheme."
 (and (regexp-exec domain-label-regexp
 (substring host start end))
 (lp (1+ end)))
- (regexp-exec top-label-regexp host start)))))))
+ (if (< start (string-length host))
+ (regexp-exec top-label-regexp host start)
+ #t)))))))

 (define userinfo-pat
 (string-append "[" letters digits "_.!~*'();:&=+$,-]+"))
diff --git a/test-suite/tests/web-uri.test
b/test-suite/tests/web-uri.test
index 95fd82f16..c49142d48 100644
--- a/test-suite/tests/web-uri.test
+++ b/test-suite/tests/web-uri.test
@@ -367,6 +367,9 @@
 (pass-if "//bad.host.1"
 (not (string->uri-reference "//bad.host.1")))

+ (pass-if "//bad.host.."
+ (not (string->uri-reference "//bad.host..")))
+
 (pass-if "http://1.good.host"
 (uri=? (string->uri-reference "http://1.good.host")
 #:scheme 'http #:host "1.good.host" #:path ""))
@@ -375,6 +378,10 @@
 (uri=? (string->uri-reference "//1.good.host")
 #:host "1.good.host" #:path ""))

+ (pass-if "//1.good.host."
+ (uri=? (string->uri-reference "//1.good.host.")
+ #:host "1.good.host." #:path ""))
+
 (when (memq 'socket *features*)
 (pass-if "http://192.0.2.1"
 (uri=? (string->uri-reference "http://192.0.2.1")



[-- Attachment #2: Type: text/html, Size: 2756 bytes --]

bug#53201: string->uri-reference rejects domain names with final ‘.’

[dsmich]

[-- Attachment #1.1: Type: text/plain, Size: 48 bytes --]

New patch. Now with 3 test cases!

-Dale



[-- Attachment #1.2: Type: text/html, Size: 129 bytes --]

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-Allow-trailing-.-in-urls.patch --]
[-- Type: text/x-patch, Size: 2269 bytes --]

From f4eece6395e75197030bff42a583e847e5a34e15 Mon Sep 17 00:00:00 2001
From: "Dale P. Smith" <dalepsmith@gmail.com>
Date: Thu, 27 Jan 2022 19:20:57 -0500
Subject: [PATCH] Allow trailing "." in urls

bug #53201
---
 module/web/uri.scm            | 17 ++++++++++-------
 test-suite/tests/web-uri.test | 10 ++++++++++
 2 files changed, 20 insertions(+), 7 deletions(-)

diff --git a/module/web/uri.scm b/module/web/uri.scm
index 8e0b9bee7..8c5c0d6f0 100644
--- a/module/web/uri.scm
+++ b/module/web/uri.scm
@@ -206,13 +206,16 @@ for ‘build-uri’ except there is no scheme."
    ((regexp-exec ipv6-regexp host)
     (false-if-exception (inet-pton AF_INET6 host)))
    (else
-    (let lp ((start 0))
-      (let ((end (string-index host #\. start)))
-        (if end
-            (and (regexp-exec domain-label-regexp
-                              (substring host start end))
-                 (lp (1+ end)))
-            (regexp-exec top-label-regexp host start)))))))
+    (let ((last (1- (string-length host))))
+      (let lp ((start 0))
+        (let ((end (string-index host #\. start)))
+          (if (and end (< end last))
+              (and (regexp-exec domain-label-regexp
+                                (substring host start end))
+                   (lp (1+ end)))
+              (if end
+                  (regexp-exec top-label-regexp (substring host start end))
+                  (regexp-exec top-label-regexp host start)))))))))
 
 (define userinfo-pat
   (string-append "[" letters digits "_.!~*'();:&=+$,-]+"))
diff --git a/test-suite/tests/web-uri.test b/test-suite/tests/web-uri.test
index 95fd82f16..e9fb766f0 100644
--- a/test-suite/tests/web-uri.test
+++ b/test-suite/tests/web-uri.test
@@ -367,6 +367,16 @@
   (pass-if "//bad.host.1"
     (not (string->uri-reference "//bad.host.1")))
 
+  (pass-if "//bad.host.1."
+    (not (string->uri-reference "//bad.host.1.")))
+
+  (pass-if "//bad.host.."
+    (not (string->uri-reference "//bad.host..")))
+
+  (pass-if "//1.good.host."
+    (uri=? (string->uri-reference "//1.good.host.")
+           #:host "1.good.host." #:path ""))
+
   (pass-if "http://1.good.host"
     (uri=? (string->uri-reference "http://1.good.host")
            #:scheme 'http #:host "1.good.host" #:path ""))
-- 
2.30.2