~ruther/guix-local

d17551d9438c6fe5c9bc3674e39345f15dc0c0ac — Ludovic Courtès 11 years ago cfaf863 
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.
patch browse .tar.gz 
1 files changed, 25 insertions(+), 40 deletions(-)

M guix/build/download.scm

M guix/build/download.scm => guix/build/download.scm +25 -40
@@ 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