nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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'.
This commit is contained in:
Ludovic Courtès 2019-01-21 10:05:00 +01:00
parent c680a7daa5
commit e9dfa4d839
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
1 changed files with 30 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
build-aux/build-self.scm
View File

@ -1,5 +1,5 @@
;;; GNU Guix --- Functional package management for GNU ;;; 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. ;;; This file is part of GNU Guix.
;;; ;;;
@ -293,9 +293,6 @@ interface (FFI) of Guile.")
(use-modules (ice-9 match)) (use-modules (ice-9 match))
(eval-when (expand load eval) (eval-when (expand load eval)
;; Don't augment '%load-path'.
(unsetenv "GUIX_PACKAGE_PATH")
;; (gnu packages …) modules are going to be looked up ;; (gnu packages …) modules are going to be looked up
;; under SOURCE. (guix config) is looked up in FRONT. ;; under SOURCE. (guix config) is looked up in FRONT.
(match (command-line) (match (command-line)
@ -312,15 +309,11 @@ interface (FFI) of Guile.")
;; Only load Guile-Gcrypt, our own modules, or those ;; Only load Guile-Gcrypt, our own modules, or those
;; of Guile. ;; of Guile.
(match %load-compiled-path (set! %load-compiled-path
((front _ ... sys1 sys2) (cons (string-append #$guile-gcrypt "/lib/guile/"
(unless (string-prefix? #$guile-gcrypt front) (effective-version)
(set! %load-compiled-path "/site-ccache")
(list (string-append #$guile-gcrypt %load-compiled-path)))
"/lib/guile/"
(effective-version)
"/site-ccache")
front sys1 sys2))))))
(use-modules (guix store) (use-modules (guix store)
(guix self) (guix self)
@ -372,6 +365,19 @@ interface (FFI) of Guile.")
derivation-file-name)))))) derivation-file-name))))))
#:module-path (list source)))) #: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. ;; The procedure below is our return value.
(define* (build source (define* (build source
#:key verbose? (version (date-version-string)) system #:key verbose? (version (date-version-string)) system
@ -406,14 +412,17 @@ files."
;; stdin will actually be /dev/null. ;; stdin will actually be /dev/null.
(let* ((pipe (with-input-from-port port (let* ((pipe (with-input-from-port port
(lambda () (lambda ()
(setenv "GUILE_WARN_DEPRECATED" "no") ;be quiet and drive ;; Make sure BUILD is not influenced by
(open-pipe* OPEN_READ ;; $GUILE_LOAD_PATH & co.
(derivation->output-path build) (with-clean-environment
source system version (setenv "GUILE_WARN_DEPRECATED" "no") ;be quiet and drive
(if (file-port? port) (open-pipe* OPEN_READ
(number->string (derivation->output-path build)
(logior major minor)) source system version
"none"))))) (if (file-port? port)
(number->string
(logior major minor))
"none"))))))
(str (get-string-all pipe)) (str (get-string-all pipe))
(status (close-pipe pipe))) (status (close-pipe pipe)))
(match str (match str