From patchwork Wed Nov 8 15:21:06 2023 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: Antero Mejr X-Patchwork-Id: 56098 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 6AC1427BBEA; Wed, 8 Nov 2023 15:21:39 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,SPF_HELO_PASS,URIBL_BLOCKED autolearn=ham autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id 4F1DD27BBE2 for ; Wed, 8 Nov 2023 15:21:35 +0000 (GMT) Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1r0kMz-0004KS-Md; Wed, 08 Nov 2023 10:21:29 -0500 Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1r0kMu-0004KB-5J for guix-patches@gnu.org; Wed, 08 Nov 2023 10:21:24 -0500 Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1r0kMt-0000Z3-TK for guix-patches@gnu.org; Wed, 08 Nov 2023 10:21:23 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1r0kNW-0003ww-EN for guix-patches@gnu.org; Wed, 08 Nov 2023 10:22:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#62848] [PATCH 2/2] environment: Add --remote option and emacsclient-eshell backend. Resent-From: Antero Mejr Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Wed, 08 Nov 2023 15:22:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 62848 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: moreinfo patch To: Liliana Marie Prikler Cc: 62848@debbugs.gnu.org, maxim.cournoyer@gmail.com Received: via spool by 62848-submit@debbugs.gnu.org id=B62848.169945692015174 (code B ref 62848); Wed, 08 Nov 2023 15:22:02 +0000 Received: (at 62848) by debbugs.gnu.org; 8 Nov 2023 15:22:00 +0000 Received: from localhost ([127.0.0.1]:46139 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1r0kNT-0003wg-AK for submit@debbugs.gnu.org; Wed, 08 Nov 2023 10:22:00 -0500 Received: from mout-p-201.mailbox.org ([80.241.56.171]:58964) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1r0kNQ-0003wR-Ef for 62848@debbugs.gnu.org; Wed, 08 Nov 2023 10:21:58 -0500 Received: from smtp1.mailbox.org (smtp1.mailbox.org [IPv6:2001:67c:2050:b231:465::1]) (using TLSv1.3 with cipher TLS_AES_256_GCM_SHA384 (256/256 bits) key-exchange X25519 server-signature RSA-PSS (4096 bits) server-digest SHA256) (No client certificate requested) by mout-p-201.mailbox.org (Postfix) with ESMTPS id 4SQTLs71fvz9sbD; Wed, 8 Nov 2023 16:21:09 +0100 (CET) DKIM-Signature: v=1; a=rsa-sha256; c=relaxed/relaxed; d=mailbox.org; s=mail20150812; t=1699456870; h=from:from:reply-to:subject:subject:date:date:message-id:message-id: to:to:cc:cc:mime-version:mime-version:content-type:content-type: content-transfer-encoding:content-transfer-encoding: in-reply-to:in-reply-to:references:references; bh=YpfEvVhf72kxNBUkuTzrPuy64ZlORKTLUuV1SjA2WiI=; b=jvNBFqskklZVQkfsUJGggFbQYdN8/yVTxcwjnD8JVu7bF0WGj/HZxqqnrwf3tbTIiZRQjN oBPUmCbIT4reG8n09lCvK7xXnuFQ7rw3BPVDitXRImtqCOopZ733DW/gwMmeQWRlRUCXKd 1pAN8lJLaXZI45AH9t9Agc+A2LHH46meyXHfuptdO82P7ZLW84MIAZ/L7ShwAC/y+s/wDC NS5e/l08cthPrSGl7ca/jdvs1fDEQnV6MykRhzI9T5gU6YsSh+I+6y3KzZM3Ok8T6k3Igg Hix5DYSy4Cyi/UDbYb/zhcmTjSOmae0abxnTXPr4kgVxHZLlZITqYCPljJXGWQ== In-Reply-To: <16e985a5a6cc331daecfb58a1a737e6c6f76fa32.camel@gmail.com> (Liliana Marie Prikler's message of "Wed, 08 Nov 2023 06:29:03 +0100") References: <87msvpmc2e.fsf@mailbox.org> <16e985a5a6cc331daecfb58a1a737e6c6f76fa32.camel@gmail.com> Date: Wed, 08 Nov 2023 15:21:06 +0000 Message-ID: <87leb8uv8d.fsf_-_@mailbox.org> MIME-Version: 1.0 X-MBO-RS-META: ruqary1yd81q1zaapp4txo37ue5b797b X-MBO-RS-ID: 0716bf5160813ff72f3 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Reply-to: Antero Mejr X-ACL-Warn: , Antero Mejr via Guix-patches X-Patchwork-Original-From: Antero Mejr via Guix-patches via From: Antero Mejr Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org X-getmail-retrieved-from-mailbox: Patches * 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 ((($ 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 ;;; Copyright © 2018 Mike Gerwitz ;;; Copyright © 2022, 2023 John Kehayias +;;; Copyright © 2023, Antero Mejr ;;; ;;; 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