me
/
guix
Archived
1
0
Fork 0
Code

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.
master
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
1 changed files with 22 additions and 22 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

42
guix/build/download.scm
View File

@ -39,6 +39,7 @@
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:export (open-socket-for-uri #:export (open-socket-for-uri
open-connection-for-uri open-connection-for-uri
http-fetch
%x509-certificate-directory %x509-certificate-directory
close-connection close-connection
resolve-uri-reference resolve-uri-reference
@ -745,11 +746,11 @@ Return the resulting target URI."
#:query (uri-query ref) #:query (uri-query ref)
#:fragment (uri-fragment ref))))) #:fragment (uri-fragment ref)))))
(define* (http-fetch uri file #:key timeout (verify-certificate? #t)) (define* (http-fetch uri #:key timeout (verify-certificate? #t))
"Fetch data from URI and write it to FILE; when TIMEOUT is true, bail out if "Return an input port containing the data at URI, and the expected number of
the connection could not be established in less than TIMEOUT seconds. Return bytes available or #f. When TIMEOUT is true, bail out if the connection could
FILE on success. When VERIFY-CERTIFICATE? is true, verify HTTPS not be established in less than TIMEOUT seconds. When VERIFY-CERTIFICATE? is
certificates; otherwise simply ignore them." true, verify HTTPS certificates; otherwise simply ignore them."
(define headers (define headers
`(;; Some web sites, such as http://dist.schmorp.de, would block you if `(;; Some web sites, such as http://dist.schmorp.de, would block you if
@ -779,20 +780,10 @@ certificates; otherwise simply ignore them."
#:streaming? #t #:streaming? #t
#:headers headers)) #:headers headers))
((code) ((code)
(response-code resp)) (response-code resp)))
((size)
(response-content-length resp)))
(case code (case code
((200) ; OK ((200) ; OK
(begin (values port (response-content-length resp)))
(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))
((301 ; moved permanently ((301 ; moved permanently
302 ; found (redirection) 302 ; found (redirection)
303 ; see other 303 ; see other
@ -802,7 +793,7 @@ certificates; otherwise simply ignore them."
(format #t "following redirection to `~a'...~%" (format #t "following redirection to `~a'...~%"
(uri->string uri)) (uri->string uri))
(close connection) (close connection)
(http-fetch uri file (http-fetch uri
#:timeout timeout #:timeout timeout
#:verify-certificate? verify-certificate?))) #:verify-certificate? verify-certificate?)))
(else (else
@ -873,10 +864,19 @@ otherwise simply ignore them."
file (uri->string uri)) file (uri->string uri))
(case (uri-scheme uri) (case (uri-scheme uri)
((http https) ((http https)
(false-if-exception* (http-fetch uri file (false-if-exception*
#:verify-certificate? (let-values (((port size)
verify-certificate? (http-fetch uri
#:verify-certificate? verify-certificate?
#:timeout timeout))) #: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) ((ftp)
(false-if-exception* (ftp-fetch uri file (false-if-exception* (ftp-fetch uri file
#:timeout timeout))) #:timeout timeout)))