Toggle diff (180 lines)
diff --git a/doc/guix.texi b/doc/guix.texi
index 1ac077d98a..68d39ed02f 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -4454,9 +4454,24 @@ default behavior. Packages appearing after are interpreted as packages
that will be added to the environment directly.
@item --pure
-Unset existing environment variables when building the new environment.
-This has the effect of creating an environment in which search paths
-only contain package inputs.
+Unset existing environment variables when building the new environment, except
+those specified with @option{--inherit} (see below.) This has the effect of
+creating an environment in which search paths only contain package inputs.
+
+@item --inherit=@var{regexp}
+When used alongside @option{--pure}, inherit all the environment variables
+matching @var{regexp}---in other words, put them on a ``white list'' of
+environment variables that must be preserved.
+
+@example
+guix environment --pure --inherit=^SLURM --ad-hoc openmpi @dots{} \
+ -- mpirun @dots{}
+@end example
+
+This example runs @command{mpirun} in a context where the only environment
+variables defined are @code{PATH}, environment variables whose name starts
+with @code{SLURM}, as well as the usual ``precious'' variables (@code{HOME},
+@code{USER}, etc.)
@item --search-paths
Display the environment variable definitions that make up the
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 3143ea9281..3966531efa 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -57,20 +57,27 @@
(define %default-shell
(or (getenv "SHELL") "/bin/sh"))
-(define (purify-environment)
- "Unset almost all environment variables. A small number of variables such
-as 'HOME' and 'USER' are left untouched."
+(define (purify-environment white-list)
+ "Unset all environment variables except those that match the regexps in
+WHITE-LIST and those listed in %PRECIOUS-VARIABLES. A small number of
+variables such as 'HOME' and 'USER' are left untouched."
(for-each unsetenv
- (remove (cut member <> %precious-variables)
+ (remove (lambda (variable)
+ (or (member variable %precious-variables)
+ (find (cut regexp-exec <> variable)
+ white-list)))
(match (get-environment-variables)
(((names . _) ...)
names)))))
-(define* (create-environment profile manifest #:key pure?)
- "Set the environment variables specified by MANIFEST for PROFILE. When PURE?
-is #t, unset the variables in the current environment. Otherwise, augment
-existing environment variables with additional search paths."
- (when pure? (purify-environment))
+(define* (create-environment profile manifest
+ #:key pure? (white-list '()))
+ "Set the environment variables specified by MANIFEST for PROFILE. When
+PURE? is #t, unset the variables in the current environment except those that
+match the regexps in WHITE-LIST. Otherwise, augment existing environment
+variables with additional search paths."
+ (when pure?
+ (purify-environment white-list))
(for-each (match-lambda
((($ <search-path-specification> variable _ separator) . value)
(let ((current (getenv variable)))
@@ -133,6 +140,8 @@ COMMAND or an interactive shell in that environment.\n"))
of only their inputs"))
(display (G_ "
--pure unset existing environment variables"))
+ (display (G_ "
+ --inherit=REGEXP inherit environment variables that match REGEXP"))
(display (G_ "
--search-paths display needed environment variable definitions"))
(display (G_ "
@@ -206,6 +215,11 @@ COMMAND or an interactive shell in that environment.\n"))
(option '("pure") #f #f
(lambda (opt name arg result)
(alist-cons 'pure #t result)))
+ (option '("inherit") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'inherit-regexp
+ (make-regexp* arg)
+ result)))
(option '(#\E "exec") #t #f ; deprecated
(lambda (opt name arg result)
(alist-cons 'exec (list %default-shell "-c" arg) result)))
@@ -397,25 +411,30 @@ and suitable for 'exit'."
(define primitive-exit/status (compose primitive-exit status->exit-code))
(define* (launch-environment command profile manifest
- #:key pure?)
+ #:key pure? (white-list '()))
"Run COMMAND in a new environment containing INPUTS, using the native search
paths defined by the list PATHS. When PURE?, pre-existing environment
-variables are cleared before setting the new ones."
+variables are cleared before setting the new ones, except those matching the
+regexps in WHITE-LIST."
;; Properly handle SIGINT, so pressing C-c in an interactive terminal
;; application works.
(sigaction SIGINT SIG_DFL)
- (create-environment profile manifest #:pure? pure?)
+ (create-environment profile manifest
+ #:pure? pure? #:white-list white-list)
(match command
((program . args)
(apply execlp program program args))))
-(define* (launch-environment/fork command profile manifest #:key pure?)
+(define* (launch-environment/fork command profile manifest
+ #:key pure? (white-list '()))
"Run COMMAND in a new process with an environment containing PROFILE, with
the search paths specified by MANIFEST. When PURE?, pre-existing environment
-variables are cleared before setting the new ones."
+variables are cleared before setting the new ones, except those matching the
+regexps in WHITE-LIST."
(match (primitive-fork)
(0 (launch-environment command profile manifest
- #:pure? pure?))
+ #:pure? pure?
+ #:white-list white-list))
(pid (match (waitpid pid)
((_ . status) status)))))
@@ -672,7 +691,8 @@ message if any test fails."
;; within the container.
'("/bin/sh")
(list %default-shell))))
- (mappings (pick-all opts 'file-system-mapping)))
+ (mappings (pick-all opts 'file-system-mapping))
+ (white-list (pick-all opts 'inherit-regexp)))
(when container? (assert-container-features))
@@ -741,4 +761,5 @@ message if any test fails."
(return
(exit/status
(launch-environment/fork command profile manifest
+ #:white-list white-list
#:pure? pure?))))))))))))))
diff --git a/tests/guix-environment.sh b/tests/guix-environment.sh
index 30b21028aa..ccbe027c7b 100644
--- a/tests/guix-environment.sh
+++ b/tests/guix-environment.sh
@@ -1,5 +1,5 @@
# GNU Guix --- Functional package management for GNU
-# Copyright © 2015, 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
#
# This file is part of GNU Guix.
#
@@ -49,6 +49,19 @@ test -x `sed -r 's/^export PATH="(.*)"/\1/' "$tmpdir/a"`/guile
cmp "$tmpdir/a" "$tmpdir/b"
+# Check '--inherit'.
+GUIX_TEST_ABC=1
+GUIX_TEST_DEF=2
+GUIX_TEST_XYZ=3
+export GUIX_TEST_ABC GUIX_TEST_DEF GUIX_TEST_XYZ
+guix environment --bootstrap --ad-hoc guile-bootstrap --pure \
+ --inherit='^GUIX_TEST_A' --inherit='^GUIX_TEST_D' \
+ -- "$SHELL" -c set > "$tmpdir/a"
+grep '^PATH=' "$tmpdir/a"
+grep '^GUIX_TEST_ABC=' "$tmpdir/a"
+grep '^GUIX_TEST_DEF=' "$tmpdir/a"
+if grep '^GUIX_TEST_XYZ=' "$tmpdir/a"; then false; else true; fi
+
# Make sure the exit value is preserved.
if guix environment --bootstrap --ad-hoc guile-bootstrap --pure \
-- guile -c '(exit 42)'
--
2.20.1
