summaryrefslogtreecommitdiff
path: root/guix
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-05-01 15:03:30 +0200
committerLudovic Courtès <ludo@gnu.org>2015-05-01 15:03:30 +0200
commitbf4af30bb2bce9dd5baf91f313ea35c55893eb10 (patch)
tree94aa42278cd88cb50304e7fe34854399fc5255af /guix
parent9e63a388d91f73e2b82f8c4688f131680fe5f165 (diff)
parentbc7d089a9cb5ce843730f863cc03195168a956b9 (diff)
Merge branch 'master' into core-updates
Diffstat (limited to 'guix')
-rw-r--r--guix/build/download.scm65
-rw-r--r--guix/derivations.scm12
-rw-r--r--guix/download.scm3
-rw-r--r--guix/gexp.scm2
-rwxr-xr-xguix/scripts/substitute.scm1
-rw-r--r--guix/serialization.scm7
6 files changed, 45 insertions, 45 deletions
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
diff --git a/guix/derivations.scm b/guix/derivations.scm
index 7737e39b2d..1056caa70a 100644
--- a/guix/derivations.scm
+++ b/guix/derivations.scm
@@ -692,7 +692,7 @@ HASH-ALGO, of the derivation NAME. RECURSIVE? has the same meaning as for
(inputs '()) (outputs '("out"))
hash hash-algo recursive?
references-graphs allowed-references
- local-build?)
+ leaked-env-vars local-build?)
"Build a derivation with the given arguments, and return the resulting
<derivation> object. When HASH and HASH-ALGO are given, a
fixed-output derivation is created---i.e., one whose result is known in
@@ -707,6 +707,12 @@ the build environment in the corresponding file, in a simple text format.
When ALLOWED-REFERENCES is true, it must be a list of store items or outputs
that the derivation's output may refer to.
+When LEAKED-ENV-VARS is true, it must be a list of strings denoting
+environment variables that are allowed to \"leak\" from the daemon's
+environment to the build environment. This is only applicable to fixed-output
+derivations--i.e., when HASH is true. The main use is to allow variables such
+as \"http_proxy\" to be passed to derivations that download files.
+
When LOCAL-BUILD? is true, declare that the derivation is not a good candidate
for offloading and should rather be built locally. This is the case for small
derivations where the costs of data transfers would outweigh the benefits."
@@ -751,6 +757,10 @@ derivations where the costs of data transfers would outweigh the benefits."
`(("allowedReferences"
. ,(string-join allowed-references)))
'())
+ ,@(if leaked-env-vars
+ `(("impureEnvVars"
+ . ,(string-join leaked-env-vars)))
+ '())
,@env-vars)))
(match references-graphs
(((file . path) ...)
diff --git a/guix/download.scm b/guix/download.scm
index 3e4024fe1f..6b0349402a 100644
--- a/guix/download.scm
+++ b/guix/download.scm
@@ -271,6 +271,9 @@ in the store."
(guix build utils)
(guix ftp-client))
+ ;; Honor the user's proxy settings.
+ #:leaked-env-vars '("http_proxy" "https_proxy")
+
;; In general, offloading downloads is not a good idea.
;;#:local-build? #t
;; FIXME: The above would also disable use of
diff --git a/guix/gexp.scm b/guix/gexp.scm
index a2da72e76c..b08a361232 100644
--- a/guix/gexp.scm
+++ b/guix/gexp.scm
@@ -282,6 +282,7 @@ names and file names suitable for the #:allowed-references argument to
(graft? (%graft?))
references-graphs
allowed-references
+ leaked-env-vars
local-build?)
"Return a derivation NAME that runs EXP (a gexp) with GUILE-FOR-BUILD (a
derivation) on SYSTEM. When TARGET is true, it is used as the
@@ -400,6 +401,7 @@ The other arguments are as for 'derivation'."
#:hash hash #:hash-algo hash-algo #:recursive? recursive?
#:references-graphs (and=> graphs graphs-file-names)
#:allowed-references allowed
+ #:leaked-env-vars leaked-env-vars
#:local-build? local-build?))))
(define* (gexp-inputs exp #:key native?)
diff --git a/guix/scripts/substitute.scm b/guix/scripts/substitute.scm
index adf94a7ac3..b9983c5b9c 100755
--- a/guix/scripts/substitute.scm
+++ b/guix/scripts/substitute.scm
@@ -467,6 +467,7 @@ to read the response body. Return the list of results."
;; case we have to try again. Check whether that is the case.
(match (assq 'connection (response-headers resp))
(('connection 'close)
+ (close-port p)
(connect requests result)) ;try again
(_
(loop tail ;keep going
diff --git a/guix/serialization.scm b/guix/serialization.scm
index a99f53ee0b..51d7ef76c6 100644
--- a/guix/serialization.scm
+++ b/guix/serialization.scm
@@ -140,10 +140,9 @@ substitute invalid byte sequences with question marks. This is a
;; not very efficient. Eventually Guile may provide a lightweight
;; permissive UTF-8 decoder.
(let* ((bv (read-byte-string p))
- (port (with-fluids ((%default-port-encoding "UTF-8")
- (%default-port-conversion-strategy
- 'substitute))
- (open-bytevector-input-port bv))))
+ (port (open-bytevector-input-port bv)))
+ (set-port-encoding! port "UTF-8")
+ (set-port-conversion-strategy! port 'substitute)
(get-string-all port)))
(define (write-string-list l p)