[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
04/12: profiles: Add 'load-profile'.
From: |
guix-commits |
Subject: |
04/12: profiles: Add 'load-profile'. |
Date: |
Fri, 18 Jun 2021 08:25:50 -0400 (EDT) |
civodul pushed a commit to branch master
in repository guix.
commit ee61777a326c3395518dee5e50ffc9c35ae53f3d
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Tue Jun 15 10:02:48 2021 +0200
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.
---
guix/profiles.scm | 41 +++++++++++++++++++++++++++++++++++
guix/scripts/environment.scm | 51 +++++++-------------------------------------
tests/profiles.scm | 27 +++++++++++++++++++++++
3 files changed, 76 insertions(+), 43 deletions(-)
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 8cbffa4..09b2d15 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))
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 5ceb86f..6958bd6 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -52,50 +52,9 @@
#:export (assert-container-features
guix-environment))
-;; Protect some env vars from purification. Borrowed from nix-shell.
-(define %precious-variables
- '("HOME" "USER" "LOGNAME" "DISPLAY" "TERM" "TZ" "PAGER"))
-
(define %default-shell
(or (getenv "SHELL") "/bin/sh"))
-(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 (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? (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)))
- (setenv variable
- (if (and current (not pure?))
- (if separator
- (string-append value separator current)
- value)
- value)))))
- (profile-search-paths profile manifest))
-
- ;; Give users a way to know that they're in 'guix environment', so they can
- ;; adjust 'PS1' accordingly, for instance. Set it to PROFILE so users can
- ;; conveniently access its contents.
- (setenv "GUIX_ENVIRONMENT" profile))
-
(define* (show-search-paths profile manifest #:key pure?)
"Display the search paths of MANIFEST applied to PROFILE. When PURE? is #t,
do not augment existing environment variables with additional search paths."
@@ -425,8 +384,14 @@ 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? #:white-list white-list)
+ (load-profile profile manifest
+ #:pure? pure? #:white-list-regexps white-list)
+
+ ;; Give users a way to know that they're in 'guix environment', so they can
+ ;; adjust 'PS1' accordingly, for instance. Set it to PROFILE so users can
+ ;; conveniently access its contents.
+ (setenv "GUIX_ENVIRONMENT" profile)
+
(match command
((program . args)
(apply execlp program program args))))
diff --git a/tests/profiles.scm b/tests/profiles.scm
index ce77711..1a06ff8 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -279,6 +279,33 @@
(string=? (dirname (readlink bindir))
(derivation->output-path guile))))))
+(test-assertm "load-profile"
+ (mlet* %store-monad
+ ((entry -> (package->manifest-entry %bootstrap-guile))
+ (guile (package->derivation %bootstrap-guile))
+ (drv (profile-derivation (manifest (list entry))
+ #:hooks '()
+ #:locales? #f))
+ (profile -> (derivation->output-path drv))
+ (bindir -> (string-append profile "/bin"))
+ (_ (built-derivations (list drv))))
+ (define-syntax-rule (with-environment-excursion exp ...)
+ (let ((env (environ)))
+ (dynamic-wind
+ (const #t)
+ (lambda () exp ...)
+ (lambda () (environ env)))))
+
+ (return (and (with-environment-excursion
+ (load-profile profile)
+ (and (string-prefix? (string-append bindir ":")
+ (getenv "PATH"))
+ (getenv "GUILE_LOAD_PATH")))
+ (with-environment-excursion
+ (load-profile profile #:pure? #t #:white-list '())
+ (equal? (list (string-append "PATH=" bindir))
+ (environ)))))))
+
(test-assertm "<profile>"
(mlet* %store-monad
((entry -> (package->manifest-entry %bootstrap-guile))
- branch master updated (bccf2a9 -> 2ef71b6), guix-commits, 2021/06/18
- 03/12: lint: check-patch-headers: Recognize Git diffs., guix-commits, 2021/06/18
- 01/12: import: launchpad: Gracefully handle 404s from api.launchpad.net., guix-commits, 2021/06/18
- 04/12: profiles: Add 'load-profile'.,
guix-commits <=
- 05/12: profiles: Add "XAUTHORITY" to the precious variables., guix-commits, 2021/06/18
- 02/12: build: Remove Guile 2.2 workaround., guix-commits, 2021/06/18
- 08/12: doc: Explain more reasons for commit revocation., guix-commits, 2021/06/18
- 11/12: gnu: xdg-desktop-portal: Update to 1.8.1 and honor XDG_DESKTOP_PORTAL_DIR., guix-commits, 2021/06/18
- 06/12: doc: Structure the "Commit Access" section., guix-commits, 2021/06/18
- 07/12: doc: Add "Addressing Issues" section., guix-commits, 2021/06/18
- 09/12: doc: Clarify Git commit signing; fix typo., guix-commits, 2021/06/18
- 10/12: gnu: pipewire: Update to 0.3.29., guix-commits, 2021/06/18
- 12/12: gnu: xdg-desktop-portal-wlr: Update to 0.4.0., guix-commits, 2021/06/18