download: Abstract the receive buffer size.
* guix/build/download.scm (%http-receive-buffer-size): New variable. (progress-proc, tls-wrap, http-fetch): Use it.
This commit is contained in:
parent
2c1fb35377
commit
e7620dc995
@ -1,5 +1,5 @@
|
|||||||
;;; GNU Guix --- Functional package management for GNU
|
;;; GNU Guix --- Functional package management for GNU
|
||||||
;;; Copyright © 2012, 2013, 2014 Ludovic Courtès <ludo@gnu.org>
|
;;; Copyright © 2012, 2013, 2014, 2015 Ludovic Courtès <ludo@gnu.org>
|
||||||
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
|
;;; Copyright © 2015 Mark H Weaver <mhw@netris.org>
|
||||||
;;;
|
;;;
|
||||||
;;; This file is part of GNU Guix.
|
;;; This file is part of GNU Guix.
|
||||||
@ -42,6 +42,10 @@
|
|||||||
;;;
|
;;;
|
||||||
;;; Code:
|
;;; Code:
|
||||||
|
|
||||||
|
(define %http-receive-buffer-size
|
||||||
|
;; Size of the HTTP receive buffer.
|
||||||
|
65536)
|
||||||
|
|
||||||
(define* (progress-proc file size #:optional (log-port (current-output-port)))
|
(define* (progress-proc file size #:optional (log-port (current-output-port)))
|
||||||
"Return a procedure to show the progress of FILE's download, which is
|
"Return a procedure to show the progress of FILE's download, which is
|
||||||
SIZE byte long. The returned procedure is suitable for use as an
|
SIZE byte long. The returned procedure is suitable for use as an
|
||||||
@ -92,7 +96,7 @@ abbreviation of URI showing the scheme, host, and basename of the file."
|
|||||||
(call-with-output-file file
|
(call-with-output-file file
|
||||||
(lambda (out)
|
(lambda (out)
|
||||||
(dump-port in out
|
(dump-port in out
|
||||||
#:buffer-size 65536 ; don't flood the log
|
#:buffer-size %http-receive-buffer-size
|
||||||
#:progress (progress-proc (uri-abbreviation uri) size))))
|
#:progress (progress-proc (uri-abbreviation uri) size))))
|
||||||
|
|
||||||
(ftp-close conn))
|
(ftp-close conn))
|
||||||
@ -182,7 +186,7 @@ which is not available during bootstrap."
|
|||||||
(connect s (addrinfo:addr ai))
|
(connect s (addrinfo:addr ai))
|
||||||
|
|
||||||
;; Buffer input and output on this port.
|
;; Buffer input and output on this port.
|
||||||
(setvbuf s _IOFBF)
|
(setvbuf s _IOFBF %http-receive-buffer-size)
|
||||||
|
|
||||||
(if (eq? 'https (uri-scheme uri))
|
(if (eq? 'https (uri-scheme uri))
|
||||||
(tls-wrap s (uri-host uri))
|
(tls-wrap s (uri-host uri))
|
||||||
@ -334,7 +338,7 @@ Return the resulting target URI."
|
|||||||
(if (port? bv-or-port)
|
(if (port? bv-or-port)
|
||||||
(begin
|
(begin
|
||||||
(dump-port bv-or-port p
|
(dump-port bv-or-port p
|
||||||
#:buffer-size 65536 ; don't flood the log
|
#:buffer-size %http-receive-buffer-size
|
||||||
#:progress (progress-proc (uri-abbreviation uri)
|
#:progress (progress-proc (uri-abbreviation uri)
|
||||||
size))
|
size))
|
||||||
(newline))
|
(newline))
|
||||||
|
Loading…
Reference in New Issue
Block a user