From 2c8e04f13670c8c7ad8c7195c305960dd1905363 Mon Sep 17 00:00:00 2001
From: "Jakob L. Kreuze" <zerodaysfordays@sdf.lonestar.org>
Date: Fri, 9 Aug 2019 14:24:57 -0400
Subject: remote: Build derivations appropriate for the remote's
* gnu/machine/ssh.scm (machine-ssh-configuration): Add 'system' field.
(managed-host-remote-eval): Pass 'system' field to 'remote-eval'.
(machine-check-building-for-appropriate-system): New variable.
(check-deployment-sanity): Add call to
'machine-check-building-for-appropriate-system'.
* doc/guix.texi (Invoking guix deploy): Describe new 'system' field.
* guix/ssh.scm (remote-system): New variable.
* guix/remote.scm (remote-eval): Use result of 'remote-system' when
lowering the G-Expression.
(remote-eval): Add 'system' keyword argument.
(trampoline): Return a <program-file> rather than a <scheme-file>.
---
doc/guix.texi | 3 +++
1 file changed, 3 insertions(+)
(limited to 'doc')
diff --git a/doc/guix.texi b/doc/guix.texi
index 734206a4b2..a7facf4701 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -25573,6 +25573,9 @@ with an @code{environment} of @code{managed-host-environment-type}.
@table @asis
@item @code{host-name}
+@item @code{system}
+The Nix system type describing the architecture of the machine being deployed
+to. This should look something like ``x86_64-linux''.
@item @code{port} (default: @code{22})
@item @code{user} (default: @code{"root"})
@item @code{identity} (default: @code{#f})
--
cgit v1.2.3
From 5ea7537b9a650cfa525401c19879080a9cf42e13 Mon Sep 17 00:00:00 2001
From: "Jakob L. Kreuze" <zerodaysfordays@sdf.lonestar.org>
Date: Thu, 15 Aug 2019 04:05:04 -0400
Subject: machine: Allow non-root users to deploy.
* 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 | 8 ++++++++
guix/remote.scm | 57 +++++++++++++++++++++++++++++++++--------------------
guix/ssh.scm | 25 ++++++++++++++++-------
4 files changed, 72 insertions(+), 28 deletions(-)
(limited to 'doc')
diff --git a/doc/guix.texi b/doc/guix.texi
index a7facf4701..e5cec7ad25 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 670990a633..fb15d39e61 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -101,6 +101,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."
diff --git a/guix/remote.scm b/guix/remote.scm
index bcac64ea7a..d8124e41ab 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))
@@ -92,7 +106,8 @@ result to the current output port using the (guix repl) protocol."
(build-locally? #t)
(system (%current-system))
(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
@@ -119,7 +134,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 +143,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 9b5ca68894..90311127a1 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -98,16 +98,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 ()
--
cgit v1.2.3
From 3033d59ac9a747b42a1fa6ca6664d4fbc62ca117 Mon Sep 17 00:00:00 2001
From: "Jakob L. Kreuze" <zerodaysfordays@sdf.lonestar.org>
Date: Thu, 15 Aug 2019 04:06:41 -0400
Subject: machine: Automatically authorize the coordinator's signing key.
* guix/ssh.scm (remote-authorize-signing-key): New variable.
* gnu/machine/ssh.scm (deploy-managed-host): Authorize coordinator's
signing key before any invocations of 'remote-eval'.
(deploy-managed-host): Display an error if a signing key does not exist.
* doc/guix.texi (Invoking guix deploy): Remove section describing manual
signing key authorization.
(Invoking guix deploy): Add section describing the 'authorize?' field.
---
doc/guix.texi | 3 +++
gnu/machine/ssh.scm | 33 ++++++++++++++++++++++++++-------
guix/ssh.scm | 23 +++++++++++++++++++++++
3 files changed, 52 insertions(+), 7 deletions(-)
(limited to 'doc')
diff --git a/doc/guix.texi b/doc/guix.texi
index e5cec7ad25..d80f62970d 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -25586,6 +25586,9 @@ with an @code{environment} of @code{managed-host-environment-type}.
@item @code{system}
The Nix system type describing the architecture of the machine being deployed
to. This should look something like ``x86_64-linux''.
+@item @code{authorize?} (default: @code{#t})
+If true, the coordinator's signing key will be added to the remote's ACL
+keyring.
@item @code{port} (default: @code{22})
@item @code{user} (default: @code{"root"})
@item @code{identity} (default: @code{#f})
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 4b5d5fe3a2..ac3aa3e370 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -28,13 +28,16 @@
#:use-module (guix i18n)
#:use-module (guix modules)
#:use-module (guix monads)
+ #:use-module (guix pki)
#:use-module (guix records)
#:use-module (guix remote)
#:use-module (guix scripts system reconfigure)
#:use-module (guix ssh)
#:use-module (guix store)
#:use-module (guix utils)
+ #:use-module (gcrypt pk-crypto)
#:use-module (ice-9 match)
+ #:use-module (ice-9 textual-ports)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-19)
#:use-module (srfi srfi-26)
@@ -48,6 +51,7 @@
machine-ssh-configuration-host-name
machine-ssh-configuration-build-locally?
+ machine-ssh-configuration-authorize?
machine-ssh-configuration-port
machine-ssh-configuration-user
machine-ssh-configuration-session))
@@ -70,17 +74,19 @@
make-machine-ssh-configuration
machine-ssh-configuration?
this-machine-ssh-configuration
- (host-name machine-ssh-configuration-host-name) ; string
- (system machine-ssh-configuration-system) ; string
- (build-locally? machine-ssh-configuration-build-locally?
+ (host-name machine-ssh-configuration-host-name) ; string
+ (system machine-ssh-configuration-system) ; string
+ (build-locally? machine-ssh-configuration-build-locally? ; boolean
(default #t))
- (port machine-ssh-configuration-port ; integer
+ (authorize? machine-ssh-configuration-authorize? ; boolean
+ (default #t))
+ (port machine-ssh-configuration-port ; integer
(default 22))
- (user machine-ssh-configuration-user ; string
+ (user machine-ssh-configuration-user ; string
(default "root"))
- (identity machine-ssh-configuration-identity ; path to a private key
+ (identity machine-ssh-configuration-identity ; path to a private key
(default #f))
- (session machine-ssh-configuration-session ; session
+ (session machine-ssh-configuration-session ; session
(default #f)))
(define (machine-ssh-session machine)
@@ -359,6 +365,19 @@ the 'should-roll-back' field set to SHOULD-ROLL-BACK?"
"Internal implementation of 'deploy-machine' for MACHINE instances with an
environment type of 'managed-host."
(maybe-raise-unsupported-configuration-error machine)
+ (when (machine-ssh-configuration-authorize?
+ (machine-configuration machine))
+ (unless (file-exists? %public-key-file)
+ (raise (condition
+ (&message
+ (message (format #f (G_ "no signing key '~a'. \
+have you run 'guix archive --generate-key?'")
+ %public-key-file))))))
+ (remote-authorize-signing-key (call-with-input-file %public-key-file
+ (lambda (port)
+ (string->canonical-sexp
+ (get-string-all port))))
+ (machine-ssh-session machine)))
(mlet %store-monad ((_ (check-deployment-sanity machine))
(boot-parameters (machine-boot-parameters machine)))
(let* ((os (machine-operating-system machine))
diff --git a/guix/ssh.scm b/guix/ssh.scm
index 90311127a1..24834c6f68 100644
--- a/guix/ssh.scm
+++ b/guix/ssh.scm
@@ -21,6 +21,7 @@
#:use-module (guix inferior)
#:use-module (guix i18n)
#:use-module ((guix utils) #:select (&fix-hint))
+ #:use-module (gcrypt pk-crypto)
#:use-module (ssh session)
#:use-module (ssh auth)
#:use-module (ssh key)
@@ -40,6 +41,7 @@
remote-daemon-channel
connect-to-remote-daemon
remote-system
+ remote-authorize-signing-key
send-files
retrieve-files
retrieve-files*
@@ -300,6 +302,27 @@ 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)
+ "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
+ `(begin
+ (use-modules (guix build utils)
+ (guix pki)
+ (guix utils)
+ (gcrypt pk-crypto)
+ (srfi srfi-26))
+
+ (define acl (current-acl))
+ (define key (string->canonical-sexp ,(canonical-sexp->string key)))
+
+ (unless (authorized-key? key)
+ (let ((acl (public-keys->acl (cons key (acl->public-keys acl)))))
+ (mkdir-p (dirname %acl-file))
+ (with-atomic-file-output %acl-file
+ (cut write-acl acl <>)))))
+ session))
+
(define* (send-files local files remote
#:key
recursive?
--
cgit v1.2.3
From 3967a946c6b36bdd51bd0f11b75ad1f7ef3d4674 Mon Sep 17 00:00:00 2001
From: "Jakob L. Kreuze" <zerodaysfordays@sdf.lonestar.org>
Date: Thu, 15 Aug 2019 04:07:19 -0400
Subject: doc: Add description of 'build-locally?'.
* doc/guix.texi (Invoking guix deploy): Add section describing the
'build-locally?' field of 'managed-host-environment-type'.
---
doc/guix.texi | 2 ++
1 file changed, 2 insertions(+)
(limited to 'doc')
diff --git a/doc/guix.texi b/doc/guix.texi
index d80f62970d..043851e418 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -25583,6 +25583,8 @@ with an @code{environment} of @code{managed-host-environment-type}.
@table @asis
@item @code{host-name}
+@item @code{build-locally?} (default: @code{#t})
+If false, system derivations will be built on the machine being deployed to.
@item @code{system}
The Nix system type describing the architecture of the machine being deployed
to. This should look something like ``x86_64-linux''.
--
cgit v1.2.3