ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-26 14:28:15 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

download: Abstract the receive buffer size.

Browse source 
* 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
Show stats Download patch file Download diff file Expand all files Collapse all files

12
guix/build/download.scm
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 @@ (define-module (guix build download)
;;; ;;;
;;; 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 @@ (define (ftp-fetch uri 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 @@ (define addresses
(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 @@ (define headers
(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))