Package: guix-patches;
Reported by: Antero Mejr <antero <at> mailbox.org>
Date: Sat, 15 Apr 2023 01:45:01 UTC
Severity: normal
Tags: moreinfo, patch
Message #28 received at 62848 <at> debbugs.gnu.org (full text, mbox):
From: Liliana Marie Prikler <liliana.prikler <at> gmail.com> To: Antero Mejr <antero <at> mailbox.org> Cc: 62848 <at> debbugs.gnu.org, maxim.cournoyer <at> gmail.com Subject: Re: [PATCH 2/2] environment: Add --remote option and emacsclient-eshell backend. Date: Wed, 08 Nov 2023 20:32:08 +0100
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 <at> gnu.org>
> ;;; Copyright © 2018 Mike Gerwitz <mtg <at> gnu.org>
> ;;; Copyright © 2022, 2023 John Kehayias
> <john.kehayias <at> protonmail.com>
> +;;; Copyright © 2023, Antero Mejr <antero <at> 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
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.