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

support URIs with domain names starting with numbers

Browse source 
* 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.
This commit is contained in:
Daniel Hartwig 2011-12-30 17:49:37 +08:00 • committed by Andy Wingo
parent d540a1d648
commit 274e2eecf1
2 changed files with 49 additions and 2 deletions
Download patch file Download diff file Expand all files Collapse all files

2
module/web/uri.scm
View file

@ -91,7 +91,7 @@ consistency checks to make sure that the constructed URI is valid."
(define ipv4-regexp
(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

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

@ -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 ""))
@ -188,6 +219,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:"))))
@ -197,7 +240,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"))))