From: zerodaysfordays@sdf.lonestar.org (Jakob L. Kreuze)
To: Ricardo Wurmus <rekado@elephly.net>
Cc: 36957@debbugs.gnu.org
Subject: [bug#36957] [PATCH v3] machine: Allow non-root users to deploy.
Date: Thu, 08 Aug 2019 16:26:27 -0400 [thread overview]
Message-ID: <87pnlfjte4.fsf_-_@sdf.lonestar.org> (raw)
In-Reply-To: <87y304vyyo.fsf@elephly.net> (Ricardo Wurmus's message of "Thu, 08 Aug 2019 10:33:03 +0200")
[-- Attachment #1: Type: text/plain, Size: 10524 bytes --]
* doc/guix.texi (Invoking guix deploy): Add section describing
prerequisites for deploying as a non-root user.
* guix/remote.scm (remote-pipe-for-gexp): New optional 'become-command'
argument.
(%remote-eval): New optional 'become-command' argument.
(remote-eval): New 'become-command' keyword argument.
* guix/ssh.scm (remote-inferior): New optional 'become-command'
argument.
(inferior-remote-eval): New optional 'become-command' argument.
(remote-authorize-signing-key): New optional 'become-command' argument.
* gnu/machine/ssh.scm (machine-become-command): New variable.
(managed-host-remote-eval): Invoke 'remote-eval' with the
'#:become-command' keyword.
(deploy-managed-host): Invoke 'remote-authorize-signing-key' with the
'#:become-command' keyword.
---
doc/guix.texi | 10 ++++++++
gnu/machine/ssh.scm | 12 ++++++++-
guix/remote.scm | 60 ++++++++++++++++++++++++++++-----------------
guix/ssh.scm | 25 +++++++++++++------
4 files changed, 77 insertions(+), 30 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index 734206a4b2..1478749d7d 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -25514,6 +25514,7 @@ evaluates to. As an example, @var{file} might contain a definition like this:
(environment managed-host-environment-type)
(configuration (machine-ssh-configuration
(host-name "localhost")
+ (user "alice")
(identity "./id_rsa")
(port 2222)))))
@end example
@@ -25546,6 +25547,15 @@ accepts store items it receives from the coordinator:
# guix archive --authorize < coordinator-public-key.txt
@end example
+@code{user}, in this example, specifies the name of the user account to log in
+as to perform the deployment. Its default value is @code{root}, but root
+login over SSH may be forbidden in some cases. To work around this,
+@command{guix deploy} can log in as an unprivileged user and employ
+@code{sudo} to escalate privileges. This will only work if @code{sudo} is
+currently installed on the remote and can be invoked non-interactively as
+@code{user}. That is: the line in @code{sudoers} granting @code{user} the
+ability to use @code{sudo} must contain the @code{NOPASSWD} tag.
+
@deftp {Data Type} machine
This is the data type representing a single machine in a heterogeneous Guix
deployment.
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index ba3e33c922..aba98f8de5 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -99,6 +99,14 @@ one from the configuration's parameters if one was not provided."
;;; Remote evaluation.
;;;
+(define (machine-become-command machine)
+ "Return as a list of strings the program and arguments necessary to run a
+shell command with escalated privileges for MACHINE's configuration."
+ (if (string= "root" (machine-ssh-configuration-user
+ (machine-configuration machine)))
+ '()
+ '("/run/setuid-programs/sudo" "-n" "--")))
+
(define (managed-host-remote-eval machine exp)
"Internal implementation of 'machine-remote-eval' for MACHINE instances with
an environment type of 'managed-host."
@@ -106,7 +114,9 @@ an environment type of 'managed-host."
(remote-eval exp (machine-ssh-session machine)
#:build-locally?
(machine-ssh-configuration-build-locally?
- (machine-configuration machine))))
+ (machine-configuration machine))
+ #:become-command
+ (machine-become-command machine)))
\f
;;;
diff --git a/guix/remote.scm b/guix/remote.scm
index 5fecd954e9..b0b6afba93 100644
--- a/guix/remote.scm
+++ b/guix/remote.scm
@@ -26,6 +26,8 @@
#:use-module (guix derivations)
#:use-module (ssh popen)
#:use-module (srfi srfi-1)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
#:use-module (ice-9 match)
#:export (remote-eval))
@@ -40,29 +42,41 @@
;;;
;;; Code:
-(define (remote-pipe-for-gexp lowered session)
- "Return a remote pipe for the given SESSION to evaluate LOWERED."
+(define* (remote-pipe-for-gexp lowered session #:optional become-command)
+ "Return a remote pipe for the given SESSION to evaluate LOWERED. If
+BECOME-COMMAND is given, use that to invoke the remote Guile REPL."
(define shell-quote
(compose object->string object->string))
- (apply open-remote-pipe* session OPEN_READ
- (string-append (derivation-input-output-path
- (lowered-gexp-guile lowered))
- "/bin/guile")
- "--no-auto-compile"
- (append (append-map (lambda (directory)
- `("-L" ,directory))
- (lowered-gexp-load-path lowered))
- (append-map (lambda (directory)
- `("-C" ,directory))
- (lowered-gexp-load-path lowered))
- `("-c"
- ,(shell-quote (lowered-gexp-sexp lowered))))))
+ (define repl-command
+ (append (or become-command '())
+ (list
+ (string-append (derivation-input-output-path
+ (lowered-gexp-guile lowered))
+ "/bin/guile")
+ "--no-auto-compile")
+ (append-map (lambda (directory)
+ `("-L" ,directory))
+ (lowered-gexp-load-path lowered))
+ (append-map (lambda (directory)
+ `("-C" ,directory))
+ (lowered-gexp-load-path lowered))
+ `("-c"
+ ,(shell-quote (lowered-gexp-sexp lowered)))))
-(define (%remote-eval lowered session)
+ (let ((pipe (apply open-remote-pipe* session OPEN_READ repl-command)))
+ (when (eof-object? (peek-char pipe))
+ (raise (condition
+ (&message
+ (message (format #f (G_ "failed to run '~{~a~^ ~}'")
+ repl-command))))))
+ pipe))
+
+(define* (%remote-eval lowered session #:optional become-command)
"Evaluate LOWERED, a lowered gexp, in SESSION. This assumes that all the
-prerequisites of EXP are already available on the host at SESSION."
- (let* ((pipe (remote-pipe-for-gexp lowered session))
+prerequisites of EXP are already available on the host at SESSION. If
+BECOME-COMMAND is given, use that to invoke the remote Guile REPL."
+ (let* ((pipe (remote-pipe-for-gexp lowered session become-command))
(result (read-repl-response pipe)))
(close-port pipe)
result))
@@ -90,12 +104,14 @@ result to the current output port using the (guix repl) protocol."
#:key
(build-locally? #t)
(module-path %load-path)
- (socket-name "/var/guix/daemon-socket/socket"))
+ (socket-name "/var/guix/daemon-socket/socket")
+ (become-command #f))
"Evaluate EXP, a gexp, on the host at SESSION, an SSH session. Ensure that
all the elements EXP refers to are built and deployed to SESSION beforehand.
When BUILD-LOCALLY? is true, said dependencies are built locally and sent to
the remote store afterwards; otherwise, dependencies are built directly on the
-remote store."
+remote store. If BECOME-COMMAND is given, use that to invoke the remote Guile
+REPL."
(mlet %store-monad ((lowered (lower-gexp (trampoline exp)
#:module-path %load-path))
(remote -> (connect-to-remote-daemon session
@@ -115,7 +131,7 @@ remote store."
(built-derivations inputs)
((store-lift send-files) to-send remote #:recursive? #t)
(return (close-connection remote))
- (return (%remote-eval lowered session))))
+ (return (%remote-eval lowered session become-command))))
(let ((to-send (append (map (compose derivation-file-name
derivation-input-derivation)
inputs)
@@ -124,4 +140,4 @@ remote store."
((store-lift send-files) to-send remote #:recursive? #t)
(return (build-derivations remote inputs))
(return (close-connection remote))
- (return (%remote-eval lowered session)))))))
+ (return (%remote-eval lowered session become-command)))))))
diff --git a/guix/ssh.scm b/guix/ssh.scm
index ede00133c8..0f65f9e65b 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -97,16 +97,27 @@ specifies; otherwise use them. Throw an error on failure."
(message (format #f (G_ "SSH connection to '~a' failed: ~a~%")
host (get-error session))))))))))
-(define (remote-inferior session)
- "Return a remote inferior for the given SESSION."
- (let ((pipe (open-remote-pipe* session OPEN_BOTH
- "guix" "repl" "-t" "machine")))
+(define* (remote-inferior session #:optional become-command)
+ "Return a remote inferior for the given SESSION. If BECOME-COMMAND is
+given, use that to invoke the remote Guile REPL."
+ (let* ((repl-command (append (or become-command '())
+ '("guix" "repl" "-t" "machine")))
+ (pipe (apply open-remote-pipe* session OPEN_BOTH repl-command)))
+ ;; XXX: 'channel-get-exit-status' would be better here, but hangs if the
+ ;; process does succeed. This doesn't reflect the documentation, so it's
+ ;; possible that it's a bug in guile-ssh.
+ (when (eof-object? (peek-char pipe))
+ (raise (condition
+ (&message
+ (message (format #f (G_ "failed to run '~{~a~^ ~}'")
+ repl-command))))))
(port->inferior pipe)))
-(define (inferior-remote-eval exp session)
+(define* (inferior-remote-eval exp session #:optional become-command)
"Evaluate EXP in a new inferior running in SESSION, and close the inferior
-right away."
- (let ((inferior (remote-inferior session)))
+right away. If BECOME-COMMAND is given, use that to invoke the remote Guile
+REPL."
+ (let ((inferior (remote-inferior session become-command)))
(dynamic-wind
(const #t)
(lambda ()
--
2.22.0
[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]
prev parent reply other threads:[~2019-08-08 20:27 UTC|newest]
Thread overview: 21+ messages / expand[flat|nested] mbox.gz Atom feed top
2019-08-07 12:46 [bug#36957] [PATCH] machine: Allow non-root users to deploy Jakob L. Kreuze
2019-08-07 17:43 ` Ricardo Wurmus
2019-08-07 19:17 ` Christopher Lemmer Webber
2019-08-07 20:20 ` Jakob L. Kreuze
2019-08-07 20:34 ` Ricardo Wurmus
2019-08-07 20:39 ` Jakob L. Kreuze
2019-08-07 22:31 ` Christopher Lemmer Webber
2019-08-08 0:20 ` [bug#36957] [PATCH v2] " Jakob L. Kreuze
2019-08-08 8:33 ` Ricardo Wurmus
2019-08-08 20:24 ` Jakob L. Kreuze
2019-08-14 20:52 ` Christopher Lemmer Webber
2019-08-15 8:03 ` [bug#36957] [PATCH 0/5] Consolidated patches for guix deploy Jakob L. Kreuze
2019-08-15 8:05 ` [bug#36957] [PATCH 1/5] machine: Allow non-root users to deploy Jakob L. Kreuze
2019-08-15 8:05 ` [bug#36957] [PATCH 2/5] machine: Implement 'roll-back-machine' Jakob L. Kreuze
2019-08-15 8:06 ` [bug#36957] [PATCH 3/5] machine: Automatically authorize the coordinator's signing key Jakob L. Kreuze
2019-08-15 8:07 ` [bug#36957] [PATCH 4/5] doc: Add description of 'build-locally?' Jakob L. Kreuze
2019-08-15 8:08 ` [bug#36957] [PATCH 5/5] remote: Use (%daemon-socket-uri) rather than hard-coded path Jakob L. Kreuze
2019-08-15 11:44 ` bug#36957: " Christopher Lemmer Webber
2019-08-15 15:07 ` [bug#36957] [PATCH 1/5] machine: Allow non-root users to deploy Ricardo Wurmus
2019-08-15 16:13 ` Jakob L. Kreuze
2019-08-08 20:26 ` Jakob L. Kreuze [this message]
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://guix.gnu.org/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=87pnlfjte4.fsf_-_@sdf.lonestar.org \
--to=zerodaysfordays@sdf.lonestar.org \
--cc=36957@debbugs.gnu.org \
--cc=rekado@elephly.net \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
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).