all messages for Guix-related lists mirrored at yhetil.org
 help / color / mirror / code / Atom feed
* [bug#36957] [PATCH] machine: Allow non-root users to deploy.
@ 2019-08-07 12:46 Jakob L. Kreuze
  2019-08-07 17:43 ` Ricardo Wurmus
  2019-08-07 22:31 ` Christopher Lemmer Webber
  0 siblings, 2 replies; 21+ messages in thread
From: Jakob L. Kreuze @ 2019-08-07 12:46 UTC (permalink / raw)
  To: 36957

[-- Attachment #1: Type: text/plain, Size: 12040 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 | 15 ++++++++++--
 guix/remote.scm     | 60 ++++++++++++++++++++++++++++-----------------
 guix/ssh.scm        | 30 ++++++++++++++++-------
 4 files changed, 82 insertions(+), 33 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index 64ca44d494..144981af10 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
@@ -25530,6 +25531,15 @@ complex deployment may involve, for example, starting virtual machines through
 a Virtual Private Server (VPS) provider.  In such a case, a different
 @var{environment} type would be used.
 
+@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 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 90deff19a8..083e443a16 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -105,6 +105,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."
@@ -112,7 +120,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
 ;;;
@@ -335,7 +345,8 @@ environment type of 'managed-host."
   (remote-authorize-signing-key (call-with-input-file %public-key-file
                                   (lambda (port)
                                     (string->canonical-sexp (get-string-all port))))
-                                (machine-ssh-session machine))
+                                (machine-ssh-session machine)
+                                (machine-become-command machine))
   (mlet %store-monad ((_ (check-deployment-sanity machine))
                       (boot-parameters (machine-boot-parameters machine)))
     (let* ((os (machine-operating-system machine))
diff --git a/guix/remote.scm b/guix/remote.scm
index d5738ebbfa..d5992763b2 100644
--- a/guix/remote.scm
+++ b/guix/remote.scm
@@ -27,6 +27,8 @@
   #:use-module (guix utils)
   #: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))
 
@@ -41,29 +43,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))
@@ -91,12 +105,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 ((system -> (remote-system session))
                        (lowered (lower-gexp (trampoline exp)
                                             #:system system
@@ -119,7 +135,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)
@@ -128,4 +144,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 5186c646ca..7bc499a2fe 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -100,16 +100,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 ()
@@ -291,7 +302,7 @@ the machine on the other end of SESSION."
   (inferior-remote-eval '(begin (use-modules (guix utils)) (%current-system))
                         session))
 
-(define (remote-authorize-signing-key key session)
+(define* (remote-authorize-signing-key key session #:optional become-command)
   "Send KEY, a canonical sexp containing a public key, over SESSION and add it
 to the system ACL file if it has not yet been authorized."
   (inferior-remote-eval
@@ -310,7 +321,8 @@ to the system ACL file if it has not yet been authorized."
           (mkdir-p (dirname %acl-file))
           (with-atomic-file-output %acl-file
             (cut write-acl acl <>)))))
-   session))
+   session
+   become-command))
 
 (define* (send-files local files remote
                      #:key
-- 
2.22.0


[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

^ permalink raw reply related	[flat|nested] 21+ messages in thread

end of thread, other threads:[~2019-08-15 16:14 UTC | newest]

Thread overview: 21+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
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       ` [bug#36957] [PATCH v3] " Jakob L. Kreuze

Code repositories for project(s) associated with this external index

	https://git.savannah.gnu.org/cgit/guix.git

This is an external index of several public inboxes,
see mirroring instructions on how to clone and mirror
all data and code used by this external index.