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