diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2021-06-15 10:02:48 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2021-06-18 14:18:07 +0200 |
| commit | ee61777a326c3395518dee5e50ffc9c35ae53f3d (patch) | |
| tree | 3b939e0c7a0ea69383d21cae4cfd0e91d8a53ceb /guix/profiles.scm | |
| parent | c5b1b48f09bb9af60aef5d48191b284d4b281a34 (diff) | |
profiles: Add 'load-profile'.
* guix/profiles.scm (%precious-variables): New variable.
(purify-environment, load-profile): New procedures.
* guix/scripts/environment.scm (%precious-variables)
(purify-environment, create-environment): Remove.
(launch-environment): Call 'load-profile' instead of 'create-environment'.
* tests/profiles.scm ("load-profile"): New test.
Diffstat (limited to 'guix/profiles.scm')
| -rw-r--r-- | guix/profiles.scm | 41 |
1 files changed, 41 insertions, 0 deletions
diff --git a/guix/profiles.scm b/guix/profiles.scm index 8cbffa4d2b..09b2d1525a 100644 --- a/guix/profiles.scm +++ b/guix/profiles.scm @@ -11,6 +11,7 @@ ;;; Copyright © 2019 Kyle Meyer <kyle@kyleam.com> ;;; Copyright © 2019 Mathieu Othacehe <m.othacehe@gmail.com> ;;; Copyright © 2020 Danny Milosavljevic <dannym@scratchpost.org> +;;; Copyright © 2014 David Thompson <davet@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -54,6 +55,7 @@ #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:autoload (srfi srfi-98) (get-environment-variables) #:export (&profile-error profile-error? profile-error-profile @@ -127,6 +129,7 @@ %default-profile-hooks profile-derivation profile-search-paths + load-profile profile profile? @@ -1916,6 +1919,44 @@ already effective." (evaluate-search-paths (manifest-search-paths manifest) (list profile) getenv)) +(define %precious-variables + ;; Environment variables in the default 'load-profile' white list. + '("HOME" "USER" "LOGNAME" "DISPLAY" "TERM" "TZ" "PAGER")) + +(define (purify-environment white-list white-list-regexps) + "Unset all environment variables except those that match the regexps in +WHITE-LIST-REGEXPS and those listed in WHITE-LIST." + (for-each unsetenv + (remove (lambda (variable) + (or (member variable white-list) + (find (cut regexp-exec <> variable) + white-list-regexps))) + (match (get-environment-variables) + (((names . _) ...) + names))))) + +(define* (load-profile profile + #:optional (manifest (profile-manifest profile)) + #:key pure? (white-list-regexps '()) + (white-list %precious-variables)) + "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-REGEXPS and those listed in WHITE-LIST. +Otherwise, augment existing environment variables with additional search +paths." + (when pure? + (purify-environment white-list white-list-regexps)) + (for-each (match-lambda + ((($ <search-path-specification> variable _ separator) . value) + (let ((current (getenv variable))) + (setenv variable + (if (and current (not pure?)) + (if separator + (string-append value separator current) + value) + value))))) + (profile-search-paths profile manifest))) + (define (profile-regexp profile) "Return a regular expression that matches PROFILE's name and number." (make-regexp (string-append "^" (regexp-quote (basename profile)) |