From e9dfa4d839cf21b8519724ef53df4862a74c67ec Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= Date: Mon, 21 Jan 2019 10:05:00 +0100 Subject: 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'. --- build-aux/build-self.scm | 51 ++++++++++++++++++++++++++++-------------------- 1 file changed, 30 insertions(+), 21 deletions(-) (limited to 'build-aux') 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 +;;; Copyright © 2014, 2016, 2017, 2018, 2019 Ludovic Courtès ;;; ;;; 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 -- cgit v1.2.3