me
/
guix
Archived
1
0
Fork 0
Code

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.
master
Jakob L. Kreuze 2019-08-15 04:05:04 -04:00 committed by Christopher Lemmer Webber
parent 03cbd94d48
commit 5ea7537b9a
No known key found for this signature in database
GPG Key ID: 4BC025925FF8F4D3
4 changed files with 72 additions and 28 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
doc/guix.texi
View File

@ -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.

8
gnu/machine/ssh.scm
View File

@ -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."

57
guix/remote.scm
View File

@ -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)))))))

25
guix/ssh.scm
View File

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