summaryrefslogtreecommitdiff
path: root/guix/build/download.scm
diff options
context:
space:
mode:
Diffstat (limited to 'guix/build/download.scm')
-rw-r--r--guix/build/download.scm92
1 files changed, 50 insertions, 42 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm
index a3105ad41d..65d18eb839 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -19,7 +19,7 @@
(define-module (guix build download)
#:use-module (web uri)
- #:use-module (web client)
+ #:use-module ((web client) #:hide (open-socket-for-uri))
#:use-module (web response)
#:use-module (guix ftp-client)
#:use-module (guix build utils)
@@ -30,7 +30,8 @@
#:use-module (srfi srfi-26)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
- #:export (open-connection-for-uri
+ #:export (open-socket-for-uri
+ open-connection-for-uri
resolve-uri-reference
maybe-expand-mirrors
url-fetch
@@ -195,47 +196,54 @@ host name without trailing dot."
(add-weak-reference record port)
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)
- "Return an open input/output port for a connection to URI.
-
-This is the same as Guile's `open-socket-for-uri', except that we always
-use a numeric port argument, to avoid the need to go through libc's NSS,
-which is not available during bootstrap."
- (define addresses
- (let ((port (or (uri-port uri)
- (case (uri-scheme uri)
- ((http) 80) ; /etc/services, not for me!
- ((https) 443)
- (else
- (error "unsupported URI scheme" uri))))))
- (delete-duplicates (getaddrinfo (uri-host uri)
- (number->string port)
- AI_NUMERICSERV)
- (lambda (ai1 ai2)
- (equal? (addrinfo:addr ai1)
- (addrinfo:addr ai2))))))
-
- (let loop ((addresses addresses))
- (let* ((ai (car addresses))
- (s (with-fluids ((%default-port-encoding #f))
- ;; Restrict ourselves to TCP.
- (socket (addrinfo:fam ai) SOCK_STREAM IPPROTO_IP))))
- (catch 'system-error
- (lambda ()
- (connect s (addrinfo:addr ai))
-
- ;; Buffer input and output on this port.
- (setvbuf s _IOFBF %http-receive-buffer-size)
-
- (if (eq? 'https (uri-scheme uri))
- (tls-wrap s (uri-host uri))
- s))
- (lambda args
- ;; Connection failed, so try one of the other addresses.
- (close s)
- (if (null? (cdr addresses))
- (apply throw args)
- (loop (cdr addresses))))))))
+ "Like 'open-socket-for-uri', but also handle HTTPS connections."
+ (define https?
+ (eq? 'https (uri-scheme uri)))
+
+ (let-syntax ((with-https-proxy
+ (syntax-rules ()
+ ((_ exp)
+ ;; For HTTPS URIs, honor 'https_proxy', not 'http_proxy'.
+ ;; FIXME: Proxying is not supported for https.
+ (let ((thunk (lambda () exp)))
+ (if (and https?
+ (module-variable
+ (resolve-interface '(web client))
+ 'current-http-proxy))
+ (parameterize ((current-http-proxy #f))
+ (when (getenv "https_proxy")
+ (format (current-error-port)
+ "warning: 'https_proxy' is ignored~%"))
+ (thunk))
+ (thunk)))))))
+ (with-https-proxy
+ (let ((s (open-socket-for-uri uri)))
+ ;; Buffer input and output on this port.
+ (setvbuf s _IOFBF %http-receive-buffer-size)
+
+ (if https?
+ (tls-wrap s (uri-host uri))
+ s)))))
;; XXX: This is an awful hack to make sure the (set-port-encoding! p
;; "ISO-8859-1") call in `read-response' passes, even during bootstrap