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 ind14ecda
to work around the lack of NSS modules during bootstrap but that has become unnecessary since0621349
, 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:
parent
cfaf863f15
commit
d17551d943
1 changed files with 24 additions and 39 deletions
|
@ -196,46 +196,31 @@ (define (log level str)
|
|||
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
|
||||
|
|
Loading…
Reference in a new issue