--- Begin Message ---
|
Subject: |
[PATCH] deploy: Add '--execute'. |
|
Date: |
Sun, 23 Jan 2022 22:21:47 +0100 |
* guix/scripts/deploy.scm (show-help, %options): Add '--execute'.
(invoke-command): New procedure.
(guix-deploy): Break arguments at "--" and handle '-x' and associated
command.
* doc/guix.texi (Invoking guix deploy): Document it.
---
doc/guix.texi | 24 +++++++++
guix/scripts/deploy.scm | 111 +++++++++++++++++++++++++++++++++++++---
2 files changed, 127 insertions(+), 8 deletions(-)
Hi!
Here's a simple but handy option for ‘guix deploy’.
One of the primary use cases for me is being able to run ‘herd
restart XYZ’ after deployment, but I’m also thinking of adding
special support for such things in <machine>:
• ‘deploy-hook’, which would take a gexp to run after
successful deployment;
• and/or ‘services-to-restart’, which would take a list
of Shepherd services to restart after successful deployment.
Thoughts?
Thanks,
Ludo’.
diff --git a/doc/guix.texi b/doc/guix.texi
index 912a8e3c5a..dbbb50682b 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -35627,6 +35627,30 @@ be accomplished with the following operating system
configuration snippet:
For more information regarding the format of the @file{sudoers} file,
consult @command{man sudoers}.
+Once you've deployed a system on a set of machines, you may find it
+useful to run a command on all of them. The @option{--execute} or
+@option{-x} option lets you do that; the example below runs
+@command{uname -a} on all the machines listed in the deployment file:
+
+@example
+guix deploy @var{file} -x -- uname -a
+@end example
+
+One thing you may often need to do after deployment is restart specific
+services on all the machines, which you can do like so:
+
+@example
+guix deploy @var{file} -x -- herd restart @var{service}
+@end example
+
+The @command{guix deploy -x} command returns zero if and only if the
+command succeeded on all the machines.
+
+@c FIXME/TODO: Separate the API doc from the CLI doc.
+
+Below are the data types you need to know about when writing a
+deployment file.
+
@deftp {Data Type} machine
This is the data type representing a single machine in a heterogeneous Guix
deployment.
diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm
index 1707622c4f..27478eabc0 100644
--- a/guix/scripts/deploy.scm
+++ b/guix/scripts/deploy.scm
@@ -1,7 +1,7 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 David Thompson <davet@gnu.org>
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org>
-;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -24,18 +24,21 @@ (define-module (guix scripts deploy)
#:use-module (guix scripts)
#:use-module (guix scripts build)
#:use-module (guix store)
+ #:use-module (guix gexp)
#:use-module (guix ui)
#:use-module (guix utils)
#:use-module (guix grafts)
- #:use-module (guix status)
+ #:use-module ((guix status) #:select (with-status-verbosity))
#:use-module (guix diagnostics)
#:use-module (guix i18n)
#:use-module (ice-9 format)
+ #:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
#:use-module (srfi srfi-37)
+ #:use-module (srfi srfi-71)
#:export (guix-deploy))
;;; Commentary:
@@ -58,6 +61,9 @@ (define (show-help)
-V, --version display version information and exit"))
(newline)
(display (G_ "
+ -x, --execute execute the following command on all the machines"))
+ (newline)
+ (display (G_ "
-v, --verbosity=LEVEL use the given verbosity LEVEL"))
(show-bug-report-information))
@@ -70,6 +76,9 @@ (define %options
(lambda args
(show-version-and-exit "guix deploy")))
+ (option '(#\x "execute") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'execute-command? #t result)))
(option '(#\s "system") #t #f
(lambda (opt name arg result)
(alist-cons 'system arg
@@ -152,6 +161,74 @@ (define (deploy-machine* store machine)
(info (G_ "successfully deployed ~a~%")
(machine-display-name machine))))
+(define (invoke-command store machine command)
+ "Invoke COMMAND, a list of strings, on MACHINE. Display its output (if any)
+and its error code if it's non-zero. Return true if COMMAND succeeded, false
+otherwise."
+ (define invocation
+ #~(begin
+ (use-modules (ice-9 match)
+ (ice-9 rdelim)
+ (srfi srfi-11))
+
+ (define (spawn . command)
+ ;; Spawn COMMAND; return its PID and an input port to read its
+ ;; standard output and standard error.
+ (match (pipe)
+ ((input . output)
+ (match (pipe)
+ ((input . output)
+ (match (primitive-fork)
+ (0
+ (dynamic-wind
+ (const #t)
+ (lambda ()
+ (close-port input)
+ (dup2 (fileno output) 1)
+ (dup2 (fileno output) 2)
+ (apply execlp (car command) command))
+ (lambda ()
+ (primitive-exit 127))))
+ (pid
+ (close-port output)
+ (values pid input))))))))
+
+ ;; XXX: 'open-pipe*' is unsuitable here because it does not capture
+ ;; stderr, so roll our own.
+ (let-values (((pid pipe) (spawn #$@command)))
+ (let loop ((lines '()))
+ (match (read-line pipe 'concat)
+ ((? eof-object?)
+ (list (cdr (waitpid pid))
+ (string-concatenate-reverse lines)))
+ (line
+ (loop (cons line lines))))))))
+
+ (match (run-with-store store
+ (machine-remote-eval machine invocation))
+ ((code output)
+ (match code
+ ((? zero?)
+ (info (G_ "~a: command succeeded~%")
+ (machine-display-name machine)))
+ ((= status:exit-val code)
+ (report-error (G_ "~a: command exited with code ~a~%")
+ (machine-display-name machine) code))
+ ((= status:stop-sig signal)
+ (report-error (G_ "~a: command stopped with signal ~a~%")
+ signal))
+ ((= status:term-sig signal)
+ (report-error (G_ "~a: command terminated with signal ~a~%")
+ signal)))
+
+ (unless (string-null? output)
+ (info (G_ "command output on ~a:~%")
+ (machine-display-name machine))
+ (display output)
+ (newline))
+
+ (zero? code))))
+
(define-command (guix-deploy . args)
(synopsis "deploy operating systems on a set of machines")
@@ -159,14 +236,17 @@ (define (handle-argument arg result)
(alist-cons 'file arg result))
(with-error-handling
- (let* ((opts (parse-command-line args %options (list %default-options)
+ (let* ((args command (break (cut string=? "--" <>) args))
+ (opts (parse-command-line args %options (list %default-options)
#:argument-handler handle-argument))
(file (assq-ref opts 'file))
- (machines (and file (load-source-file file))))
+ (machines (and file (load-source-file file)))
+ (execute-command? (assoc-ref opts 'execute-command?)))
(unless file
(leave (G_ "missing deployment file argument~%")))
- (show-what-to-deploy machines)
+ (when (and (pair? command) (not execute-command?))
+ (leave (G_ "'--' was used by '-x' was not specified~%")))
(with-status-verbosity (assoc-ref opts 'verbosity)
(with-store store
@@ -176,6 +256,21 @@ (define (handle-argument arg result)
#:verbosity
(assoc-ref opts 'verbosity))
(parameterize ((%graft? (assq-ref opts 'graft?)))
- (map/accumulate-builds store
- (cut deploy-machine* store <>)
- machines))))))))
+ (if execute-command?
+ (match command
+ (("--" command ..1)
+ ;; Exit with zero unless COMMAND failed on one or more
+ ;; machines.
+ (exit
+ (fold (lambda (machine result)
+ (and (invoke-command store machine command)
+ result))
+ #t
+ machines)))
+ (_
+ (leave (G_ "'-x' specified but no command given~%"))))
+ (begin
+ (show-what-to-deploy machines)
+ (map/accumulate-builds store
+ (cut deploy-machine* store <>)
+ machines))))))))))
base-commit: ee6bf00b2d89f6acab55b7a82896d99e39c1229b
--
2.34.0
--- End Message ---
--- Begin Message ---
|
Subject: |
Re: bug#53486: [PATCH] deploy: Add '--execute'. |
|
Date: |
Wed, 02 Feb 2022 18:44:17 +0100 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/27.2 (gnu/linux) |
Hi,
Ricardo Wurmus <rekado@elephly.net> skribis:
> Ludovic Courtès <ludo@gnu.org> writes:
>
>> Hi,
>>
>> Ricardo Wurmus <rekado@elephly.net> skribis:
>>
>>> This sure is useful, but for the very first time I feel that this
>>> doesn’t quite belong. There are a bunch of tools out there that focus
>>> exclusively on remote execution on several machines at once.
>>>
>>> One of them is pdsh, which lets you also define groups of machines by
>>> type and submit to a selected subset. It also displays remote output
>>> locally, and it sends local input to the remote as well.
>>>
>>> It’s tempting to add this to “guix deploy” because it likely that
>>> parallel remote execution is desired when “guix deploy” is used, but it
>>> also feels … kinda wrong.
>>
>> True, but here that allows you to talk to the machines actually listed
>> in ‘deploy.scm’. Were you to use an external tool, you’d have to
>> somehow grep/sed the thing to get a list of host names.
>
> That’s a good point.
Actually the impetus for me was when I found myself repeatedly writing
half-baked Bash ‘for’ loops on berlin and then learned that Mathieu had
promoted the ‘for’ loop to a shell script in his home directory. I
thought we could do better. :-)
That said, I agree that it’s no substitute for real tools in this area
like pdsh; it’s really just a helper for basic situations.
> As a stepping stone towards something more … “ordered” I guess my
> objections to the feature melt away :) Don’t let me be in the way!
Alright, pushed as 5c13484646069064c834bbd3cd02c3bc80d94cb6!
Thanks,
Ludo’.
--- End Message ---