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.
This commit is contained in:
Ludovic Courtès 2015-04-30 22:13:04 +02:00
parent cfaf863f15
commit d17551d943
1 changed files with 24 additions and 39 deletions

View File

@ -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.
"Like 'open-socket-for-uri', but also handle HTTPS connections."
(define https?
(eq? 'https (uri-scheme 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))))))))
(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