diff options
author | Ludovic Courtès <ludo@gnu.org> | 2019-01-21 10:05:00 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2019-01-21 10:19:32 +0100 |
commit | e9dfa4d839cf21b8519724ef53df4862a74c67ec (patch) | |
tree | 775fbcbbbb8f06ef603b74e6bf793f749eaee7cd /build-aux/build-self.scm | |
parent | c680a7daa5e143dd37d1d045805e073497c591be (diff) | |
download | guix-e9dfa4d839cf21b8519724ef53df4862a74c67ec.tar guix-e9dfa4d839cf21b8519724ef53df4862a74c67ec.tar.gz |
build-self: Execute trampoline in a clean environment.
Previously execution of the trampoline would be somewhat sensitive to
GUILE_LOAD_PATH & co., for example.
* build-aux/build-self.scm (build-program): Remove 'unsetenv' call and
%LOAD-COMPILED-PATH hack.
(call-with-clean-environment): New procedure.
(with-clean-environment): New macro.
(build): Wrap 'open-pipe*' call in 'with-clean-environment'.
Diffstat (limited to 'build-aux/build-self.scm')
-rw-r--r-- | build-aux/build-self.scm | 51 |
1 files changed, 30 insertions, 21 deletions
diff --git a/build-aux/build-self.scm b/build-aux/build-self.scm index 87a45d94db..f70c3d91ff 100644 --- a/build-aux/build-self.scm +++ b/build-aux/build-self.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2014, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2014, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -293,9 +293,6 @@ interface (FFI) of Guile.") (use-modules (ice-9 match)) (eval-when (expand load eval) - ;; Don't augment '%load-path'. - (unsetenv "GUIX_PACKAGE_PATH") - ;; (gnu packages …) modules are going to be looked up ;; under SOURCE. (guix config) is looked up in FRONT. (match (command-line) @@ -312,15 +309,11 @@ interface (FFI) of Guile.") ;; Only load Guile-Gcrypt, our own modules, or those ;; of Guile. - (match %load-compiled-path - ((front _ ... sys1 sys2) - (unless (string-prefix? #$guile-gcrypt front) - (set! %load-compiled-path - (list (string-append #$guile-gcrypt - "/lib/guile/" - (effective-version) - "/site-ccache") - front sys1 sys2)))))) + (set! %load-compiled-path + (cons (string-append #$guile-gcrypt "/lib/guile/" + (effective-version) + "/site-ccache") + %load-compiled-path))) (use-modules (guix store) (guix self) @@ -372,6 +365,19 @@ interface (FFI) of Guile.") derivation-file-name)))))) #:module-path (list source)))) +(define (call-with-clean-environment thunk) + (let ((env (environ))) + (dynamic-wind + (lambda () + (environ '())) + thunk + (lambda () + (environ env))))) + +(define-syntax-rule (with-clean-environment exp ...) + "Evaluate EXP in a context where zero environment variables are defined." + (call-with-clean-environment (lambda () exp ...))) + ;; The procedure below is our return value. (define* (build source #:key verbose? (version (date-version-string)) system @@ -406,14 +412,17 @@ files." ;; stdin will actually be /dev/null. (let* ((pipe (with-input-from-port port (lambda () - (setenv "GUILE_WARN_DEPRECATED" "no") ;be quiet and drive - (open-pipe* OPEN_READ - (derivation->output-path build) - source system version - (if (file-port? port) - (number->string - (logior major minor)) - "none"))))) + ;; Make sure BUILD is not influenced by + ;; $GUILE_LOAD_PATH & co. + (with-clean-environment + (setenv "GUILE_WARN_DEPRECATED" "no") ;be quiet and drive + (open-pipe* OPEN_READ + (derivation->output-path build) + source system version + (if (file-port? port) + (number->string + (logior major minor)) + "none")))))) (str (get-string-all pipe)) (status (close-pipe pipe))) (match str |