[bug#49034] [PATCH] profiles: Add 'load-profile'.

[bug#49034] [PATCH] profiles: Add 'load-profile'.

[Ludovic Courtès]

* 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(-)

Hi!

While explaining the profile bit of the ‘render-videos.scm’ example
at <https://guix.gnu.org/en/blog/2021/reproducible-data-processing-pipelines/>,
I realized we were missing a helper to “load” a profile—i.e., set all
its environment variables.

This patch moves said helper from (guix scripts environment) to
(guix profiles) and streamlines it.

Thoughts?

Ludo’.

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))
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 5ceb86f7a9..6958bd6238 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 ce77711d63..1a06ff88f3 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))
-- 
2.32.0

[bug#49034] [PATCH] profiles: Add 'load-profile'.

[Leo Prikler]

Am Dienstag, den 15.06.2021, 10:13 +0200 schrieb Ludovic Courtès:
> * 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(-)
> 
> Hi!
> 
> While explaining the profile bit of the ‘render-videos.scm’ example
> at <
> https://guix.gnu.org/en/blog/2021/reproducible-data-processing-pipelines/>
> ;,
> I realized we were missing a helper to “load” a profile—i.e., set all
> its environment variables.
> 
> This patch moves said helper from (guix scripts environment) to
> (guix profiles) and streamlines it.
> 
> Thoughts?
> 
> Ludo’.
I, for one, welcome this patch.  Adding “load-profile” to (guix
profiles) will improve the multi-profile use-case, as one will be able
to use it from a Guile REPL or a shell wrapper.

Regards,
Leo
> 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))
> diff --git a/guix/scripts/environment.scm
> b/guix/scripts/environment.scm
> index 5ceb86f7a9..6958bd6238 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 ce77711d63..1a06ff88f3 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))

[bug#49034] [PATCH] profiles: Add 'load-profile'.

[zimoun]

Hi,

On Tue, 15 Jun 2021 at 10:13, Ludovic Courtès <ludo@gnu.org> wrote:
> * 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(-)

Neat.  LGTM.

Cheers,
simon

[bug#49034] [PATCH] profiles: Add 'load-profile'.

[Maxime Devos]

[-- Attachment #1: Type: text/plain, Size: 1084 bytes --]

Ludovic Courtès schreef op di 15-06-2021 om 10:13 [+0200]:
> +(define %precious-variables
> +  ;; Environment variables in the default 'load-profile' white list.
> +  '("HOME" "USER" "LOGNAME" "DISPLAY" "TERM" "TZ" "PAGER"))
[...]
> -;; Protect some env vars from purification.  Borrowed from nix-shell.
> -(define %precious-variables
> -  '("HOME" "USER" "LOGNAME" "DISPLAY" "TERM" "TZ" "PAGER"))

This is really a separate issue, but I don't understand why "XAUTHORITY"
isn't in the list. Without preserving XAUTHORITY, the following won't work
(at least on my desktop environment):

  guix environment --pure --ad-hoc atril -- atril stuff.pdf
  # No protocol specified
  # Cannot parse arguments: Cannot open display: 

But the following does start atril:
  guix environment --preserve=XAUTHORITY --pure --ad-hoc atril -- atril stuff.pdf
  # A window titled ‘Atril Document Viewer’

Could "XAUTHORITY" be added to the list?
Preserving "DISPLAY" but not "XAUTHORITY" seems rather useless to me,
at least on my desktop environment.

Greetings,
Maxime

[-- Attachment #2: This is a digitally signed message part --]
[-- Type: application/pgp-signature, Size: 260 bytes --]

[bug#49034] [PATCH] profiles: Add 'load-profile'.

[Ludovic Courtès]

Hi,

Maxime Devos <maximedevos@telenet.be> skribis:

> Ludovic Courtès schreef op di 15-06-2021 om 10:13 [+0200]:
>> +(define %precious-variables
>> +  ;; Environment variables in the default 'load-profile' white list.
>> +  '("HOME" "USER" "LOGNAME" "DISPLAY" "TERM" "TZ" "PAGER"))
> [...]
>> -;; Protect some env vars from purification.  Borrowed from nix-shell.
>> -(define %precious-variables
>> -  '("HOME" "USER" "LOGNAME" "DISPLAY" "TERM" "TZ" "PAGER"))
>
> This is really a separate issue, but I don't understand why "XAUTHORITY"
> isn't in the list. Without preserving XAUTHORITY, the following won't work
> (at least on my desktop environment):
>
>   guix environment --pure --ad-hoc atril -- atril stuff.pdf
>   # No protocol specified
>   # Cannot parse arguments: Cannot open display: 
>
> But the following does start atril:
>   guix environment --preserve=XAUTHORITY --pure --ad-hoc atril -- atril stuff.pdf
>   # A window titled ‘Atril Document Viewer’
>
> Could "XAUTHORITY" be added to the list?
> Preserving "DISPLAY" but not "XAUTHORITY" seems rather useless to me,
> at least on my desktop environment.

Agreed, I’ll do that.

Thanks,
Ludo’.

bug#49034: [PATCH] profiles: Add 'load-profile'.

[Ludovic Courtès]

Hi,

Ludovic Courtès <ludo@gnu.org> skribis:

> * 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(-)

Pushed as ee61777a326c3395518dee5e50ffc9c35ae53f3d, thanks everyone!

Ludo’.