diff options
| author | Daniel Hartwig <mandyke@gmail.com> | 2011-12-31 00:16:42 +0800 |
|---|---|---|
| committer | Andy Wingo <wingo@pobox.com> | 2012-07-06 12:33:41 +0200 |
| commit | 81e7210f1427d5209357cbcb241e22ce278dd73e (patch) | |
| tree | d7e1e9d57902a1a0ce9fc08418e5ca75881384f9 | |
| parent | 274e2eecf18a726280802230ab50774fa11e1107 (diff) | |
| download | guile-81e7210f1427d5209357cbcb241e22ce278dd73e.tar.gz | |
enhance IPv6 support
* module/web/uri.scm (valid-host?): Support dotted-quad notation
in IPv6 addresses.
(parse-authority): Support IPv6 literals.
* test-suite/tests/web-uri.test: Add and fix tests.
| -rw-r--r-- | module/web/uri.scm | 4 | ||||
| -rw-r--r-- | test-suite/tests/web-uri.test | 16 |
2 files changed, 14 insertions, 6 deletions
diff --git a/module/web/uri.scm b/module/web/uri.scm index 695442904..ba36a3828 100644 --- a/module/web/uri.scm +++ b/module/web/uri.scm @@ -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 @@ -115,7 +115,7 @@ consistency checks to make sure that the constructed URI is valid." (define userinfo-pat "[a-zA-Z0-9_.!~*'();:&=+$,-]+") (define host-pat - "[a-zA-Z0-9.-]+") + "[a-zA-Z0-9.-]+|\\[[0-9a-FA-F:.]+\\]") (define port-pat "[0-9]*") (define authority-regexp diff --git a/test-suite/tests/web-uri.test b/test-suite/tests/web-uri.test index 62ec295a3..38929fe0d 100644 --- a/test-suite/tests/web-uri.test +++ b/test-suite/tests/web-uri.test @@ -102,6 +102,10 @@ (uri=? (build-uri 'http #:host "[2001:db8::1]") #:scheme 'http #:host "[2001:db8::1]" #:path "")) + (pass-if "http://[::ffff:192.0.2.1]" + (uri=? (build-uri 'http #:host "[::ffff:192.0.2.1]") + #:scheme 'http #:host "[::ffff:192.0.2.1]" #:path "")) + (pass-if-uri-exception "http://foo:not-a-port" "Expected.*port" (build-uri 'http #:host "foo" #:port "not-a-port")) @@ -160,12 +164,16 @@ #:scheme 'http #:host "[2001:db8::1]" #:path "")) (pass-if "http://[2001:db8::1]:80" - (uri=? (string->uri "http://[2001:db8::1]") + (uri=? (string->uri "http://[2001:db8::1]:80") #:scheme 'http #:host "[2001:db8::1]" #:port 80 #:path "")) + (pass-if "http://[::ffff:192.0.2.1]" + (uri=? (string->uri "http://[::ffff:192.0.2.1]") + #:scheme 'http #:host "[::ffff:192.0.2.1]" #:path "")) + (pass-if "http://foo:" (uri=? (string->uri "http://foo:") #:scheme 'http #:host "foo" #:path "")) @@ -227,9 +235,9 @@ (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://[::ffff:192.0.2.1]" + (equal? "http://[::ffff:192.0.2.1]" + (uri->string (string->uri "http://[::ffff:192.0.2.1]")))) (pass-if "http://foo:" (equal? "http://foo" |