summaryrefslogtreecommitdiff
path: root/guix/build/download.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-04-30 22:13:04 +0200
committerLudovic Courtès <ludo@gnu.org>2015-05-01 00:06:17 +0200
commitd17551d9438c6fe5c9bc3674e39345f15dc0c0ac (patch)
tree227da47b85a7ba467b460538d1b1ecc6c610df82 /guix/build/download.scm
parentcfaf863f15fca75b6c2cc81ae61d8c54ecd7cf28 (diff)
download: Simplify 'open-connection-for-uri' to support HTTP proxies.
Partly fixes <http://bugs.gnu.org/20402>. Reported by Joshua Randall <jcrandall@alum.mit.edu>. * guix/build/download.scm (open-connection-for-uri): Rewrite to be a small wrapper around 'open-socket-for-uri'. This procedure was initially introduced in d14ecda to work around the lack of NSS modules during bootstrap but that has become unnecessary since 0621349, which introduced a bootstrap Guile that uses static NSS modules (from commit d3b5972.) On Guile >= 2.0.10, this allows the 'http_proxy' environment variable to be used.
Diffstat (limited to 'guix/build/download.scm')
-rw-r--r--guix/build/download.scm65
1 files changed, 25 insertions, 40 deletions
diff --git a/guix/build/download.scm b/guix/build/download.scm
index a3105ad41d..2e0b019d38 100644
--- a/guix/build/download.scm
+++ b/guix/build/download.scm
@@ -196,46 +196,31 @@ host name without trailing dot."
record)))
(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)))
+ (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