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.

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

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

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