urls: support IPV6 urls.

diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor
index 37f8c1e597b2c02f636ab3b7bbde6004c2b40eb2..b5fae6782448bc72836e3b067fcbfa4fce198a8a 100644 (file)
--- a/basis/urls/urls.factor
+++ b/basis/urls/urls.factor
@@ -1,8 +1,9 @@
 ! Copyright (C) 2008, 2011 Slava Pestov.
 ! See http://factorcode.org/license.txt for BSD license.
 
-USING: accessors ascii assocs combinators fry io.pathnames
-io.sockets io.sockets.secure kernel lexer linked-assocs make
+USING: accessors ascii assocs combinators
+combinators.short-circuit fry io.pathnames io.sockets
+io.sockets.secure kernel lexer linked-assocs make math
 math.parser multiline namespaces peg.ebnf present sequences
 sequences.generalizations splitting strings strings.parser
 urls.encoding vocabs.loader ;
@@ -25,10 +26,10 @@ TUPLE: url protocol username password host port path query anchor ;
 : set-query-params ( url params -- url )
     [ swap set-query-param ] assoc-each ;
 
-ERROR: malformed-port ;
+ERROR: malformed-port string ;
 
 : parse-port ( string -- port/f )
-    [ f ] [ string>number [ malformed-port ] unless* ] if-empty ;
+    [ f ] [ dup string>number [ ] [ malformed-port ] ?if ] if-empty ;
 
 : parse-host ( string -- host/f port/f )
     [
@@ -52,10 +53,11 @@ path     = [^#?]+          => [[ url-decode ]]
 query    = [^#]+           => [[ query>assoc ]]
 anchor   = .+              => [[ url-decode ]]
 hostname = [^/#?:]+        => [[ url-decode ]]
+ipv6     = "[" [^\]]+ "]"  => [[ concat url-decode ]]
 port     = [^/#?]+         => [[ url-decode parse-port ]]
 
 auth     = username (":"~ password?)? "@"~
-host     = hostname (":"~ port?)?
+host     = (ipv6 | hostname) (":"~ port?)?
 
 url      = (protocol ":"~)?
            ("//"~ auth? host?)?
@@ -102,10 +104,18 @@ M: pathname >url string>> >url ;
     [ port>> ] [ protocol>> protocol-port ] bi over =
     [ drop f ] when ;
 
+: ipv6-host ( host -- host/ipv6 ipv6? )
+    dup { [ "[" head? ] [ "]" tail? ] } 1&& [
+        1 swap [ length 1 - ] [ subseq ] bi t
+    ] [ f ] if ;
+
+: unparse-host ( url -- host )
+    host>> ipv6-host [ url-encode ] [ [ "[" "]" surround ] when ] bi* ;
+
 : unparse-host-part ( url -- )
     {
         [ unparse-username-password ]
-        [ host>> url-encode % ]
+        [ unparse-host % ]
         [ url-port [ ":" % # ] when* ]
         [ path>> "/" head? [ "/" % ] unless ]
     } cleave ;
@@ -170,13 +180,13 @@ PRIVATE>
 
 : url-addr ( url -- addr )
     [
-        [ host>> ]
+        [ host>> ipv6-host drop ]
         [ port>> ]
         [ protocol>> protocol-port ]
         tri or <inet>
     ] [
         dup protocol>> secure-protocol?
-        [ host>> <secure> ] [ drop ] if
+        [ host>> ipv6-host drop <secure> ] [ drop ] if
     ] bi ;
 
 : set-url-addr ( url addr -- url )