3
5
Fork 0
mirror of git://git.savannah.gnu.org/guix.git synced 2023-12-14 03:33:07 +01:00

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:
Ludovic Courtès 2019-02-15 08:45:57 +01:00 committed by Ludovic Courtès
parent 3a34c9e62e
commit e6e599fa01
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 69 additions and 20 deletions

View file

@ -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

View file

@ -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?))))))))))))))

View file

@ -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)'