From d17551d9438c6fe5c9bc3674e39345f15dc0c0ac Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Thu, 30 Apr 2015 22:13:04 +0200 Subject: download: Simplify 'open-connection-for-uri' to support HTTP proxies. Partly fixes . Reported by Joshua Randall . * 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 file changed, 25 insertions(+), 40 deletions(-) (limited to 'guix/build') 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 -- cgit v1.2.3