* [bug#62848] [PATCH] environment: Add --remote option and emacsclient-eshell backend.
@ 2023-04-15 1:44 Antero Mejr via Guix-patches via
2023-09-01 13:26 ` Maxim Cournoyer
2023-11-07 22:30 ` [bug#62848] [PATCH v2] " Antero Mejr via Guix-patches via
0 siblings, 2 replies; 8+ messages in thread
From: Antero Mejr via Guix-patches via @ 2023-04-15 1:44 UTC (permalink / raw)
To: 62848; +Cc: ludo
* guix/scripts/environment.scm (launch-environment/eshell): New procedure.
(guix-environment*): Add logic for remote backend switching.
(%options): Add --remote and --list-remote-backends options.
(show-environment-options-help): Add help text for new options.
* guix/profiles.scm (load-profile)[getenv-proc, setenv-proc, unsetenv-proc]:
New optional keyword arguments.
(purify-environment)[unsetenv-proc]: New argument.
* doc/guix.texi(Invoking guix shell): Document --remote and
--list-remote-backends options.
---
"guix shell" doesn't support eshell due to eshell's quirks.
This change makes environments/profiles more network transparent to
support eshell, and maybe other remote environments in the future.
doc/guix.texi | 17 ++++++++
guix/profiles.scm | 30 ++++++++------
guix/scripts/environment.scm | 80 ++++++++++++++++++++++++++++++++++--
3 files changed, 112 insertions(+), 15 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index adb1975935..f609e0c9b6 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6245,6 +6245,23 @@ environment.
@itemx -s @var{system}
Attempt to build for @var{system}---e.g., @code{i686-linux}.
+@item --remote=@var{backend}[=@var{args}]
+Create an environment over a remote connection using @var{backend},
+optionally passing @var{args} to the backend.
+
+This option causes the @option{--container} option to be ignored.
+
+When @var{backend} is @code{emacsclient-eshell}, a new eshell buffer
+with the Guix environment will be opened. An Emacs server must already
+be running, and the @code{emacsclient} program must be available. Due
+to the way @code{eshell} handles commands, the @var{command} argument,
+if specified, will run in the initial @code{eshell} environment instead
+of the Guix @code{eshell} environment.
+
+@item --list-remote-backends
+Display the @var{backend} options for @code{guix shell --remote=BACKEND}
+and exit.
+
@item --container
@itemx -C
@cindex container
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 03333785f9..1bf6783eea 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -2062,10 +2062,10 @@ (define %precious-variables
;; Environment variables in the default 'load-profile' white list.
'("HOME" "USER" "LOGNAME" "DISPLAY" "XAUTHORITY" "TERM" "TZ" "PAGER"))
-(define (purify-environment white-list white-list-regexps)
+(define (purify-environment white-list white-list-regexps unsetenv-proc)
"Unset all environment variables except those that match the regexps in
WHITE-LIST-REGEXPS and those listed in WHITE-LIST."
- (for-each unsetenv
+ (for-each unsetenv-proc
(remove (lambda (variable)
(or (member variable white-list)
(find (cut regexp-exec <> variable)
@@ -2077,23 +2077,29 @@ (define (purify-environment white-list white-list-regexps)
(define* (load-profile profile
#:optional (manifest (profile-manifest profile))
#:key pure? (white-list-regexps '())
- (white-list %precious-variables))
+ (white-list %precious-variables)
+ (getenv-proc getenv) (setenv-proc setenv)
+ (unsetenv-proc unsetenv))
"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."
+paths.
+GETENV-PROC is a one-argument procedure that returns an env var value.
+SETENV-PROC is a two-argument procedure the sets environment variables.
+UNSETENV-PROC is a one-argument procedure that unsets environment variables.
+Change those procedures to load a profile over a remote connection."
(when pure?
- (purify-environment white-list white-list-regexps))
+ (purify-environment white-list white-list-regexps unsetenv-proc))
(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)))))
+ (let ((current (getenv-proc variable)))
+ (setenv-proc variable
+ (if (and current (not pure?))
+ (if separator
+ (string-append value separator current)
+ value)
+ value)))))
(profile-search-paths profile manifest)))
(define (profile-regexp profile)
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index ebfc05731c..7e67cf1d1d 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -53,6 +53,7 @@ (define-module (guix scripts environment)
#:autoload (gnu packages bootstrap) (bootstrap-executable %bootstrap-guile)
#:autoload (gnu packages package-management) (guix)
#:use-module (ice-9 match)
+ #:use-module (ice-9 popen)
#:autoload (ice-9 rdelim) (read-line)
#:use-module (ice-9 vlist)
#:autoload (web uri) (string->uri uri-scheme)
@@ -104,6 +105,13 @@ (define (show-environment-options-help)
(display (G_ "
-r, --root=FILE make FILE a symlink to the result, and register it
as a garbage collector root"))
+ (display (G_ "
+ --remote=BACKEND[=ARGS]
+ create environment over a remote connection by
+ passing ARGS to BACKEND"))
+ (display (G_ "
+ --list-remote-backends
+ list available remote backends and exit"))
(display (G_ "
-C, --container run command within an isolated container"))
(display (G_ "
@@ -283,6 +291,13 @@ (define %options
(option '("bootstrap") #f #f
(lambda (opt name arg result)
(alist-cons 'bootstrap? #t result)))
+ (option '("remote") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'remote arg result)))
+ (option '("list-remote-backends") #f #f
+ (lambda args
+ (display "emacsclient-eshell\n")
+ (exit 0)))
(append %transformation-options
%standard-build-options
@@ -715,6 +730,50 @@ (define* (launch-environment/fork command profile manifest
((_ . status)
status)))))
+(define* (launch-environment/eshell args command profile manifest
+ #:key pure? (white-list '()))
+ "Create an new eshell buffer 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 regexps in WHITE-LIST."
+
+ (define (escape in)
+ (string-append "\"" (string-replace-substring in "\"" "\\\"") "\""))
+
+ (define* (ec cmd #:optional (check? #f))
+ (let* ((cmd (string-append "emacsclient " args " -e " (escape cmd)))
+ (port (open-input-pipe cmd))
+ (str (read-line port))
+ (code (status:exit-val (close-pipe port))))
+ (if (and check? (or (not (eqv? code 0)) (eof-object? str)))
+ (leave
+ (G_ "Emacs server connection failed. Is the server running?~%")))
+ str))
+
+ (let ((buf (ec "(buffer-name (eshell t))" #t)))
+ (define (ec-buf cmd)
+ (ec (string-append "(with-current-buffer " buf " " cmd ")")))
+
+ (load-profile
+ profile manifest #:pure? pure? #:white-list-regexps white-list
+ #:setenv-proc (lambda (var val)
+ (ec-buf
+ (if (string=? var "PATH")
+ ;; TODO: TRAMP support?
+ (string-append "(eshell-set-path " (escape val) ")")
+ (string-append "(setenv " (escape var) " "
+ (escape val) ")"))))
+ #:unsetenv-proc (lambda (var)
+ (ec-buf
+ (string-append "(setenv " (escape var) ")"))))
+
+ (match command
+ ((program . args)
+ (ec-buf
+ (string-append
+ "(eshell-command "
+ (escape (string-append program " " (string-join args)))")"))))))
+
(define* (launch-environment/container #:key command bash user user-mappings
profile manifest link-profile? network?
map-cwd? emulate-fhs? nesting?
@@ -1081,7 +1140,10 @@ (define (guix-environment* opts)
'("/bin/sh")
(list %default-shell))))
(mappings (pick-all opts 'file-system-mapping))
- (white-list (pick-all opts 'inherit-regexp)))
+ (white-list (pick-all opts 'inherit-regexp))
+ (remote (match (string-split (assoc-ref opts 'remote) #\=)
+ ((x) (cons x ""))
+ ((x . y) (cons x (string-join y))))))
(define store-needed?
;; Whether connecting to the daemon is needed.
@@ -1119,6 +1181,10 @@ (define-syntax-rule (with-store/maybe store exp ...)
(when (pair? symlinks)
(leave (G_ "'--symlink' cannot be used without '--container~%'"))))
+ (when (and remote (not (member (car remote) '("emacsclient-eshell"))))
+ (leave
+ (G_ "Invalid remote backend, see --list-remote-backends for options.~%'")))
+
(with-store/maybe store
(with-status-verbosity (assoc-ref opts 'verbosity)
(define manifest-from-opts
@@ -1172,15 +1238,23 @@ (define manifest
(mwhen (assoc-ref opts 'check?)
(return
- (if container?
+ (if (or container? remote)
(warning (G_ "'--check' is unnecessary \
-when using '--container'; doing nothing~%"))
+when using '--container' or '--remote'; doing nothing~%"))
(validate-child-shell-environment profile manifest))))
(cond
((assoc-ref opts 'search-paths)
(show-search-paths profile manifest #:pure? pure?)
(return #t))
+ (remote
+ (match (car remote)
+ ("emacsclient-eshell"
+ (return
+ (launch-environment/eshell (cdr remote)
+ command profile manifest
+ #:white-list white-list
+ #:pure? pure?)))))
(container?
(let ((bash-binary
(if bootstrap?
--
2.39.2
^ permalink raw reply related [flat|nested] 8+ messages in thread
* [bug#62848] [PATCH] environment: Add --remote option and emacsclient-eshell backend.
2023-04-15 1:44 [bug#62848] [PATCH] environment: Add --remote option and emacsclient-eshell backend Antero Mejr via Guix-patches via
@ 2023-09-01 13:26 ` Maxim Cournoyer
2023-11-07 22:30 ` [bug#62848] [PATCH v2] " Antero Mejr via Guix-patches via
1 sibling, 0 replies; 8+ messages in thread
From: Maxim Cournoyer @ 2023-09-01 13:26 UTC (permalink / raw)
To: Antero Mejr; +Cc: ludo, 62848
Hi Antero,
Antero Mejr <antero@mailbox.org> writes:
> * guix/scripts/environment.scm (launch-environment/eshell): New procedure.
> (guix-environment*): Add logic for remote backend switching.
> (%options): Add --remote and --list-remote-backends options.
> (show-environment-options-help): Add help text for new options.
> * guix/profiles.scm (load-profile)[getenv-proc, setenv-proc, unsetenv-proc]:
> New optional keyword arguments.
> (purify-environment)[unsetenv-proc]: New argument.
> * doc/guix.texi(Invoking guix shell): Document --remote and
> --list-remote-backends options.
This looks interesting!
[...]
> +(define* (launch-environment/eshell args command profile manifest
> + #:key pure? (white-list '()))
Maybe use the modern allow-list / block-list terminology.
> + "Create an new eshell buffer 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 regexps in WHITE-LIST."
> +
> + (define (escape in)
> + (string-append "\"" (string-replace-substring in "\"" "\\\"") "\""))
> +
> + (define* (ec cmd #:optional (check? #f))
^
Shouldn't we always check for errors? When is it useful to let them
through?
> + (let* ((cmd (string-append "emacsclient " args " -e " (escape cmd)))
Instead of having to escape stuff, it'd be better to avoid using a shell
for the invocation by opening the pipe with (open-pipe* OPEN_READ prog
arg ...). There's an example if you grep for
'with-input-pipe-to-string' in the update-guix-package.scm file. This
should make the rest of the code more readable.
> + (port (open-input-pipe cmd))
> + (str (read-line port))
> + (code (status:exit-val (close-pipe port))))
> + (if (and check? (or (not (eqv? code 0)) (eof-object? str)))
^
(zero? code)
> + (leave
> + (G_ "Emacs server connection failed. Is the server running?~%")))
> + str))
> +
> + (let ((buf (ec "(buffer-name (eshell t))" #t)))
> + (define (ec-buf cmd)
> + (ec (string-append "(with-current-buffer " buf " " cmd ")")))
> +
> + (load-profile
> + profile manifest #:pure? pure? #:white-list-regexps white-list
> + #:setenv-proc (lambda (var val)
> + (ec-buf
> + (if (string=? var "PATH")
> + ;; TODO: TRAMP support?
> + (string-append "(eshell-set-path " (escape val) ")")
> + (string-append "(setenv " (escape var) " "
> + (escape val) ")"))))
> + #:unsetenv-proc (lambda (var)
> + (ec-buf
> + (string-append "(setenv " (escape var) ")"))))
> +
> + (match command
> + ((program . args)
> + (ec-buf
> + (string-append
> + "(eshell-command "
> + (escape (string-append program " " (string-join args)))")"))))))
> +
> (define* (launch-environment/container #:key command bash user user-mappings
> profile manifest link-profile? network?
> map-cwd? emulate-fhs? nesting?
> @@ -1081,7 +1140,10 @@ (define (guix-environment* opts)
> '("/bin/sh")
> (list %default-shell))))
> (mappings (pick-all opts 'file-system-mapping))
> - (white-list (pick-all opts 'inherit-regexp)))
> + (white-list (pick-all opts 'inherit-regexp))
> + (remote (match (string-split (assoc-ref opts 'remote) #\=)
> + ((x) (cons x ""))
Why is this needed?
> + ((x . y) (cons x (string-join y))))))
If using open-pipe* as suggested above, all the arguments could be kept
as a list.
>
> (define store-needed?
> ;; Whether connecting to the daemon is needed.
> @@ -1119,6 +1181,10 @@ (define-syntax-rule (with-store/maybe store exp ...)
> (when (pair? symlinks)
> (leave (G_ "'--symlink' cannot be used without '--container~%'"))))
>
> + (when (and remote (not (member (car remote) '("emacsclient-eshell"))))
> + (leave
> + (G_ "Invalid remote backend, see --list-remote-backends for options.~%'")))
This code and the --list-remote-backends associated procedure could
share a same %supported-backends list containing currently just
'("emacsclient-eshell").
> (with-store/maybe store
> (with-status-verbosity (assoc-ref opts 'verbosity)
> (define manifest-from-opts
> @@ -1172,15 +1238,23 @@ (define manifest
>
> (mwhen (assoc-ref opts 'check?)
> (return
> - (if container?
> + (if (or container? remote)
> (warning (G_ "'--check' is unnecessary \
> -when using '--container'; doing nothing~%"))
> +when using '--container' or '--remote'; doing nothing~%"))
> (validate-child-shell-environment profile manifest))))
>
> (cond
> ((assoc-ref opts 'search-paths)
> (show-search-paths profile manifest #:pure? pure?)
> (return #t))
> + (remote
> + (match (car remote)
> + ("emacsclient-eshell"
> + (return
> + (launch-environment/eshell (cdr remote)
> + command profile manifest
> + #:white-list white-list
> + #:pure? pure?)))))
> (container?
> (let ((bash-binary
> (if bootstrap?
It'd be nice to have a functional test for it; some inspiration could be
taken from tests/build-emacs-utils.scm, which skips the test if emacs is
not available.
Thanks for this contribution! Could you please send a v2 taking into
account the above comments?
--
Thanks,
Maxim
^ permalink raw reply [flat|nested] 8+ messages in thread
* [bug#62848] [PATCH v2] environment: Add --remote option and emacsclient-eshell backend.
2023-04-15 1:44 [bug#62848] [PATCH] environment: Add --remote option and emacsclient-eshell backend Antero Mejr via Guix-patches via
2023-09-01 13:26 ` Maxim Cournoyer
@ 2023-11-07 22:30 ` Antero Mejr via Guix-patches via
2023-11-08 5:29 ` Liliana Marie Prikler
1 sibling, 1 reply; 8+ messages in thread
From: Antero Mejr via Guix-patches via @ 2023-11-07 22:30 UTC (permalink / raw)
To: 62848; +Cc: maxim.cournoyer
* guix/scripts/environment.scm (launch-environment/eshell): New procedure.
(%remote-backends): New variable.
(guix-environment*): Add logic for remote backend switching.
(launch-envrionment)[white-list]: Change keyword argument name to
'allow-list'.
(launch-environment/fork)[white-list]: Change keyword argument name to
'allow-list'.
(%options): Add --remote and --list-remote-backends options.
(show-environment-options-help): Add help text for new options.
* guix/profiles.scm (load-profile)[getenv-proc, setenv-proc, unsetenv-proc]:
New optional keyword arguments.
(load-profile)[white-list]: Change keyword argument name to 'allow-list'.
(purify-environment)[white-list-regexps]: Change argument name to
'allow-list-regexps'.
(purify-environment)[unsetenv-proc]: New argument.
* guix/build/emacs-utils.scm (%emacsclient): New parameter.
(emacsclient-batch-script): New procedure.
* doc/guix.texi(Invoking guix shell): Document --remote and
--list-remote-backends options.
* tests/build-emacs-utils.scm(emacsclient-batch-script): New test.
* tests/profiles.scm(load-profile): Change 'white-list' keyword argument to
'allow-list'.
---
With requested changes from Maxim's review:
Update white-list/allow-list terminology throughout.
Always check for errors when invoking emacsclient.
Simplify emacsclient invocation code by using the
(guix build emacs-utils) module.
Add new test to build-emacs-utils.scm for testing emacsclient.
doc/guix.texi | 17 ++++++
guix/build/emacs-utils.scm | 21 +++++++
guix/profiles.scm | 42 ++++++++------
guix/scripts/environment.scm | 106 ++++++++++++++++++++++++++++-------
tests/build-emacs-utils.scm | 12 +++-
tests/profiles.scm | 2 +-
6 files changed, 160 insertions(+), 40 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 9f06f1c325..92a0d99db7 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6474,6 +6474,23 @@ Invoking guix shell
@itemx -s @var{system}
Attempt to build for @var{system}---e.g., @code{i686-linux}.
+@item --remote=@var{backend}[=@var{args}]
+Create an environment over a remote connection using @var{backend},
+optionally passing @var{args} to the backend.
+
+This option causes the @option{--container} option to be ignored.
+
+When @var{backend} is @code{emacsclient-eshell}, a new eshell buffer
+with the Guix environment will be opened. An Emacs server must already
+be running, and the @code{emacsclient} program must be available. Due
+to the way @code{eshell} handles commands, the @var{command} argument,
+if specified, will run in the initial @code{eshell} environment instead
+of the Guix @code{eshell} environment.
+
+@item --list-remote-backends
+Display the @var{backend} options for @code{guix shell --remote=BACKEND}
+and exit.
+
@item --container
@itemx -C
@cindex container
diff --git a/guix/build/emacs-utils.scm b/guix/build/emacs-utils.scm
index 8e12b5b6d4..e56e230efb 100644
--- a/guix/build/emacs-utils.scm
+++ b/guix/build/emacs-utils.scm
@@ -28,10 +28,12 @@ (define-module (guix build emacs-utils)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:export (%emacs
+ %emacsclient
emacs-batch-eval
emacs-batch-edit-file
emacs-batch-disable-compilation
emacs-batch-script
+ emacsclient-batch-script
emacs-batch-error?
emacs-batch-error-message
@@ -57,6 +59,10 @@ (define %emacs
;; The `emacs' command.
(make-parameter "emacs"))
+(define %emacsclient
+ ;; A list starting with the `emacsclient' command, plus optional arguments.
+ (make-parameter '("emacsclient")))
+
(define (expr->string expr)
"Converts EXPR, an expression, into a string."
(if (string? expr)
@@ -107,6 +113,21 @@ (define (emacs-batch-script expr)
(message (read-string (car error-pipe)))))))
output))
+(define (emacsclient-batch-script expr)
+ "Send the Elisp code EXPR to Emacs via emacsclient and return output."
+ (let* ((error-pipe (pipe))
+ (port (parameterize ((current-error-port (cdr error-pipe)))
+ (apply open-pipe* OPEN_READ
+ (car (%emacsclient)) "--eval" (expr->string expr)
+ (cdr (%emacsclient)))))
+ (output (read-string port))
+ (status (close-pipe port)))
+ (close-port (cdr error-pipe))
+ (unless (zero? status)
+ (raise (condition (&emacs-batch-error
+ (message (read-string (car error-pipe)))))))
+ (string-trim-both output (char-set-adjoin char-set:whitespace #\"))))
+
(define (emacs-generate-autoloads name directory)
"Generate autoloads for Emacs package NAME placed in DIRECTORY."
(let* ((file (string-append directory "/" name "-autoloads.el"))
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 5d2fb8dc64..eca2b82cb3 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -2103,41 +2103,47 @@ (define* (profile-search-paths profile
(list profile) getenv))
(define %precious-variables
- ;; Environment variables in the default 'load-profile' white list.
+ ;; Environment variables in the default 'load-profile' allow list.
'("HOME" "USER" "LOGNAME" "DISPLAY" "XAUTHORITY" "TERM" "TZ" "PAGER"))
-(define (purify-environment white-list white-list-regexps)
+(define (purify-environment allow-list allow-list-regexps unsetenv-proc)
"Unset all environment variables except those that match the regexps in
-WHITE-LIST-REGEXPS and those listed in WHITE-LIST."
- (for-each unsetenv
+ALLOW-LIST-REGEXPS and those listed in ALLOW-LIST."
+ (for-each unsetenv-proc
(remove (lambda (variable)
- (or (member variable white-list)
+ (or (member variable allow-list)
(find (cut regexp-exec <> variable)
- white-list-regexps)))
+ allow-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))
+ #:key pure? (allow-list-regexps '())
+ (allow-list %precious-variables)
+ (getenv-proc getenv) (setenv-proc setenv)
+ (unsetenv-proc unsetenv))
"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.
+match the regexps in ALLOW-LIST-REGEXPS and those listed in ALLOW-LIST.
Otherwise, augment existing environment variables with additional search
-paths."
+paths.
+GETENV-PROC is a one-argument procedure that returns an env var value.
+SETENV-PROC is a two-argument procedure the sets environment variables.
+UNSETENV-PROC is a one-argument procedure that unsets environment variables.
+Change those procedures to load a profile over a remote connection."
(when pure?
- (purify-environment white-list white-list-regexps))
+ (purify-environment allow-list allow-list-regexps unsetenv-proc))
(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)))))
+ (let ((current (getenv-proc variable)))
+ (setenv-proc variable
+ (if (and current (not pure?))
+ (if separator
+ (string-append value separator current)
+ value)
+ value)))))
(profile-search-paths profile manifest)))
(define (profile-regexp profile)
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 6ae3b11e39..fa033dc0ae 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2015-2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Mike Gerwitz <mtg@gnu.org>
;;; Copyright © 2022, 2023 John Kehayias <john.kehayias@protonmail.com>
+;;; Copyright © 2023, Antero Mejr <antero@mailbox.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -29,6 +30,7 @@ (define-module (guix scripts environment)
#:use-module (guix profiles)
#:use-module (guix search-paths)
#:use-module (guix build utils)
+ #:use-module (guix build emacs-utils)
#:use-module (guix monads)
#:use-module ((guix gexp) #:select (lower-object))
#:autoload (guix describe) (current-profile current-channels)
@@ -72,6 +74,9 @@ (define-module (guix scripts environment)
(define %default-shell
(or (getenv "SHELL") "/bin/sh"))
+(define %remote-backends
+ '("emacsclient-eshell"))
+
(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."
@@ -104,6 +109,13 @@ (define (show-environment-options-help)
(display (G_ "
-r, --root=FILE make FILE a symlink to the result, and register it
as a garbage collector root"))
+ (display (G_ "
+ --remote=BACKEND[=ARGS]
+ create environment over a remote connection by
+ passing ARGS to BACKEND"))
+ (display (G_ "
+ --list-remote-backends
+ list available remote backends and exit"))
(display (G_ "
-C, --container run command within an isolated container"))
(display (G_ "
@@ -287,6 +299,13 @@ (define %options
(option '("bootstrap") #f #f
(lambda (opt name arg result)
(alist-cons 'bootstrap? #t result)))
+ (option '("remote") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'remote arg result)))
+ (option '("list-remote-backends") #f #f
+ (lambda args
+ (display (string-join %remote-backends "\n" 'suffix))
+ (exit 0)))
(append %transformation-options
%standard-build-options
@@ -485,18 +504,18 @@ (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? (allow-list '())
emulate-fhs?)
"Load the environment of PROFILE, which corresponds to MANIFEST, and execute
COMMAND. When PURE?, pre-existing environment variables are cleared before
-setting the new ones, except those matching the regexps in WHITE-LIST. When
+setting the new ones, except those matching the regexps in ALLOW-LIST. When
EMULATE-FHS?, first set up an FHS environment with $PATH and generate the LD
cache."
;; Properly handle SIGINT, so pressing C-c in an interactive terminal
;; application works.
(sigaction SIGINT SIG_DFL)
(load-profile profile manifest
- #:pure? pure? #:white-list-regexps white-list)
+ #:pure? pure? #:allow-list-regexps allow-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
@@ -706,24 +725,53 @@ (define (suggest-command-name profile command)
closest))))))))
(define* (launch-environment/fork command profile manifest
- #:key pure? (white-list '()))
+ #:key pure? (allow-list '()))
"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
-regexps in WHITE-LIST."
+regexps in ALLOW-LIST."
(match (primitive-fork)
(0 (launch-environment command profile manifest
#:pure? pure?
- #:white-list white-list))
+ #:allow-list allow-list))
(pid (match (waitpid pid)
((_ . status)
status)))))
+(define* (launch-environment/eshell args command profile manifest
+ #:key pure? (allow-list '()))
+ "Create an new eshell buffer 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 regexps in ALLOW-LIST."
+
+ (parameterize ((%emacsclient (cons "emacsclient" args)))
+ (let* ((buf (emacsclient-batch-script '(buffer-name (eshell t))))
+ (ec-buf
+ (lambda (cmd)
+ (emacsclient-batch-script `(with-current-buffer ,buf ,cmd)))))
+ (load-profile
+ profile manifest #:pure? pure? #:allow-list-regexps allow-list
+ #:setenv-proc (lambda (var val)
+ (ec-buf (if (string=? var "PATH")
+ ;; TODO: TRAMP support?
+ `(eshell-set-path ,val)
+ `(setenv ,var ,val))))
+ #:unsetenv-proc (lambda (var)
+ (ec-buf `(setenv ,var))))
+ (match command
+ ((program . args)
+ (begin (ec-buf
+ `(eshell-command
+ ,(string-append program " " (string-join args))))
+ (ec-buf '(kill-buffer))))
+ (else #t)))))
+
(define* (launch-environment/container #:key command bash user user-mappings
profile manifest link-profile? network?
map-cwd? emulate-fhs? nesting?
(setup-hook #f)
- (symlinks '()) (white-list '()))
+ (symlinks '()) (allow-list '()))
"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 store. When
@@ -748,7 +796,7 @@ (define* (launch-environment/container #:key command bash user user-mappings
added to the container.
Preserve environment variables whose name matches the one of the regexps in
-WHILE-LIST."
+ALLOW-LIST."
(define (optional-mapping->fs mapping)
(and (file-exists? (file-system-mapping-source mapping))
(file-system-mapping->bind-mount mapping)))
@@ -818,7 +866,7 @@ (define* (launch-environment/container #:key command bash user user-mappings
(environ (filter (match-lambda
((variable . value)
(find (cut regexp-exec <> variable)
- white-list)))
+ allow-list)))
(get-environment-variables)))
;; Bind-mount all requisite store items, user-specified mappings,
;; /bin/sh, the current working directory, and possibly networking
@@ -931,7 +979,7 @@ (define* (launch-environment/container #:key command bash user user-mappings
(override-user-dir user home cwd)
home-dir))
- ;; Set environment variables that match WHITE-LIST.
+ ;; Set environment variables that match ALLOW-LIST.
(for-each (match-lambda
((variable . value)
(setenv variable value)))
@@ -1081,16 +1129,19 @@ (define (guix-environment* opts)
(bootstrap? (assoc-ref opts 'bootstrap?))
(system (assoc-ref opts 'system))
(profile (assoc-ref opts 'profile))
+ (remote (string-split (assoc-ref opts 'remote) #\=))
(command (or (assoc-ref opts 'exec)
;; Spawn a shell if the user didn't specify
;; anything in particular.
- (if container?
- ;; The user's shell is likely not available
- ;; within the container.
- '("/bin/sh")
- (list %default-shell))))
+ (cond (container?
+ ;; The user's shell is likely not available
+ ;; within the container.
+ '("/bin/sh"))
+ ;; For remote, let the backend decide.
+ (remote '())
+ (else (list %default-shell)))))
(mappings (pick-all opts 'file-system-mapping))
- (white-list (pick-all opts 'inherit-regexp)))
+ (allow-list (pick-all opts 'inherit-regexp)))
(define store-needed?
;; Whether connecting to the daemon is needed.
@@ -1129,6 +1180,10 @@ (define (guix-environment* opts)
(when (pair? symlinks)
(leave (G_ "'--symlink' cannot be used without '--container'~%"))))
+ (when (and remote (not (member (car remote) %remote-backends)))
+ (leave
+ (G_ "Invalid remote backend, see --list-remote-backends for options.~%'")))
+
(with-store/maybe store
(with-status-verbosity (assoc-ref opts 'verbosity)
(define manifest-from-opts
@@ -1182,15 +1237,26 @@ (define (guix-environment* opts)
(mwhen (assoc-ref opts 'check?)
(return
- (if container?
+ (if (or container? remote)
(warning (G_ "'--check' is unnecessary \
-when using '--container'; doing nothing~%"))
+when using '--container' or '--remote'; doing nothing~%"))
(validate-child-shell-environment profile manifest))))
(cond
((assoc-ref opts 'search-paths)
(show-search-paths profile manifest #:pure? pure?)
(return #t))
+ (remote
+ (match (car remote)
+ ("emacsclient-eshell"
+ (return
+ (launch-environment/eshell
+ (match (cdr remote)
+ ((args) (string-split args #\space))
+ (_ '()))
+ command profile manifest
+ #:allow-list allow-list
+ #:pure? pure?)))))
(container?
(let ((bash-binary
(if bootstrap?
@@ -1203,7 +1269,7 @@ (define (guix-environment* opts)
#:user-mappings mappings
#:profile profile
#:manifest manifest
- #:white-list white-list
+ #:allow-list allow-list
#:link-profile? link-prof?
#:network? network?
#:map-cwd? (not no-cwd?)
@@ -1218,7 +1284,7 @@ (define (guix-environment* opts)
(return
(exit/status
(launch-environment/fork command profile manifest
- #:white-list white-list
+ #:allow-list allow-list
#:pure? pure?)))))))))))))
;;; Local Variables:
diff --git a/tests/build-emacs-utils.scm b/tests/build-emacs-utils.scm
index 4e851ed959..6b845b93b9 100644
--- a/tests/build-emacs-utils.scm
+++ b/tests/build-emacs-utils.scm
@@ -29,12 +29,22 @@ (define-module (test build-emacs-utils)
(test-begin "build-emacs-utils")
;; Only run the following tests if emacs is present.
-(test-skip (if (which "emacs") 0 5))
+(test-skip (if (which "emacs") 0 6))
(test-equal "emacs-batch-script: print foo from emacs"
"foo"
(emacs-batch-script '(princ "foo")))
+;; Note: If this test fails, subsequent runs might end up in a bad state.
+;; Running "emacsclient -s test -e '(kill-emacs)'" should fix it.
+(test-equal "emacsclient-batch-script: print foo from emacs via emacsclient"
+ "foo"
+ (begin (invoke (%emacs) "--quick" "--daemon=test")
+ (parameterize ((%emacsclient '("emacsclient" "-s" "test")))
+ (let ((out (emacsclient-batch-script '(princ "foo"))))
+ (emacsclient-batch-script '(kill-emacs))
+ out))))
+
(test-assert "emacs-batch-script: raise &emacs-batch-error on failure"
(guard (c ((emacs-batch-error? c)
;; The error message format changed between Emacs 27 and Emacs
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 9c419ada93..1e134f5105 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -367,7 +367,7 @@ (define glibc
(getenv "PATH"))
(getenv "GUILE_LOAD_PATH")))
(with-environment-excursion
- (load-profile profile #:pure? #t #:white-list '())
+ (load-profile profile #:pure? #t #:allow-list '())
(equal? (list (string-append "PATH=" bindir))
(environ)))))))
base-commit: 220759226e93d76d8d80058f69f9d8b29714bbde
--
2.41.0
^ permalink raw reply related [flat|nested] 8+ messages in thread
* [bug#62848] [PATCH v2] environment: Add --remote option and emacsclient-eshell backend.
2023-11-07 22:30 ` [bug#62848] [PATCH v2] " Antero Mejr via Guix-patches via
@ 2023-11-08 5:29 ` Liliana Marie Prikler
2023-11-08 15:19 ` [bug#62848] [PATCH 1/2] guix: Rename white-list to allow-list Antero Mejr via Guix-patches via
` (2 more replies)
0 siblings, 3 replies; 8+ messages in thread
From: Liliana Marie Prikler @ 2023-11-08 5:29 UTC (permalink / raw)
To: Antero Mejr, 62848; +Cc: maxim.cournoyer
Am Dienstag, dem 07.11.2023 um 22:30 +0000 schrieb Antero Mejr:
> * guix/scripts/environment.scm (launch-environment/eshell): New
> procedure.
> (%remote-backends): New variable.
> (guix-environment*): Add logic for remote backend switching.
> (launch-envrionment)[white-list]: Change keyword argument name to
> 'allow-list'.
You have a typo here. In general, should be (launch-environment):
Rename #:white-list to #:allow-list
> (launch-environment/fork)[white-list]: Change keyword argument name
> to
> 'allow-list'.
> (%options): Add --remote and --list-remote-backends options.
> (show-environment-options-help): Add help text for new options.
> * guix/profiles.scm (load-profile)[getenv-proc, setenv-proc,
> unsetenv-proc]:
> New optional keyword arguments.
> (load-profile)[white-list]: Change keyword argument name to 'allow-
> list'.
> (purify-environment)[white-list-regexps]: Change argument name to
> 'allow-list-regexps'.
> (purify-environment)[unsetenv-proc]: New argument.
> * guix/build/emacs-utils.scm (%emacsclient): New parameter.
> (emacsclient-batch-script): New procedure.
> * doc/guix.texi(Invoking guix shell): Document --remote and
> --list-remote-backends options.
> * tests/build-emacs-utils.scm(emacsclient-batch-script): New test.
> * tests/profiles.scm(load-profile): Change 'white-list' keyword
> argument to
> 'allow-list'.
> ---
> With requested changes from Maxim's review:
> Update white-list/allow-list terminology throughout.
> Always check for errors when invoking emacsclient.
> Simplify emacsclient invocation code by using the
> (guix build emacs-utils) module.
> Add new test to build-emacs-utils.scm for testing emacsclient.
You have merged two changes into one patch imho. I think it'd be
better if you swapped the wording first and then added the emacsclient
code.
Interestingly, this still won't support emacs sans client IIUC as we
anyhow have to spawn a new process. Can we (perhaps in cooperation
with guix-emacs) make it so that 'guix shell' spawned from eshell does
"the right thing"?
Cheers
^ permalink raw reply [flat|nested] 8+ messages in thread
* [bug#62848] [PATCH 1/2] guix: Rename white-list to allow-list.
2023-11-08 5:29 ` Liliana Marie Prikler
@ 2023-11-08 15:19 ` Antero Mejr via Guix-patches via
2023-11-08 15:21 ` [bug#62848] [PATCH 2/2] environment: Add --remote option and emacsclient-eshell backend Antero Mejr via Guix-patches via
2023-11-08 15:34 ` [bug#62848] [PATCH v2] " Antero Mejr via Guix-patches via
2 siblings, 0 replies; 8+ messages in thread
From: Antero Mejr via Guix-patches via @ 2023-11-08 15:19 UTC (permalink / raw)
To: Liliana Marie Prikler; +Cc: 62848, maxim.cournoyer
* guix/profiles.scm (purify-environment): Rename white-list-regexps to
allow-list-regexps. Rename white-list to allow-list.
(load-profile): Rename #:white-list-regexps to #:allow-list-regexps.
* guix/scripts/environment.scm (launch-environment): Rename
(launch-environment/fork): Rename #:white-list-regexps to
(launch-environment/container): Rename #:white-list-regexps to
(guix-environment*): Rename white-list to allow-list.
* tests/profiles.scm (load-profile): Rename #:white-list to #:allow-list in
load-profile procedure call.
---
guix/profiles.scm | 18 +++++++++---------
guix/scripts/environment.scm | 24 ++++++++++++------------
tests/profiles.scm | 2 +-
3 files changed, 22 insertions(+), 22 deletions(-)
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 5d2fb8dc64..380f42c5a1 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -2103,32 +2103,32 @@ (define* (profile-search-paths profile
(list profile) getenv))
(define %precious-variables
- ;; Environment variables in the default 'load-profile' white list.
+ ;; Environment variables in the default 'load-profile' allow list.
'("HOME" "USER" "LOGNAME" "DISPLAY" "XAUTHORITY" "TERM" "TZ" "PAGER"))
-(define (purify-environment white-list white-list-regexps)
+(define (purify-environment allow-list allow-list-regexps)
"Unset all environment variables except those that match the regexps in
-WHITE-LIST-REGEXPS and those listed in WHITE-LIST."
+ALLOW-LIST-REGEXPS and those listed in ALLOW-LIST."
(for-each unsetenv
(remove (lambda (variable)
- (or (member variable white-list)
+ (or (member variable allow-list)
(find (cut regexp-exec <> variable)
- white-list-regexps)))
+ allow-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))
+ #:key pure? (allow-list-regexps '())
+ (allow-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.
+match the regexps in ALLOW-LIST-REGEXPS and those listed in ALLOW-LIST.
Otherwise, augment existing environment variables with additional search
paths."
(when pure?
- (purify-environment white-list white-list-regexps))
+ (purify-environment allow-list allow-list-regexps))
(for-each (match-lambda
((($ <search-path-specification> variable _ separator) . value)
(let ((current (getenv variable)))
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index 6ae3b11e39..e1ab66c9ed 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -485,18 +485,18 @@ (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? (allow-list '())
emulate-fhs?)
"Load the environment of PROFILE, which corresponds to MANIFEST, and execute
COMMAND. When PURE?, pre-existing environment variables are cleared before
-setting the new ones, except those matching the regexps in WHITE-LIST. When
+setting the new ones, except those matching the regexps in ALLOW-LIST. When
EMULATE-FHS?, first set up an FHS environment with $PATH and generate the LD
cache."
;; Properly handle SIGINT, so pressing C-c in an interactive terminal
;; application works.
(sigaction SIGINT SIG_DFL)
(load-profile profile manifest
- #:pure? pure? #:white-list-regexps white-list)
+ #:pure? pure? #:allow-list-regexps allow-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
@@ -706,15 +706,15 @@ (define (suggest-command-name profile command)
closest))))))))
(define* (launch-environment/fork command profile manifest
- #:key pure? (white-list '()))
+ #:key pure? (allow-list '()))
"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
-regexps in WHITE-LIST."
+regexps in ALLOW-LIST."
(match (primitive-fork)
(0 (launch-environment command profile manifest
#:pure? pure?
- #:white-list white-list))
+ #:allow-list allow-list))
(pid (match (waitpid pid)
((_ . status)
status)))))
@@ -723,7 +723,7 @@ (define* (launch-environment/container #:key command bash user user-mappings
profile manifest link-profile? network?
map-cwd? emulate-fhs? nesting?
(setup-hook #f)
- (symlinks '()) (white-list '()))
+ (symlinks '()) (allow-list '()))
"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 store. When
@@ -818,7 +818,7 @@ (define* (launch-environment/container #:key command bash user user-mappings
(environ (filter (match-lambda
((variable . value)
(find (cut regexp-exec <> variable)
- white-list)))
+ allow-list)))
(get-environment-variables)))
;; Bind-mount all requisite store items, user-specified mappings,
;; /bin/sh, the current working directory, and possibly networking
@@ -931,7 +931,7 @@ (define* (launch-environment/container #:key command bash user user-mappings
(override-user-dir user home cwd)
home-dir))
- ;; Set environment variables that match WHITE-LIST.
+ ;; Set environment variables that match ALLOW-LIST.
(for-each (match-lambda
((variable . value)
(setenv variable value)))
@@ -1090,7 +1090,7 @@ (define (guix-environment* opts)
'("/bin/sh")
(list %default-shell))))
(mappings (pick-all opts 'file-system-mapping))
- (white-list (pick-all opts 'inherit-regexp)))
+ (allow-list (pick-all opts 'inherit-regexp)))
(define store-needed?
;; Whether connecting to the daemon is needed.
@@ -1203,7 +1203,7 @@ (define (guix-environment* opts)
#:user-mappings mappings
#:profile profile
#:manifest manifest
- #:white-list white-list
+ #:allow-list allow-list
#:link-profile? link-prof?
#:network? network?
#:map-cwd? (not no-cwd?)
@@ -1218,7 +1218,7 @@ (define (guix-environment* opts)
(return
(exit/status
(launch-environment/fork command profile manifest
- #:white-list white-list
+ #:allow-list allow-list
#:pure? pure?)))))))))))))
;;; Local Variables:
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 9c419ada93..1e134f5105 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -367,7 +367,7 @@ (define glibc
(getenv "PATH"))
(getenv "GUILE_LOAD_PATH")))
(with-environment-excursion
- (load-profile profile #:pure? #t #:white-list '())
+ (load-profile profile #:pure? #t #:allow-list '())
(equal? (list (string-append "PATH=" bindir))
(environ)))))))
base-commit: 220759226e93d76d8d80058f69f9d8b29714bbde
--
2.41.0
^ permalink raw reply related [flat|nested] 8+ messages in thread
* [bug#62848] [PATCH 2/2] environment: Add --remote option and emacsclient-eshell backend.
2023-11-08 5:29 ` Liliana Marie Prikler
2023-11-08 15:19 ` [bug#62848] [PATCH 1/2] guix: Rename white-list to allow-list Antero Mejr via Guix-patches via
@ 2023-11-08 15:21 ` Antero Mejr via Guix-patches via
2023-11-08 19:32 ` Liliana Marie Prikler
2023-11-08 15:34 ` [bug#62848] [PATCH v2] " Antero Mejr via Guix-patches via
2 siblings, 1 reply; 8+ messages in thread
From: Antero Mejr via Guix-patches via @ 2023-11-08 15:21 UTC (permalink / raw)
To: Liliana Marie Prikler; +Cc: 62848, maxim.cournoyer
* guix/scripts/environment.scm (launch-environment/eshell): New procedure.
(%remote-backends): New variable.
(guix-environment*): Add logic for remote backend switching.
(%options): Add --remote and --list-remote-backends options.
(show-environment-options-help): Add help text for new options.
* guix/profiles.scm (load-profile)[getenv-proc, setenv-proc, unsetenv-proc]:
New optional keyword arguments.
(purify-environment)[unsetenv-proc]: New argument.
* guix/build/emacs-utils.scm (%emacsclient): New parameter.
(emacsclient-batch-script): New procedure.
* doc/guix.texi(Invoking guix shell): Document --remote and
--list-remote-backends options.
* tests/build-emacs-utils.scm(emacsclient-batch-script): New test.
---
doc/guix.texi | 17 ++++++++
guix/build/emacs-utils.scm | 21 +++++++++
guix/profiles.scm | 30 +++++++------
guix/scripts/environment.scm | 82 ++++++++++++++++++++++++++++++++----
tests/build-emacs-utils.scm | 12 +++++-
5 files changed, 141 insertions(+), 21 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 9f06f1c325..92a0d99db7 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -6474,6 +6474,23 @@ Invoking guix shell
@itemx -s @var{system}
Attempt to build for @var{system}---e.g., @code{i686-linux}.
+@item --remote=@var{backend}[=@var{args}]
+Create an environment over a remote connection using @var{backend},
+optionally passing @var{args} to the backend.
+
+This option causes the @option{--container} option to be ignored.
+
+When @var{backend} is @code{emacsclient-eshell}, a new eshell buffer
+with the Guix environment will be opened. An Emacs server must already
+be running, and the @code{emacsclient} program must be available. Due
+to the way @code{eshell} handles commands, the @var{command} argument,
+if specified, will run in the initial @code{eshell} environment instead
+of the Guix @code{eshell} environment.
+
+@item --list-remote-backends
+Display the @var{backend} options for @code{guix shell --remote=BACKEND}
+and exit.
+
@item --container
@itemx -C
@cindex container
diff --git a/guix/build/emacs-utils.scm b/guix/build/emacs-utils.scm
index 8e12b5b6d4..e56e230efb 100644
--- a/guix/build/emacs-utils.scm
+++ b/guix/build/emacs-utils.scm
@@ -28,10 +28,12 @@ (define-module (guix build emacs-utils)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:export (%emacs
+ %emacsclient
emacs-batch-eval
emacs-batch-edit-file
emacs-batch-disable-compilation
emacs-batch-script
+ emacsclient-batch-script
emacs-batch-error?
emacs-batch-error-message
@@ -57,6 +59,10 @@ (define %emacs
;; The `emacs' command.
(make-parameter "emacs"))
+(define %emacsclient
+ ;; A list starting with the `emacsclient' command, plus optional arguments.
+ (make-parameter '("emacsclient")))
+
(define (expr->string expr)
"Converts EXPR, an expression, into a string."
(if (string? expr)
@@ -107,6 +113,21 @@ (define (emacs-batch-script expr)
(message (read-string (car error-pipe)))))))
output))
+(define (emacsclient-batch-script expr)
+ "Send the Elisp code EXPR to Emacs via emacsclient and return output."
+ (let* ((error-pipe (pipe))
+ (port (parameterize ((current-error-port (cdr error-pipe)))
+ (apply open-pipe* OPEN_READ
+ (car (%emacsclient)) "--eval" (expr->string expr)
+ (cdr (%emacsclient)))))
+ (output (read-string port))
+ (status (close-pipe port)))
+ (close-port (cdr error-pipe))
+ (unless (zero? status)
+ (raise (condition (&emacs-batch-error
+ (message (read-string (car error-pipe)))))))
+ (string-trim-both output (char-set-adjoin char-set:whitespace #\"))))
+
(define (emacs-generate-autoloads name directory)
"Generate autoloads for Emacs package NAME placed in DIRECTORY."
(let* ((file (string-append directory "/" name "-autoloads.el"))
diff --git a/guix/profiles.scm b/guix/profiles.scm
index 380f42c5a1..eca2b82cb3 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -2106,10 +2106,10 @@ (define %precious-variables
;; Environment variables in the default 'load-profile' allow list.
'("HOME" "USER" "LOGNAME" "DISPLAY" "XAUTHORITY" "TERM" "TZ" "PAGER"))
-(define (purify-environment allow-list allow-list-regexps)
+(define (purify-environment allow-list allow-list-regexps unsetenv-proc)
"Unset all environment variables except those that match the regexps in
ALLOW-LIST-REGEXPS and those listed in ALLOW-LIST."
- (for-each unsetenv
+ (for-each unsetenv-proc
(remove (lambda (variable)
(or (member variable allow-list)
(find (cut regexp-exec <> variable)
@@ -2121,23 +2121,29 @@ (define (purify-environment allow-list allow-list-regexps)
(define* (load-profile profile
#:optional (manifest (profile-manifest profile))
#:key pure? (allow-list-regexps '())
- (allow-list %precious-variables))
+ (allow-list %precious-variables)
+ (getenv-proc getenv) (setenv-proc setenv)
+ (unsetenv-proc unsetenv))
"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 ALLOW-LIST-REGEXPS and those listed in ALLOW-LIST.
Otherwise, augment existing environment variables with additional search
-paths."
+paths.
+GETENV-PROC is a one-argument procedure that returns an env var value.
+SETENV-PROC is a two-argument procedure the sets environment variables.
+UNSETENV-PROC is a one-argument procedure that unsets environment variables.
+Change those procedures to load a profile over a remote connection."
(when pure?
- (purify-environment allow-list allow-list-regexps))
+ (purify-environment allow-list allow-list-regexps unsetenv-proc))
(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)))))
+ (let ((current (getenv-proc variable)))
+ (setenv-proc variable
+ (if (and current (not pure?))
+ (if separator
+ (string-append value separator current)
+ value)
+ value)))))
(profile-search-paths profile manifest)))
(define (profile-regexp profile)
diff --git a/guix/scripts/environment.scm b/guix/scripts/environment.scm
index e1ab66c9ed..fa033dc0ae 100644
--- a/guix/scripts/environment.scm
+++ b/guix/scripts/environment.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2015-2023 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2018 Mike Gerwitz <mtg@gnu.org>
;;; Copyright © 2022, 2023 John Kehayias <john.kehayias@protonmail.com>
+;;; Copyright © 2023, Antero Mejr <antero@mailbox.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -29,6 +30,7 @@ (define-module (guix scripts environment)
#:use-module (guix profiles)
#:use-module (guix search-paths)
#:use-module (guix build utils)
+ #:use-module (guix build emacs-utils)
#:use-module (guix monads)
#:use-module ((guix gexp) #:select (lower-object))
#:autoload (guix describe) (current-profile current-channels)
@@ -72,6 +74,9 @@ (define-module (guix scripts environment)
(define %default-shell
(or (getenv "SHELL") "/bin/sh"))
+(define %remote-backends
+ '("emacsclient-eshell"))
+
(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."
@@ -104,6 +109,13 @@ (define (show-environment-options-help)
(display (G_ "
-r, --root=FILE make FILE a symlink to the result, and register it
as a garbage collector root"))
+ (display (G_ "
+ --remote=BACKEND[=ARGS]
+ create environment over a remote connection by
+ passing ARGS to BACKEND"))
+ (display (G_ "
+ --list-remote-backends
+ list available remote backends and exit"))
(display (G_ "
-C, --container run command within an isolated container"))
(display (G_ "
@@ -287,6 +299,13 @@ (define %options
(option '("bootstrap") #f #f
(lambda (opt name arg result)
(alist-cons 'bootstrap? #t result)))
+ (option '("remote") #t #f
+ (lambda (opt name arg result)
+ (alist-cons 'remote arg result)))
+ (option '("list-remote-backends") #f #f
+ (lambda args
+ (display (string-join %remote-backends "\n" 'suffix))
+ (exit 0)))
(append %transformation-options
%standard-build-options
@@ -719,6 +738,35 @@ (define* (launch-environment/fork command profile manifest
((_ . status)
status)))))
+(define* (launch-environment/eshell args command profile manifest
+ #:key pure? (allow-list '()))
+ "Create an new eshell buffer 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 regexps in ALLOW-LIST."
+
+ (parameterize ((%emacsclient (cons "emacsclient" args)))
+ (let* ((buf (emacsclient-batch-script '(buffer-name (eshell t))))
+ (ec-buf
+ (lambda (cmd)
+ (emacsclient-batch-script `(with-current-buffer ,buf ,cmd)))))
+ (load-profile
+ profile manifest #:pure? pure? #:allow-list-regexps allow-list
+ #:setenv-proc (lambda (var val)
+ (ec-buf (if (string=? var "PATH")
+ ;; TODO: TRAMP support?
+ `(eshell-set-path ,val)
+ `(setenv ,var ,val))))
+ #:unsetenv-proc (lambda (var)
+ (ec-buf `(setenv ,var))))
+ (match command
+ ((program . args)
+ (begin (ec-buf
+ `(eshell-command
+ ,(string-append program " " (string-join args))))
+ (ec-buf '(kill-buffer))))
+ (else #t)))))
+
(define* (launch-environment/container #:key command bash user user-mappings
profile manifest link-profile? network?
map-cwd? emulate-fhs? nesting?
@@ -748,7 +796,7 @@ (define* (launch-environment/container #:key command bash user user-mappings
added to the container.
Preserve environment variables whose name matches the one of the regexps in
-WHILE-LIST."
+ALLOW-LIST."
(define (optional-mapping->fs mapping)
(and (file-exists? (file-system-mapping-source mapping))
(file-system-mapping->bind-mount mapping)))
@@ -1081,14 +1129,17 @@ (define (guix-environment* opts)
(bootstrap? (assoc-ref opts 'bootstrap?))
(system (assoc-ref opts 'system))
(profile (assoc-ref opts 'profile))
+ (remote (string-split (assoc-ref opts 'remote) #\=))
(command (or (assoc-ref opts 'exec)
;; Spawn a shell if the user didn't specify
;; anything in particular.
- (if container?
- ;; The user's shell is likely not available
- ;; within the container.
- '("/bin/sh")
- (list %default-shell))))
+ (cond (container?
+ ;; The user's shell is likely not available
+ ;; within the container.
+ '("/bin/sh"))
+ ;; For remote, let the backend decide.
+ (remote '())
+ (else (list %default-shell)))))
(mappings (pick-all opts 'file-system-mapping))
(allow-list (pick-all opts 'inherit-regexp)))
@@ -1129,6 +1180,10 @@ (define (guix-environment* opts)
(when (pair? symlinks)
(leave (G_ "'--symlink' cannot be used without '--container'~%"))))
+ (when (and remote (not (member (car remote) %remote-backends)))
+ (leave
+ (G_ "Invalid remote backend, see --list-remote-backends for options.~%'")))
+
(with-store/maybe store
(with-status-verbosity (assoc-ref opts 'verbosity)
(define manifest-from-opts
@@ -1182,15 +1237,26 @@ (define (guix-environment* opts)
(mwhen (assoc-ref opts 'check?)
(return
- (if container?
+ (if (or container? remote)
(warning (G_ "'--check' is unnecessary \
-when using '--container'; doing nothing~%"))
+when using '--container' or '--remote'; doing nothing~%"))
(validate-child-shell-environment profile manifest))))
(cond
((assoc-ref opts 'search-paths)
(show-search-paths profile manifest #:pure? pure?)
(return #t))
+ (remote
+ (match (car remote)
+ ("emacsclient-eshell"
+ (return
+ (launch-environment/eshell
+ (match (cdr remote)
+ ((args) (string-split args #\space))
+ (_ '()))
+ command profile manifest
+ #:allow-list allow-list
+ #:pure? pure?)))))
(container?
(let ((bash-binary
(if bootstrap?
diff --git a/tests/build-emacs-utils.scm b/tests/build-emacs-utils.scm
index 4e851ed959..6b845b93b9 100644
--- a/tests/build-emacs-utils.scm
+++ b/tests/build-emacs-utils.scm
@@ -29,12 +29,22 @@ (define-module (test build-emacs-utils)
(test-begin "build-emacs-utils")
;; Only run the following tests if emacs is present.
-(test-skip (if (which "emacs") 0 5))
+(test-skip (if (which "emacs") 0 6))
(test-equal "emacs-batch-script: print foo from emacs"
"foo"
(emacs-batch-script '(princ "foo")))
+;; Note: If this test fails, subsequent runs might end up in a bad state.
+;; Running "emacsclient -s test -e '(kill-emacs)'" should fix it.
+(test-equal "emacsclient-batch-script: print foo from emacs via emacsclient"
+ "foo"
+ (begin (invoke (%emacs) "--quick" "--daemon=test")
+ (parameterize ((%emacsclient '("emacsclient" "-s" "test")))
+ (let ((out (emacsclient-batch-script '(princ "foo"))))
+ (emacsclient-batch-script '(kill-emacs))
+ out))))
+
(test-assert "emacs-batch-script: raise &emacs-batch-error on failure"
(guard (c ((emacs-batch-error? c)
;; The error message format changed between Emacs 27 and Emacs
--
2.41.0
^ permalink raw reply related [flat|nested] 8+ messages in thread
* [bug#62848] [PATCH v2] environment: Add --remote option and emacsclient-eshell backend.
2023-11-08 5:29 ` Liliana Marie Prikler
2023-11-08 15:19 ` [bug#62848] [PATCH 1/2] guix: Rename white-list to allow-list Antero Mejr via Guix-patches via
2023-11-08 15:21 ` [bug#62848] [PATCH 2/2] environment: Add --remote option and emacsclient-eshell backend Antero Mejr via Guix-patches via
@ 2023-11-08 15:34 ` Antero Mejr via Guix-patches via
2 siblings, 0 replies; 8+ messages in thread
From: Antero Mejr via Guix-patches via @ 2023-11-08 15:34 UTC (permalink / raw)
To: Liliana Marie Prikler; +Cc: 62848, maxim.cournoyer
Liliana Marie Prikler <liliana.prikler@gmail.com> writes:
> You have merged two changes into one patch imho. I think it'd be
> better if you swapped the wording first and then added the emacsclient
> code.
Fixed in updated patch set.
> Interestingly, this still won't support emacs sans client IIUC as we
> anyhow have to spawn a new process. Can we (perhaps in cooperation
> with guix-emacs) make it so that 'guix shell' spawned from eshell does
> "the right thing"?
Not 100% sure what you mean, but I do not think it is possible to start
eshell (or interact with an existing eshell) without using emacsclient
or starting a new emacs process. Starting a new emacs process is
cumbersome and doesn't make sense to me - I wouldn't want to start
another instance of emacs just to use a guix shell environment.
Currently, running guix shell in eshellwill invoke $SHELL, which seems
like the "right thing" but isn't very useful, since then you lose all
the eshell features.
The intention of this patch is that the user will have an emacs server
already running, via the forthcoming 'home-emacs-service-type' service
or some other method. Then guix shell can communicate with that server
to set up the environment in a new eshell buffer.
^ permalink raw reply [flat|nested] 8+ messages in thread
* [bug#62848] [PATCH 2/2] environment: Add --remote option and emacsclient-eshell backend.
2023-11-08 15:21 ` [bug#62848] [PATCH 2/2] environment: Add --remote option and emacsclient-eshell backend Antero Mejr via Guix-patches via
@ 2023-11-08 19:32 ` Liliana Marie Prikler
0 siblings, 0 replies; 8+ messages in thread
From: Liliana Marie Prikler @ 2023-11-08 19:32 UTC (permalink / raw)
To: Antero Mejr; +Cc: 62848, maxim.cournoyer
Am Mittwoch, dem 08.11.2023 um 15:21 +0000 schrieb Antero Mejr:
> * guix/scripts/environment.scm (launch-environment/eshell): New
> procedure.
> (%remote-backends): New variable.
> (guix-environment*): Add logic for remote backend switching.
> (%options): Add --remote and --list-remote-backends options.
> (show-environment-options-help): Add help text for new options.
> * guix/profiles.scm (load-profile)[getenv-proc, setenv-proc,
> unsetenv-proc]:
> New optional keyword arguments.
> (purify-environment)[unsetenv-proc]: New argument.
> * guix/build/emacs-utils.scm (%emacsclient): New parameter.
> (emacsclient-batch-script): New procedure.
> * doc/guix.texi(Invoking guix shell): Document --remote and
> --list-remote-backends options.
> * tests/build-emacs-utils.scm(emacsclient-batch-script): New test.
>
> ---
> doc/guix.texi | 17 ++++++++
> guix/build/emacs-utils.scm | 21 +++++++++
> guix/profiles.scm | 30 +++++++------
> guix/scripts/environment.scm | 82 ++++++++++++++++++++++++++++++++--
> --
> tests/build-emacs-utils.scm | 12 +++++-
> 5 files changed, 141 insertions(+), 21 deletions(-)
>
> diff --git a/doc/guix.texi b/doc/guix.texi
> index 9f06f1c325..92a0d99db7 100644
> --- a/doc/guix.texi
> +++ b/doc/guix.texi
> @@ -6474,6 +6474,23 @@ Invoking guix shell
> @itemx -s @var{system}
> Attempt to build for @var{system}---e.g., @code{i686-linux}.
>
> +@item --remote=@var{backend}[=@var{args}]
> +Create an environment over a remote connection using @var{backend},
> +optionally passing @var{args} to the backend.
> +
> +This option causes the @option{--container} option to be ignored.
> +
> +When @var{backend} is @code{emacsclient-eshell}, a new eshell buffer
> +with the Guix environment will be opened. An Emacs server must
> already
> +be running, and the @code{emacsclient} program must be available.
> Due
> +to the way @code{eshell} handles commands, the @var{command}
> argument,
> +if specified, will run in the initial @code{eshell} environment
> instead
> +of the Guix @code{eshell} environment.
> +
> +@item --list-remote-backends
> +Display the @var{backend} options for @code{guix shell --
> remote=BACKEND}
> +and exit.
> +
> @item --container
> @itemx -C
> @cindex container
> diff --git a/guix/build/emacs-utils.scm b/guix/build/emacs-utils.scm
> index 8e12b5b6d4..e56e230efb 100644
> --- a/guix/build/emacs-utils.scm
> +++ b/guix/build/emacs-utils.scm
> @@ -28,10 +28,12 @@ (define-module (guix build emacs-utils)
> #:use-module (srfi srfi-34)
> #:use-module (srfi srfi-35)
> #:export (%emacs
> + %emacsclient
> emacs-batch-eval
> emacs-batch-edit-file
> emacs-batch-disable-compilation
> emacs-batch-script
> + emacsclient-batch-script
>
> emacs-batch-error?
> emacs-batch-error-message
> @@ -57,6 +59,10 @@ (define %emacs
> ;; The `emacs' command.
> (make-parameter "emacs"))
>
> +(define %emacsclient
> + ;; A list starting with the `emacsclient' command, plus optional
> arguments.
> + (make-parameter '("emacsclient")))
> +
I think we should have emacsclient as a string parameter analogous to
emacs itself.
> (define (expr->string expr)
> "Converts EXPR, an expression, into a string."
> (if (string? expr)
> @@ -107,6 +113,21 @@ (define (emacs-batch-script expr)
> (message (read-string (car error-
> pipe)))))))
> output))
>
> +(define (emacsclient-batch-script expr)
> + "Send the Elisp code EXPR to Emacs via emacsclient and return
> output."
> + (let* ((error-pipe (pipe))
> + (port (parameterize ((current-error-port (cdr error-pipe)))
> + (apply open-pipe* OPEN_READ
> + (car (%emacsclient)) "--eval" (expr->string
> expr)
> + (cdr (%emacsclient)))))
Instead of passing extra parameters via %emacsclient, how about using
additional (keyword) arguments? I think #:socket-name and #:server-
file are obvious ones to have, but for the purpose here you might also
add a catch-all #:client-arguments which defaults to '().
> + (output (read-string port))
> + (status (close-pipe port)))
> + (close-port (cdr error-pipe))
> + (unless (zero? status)
> + (raise (condition (&emacs-batch-error
> + (message (read-string (car error-
> pipe)))))))
> + (string-trim-both output (char-set-adjoin char-set:whitespace
> #\"))))
> +
> (define (emacs-generate-autoloads name directory)
> "Generate autoloads for Emacs package NAME placed in DIRECTORY."
> (let* ((file (string-append directory "/" name "-autoloads.el"))
> diff --git a/guix/profiles.scm b/guix/profiles.scm
> index 380f42c5a1..eca2b82cb3 100644
> --- a/guix/profiles.scm
> +++ b/guix/profiles.scm
> @@ -2106,10 +2106,10 @@ (define %precious-variables
> ;; Environment variables in the default 'load-profile' allow list.
> '("HOME" "USER" "LOGNAME" "DISPLAY" "XAUTHORITY" "TERM" "TZ"
> "PAGER"))
>
> -(define (purify-environment allow-list allow-list-regexps)
> +(define (purify-environment allow-list allow-list-regexps unsetenv-
> proc)
You might want to use #:optional or #:key (unsetenv unsetenv) here.
> "Unset all environment variables except those that match the
> regexps in
> ALLOW-LIST-REGEXPS and those listed in ALLOW-LIST."
> - (for-each unsetenv
> + (for-each unsetenv-proc
> (remove (lambda (variable)
> (or (member variable allow-list)
> (find (cut regexp-exec <> variable)
> @@ -2121,23 +2121,29 @@ (define (purify-environment allow-list allow-
> list-regexps)
> (define* (load-profile profile
> #:optional (manifest (profile-manifest
> profile))
> #:key pure? (allow-list-regexps '())
> - (allow-list %precious-variables))
> + (allow-list %precious-variables)
> + (getenv-proc getenv) (setenv-proc setenv)
> + (unsetenv-proc unsetenv))
Same here, you can just shadow getenv et al.
> "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 ALLOW-LIST-REGEXPS and those listed in ALLOW-
> LIST.
> Otherwise, augment existing environment variables with additional
> search
> -paths."
> +paths.
> +GETENV-PROC is a one-argument procedure that returns an env var
> value.
> +SETENV-PROC is a two-argument procedure the sets environment
> variables.
> +UNSETENV-PROC is a one-argument procedure that unsets environment
> variables.
> +Change those procedures to load a profile over a remote connection."
> (when pure?
> - (purify-environment allow-list allow-list-regexps))
> + (purify-environment allow-list allow-list-regexps unsetenv-
> proc))
> (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)))))
> + (let ((current (getenv-proc variable)))
> + (setenv-proc variable
> + (if (and current (not pure?))
> + (if separator
> + (string-append value separator
> current)
> + value)
> + value)))))
> (profile-search-paths profile manifest)))
>
> (define (profile-regexp profile)
> diff --git a/guix/scripts/environment.scm
> b/guix/scripts/environment.scm
> index e1ab66c9ed..fa033dc0ae 100644
> --- a/guix/scripts/environment.scm
> +++ b/guix/scripts/environment.scm
> @@ -3,6 +3,7 @@
> ;;; Copyright © 2015-2023 Ludovic Courtès <ludo@gnu.org>
> ;;; Copyright © 2018 Mike Gerwitz <mtg@gnu.org>
> ;;; Copyright © 2022, 2023 John Kehayias
> <john.kehayias@protonmail.com>
> +;;; Copyright © 2023, Antero Mejr <antero@mailbox.org>
> ;;;
> ;;; This file is part of GNU Guix.
> ;;;
> @@ -29,6 +30,7 @@ (define-module (guix scripts environment)
> #:use-module (guix profiles)
> #:use-module (guix search-paths)
> #:use-module (guix build utils)
> + #:use-module (guix build emacs-utils)
> #:use-module (guix monads)
> #:use-module ((guix gexp) #:select (lower-object))
> #:autoload (guix describe) (current-profile current-channels)
> @@ -72,6 +74,9 @@ (define-module (guix scripts environment)
> (define %default-shell
> (or (getenv "SHELL") "/bin/sh"))
>
> +(define %remote-backends
> + '("emacsclient-eshell"))
> +
> (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."
> @@ -104,6 +109,13 @@ (define (show-environment-options-help)
> (display (G_ "
> -r, --root=FILE make FILE a symlink to the result, and
> register it
> as a garbage collector root"))
> + (display (G_ "
> + --remote=BACKEND[=ARGS]
> + create environment over a remote connection
> by
> + passing ARGS to BACKEND"))
> + (display (G_ "
> + --list-remote-backends
> + list available remote backends and exit"))
> (display (G_ "
> -C, --container run command within an isolated container"))
> (display (G_ "
> @@ -287,6 +299,13 @@ (define %options
> (option '("bootstrap") #f #f
> (lambda (opt name arg result)
> (alist-cons 'bootstrap? #t result)))
> + (option '("remote") #t #f
> + (lambda (opt name arg result)
> + (alist-cons 'remote arg result)))
> + (option '("list-remote-backends") #f #f
> + (lambda args
> + (display (string-join %remote-backends "\n"
> 'suffix))
> + (exit 0)))
>
> (append %transformation-options
> %standard-build-options
> @@ -719,6 +738,35 @@ (define* (launch-environment/fork command
> profile manifest
> ((_ . status)
> status)))))
>
> +(define* (launch-environment/eshell args command profile manifest
> + #:key pure? (allow-list '()))
> + "Create an new eshell buffer 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 regexps in ALLOW-LIST."
> +
> + (parameterize ((%emacsclient (cons "emacsclient" args)))
> + (let* ((buf (emacsclient-batch-script '(buffer-name (eshell
> t))))
> + (ec-buf
> + (lambda (cmd)
> + (emacsclient-batch-script `(with-current-buffer ,buf
> ,cmd)))))
> + (load-profile
> + profile manifest #:pure? pure? #:allow-list-regexps allow-list
> + #:setenv-proc (lambda (var val)
> + (ec-buf (if (string=? var "PATH")
> + ;; TODO: TRAMP support?
> + `(eshell-set-path ,val)
> + `(setenv ,var ,val))))
> + #:unsetenv-proc (lambda (var)
> + (ec-buf `(setenv ,var))))
> + (match command
> + ((program . args)
> + (begin (ec-buf
> + `(eshell-command
> + ,(string-append program " " (string-join args))))
> + (ec-buf '(kill-buffer))))
> + (else #t)))))
> +
> (define* (launch-environment/container #:key command bash user user-
> mappings
> profile manifest link-
> profile? network?
> map-cwd? emulate-fhs?
> nesting?
> @@ -748,7 +796,7 @@ (define* (launch-environment/container #:key
> command bash user user-mappings
> added to the container.
>
> Preserve environment variables whose name matches the one of the
> regexps in
> -WHILE-LIST."
> +ALLOW-LIST."
> (define (optional-mapping->fs mapping)
> (and (file-exists? (file-system-mapping-source mapping))
> (file-system-mapping->bind-mount mapping)))
> @@ -1081,14 +1129,17 @@ (define (guix-environment* opts)
> (bootstrap? (assoc-ref opts 'bootstrap?))
> (system (assoc-ref opts 'system))
> (profile (assoc-ref opts 'profile))
> + (remote (string-split (assoc-ref opts 'remote) #\=))
You might want to align the RHS here.
Also, think about the possibility of "=" turning up in the remote
arguments.
> (command (or (assoc-ref opts 'exec)
> ;; Spawn a shell if the user didn't specify
> ;; anything in particular.
> - (if container?
> - ;; The user's shell is likely not
> available
> - ;; within the container.
> - '("/bin/sh")
> - (list %default-shell))))
> + (cond (container?
> + ;; The user's shell is likely not
> available
> + ;; within the container.
> + '("/bin/sh"))
> + ;; For remote, let the backend decide.
> + (remote '())
> + (else (list %default-shell)))))
> (mappings (pick-all opts 'file-system-mapping))
> (allow-list (pick-all opts 'inherit-regexp)))
>
> @@ -1129,6 +1180,10 @@ (define (guix-environment* opts)
> (when (pair? symlinks)
> (leave (G_ "'--symlink' cannot be used without '--
> container'~%"))))
>
> + (when (and remote (not (member (car remote) %remote-backends)))
> + (leave
> + (G_ "Invalid remote backend, see --list-remote-backends for
> options.~%'")))
> +
> (with-store/maybe store
> (with-status-verbosity (assoc-ref opts 'verbosity)
> (define manifest-from-opts
> @@ -1182,15 +1237,26 @@ (define (guix-environment* opts)
>
> (mwhen (assoc-ref opts 'check?)
> (return
> - (if container?
> + (if (or container? remote)
> (warning (G_ "'--check' is unnecessary \
> -when using '--container'; doing nothing~%"))
> +when using '--container' or '--remote'; doing nothing~%"))
> (validate-child-shell-environment profile
> manifest))))
>
> (cond
> ((assoc-ref opts 'search-paths)
> (show-search-paths profile manifest #:pure? pure?)
> (return #t))
> + (remote
> + (match (car remote)
> + ("emacsclient-eshell"
> + (return
> + (launch-environment/eshell
> + (match (cdr remote)
> + ((args) (string-split args #\space))
> + (_ '()))
> + command profile manifest
> + #:allow-list allow-list
> + #:pure? pure?)))))
You can match the car and cdr in one go.
Your string-split code also ignores the way whitespace is typically
handled (and escaped!) in shells, which may or may not go well.
> (container?
> (let ((bash-binary
> (if bootstrap?
> diff --git a/tests/build-emacs-utils.scm b/tests/build-emacs-
> utils.scm
> index 4e851ed959..6b845b93b9 100644
> --- a/tests/build-emacs-utils.scm
> +++ b/tests/build-emacs-utils.scm
> @@ -29,12 +29,22 @@ (define-module (test build-emacs-utils)
>
> (test-begin "build-emacs-utils")
> ;; Only run the following tests if emacs is present.
> -(test-skip (if (which "emacs") 0 5))
> +(test-skip (if (which "emacs") 0 6))
>
> (test-equal "emacs-batch-script: print foo from emacs"
> "foo"
> (emacs-batch-script '(princ "foo")))
>
> +;; Note: If this test fails, subsequent runs might end up in a bad
> state.
> +;; Running "emacsclient -s test -e '(kill-emacs)'" should fix it.
> +(test-equal "emacsclient-batch-script: print foo from emacs via
> emacsclient"
> + "foo"
> + (begin (invoke (%emacs) "--quick" "--daemon=test")
> + (parameterize ((%emacsclient '("emacsclient" "-s" "test")))
> + (let ((out (emacsclient-batch-script '(princ "foo"))))
> + (emacsclient-batch-script '(kill-emacs))
> + out))))
> +
> (test-assert "emacs-batch-script: raise &emacs-batch-error on
> failure"
> (guard (c ((emacs-batch-error? c)
> ;; The error message format changed between Emacs 27
> and Emacs
Cheers
^ permalink raw reply [flat|nested] 8+ messages in thread
end of thread, other threads:[~2023-11-08 19:34 UTC | newest]
Thread overview: 8+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
2023-04-15 1:44 [bug#62848] [PATCH] environment: Add --remote option and emacsclient-eshell backend Antero Mejr via Guix-patches via
2023-09-01 13:26 ` Maxim Cournoyer
2023-11-07 22:30 ` [bug#62848] [PATCH v2] " Antero Mejr via Guix-patches via
2023-11-08 5:29 ` Liliana Marie Prikler
2023-11-08 15:19 ` [bug#62848] [PATCH 1/2] guix: Rename white-list to allow-list Antero Mejr via Guix-patches via
2023-11-08 15:21 ` [bug#62848] [PATCH 2/2] environment: Add --remote option and emacsclient-eshell backend Antero Mejr via Guix-patches via
2023-11-08 19:32 ` Liliana Marie Prikler
2023-11-08 15:34 ` [bug#62848] [PATCH v2] " Antero Mejr via Guix-patches via
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/guix.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).