diff --git a/basis/urls/urls-tests.factor b/basis/urls/urls-tests.factor index fb14e1ecba3..0447be47e65 100644 --- a/basis/urls/urls-tests.factor +++ b/basis/urls/urls-tests.factor @@ -115,6 +115,33 @@ CONSTANT: urls { } "t1000://www.google.com/" } + { + T{ url + { protocol "no-auth" } + { path "/some/random/path" } + } + "no-auth:/some/random/path" + } + { + T{ url + { protocol "http" } + { host "example.org" } + { path "/" } + { username "user" } + { password "" } + } + "http://user:@example.org/" + } + { + T{ url + { protocol "http" } + { host "example.org" } + { path "/" } + { username "" } + { password "pass" } + } + "http://:pass@example.org/" + } } urls [ @@ -125,6 +152,20 @@ urls [ swap [ 1array ] [ [ present ] curry ] bi* unit-test ] assoc-each +{ T{ url + { protocol "https" } + { host "www.google.com" } + { path "/" } + } } +[ "https://www.google.com:/" >url ] unit-test + +{ "https://www.google.com/" } +[ T{ url + { protocol "https" } + { host "www.google.com" } + { path "/" } +} present ] unit-test + { "b" } [ "a" "b" url-append-path ] unit-test { "a/b" } [ "a/c" "b" url-append-path ] unit-test diff --git a/basis/urls/urls.factor b/basis/urls/urls.factor index 7439b5d3595..0a1deade940 100644 --- a/basis/urls/urls.factor +++ b/basis/urls/urls.factor @@ -5,7 +5,7 @@ USING: accessors arrays ascii assocs combinators fry io.pathnames io.sockets io.sockets.secure kernel lexer linked-assocs make math.parser multiline namespaces peg.ebnf present sequences splitting strings strings.parser urls.encoding -vocabs.loader ; +vocabs.loader math math.order ; IN: urls @@ -30,7 +30,10 @@ ERROR: malformed-port ; : parse-host ( string -- host/f port/f ) [ ":" split1-last [ url-decode ] - [ dup [ string>number [ malformed-port ] unless* ] when ] bi* + [ [ f ] + [ string>number [ malformed-port ] unless* ] + if-empty + ] bi* ] [ f f ] if* ; GENERIC: >url ( obj -- url ) @@ -44,8 +47,8 @@ M: url >url ; EBNF: parse-url [=[ protocol = [a-zA-Z0-9.+-]+ => [[ url-decode ]] -username = [^/:@#?]+ => [[ url-decode ]] -password = [^/:@#?]+ => [[ url-decode ]] +username = [^/:@#?]* => [[ url-decode ]] +password = [^/:@#?]* => [[ url-decode ]] pathname = [^#?]+ => [[ url-decode ]] query = [^#]+ => [[ query>assoc ]] anchor = .+ => [[ url-decode ]] @@ -58,7 +61,8 @@ auth = (username (":" password => [[ second ]])? "@" => [[ first2 2array ]])? url = (((protocol "://") => [[ first ]] auth hostname) - | (("//") => [[ f ]] auth hostname))? + | (("//") => [[ f ]] auth hostname) + | ((protocol ":") => [[ first V{ f f } V{ } 2sequence ]]))? (pathname)? ("?" query => [[ second ]])? ("#" anchor => [[ second ]])? @@ -117,20 +121,16 @@ M: pathname >url string>> >url ; ! URL" //foo.com" takes on the protocol of the url it's derived from : unparse-protocol ( url -- ) - dup protocol>> [ - % "://" % unparse-host-part - ] [ - dup host>> [ - "//" % unparse-host-part - ] [ - drop - ] if - ] if* ; + protocol>> [ % ":" % ] when* ; + +: unparse-authority ( url -- ) + dup host>> [ "//" % unparse-host-part ] [ drop ] if ; M: url present [ { [ unparse-protocol ] + [ unparse-authority ] [ path>> url-encode % ] [ query>> dup assoc-empty? [ drop ] [ "?" % assoc>query % ] if ] [ anchor>> [ "#" % present url-encode % ] when* ]