[bug#53486] [PATCH] deploy: Add '--execute'.

[bug#53486] [PATCH] deploy: Add '--execute'.

[Ludovic Courtès]

* 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))))
+
 \f
 (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

[bug#53486] [PATCH] deploy: Add '--execute'.

[Oleg Pykhalov]

[-- Attachment #1: Type: text/plain, Size: 579 bytes --]

Hi,

Ludovic Courtès <ludo@gnu.org> writes:

[…]

> 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>:

I think for non ‘guix deploy’ users such functionality should exist,
too.  Otherwise the users could use ‘guix deploy’ by deploying to
localhost instead of ‘guix system reconfigure’.  So to avoid this we
need such things in <operating-system>.

Oleg.

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

[bug#53486] [PATCH] deploy: Add '--execute'.

[Ludovic Courtès]

Hi,

Oleg Pykhalov <go.wigust@gmail.com> skribis:

> Ludovic Courtès <ludo@gnu.org> writes:
>
> […]
>
>> 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>:
>
> I think for non ‘guix deploy’ users such functionality should exist,
> too.  Otherwise the users could use ‘guix deploy’ by deploying to
> localhost instead of ‘guix system reconfigure’.  So to avoid this we
> need such things in <operating-system>.

So that ‘guix system reconfigure’ would unconditionally refer the
Shepherd services you specify?

It’s a bit “weird”, because that information has to do with “state
transition” more than about the OS config, but why not.  Actually
‘unattended-service-type’ already has such a list, so it does seem like
the pattern comes up several times.  Hmm!

Ludo’.

[bug#53486] [PATCH] deploy: Add '--execute'.

[Ricardo Wurmus]

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.

I wonder if there’s a Guixy spin on remote execution — the
aforementioned “deploy-hook” feels more at home here, in my opinion.

-- 
Ricardo

[bug#53486] [PATCH] deploy: Add '--execute'.

[Ludovic Courtès]

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.

> I wonder if there’s a Guixy spin on remote execution — the
> aforementioned “deploy-hook” feels more at home here, in my opinion.

Yes, and it would use the same mechanism.  It would also more pleasant
for things you want to routinely do after a deployment.

Still, sometimes you just want to run “uname -a” or something to see if
you rebooted the machines, and a deploy hook won’t help with it.

WDYT?

Thanks,
Ludo’.

[bug#53486] [PATCH] deploy: Add '--execute'.

[Ricardo Wurmus]

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.

>> I wonder if there’s a Guixy spin on remote execution — the
>> aforementioned “deploy-hook” feels more at home here, in my opinion.
>
> Yes, and it would use the same mechanism.  It would also more pleasant
> for things you want to routinely do after a deployment.
>
> Still, sometimes you just want to run “uname -a” or something to see if
> you rebooted the machines, and a deploy hook won’t help with it.

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!

-- 
Ricardo

bug#53486: [PATCH] deploy: Add '--execute'.

[Ludovic Courtès]

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