From f3c86193a75b3b45740bb930847f508377cf546a Mon Sep 17 00:00:00 2001 From: Charles Date: Sun, 13 Mar 2022 12:58:19 -0500 Subject: [PATCH 1/2] guix: environment: Enable mutable environments. * guix/scripts/environment.scm (launch-environment launch-environment/fork launch-environment/container guix-environment*): Add #:set-profile? parameter set GUIX_PROFILE when --profile option is used. * guix/scripts/environment.scm (guix-environment*): Profile could point to a profile directory instead of a store directory. --- guix/scripts/environment.scm | 36 +++++++++++++++++++++--------------- 1 file changed, 21 insertions(+), 15 deletions(-) diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm index ec071402f4..3dd425eac0 100644 --- a/guix/scripts/environment.scm +++ b/guix/scripts/environment.scm @@ -2,6 +2,7 @@ ;;; Copyright © 2014, 2015, 2018 David Thompson ;;; Copyright © 2015-2022 Ludovic Courtès ;;; Copyright © 2018 Mike Gerwitz +;;; Copyright © 2022 Charles Jackson ;;; ;;; This file is part of GNU Guix. ;;; @@ -384,7 +385,7 @@ (define exit/status (compose exit status->exit-code)) (define primitive-exit/status (compose primitive-exit status->exit-code)) (define* (launch-environment command profile manifest - #:key pure? (white-list '())) + #:key pure? (white-list '()) (set-profile? #f)) "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, except those matching the @@ -399,6 +400,8 @@ (define* (launch-environment command profile manifest ;; adjust 'PS1' accordingly, for instance. Set it to PROFILE so users can ;; conveniently access its contents. (setenv "GUIX_ENVIRONMENT" profile) + (when set-profile? + (setenv "GUIX_PROFILE" profile)) (match command ((program . args) @@ -591,7 +594,7 @@ (define (validate-exit-status profile command status) status) (define* (launch-environment/fork command profile manifest - #:key pure? (white-list '())) + #:key pure? (white-list '()) (set-profile? #f)) "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, except those matching the @@ -599,14 +602,16 @@ (define* (launch-environment/fork command profile manifest (match (primitive-fork) (0 (launch-environment command profile manifest #:pure? pure? - #:white-list white-list)) + #:white-list white-list + #:set-profile? set-profile?)) (pid (match (waitpid pid) ((_ . status) (validate-exit-status profile command status)))))) (define* (launch-environment/container #:key command bash user user-mappings profile manifest link-profile? network? - map-cwd? (white-list '())) + map-cwd? (white-list '()) + (set-profile? #f)) "Run COMMAND within a container that features the software in PROFILE. Environment variables are set according to the search paths of MANIFEST. The global shell is BASH, a file name for a GNU Bash binary in the @@ -748,7 +753,7 @@ (define (exit/status* status) (if link-profile? (string-append home-dir "/.guix-profile") profile) - manifest #:pure? #f))) + manifest #:pure? #f #:set-profile? set-profile?))) #:guest-uid uid #:guest-gid gid #:namespaces (if network? @@ -880,7 +885,7 @@ (define (guix-environment* opts) (user (assoc-ref opts 'user)) (bootstrap? (assoc-ref opts 'bootstrap?)) (system (assoc-ref opts 'system)) - (profile (assoc-ref opts 'profile)) + (profile-option (assoc-ref opts 'profile)) (command (or (assoc-ref opts 'exec) ;; Spawn a shell if the user didn't specify ;; anything in particular. @@ -894,7 +899,7 @@ (define (guix-environment* opts) (define store-needed? ;; Whether connecting to the daemon is needed. - (or container? (not profile))) + (or container? (not profile-option))) (define-syntax-rule (with-store/maybe store exp ...) ;; Evaluate EXP... with STORE bound to a connection, unless @@ -928,11 +933,11 @@ (define manifest-from-opts (options/resolve-packages store opts)) (define manifest - (if profile - (profile-manifest profile) + (if profile-option + (profile-manifest profile-option) manifest-from-opts)) - (when (and profile + (when (and profile-option (> (length (manifest-entries manifest-from-opts)) 0)) (leave (G_ "'--profile' cannot be used with package options~%"))) @@ -953,12 +958,11 @@ (define manifest (mlet* %store-monad ((bash (environment-bash container? bootstrap? system)) - (prof-drv (if profile + (prof-drv (if profile-option (return #f) (manifest->derivation manifest system bootstrap?))) - (profile -> (if profile - (readlink* profile) + (profile -> (or profile-option (derivation->output-path prof-drv))) (gc-root -> (assoc-ref opts 'gc-root))) @@ -999,14 +1003,16 @@ (define manifest #:white-list white-list #:link-profile? link-prof? #:network? network? - #:map-cwd? (not no-cwd?)))) + #:map-cwd? (not no-cwd?) + #:set-profile? profile-option))) (else (return (exit/status (launch-environment/fork command profile manifest #:white-list white-list - #:pure? pure?)))))))))))))) + #:pure? pure? + #:set-profile? profile-option)))))))))))))) ;;; Local Variables: ;;; eval: (put 'with-store/maybe 'scheme-indent-function 1) -- 2.34.0