mirror/guile
mirror/guile
1
Fork 0
mirror of https://git.savannah.gnu.org/git/guile.git synced 2025-07-08 02:20:26 +02:00
Code Activity

enhance IPv6 support

Browse source 
* 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.
This commit is contained in:
Daniel Hartwig 2011-12-31 00:16:42 +08:00 • committed by Andy Wingo
parent 274e2eecf1
commit 81e7210f14
2 changed files with 14 additions and 6 deletions
Download patch file Download diff file Expand all files Collapse all files

4
module/web/uri.scm
View file

@ -91,7 +91,7 @@ consistency checks to make sure that the constructed URI is valid."
(define ipv4-regexp (define ipv4-regexp
(make-regexp "^([0-9.]+)$")) (make-regexp "^([0-9.]+)$"))
(define ipv6-regexp (define ipv6-regexp
(make-regexp "^\\[([0-9a-fA-F:]+)\\]$")) (make-regexp "^\\[([0-9a-fA-F:.]+)\\]$"))
(define domain-label-regexp (define domain-label-regexp
(make-regexp "^[a-zA-Z0-9]([a-zA-Z0-9-]*[a-zA-Z0-9])?$")) (make-regexp "^[a-zA-Z0-9]([a-zA-Z0-9-]*[a-zA-Z0-9])?$"))
(define top-label-regexp (define top-label-regexp
@ -115,7 +115,7 @@ consistency checks to make sure that the constructed URI is valid."
(define userinfo-pat (define userinfo-pat
"[a-zA-Z0-9_.!~*'();:&=+$,-]+") "[a-zA-Z0-9_.!~*'();:&=+$,-]+")
(define host-pat (define host-pat
"[a-zA-Z0-9.-]+") "[a-zA-Z0-9.-]+|\\[[0-9a-FA-F:.]+\\]")
(define port-pat (define port-pat
"[0-9]*") "[0-9]*")
(define authority-regexp (define authority-regexp

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

@ -102,6 +102,10 @@
(uri=? (build-uri 'http #:host "[2001:db8::1]") (uri=? (build-uri 'http #:host "[2001:db8::1]")
#:scheme 'http #:host "[2001:db8::1]" #:path "")) #: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" (pass-if-uri-exception "http://foo:not-a-port"
"Expected.*port" "Expected.*port"
(build-uri 'http #:host "foo" #:port "not-a-port")) (build-uri 'http #:host "foo" #:port "not-a-port"))
@ -160,12 +164,16 @@
#:scheme 'http #:host "[2001:db8::1]" #:path "")) #:scheme 'http #:host "[2001:db8::1]" #:path ""))
(pass-if "http://[2001:db8::1]:80" (pass-if "http://[2001:db8::1]:80"
(uri=? (string->uri "http://[2001:db8::1]") (uri=? (string->uri "http://[2001:db8::1]:80")
#:scheme 'http #:scheme 'http
#:host "[2001:db8::1]" #:host "[2001:db8::1]"
#:port 80 #:port 80
#:path "")) #: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:" (pass-if "http://foo:"
(uri=? (string->uri "http://foo:") (uri=? (string->uri "http://foo:")
#:scheme 'http #:host "foo" #:path "")) #:scheme 'http #:host "foo" #:path ""))
@ -227,9 +235,9 @@
(equal? "http://[2001:db8::1]" (equal? "http://[2001:db8::1]"
(uri->string (string->uri "http://[2001:db8::1]")))) (uri->string (string->uri "http://[2001:db8::1]"))))
(pass-if "http://[2001:db8::1]:80" (pass-if "http://[::ffff:192.0.2.1]"
(equal? "http://[2001:db8::1]:80" (equal? "http://[::ffff:192.0.2.1]"
(uri->string (string->uri "http://[2001:db8::1]:80")))) (uri->string (string->uri "http://[::ffff:192.0.2.1]"))))
(pass-if "http://foo:" (pass-if "http://foo:"
(equal? "http://foo" (equal? "http://foo"