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

https:// is absolute

db4
Slava Pestov 2008-04-23 01:42:30 -05:00
parent a66b74764e
commit 3a69c97298
1 changed files with 10 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
extra/http/client/client.factor
View File

@ -39,13 +39,16 @@ DEFER: http-request
SYMBOL: redirects SYMBOL: redirects
: absolute-url? ( url -- ? )
[ "http://" head? ] [ "https://" head? ] bi or ;
: do-redirect ( response -- response stream ) : do-redirect ( response -- response stream )
dup response-code 300 399 between? [ dup response-code 300 399 between? [
stdio get dispose stdio get dispose
redirects inc redirects inc
redirects get max-redirects < [ redirects get max-redirects < [
header>> "location" swap at header>> "location" swap at
dup "http://" head? [ dup absolute-url? [
absolute-redirect absolute-redirect
] [ ] [
relative-redirect relative-redirect
@ -116,8 +119,12 @@ M: download-failed error.
: download-to ( url file -- ) : download-to ( url file -- )
#! Downloads the contents of a URL to a file. #! Downloads the contents of a URL to a file.
swap http-get-stream swap check-response swap http-get-stream check-response
[ swap latin1 <file-writer> stream-copy ] with-disposal ; dup string? [
latin1 [ write ] with-file-writer
] [
[ swap latin1 <file-writer> stream-copy ] with-disposal
] if ;
: download ( url -- ) : download ( url -- )
dup download-name download-to ; dup download-name download-to ;