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
;;; 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>
;;;
;;; This file is part of GNU Guix.
@ -42,6 +42,10 @@ (define-module (guix build download)
;;;
;;; Code:
(define %http-receive-buffer-size
;; Size of the HTTP receive buffer.
65536)
(define* (progress-proc file size #:optional (log-port (current-output-port)))
"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
@ -92,7 +96,7 @@ (define (ftp-fetch uri file)
(call-with-output-file file
(lambda (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))))
(ftp-close conn))
@ -182,7 +186,7 @@ (define addresses
(connect s (addrinfo:addr ai))
;; Buffer input and output on this port.
(setvbuf s _IOFBF)
(setvbuf s _IOFBF %http-receive-buffer-size)
(if (eq? 'https (uri-scheme uri))
(tls-wrap s (uri-host uri))
@ -334,7 +338,7 @@ (define headers
(if (port? bv-or-port)
(begin
(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)
size))
(newline))