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

better support for http-get redirects

db4
Doug Coleman 2008-01-14 15:49:13 -10:00
parent 6a4062bf38
commit ba68a3732d
1 changed files with 10 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -9,11 +9,14 @@ IN: http.client
#! Extract the host name and port number from an HTTP URL. #! Extract the host name and port number from an HTTP URL.
":" split1 [ string>number ] [ 80 ] if* ; ":" split1 [ string>number ] [ 80 ] if* ;
SYMBOL: domain
: parse-url ( url -- host resource ) : parse-url ( url -- host resource )
"http://" ?head [ dup "https://" head? [
"URL must begin with http://" throw "ssl not yet supported: " swap append throw
] unless ] when "http://" ?head drop
"/" split1 [ "/" swap append ] [ "/" ] if* ; "/" split1 [ "/" swap append ] [ "/" ] if*
>r dup empty? [ drop domain get ] [ dup domain set ] if r> ;
: parse-response ( line -- code ) : parse-response ( line -- code )
"HTTP/" ?head [ " " split1 nip ] when "HTTP/" ?head [ " " split1 nip ] when
@ -52,7 +55,9 @@ DEFER: http-get-stream
: http-get ( url -- code headers string ) : http-get ( url -- code headers string )
#! Opens a stream for reading from an HTTP URL. #! Opens a stream for reading from an HTTP URL.
http-get-stream [ stdio get contents ] with-stream ; [
http-get-stream [ stdio get contents ] with-stream
] with-scope ;
: download ( url file -- ) : download ( url file -- )
#! Downloads the contents of a URL to a file. #! Downloads the contents of a URL to a file.