summaryrefslogtreecommitdiff
path: root/guix/build/download.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2017-10-16 22:31:50 +0200
committerLudovic Courtès <ludo@gnu.org>2017-10-19 23:21:49 +0200
commit347fa4aebf0bd5609761b4515578b7040f0b7d3c (patch)
tree69c938d976ed94c2f9d4808612e5e23a09d73b7e /guix/build/download.scm
parentb3ac341d4e681125c0c8b0776dfb269ddd3405f3 (diff)
download: Make 'http-fetch' public.
* guix/build/download.scm (http-fetch): Remove 'file' parameter. Change to return an input port and the content-length. Make public. (url-fetch): Adjust accordingly.
Diffstat (limited to 'guix/build/download.scm')
-rw-r--r--guix/build/download.scm44
1 files changed, 22 insertions, 22 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm
index e227ae598b..3b89f9412f 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -39,6 +39,7 @@
#:use-module (ice-9 format)
#:export (open-socket-for-uri
open-connection-for-uri
+ http-fetch
%x509-certificate-directory
close-connection
resolve-uri-reference
@@ -745,11 +746,11 @@ Return the resulting target URI."
#:query (uri-query ref)
#:fragment (uri-fragment ref)))))
-(define* (http-fetch uri file #:key timeout (verify-certificate? #t))
- "Fetch data from URI and write it to FILE; when TIMEOUT is true, bail out if
-the connection could not be established in less than TIMEOUT seconds. Return
-FILE on success. When VERIFY-CERTIFICATE? is true, verify HTTPS
-certificates; otherwise simply ignore them."
+(define* (http-fetch uri #:key timeout (verify-certificate? #t))
+ "Return an input port containing the data at URI, and the expected number of
+bytes available or #f. When TIMEOUT is true, bail out if the connection could
+not be established in less than TIMEOUT seconds. When VERIFY-CERTIFICATE? is
+true, verify HTTPS certificates; otherwise simply ignore them."
(define headers
`(;; Some web sites, such as http://dist.schmorp.de, would block you if
@@ -779,20 +780,10 @@ certificates; otherwise simply ignore them."
#:streaming? #t
#:headers headers))
((code)
- (response-code resp))
- ((size)
- (response-content-length resp)))
+ (response-code resp)))
(case code
((200) ; OK
- (begin
- (call-with-output-file file
- (lambda (p)
- (dump-port* port p
- #:buffer-size %http-receive-buffer-size
- #:reporter (progress-reporter/file
- (uri-abbreviation uri) size))
- (newline)))
- file))
+ (values port (response-content-length resp)))
((301 ; moved permanently
302 ; found (redirection)
303 ; see other
@@ -802,7 +793,7 @@ certificates; otherwise simply ignore them."
(format #t "following redirection to `~a'...~%"
(uri->string uri))
(close connection)
- (http-fetch uri file
+ (http-fetch uri
#:timeout timeout
#:verify-certificate? verify-certificate?)))
(else
@@ -873,10 +864,19 @@ otherwise simply ignore them."
file (uri->string uri))
(case (uri-scheme uri)
((http https)
- (false-if-exception* (http-fetch uri file
- #:verify-certificate?
- verify-certificate?
- #:timeout timeout)))
+ (false-if-exception*
+ (let-values (((port size)
+ (http-fetch uri
+ #:verify-certificate? verify-certificate?
+ #:timeout timeout)))
+ (call-with-output-file file
+ (lambda (output)
+ (dump-port* port output
+ #:buffer-size %http-receive-buffer-size
+ #:reporter (progress-reporter/file
+ (uri-abbreviation uri) size))
+ (newline)))
+ #t)))
((ftp)
(false-if-exception* (ftp-fetch uri file
#:timeout timeout)))