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

http.client, proxy defaults to http protocol like for the target

locals-and-roots
Jon Harper 2016-03-31 13:15:39 +02:00 committed by John Benediktsson
parent ed33bc7862
commit 617a725ba5
2 changed files with 28 additions and 12 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

16
basis/http/client/client-tests.factor
View File

@ -191,6 +191,22 @@ CONSTANT: classic-proxy-settings H{
] with-variables ] with-variables
] unit-test ] unit-test
{ URL" http://localhost:3128" } [
{ { "http.proxy" "localhost:3128" } } [
"google.com" "GET" <client-request> ?default-proxy proxy-url>>
] with-variables
] unit-test
{ URL" http://localhost:3128" } [
"google.com" "GET" <client-request>
URL" localhost:3128" >>proxy-url ?default-proxy proxy-url>>
] unit-test
{ URL" http://localhost:3128" } [
"google.com" "GET" <client-request>
"localhost:3128" >>proxy-url ?default-proxy proxy-url>>
] unit-test
{ URL" http://proxysec.private:3128" } [ { URL" http://proxysec.private:3128" } [
classic-proxy-settings [ classic-proxy-settings [
"https://google.com" "GET" <client-request> ?default-proxy proxy-url>> "https://google.com" "GET" <client-request> ?default-proxy proxy-url>>

24
basis/http/client/client.factor
View File

@ -204,10 +204,20 @@ SYMBOL: redirects
[ "HTTP_PROXY" os-env ] unless* [ "HTTP_PROXY" os-env ] unless*
] if ; ] if ;
: misparsed-url? ( url -- url' )
[ protocol>> not ] [ host>> not ] [ path>> ]
tri and and ;
: request-url ( url -- url' )
dup >url dup misparsed-url? [
drop dup url? [ present ] when
"http://" prepend >url
] [ nip ] if ensure-port ;
: ?default-proxy ( request -- request' ) : ?default-proxy ( request -- request' )
dup get-default-proxy dup get-default-proxy
over proxy-url>> 2dup and [ over proxy-url>> dup [ request-url ] when 2dup and [
pick no-proxy? [ nip ] [ [ >url ] dip derive-url ] if pick no-proxy? [ nip ] [ [ request-url ] dip derive-url ] if
] [ nip ] if check-proxy ; ] [ nip ] if check-proxy ;
: (with-http-request) ( request quot: ( chunk -- ) -- response ) : (with-http-request) ( request quot: ( chunk -- ) -- response )
@ -237,16 +247,6 @@ SYMBOL: redirects
[ do-redirect ] [ nip ] if [ do-redirect ] [ nip ] if
] with-variable ; inline recursive ] with-variable ; inline recursive
: misparsed-url? ( url -- url' )
[ protocol>> not ] [ host>> not ] [ path>> ]
tri and and ;
: request-url ( url -- url' )
dup >url dup misparsed-url? [
drop dup url? [ present ] when
"http://" prepend >url
] [ nip ] if ensure-port ;
: <client-request> ( url method -- request ) : <client-request> ( url method -- request )
<request> <request>
swap >>method swap >>method