[bug#62848,2/2] environment: Add --remote option and emacsclient-eshell backend.

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

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