mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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:
parent
b3ac341d4e
commit
347fa4aebf
1 changed files with 22 additions and 22 deletions
|
@ -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?
|
||||
(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)))
|
||||
|
|
Loading…
Reference in a new issue