futurile/guix-play
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

build-self: Execute trampoline in a clean environment.

Browse Source 
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
;;; 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