From e6e599fa0106f57b9de15f90dcab3795ff1575b6 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Fri, 15 Feb 2019 08:45:57 +0100 Subject: 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. --- guix/scripts/environment.scm | 53 +++++++++++++++++++++++++++++++------------- 1 file changed, 37 insertions(+), 16 deletions(-) (limited to 'guix/scripts/environment.scm') 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?)))))))))))))) -- cgit v1.2.3