me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Ludovic Courtès 2015-04-30 22:13:04 +02:00
parent cfaf863f15
commit d17551d943
1 changed files with 24 additions and 39 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

61
guix/build/download.scm
View File

@ -196,46 +196,31 @@ host name without trailing dot."
record))) record)))
(define (open-connection-for-uri uri) (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 (let-syntax ((with-https-proxy
use a numeric port argument, to avoid the need to go through libc's NSS, (syntax-rules ()
which is not available during bootstrap." ((_ exp)
(define addresses ;; For HTTPS URIs, honor 'https_proxy', not 'http_proxy'.
(let ((port (or (uri-port uri) ;; FIXME: Proxying is not supported for https.
(case (uri-scheme uri) (let ((thunk (lambda () exp)))
((http) 80) ; /etc/services, not for me! (if (and https?
((https) 443) (module-variable
(else (resolve-interface '(web client))
(error "unsupported URI scheme" uri)))))) 'current-http-proxy))
(delete-duplicates (getaddrinfo (uri-host uri) (parameterize ((current-http-proxy #f))
(number->string port) (when (getenv "https_proxy")
AI_NUMERICSERV) (format (current-error-port)
(lambda (ai1 ai2) "warning: 'https_proxy' is ignored~%"))
(equal? (addrinfo:addr ai1) (thunk))
(addrinfo:addr ai2)))))) (thunk)))))))
(with-https-proxy
(let loop ((addresses addresses)) (let ((s (open-socket-for-uri uri)))
(let* ((ai (car addresses)) (if https?
(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)) (tls-wrap s (uri-host uri))
s)) s)))))
(lambda args
;; Connection failed, so try one of the other addresses.
(close s)
(if (null? (cdr addresses))
(apply throw args)
(loop (cdr addresses))))))))
;; XXX: This is an awful hack to make sure the (set-port-encoding! p ;; 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 ;; "ISO-8859-1") call in `read-response' passes, even during bootstrap