summaryrefslogtreecommitdiff
path: root/guix/profiles.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2021-06-15 10:02:48 +0200
committerLudovic Courtès <ludo@gnu.org>2021-06-18 14:18:07 +0200
commitee61777a326c3395518dee5e50ffc9c35ae53f3d (patch)
tree3b939e0c7a0ea69383d21cae4cfd0e91d8a53ceb /guix/profiles.scm
parentc5b1b48f09bb9af60aef5d48191b284d4b281a34 (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.scm41
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))