steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

oauth needs this, and this needed protocol-port fixes. 

Revert "Revert "urls: Allow URLs of the form //foo.com, which take on the protocol of the URL they derive from.""

This reverts commit 76fa8b7a29f3738f44230c473b7edf841f1de7c3.
db4
John Benediktsson 2014-03-12 07:43:40 -07:00
parent 0a2fef0775
commit 317b0c8d20
2 changed files with 24 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

7
basis/urls/urls-tests.factor
View File

@ -225,6 +225,13 @@ urls [
derive-url derive-url
] unit-test ] unit-test
! Support //foo.com, which has the same protocol as the url we derive from
[ URL" http://foo.com" ]
[ URL" http://google.com" URL" //foo.com" derive-url ] unit-test
[ URL" https://foo.com" ]
[ URL" https://google.com" URL" //foo.com" derive-url ] unit-test
[ "a" ] [ [ "a" ] [
<url> "a" "b" set-query-param "b" query-param <url> "a" "b" set-query-param "b" query-param
] unit-test ] unit-test

21
basis/urls/urls.factor
View File

@ -57,7 +57,8 @@ hostname-spec = hostname ("/"|!(.)) => [[ first ]]
auth = (username (":" password => [[ second ]])? "@" auth = (username (":" password => [[ second ]])? "@"
=> [[ first2 2array ]])? => [[ first2 2array ]])?
url = ((protocol "://") => [[ first ]] auth hostname)? url = (((protocol "://") => [[ first ]] auth hostname)
| (("//") => [[ f ]] auth hostname))?
(pathname)? (pathname)?
("?" query => [[ second ]])? ("?" query => [[ second ]])?
("#" anchor => [[ second ]])? ("#" anchor => [[ second ]])?
@ -106,9 +107,7 @@ M: pathname >url string>> >url ;
[ port>> ] [ port>> ] [ protocol>> protocol-port ] tri = [ port>> ] [ port>> ] [ protocol>> protocol-port ] tri =
[ drop f ] when ; [ drop f ] when ;
: unparse-host-part ( url protocol -- ) : unparse-host-part ( url -- )
%
"://" %
{ {
[ unparse-username-password ] [ unparse-username-password ]
[ host>> url-encode % ] [ host>> url-encode % ]
@ -116,10 +115,22 @@ M: pathname >url string>> >url ;
[ path>> "/" head? [ "/" % ] unless ] [ path>> "/" head? [ "/" % ] unless ]
} cleave ; } cleave ;
! 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* ;
M: url present M: url present
[ [
{ {
[ dup protocol>> dup [ unparse-host-part ] [ 2drop ] if ] [ unparse-protocol ]
[ path>> url-encode % ] [ path>> url-encode % ]
[ query>> dup assoc-empty? [ drop ] [ "?" % assoc>query % ] if ] [ query>> dup assoc-empty? [ drop ] [ "?" % assoc>query % ] if ]
[ anchor>> [ "#" % present url-encode % ] when* ] [ anchor>> [ "#" % present url-encode % ] when* ]