01/04: download: Simplify 'open-connection-for-uri' to support HTTP proxies.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit d17551d9438c6fe5c9bc3674e39345f15dc0c0ac
Author: Ludovic Courtès <address@hidden>
Date:   Thu Apr 30 22:13:04 2015 +0200

    download: Simplify 'open-connection-for-uri' to support HTTP proxies.
    
    Partly fixes <http://bugs.gnu.org/20402>.
    Reported by Joshua Randall <address@hidden>.
    
    * 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.
---
 guix/build/download.scm |   65 ++++++++++++++++++-----------------------------
 1 files changed, 25 insertions(+), 40 deletions(-)

diff --git a/guix/build/download.scm b/guix/build/download.scm
index a3105ad..2e0b019 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