ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2025-01-26 20:49:29 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

download: Make 'http-fetch' public.

Browse source 
* 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
1 changed files with 22 additions and 22 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
guix/build/download.scm
View file

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