urls: fix for paths that contain slashes.

diff --git a/basis/urls/urls-tests.factor b/basis/urls/urls-tests.factor
index 917283d800de7bb739c02639fc0b9ce3ff783526..d6d73ec4599cd7a80d0d5457f811f4d6a922dde4 100644 (file)
--- a/basis/urls/urls-tests.factor
+++ b/basis/urls/urls-tests.factor
@@ -145,6 +145,14 @@ CONSTANT: urls {
         }
         "http://:pass@example.org/"
     }
+    {
+        T{ url
+            { protocol "http" }
+            { host "example.org" }
+            { path "/%2F/" }
+        }
+        "http://example.org/%2F/"
+    }
 }
 
 urls [

diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor
index 2985521d749fa5b3b10b8c474fab57ccdf82a783..706cb2254444722971bba40160986a1b7f4cb717 100644 (file)
--- a/basis/urls/urls.factor
+++ b/basis/urls/urls.factor
@@ -44,12 +44,15 @@ M: url >url ;
 
 <PRIVATE
 
+: parse-path ( string -- path )
+    "/" split [ url-decode "/" "%2F" replace ] map "/" join ;
+
 EBNF: parse-url [=[
 
 protocol = [a-zA-Z0-9.+-]+ => [[ url-decode ]]
 username = [^/:@#?]*       => [[ url-decode ]]
 password = [^/:@#?]*       => [[ url-decode ]]
-path     = [^#?]+          => [[ url-decode ]]
+path     = [^#?]+          => [[ parse-path ]]
 query    = [^#]+           => [[ query>assoc ]]
 anchor   = .+              => [[ url-decode ]]
 hostname = [^/#?:]+        => [[ url-decode ]]
@@ -127,12 +130,17 @@ M: pathname >url string>> >url ;
 : unparse-authority ( url -- )
     dup host>> [ "//" % unparse-host-part ] [ drop ] if ;
 
+: unparse-path ( url -- )
+    path>> "/" split [
+        "%2F" "/" replace url-encode "/" "%2F" replace
+    ] map "/" join % ;
+
 M: url present
     [
         {
             [ unparse-protocol ]
             [ unparse-authority ]
-            [ path>> url-encode % ]
+            [ unparse-path ]
             [ query>> dup assoc-empty? [ drop ] [ "?" % assoc>query % ] if ]
             [ anchor>> [ "#" % present url-encode % ] when* ]
         } cleave