Merge branch 'master' into core-updates

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