download: Work around Guile small-receive-buffer bug.

Previously, code using directly (guix build download) was still affected
by <http://bugs.gnu.org/15368>.  This includes source derivations, the
'guix download' command, and (guix gnu-maintenance).

'guix substitute' was unaffected since it used (guix http-client), which
already had the fix.

* guix/http-client.scm (open-socket-for-uri): Remove.
  (http-fetch): Remove #:buffered? argument to 'open-socket-for-uri';
  use 'setvbuf' instead.
* guix/scripts/substitute.scm (fetch): Likewise.
* guix/build/download.scm (open-socket-for-uri): New procedure, taken
  from guix/http-client.scm, but without the #:buffered? parameter.
master
Ludovic Courtès 2015-05-06 10:31:11 +02:00
parent c822fb8e34
commit 7623848343
3 changed files with 33 additions and 30 deletions

View File

@ -19,7 +19,7 @@
(define-module (guix build download) (define-module (guix build download)
#:use-module (web uri) #:use-module (web uri)
#:use-module (web client) #:use-module ((web client) #:hide (open-socket-for-uri))
#:use-module (web response) #:use-module (web response)
#:use-module (guix ftp-client) #:use-module (guix ftp-client)
#:use-module (guix build utils) #:use-module (guix build utils)
@ -30,7 +30,8 @@
#:use-module (srfi srfi-26) #:use-module (srfi srfi-26)
#:use-module (ice-9 match) #:use-module (ice-9 match)
#:use-module (ice-9 format) #:use-module (ice-9 format)
#:export (open-connection-for-uri #:export (open-socket-for-uri
open-connection-for-uri
resolve-uri-reference resolve-uri-reference
maybe-expand-mirrors maybe-expand-mirrors
url-fetch url-fetch
@ -195,6 +196,25 @@ host name without trailing dot."
(add-weak-reference record port) (add-weak-reference record port)
record))) record)))
(define (open-socket-for-uri uri)
"Return an open port for URI. This variant works around
<http://bugs.gnu.org/15368> which affects Guile's 'open-socket-for-uri' up to
2.0.11 included."
(define rmem-max
;; The maximum size for a receive buffer on Linux, see socket(7).
"/proc/sys/net/core/rmem_max")
(define buffer-size
(if (file-exists? rmem-max)
(call-with-input-file rmem-max read)
126976)) ;the default for Linux, per 'rmem_default'
(let ((s ((@ (web client) open-socket-for-uri) uri)))
;; Work around <http://bugs.gnu.org/15368> by restoring a decent
;; buffer size.
(setsockopt s SOL_SOCKET SO_RCVBUF buffer-size)
s))
(define (open-connection-for-uri uri) (define (open-connection-for-uri uri)
"Like 'open-socket-for-uri', but also handle HTTPS connections." "Like 'open-socket-for-uri', but also handle HTTPS connections."
(define https? (define https?

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>
;;; Copyright © 2012, 2015 Free Software Foundation, Inc. ;;; Copyright © 2012, 2015 Free Software Foundation, Inc.
;;; ;;;
@ -21,7 +21,7 @@
(define-module (guix http-client) (define-module (guix http-client)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module (web uri) #:use-module (web uri)
#:use-module (web client) #:use-module ((web client) #:hide (open-socket-for-uri))
#:use-module (web response) #:use-module (web response)
#:use-module (srfi srfi-11) #:use-module (srfi srfi-11)
#:use-module (srfi srfi-34) #:use-module (srfi srfi-34)
@ -30,14 +30,15 @@
#:use-module (rnrs bytevectors) #:use-module (rnrs bytevectors)
#:use-module (guix ui) #:use-module (guix ui)
#:use-module (guix utils) #:use-module (guix utils)
#:use-module ((guix build download) #:select (resolve-uri-reference)) #:use-module ((guix build download)
#:select (open-socket-for-uri resolve-uri-reference))
#:re-export (open-socket-for-uri)
#:export (&http-get-error #:export (&http-get-error
http-get-error? http-get-error?
http-get-error-uri http-get-error-uri
http-get-error-code http-get-error-code
http-get-error-reason http-get-error-reason
open-socket-for-uri
http-fetch)) http-fetch))
;;; Commentary: ;;; Commentary:
@ -207,26 +208,6 @@ closes PORT, unless KEEP-ALIVE? is true."
(module-define! (resolve-module '(web client)) (module-define! (resolve-module '(web client))
'shutdown (const #f)) 'shutdown (const #f))
(define* (open-socket-for-uri uri #:key (buffered? #t))
"Return an open port for URI. When BUFFERED? is false, the returned port is
unbuffered."
(define rmem-max
;; The maximum size for a receive buffer on Linux, see socket(7).
"/proc/sys/net/core/rmem_max")
(define buffer-size
(if (file-exists? rmem-max)
(call-with-input-file rmem-max read)
126976)) ; the default for Linux, per 'rmem_default'
(let ((s ((@ (web client) open-socket-for-uri) uri)))
;; Work around <http://bugs.gnu.org/15368> by restoring a decent
;; buffer size.
(setsockopt s SOL_SOCKET SO_RCVBUF buffer-size)
(unless buffered?
(setvbuf s _IONBF))
s))
(define* (http-fetch uri #:key port (text? #f) (buffered? #t)) (define* (http-fetch uri #:key port (text? #f) (buffered? #t))
"Return an input port containing the data at URI, and the expected number of "Return an input port containing the data at URI, and the expected number of
bytes available or #f. If TEXT? is true, the data at URI is considered to be bytes available or #f. If TEXT? is true, the data at URI is considered to be
@ -235,9 +216,9 @@ unbuffered port, suitable for use in `filtered-port'.
Raise an '&http-get-error' condition if downloading fails." Raise an '&http-get-error' condition if downloading fails."
(let loop ((uri uri)) (let loop ((uri uri))
(let ((port (or port (let ((port (or port (open-socket-for-uri uri))))
(open-socket-for-uri uri (unless buffered?
#:buffered? buffered?)))) (setvbuf port _IONBF))
(let*-values (((resp data) (let*-values (((resp data)
;; Try hard to use the API du jour to get an input port. ;; Try hard to use the API du jour to get an input port.
;; On Guile 2.0.5 and before, we can only get a string or ;; On Guile 2.0.5 and before, we can only get a string or

View File

@ -182,7 +182,9 @@ to the caller without emitting an error message."
(close-port port)))) (close-port port))))
(begin (begin
(when (or (not port) (port-closed? port)) (when (or (not port) (port-closed? port))
(set! port (open-socket-for-uri uri #:buffered? buffered?))) (set! port (open-socket-for-uri uri))
(unless buffered?
(setvbuf port _IONBF)))
(http-fetch uri #:text? #f #:port port)))))))) (http-fetch uri #:text? #f #:port port))))))))
(define-record-type <cache> (define-record-type <cache>