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:
Ludovic Courtès 2015-02-27 14:57:54 +01:00
parent 2c1fb35377
commit e7620dc995
1 changed files with 8 additions and 4 deletions

View File

@ -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))