environment: Add '--inherit'.
* guix/scripts/environment.scm (purify-environment): Add 'white-list' parameter and honor it. (create-environment): Add #:white-list parameter and honor it. (launch-environment): Likewise. (launch-environment/fork): Likewise. (show-help, %options): Add '--inherit'. (guix-environment): Define 'white-list' and pass it to 'launch-environment/fork'. * tests/guix-environment.sh: Test '--inherit'. * doc/guix.texi (Invoking guix environment): Document it.
This commit is contained in:
parent
3a34c9e62e
commit
e6e599fa01
|
@ -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
|
||||
|
|
|
@ -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?))))))))))))))
|
||||
|
|
|
@ -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)'
|
||||
|
|
Loading…
Reference in New Issue