From 9fced395b4afb4e022414a4b451a50b31ceacedd Mon Sep 17 00:00:00 2001 From: Daniel Hartwig Date: Fri, 30 Dec 2011 17:49:37 +0800 Subject: [PATCH] support URIs with domain names starting with numbers * module/web/uri.scm (valid-host?): Fix regexp to support domain names starting with numbers. * test-suite/tests/web-uri.scm: Add tests for above and IP literals. --- module/web/uri.scm | 4 +- test-suite/tests/web-uri.test | 49 ++++++++++++++++++++++++++++++++++++++++- 2 files changed, 50 insertions(+), 3 deletions(-) diff --git a/module/web/uri.scm b/module/web/uri.scm index 67ecbae..ff13847 100644 --- a/module/web/uri.scm +++ b/module/web/uri.scm @@ -89,9 +89,9 @@ consistency checks to make sure that the constructed URI is valid." ;; 3490), and non-ASCII host names. ;; (define ipv4-regexp - (make-regexp "^([0-9.]+)")) + (make-regexp "^([0-9.]+)$")) (define ipv6-regexp - (make-regexp "^\\[([0-9a-fA-F:]+)\\]+")) + (make-regexp "^\\[([0-9a-fA-F:]+)\\]$")) (define domain-label-regexp (make-regexp "^[a-zA-Z0-9]([a-zA-Z0-9-]*[a-zA-Z0-9])?$")) (define top-label-regexp diff --git a/test-suite/tests/web-uri.test b/test-suite/tests/web-uri.test index 9118eea..4f859e0 100644 --- a/test-suite/tests/web-uri.test +++ b/test-suite/tests/web-uri.test @@ -90,6 +90,18 @@ (uri=? (build-uri 'http #:host "bad.host.1" #:validate? #f) #:scheme 'http #:host "bad.host.1" #:path "")) + (pass-if "http://1.good.host" + (uri=? (build-uri 'http #:host "1.good.host") + #:scheme 'http #:host "1.good.host" #:path "")) + + (pass-if "http://192.0.2.1" + (uri=? (build-uri 'http #:host "192.0.2.1") + #:scheme 'http #:host "192.0.2.1" #:path "")) + + (pass-if "http://[2001:db8::1]" + (uri=? (build-uri 'http #:host "[2001:db8::1]") + #:scheme 'http #:host "[2001:db8::1]" #:path "")) + (pass-if-uri-exception "http://foo:not-a-port" "Expected.*port" (build-uri 'http #:host "foo" #:port "not-a-port")) @@ -135,6 +147,25 @@ (pass-if "http://bad.host.1" (not (string->uri "http://bad.host.1"))) + (pass-if "http://1.good.host" + (uri=? (string->uri "http://1.good.host") + #:scheme 'http #:host "1.good.host" #:path "")) + + (pass-if "http://192.0.2.1" + (uri=? (string->uri "http://192.0.2.1") + #:scheme 'http #:host "192.0.2.1" #:path "")) + + (pass-if "http://[2001:db8::1]" + (uri=? (string->uri "http://[2001:db8::1]") + #:scheme 'http #:host "[2001:db8::1]" #:path "")) + + (pass-if "http://[2001:db8::1]:80" + (uri=? (string->uri "http://[2001:db8::1]") + #:scheme 'http + #:host "[2001:db8::1]" + #:port 80 + #:path "")) + (pass-if "http://foo:" (uri=? (string->uri "http://foo:") #:scheme 'http #:host "foo" #:path "")) @@ -184,6 +215,18 @@ (equal? "ftp://foo@bar:22/baz" (uri->string (string->uri "ftp://foo@bar:22/baz")))) + (pass-if "http://192.0.2.1" + (equal? "http://192.0.2.1" + (uri->string (string->uri "http://192.0.2.1")))) + + (pass-if "http://[2001:db8::1]" + (equal? "http://[2001:db8::1]" + (uri->string (string->uri "http://[2001:db8::1]")))) + + (pass-if "http://[2001:db8::1]:80" + (equal? "http://[2001:db8::1]:80" + (uri->string (string->uri "http://[2001:db8::1]:80")))) + (pass-if "http://foo:" (equal? "http://foo" (uri->string (string->uri "http://foo:")))) @@ -193,7 +236,11 @@ (uri->string (string->uri "http://foo:/"))))) (with-test-prefix "decode" - (pass-if (equal? "foo bar" (uri-decode "foo%20bar")))) + (pass-if "foo%20bar" + (equal? "foo bar" (uri-decode "foo%20bar"))) + + (pass-if "foo+bar" + (equal? "foo bar" (uri-decode "foo+bar")))) (with-test-prefix "encode" (pass-if (equal? "foo%20bar" (uri-encode "foo bar")))) -- 1.7.5.4