From patchwork Fri Feb 15 10:49:28 2019 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 1094 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 9640B16BDC; Fri, 15 Feb 2019 11:07:30 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.0 (2014-02-07) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-1.9 required=5.0 tests=BAYES_00,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.0 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTP id 21CAF16B87 for ; Fri, 15 Feb 2019 11:07:30 +0000 (GMT) Received: from localhost ([127.0.0.1]:37118 helo=lists.gnu.org) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gubL7-0003Lg-BH for patchwork@mira.cbaines.net; Fri, 15 Feb 2019 06:07:29 -0500 Received: from eggs.gnu.org ([209.51.188.92]:40508) by lists.gnu.org with esmtp (Exim 4.71) (envelope-from ) id 1gubGT-0007EE-CE for guix-patches@gnu.org; Fri, 15 Feb 2019 06:02:44 -0500 Received: from Debian-exim by eggs.gnu.org with spam-scanned (Exim 4.71) (envelope-from ) id 1gub4G-0006mc-6S for guix-patches@gnu.org; Fri, 15 Feb 2019 05:50:06 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:49337) by eggs.gnu.org with esmtps (TLS1.0:RSA_AES_128_CBC_SHA1:16) (Exim 4.71) (envelope-from ) id 1gub4E-0006eg-8E for guix-patches@gnu.org; Fri, 15 Feb 2019 05:50:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1gub4D-0008M6-TA for guix-patches@gnu.org; Fri, 15 Feb 2019 05:50:01 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#34486] [PATCH 1/1] environment: Add '--inherit'. References: <20190215104257.16275-1-ludo@gnu.org> In-Reply-To: <20190215104257.16275-1-ludo@gnu.org> Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Fri, 15 Feb 2019 10:50:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 34486 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 34486@debbugs.gnu.org Received: via spool by 34486-submit@debbugs.gnu.org id=B34486.155022778132086 (code B ref 34486); Fri, 15 Feb 2019 10:50:01 +0000 Received: (at 34486) by debbugs.gnu.org; 15 Feb 2019 10:49:41 +0000 Received: from localhost ([127.0.0.1]:48618 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1gub3t-0008LR-1z for submit@debbugs.gnu.org; Fri, 15 Feb 2019 05:49:41 -0500 Received: from hera.aquilenet.fr ([185.233.100.1]:39650) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1gub3p-0008LH-30 for 34486@debbugs.gnu.org; Fri, 15 Feb 2019 05:49:38 -0500 Received: from localhost (localhost [127.0.0.1]) by hera.aquilenet.fr (Postfix) with ESMTP id 6608AFFD3; Fri, 15 Feb 2019 11:49:35 +0100 (CET) X-Virus-Scanned: Debian amavisd-new at aquilenet.fr Received: from hera.aquilenet.fr ([127.0.0.1]) by localhost (hera.aquilenet.fr [127.0.0.1]) (amavisd-new, port 10024) with ESMTP id kdmAbMDyecer; Fri, 15 Feb 2019 11:49:33 +0100 (CET) Received: from gnu.org (unknown [147.99.110.178]) by hera.aquilenet.fr (Postfix) with ESMTPSA id A9AB7FFCF; Fri, 15 Feb 2019 11:49:33 +0100 (CET) From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Fri, 15 Feb 2019 11:49:28 +0100 Message-Id: <20190215104928.16509-1-ludo@gnu.org> X-Mailer: git-send-email 2.20.1 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-detected-operating-system: by eggs.gnu.org: GNU/Linux 2.2.x-3.x [generic] X-Received-From: 209.51.188.43 X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Cc: Ludovic =?utf-8?q?Court=C3=A8s?= Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches From: Ludovic Courtès * 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 | 21 ++++++++++++-- guix/scripts/environment.scm | 53 +++++++++++++++++++++++++----------- tests/guix-environment.sh | 15 +++++++++- 3 files changed, 69 insertions(+), 20 deletions(-) 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 ((($ 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 +# Copyright © 2015, 2016, 2017, 2018, 2019 Ludovic Courtès # # 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)'