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.
This commit is contained in:
Ludovic Courtès 2017-10-16 22:31:50 +02:00
parent b3ac341d4e
commit 347fa4aebf
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5

View file

@ -39,6 +39,7 @@ (define-module (guix build download)
#: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 @@ (define (remove-dot-segments path)
#: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 @@ (define headers
#: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 @@ (define headers
(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 @@ (define (fetch uri file)
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)))