From patchwork Sun Jan 23 21:21:47 2022 Content-Type: text/plain; charset="utf-8" MIME-Version: 1.0 Content-Transfer-Encoding: 8bit X-Patchwork-Submitter: =?utf-8?q?Ludovic_Court=C3=A8s?= X-Patchwork-Id: 36779 Return-Path: X-Original-To: patchwork@mira.cbaines.net Delivered-To: patchwork@mira.cbaines.net Received: by mira.cbaines.net (Postfix, from userid 113) id 6322527BBEA; Sun, 23 Jan 2022 21:23:14 +0000 (GMT) X-Spam-Checker-Version: SpamAssassin 3.4.6 (2021-04-09) on mira.cbaines.net X-Spam-Level: X-Spam-Status: No, score=-2.7 required=5.0 tests=BAYES_00,DKIM_INVALID, DKIM_SIGNED,MAILING_LIST_MULTI,RCVD_IN_MSPIKE_H3,RCVD_IN_MSPIKE_WL, SPF_HELO_PASS,URIBL_BLOCKED autolearn=unavailable autolearn_force=no version=3.4.6 Received: from lists.gnu.org (lists.gnu.org [209.51.188.17]) by mira.cbaines.net (Postfix) with ESMTPS id A52AA27BBE9 for ; Sun, 23 Jan 2022 21:23:13 +0000 (GMT) Received: from localhost ([::1]:43424 helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1nBkKO-0006Q4-Q8 for patchwork@mira.cbaines.net; Sun, 23 Jan 2022 16:23:12 -0500 Received: from eggs.gnu.org ([209.51.188.92]:38540) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nBkKE-0006OM-Kl for guix-patches@gnu.org; Sun, 23 Jan 2022 16:23:02 -0500 Received: from debbugs.gnu.org ([209.51.188.43]:48506) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nBkKE-0006Bk-B7 for guix-patches@gnu.org; Sun, 23 Jan 2022 16:23:02 -0500 Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1nBkKE-0000DB-2W for guix-patches@gnu.org; Sun, 23 Jan 2022 16:23:02 -0500 X-Loop: help-debbugs@gnu.org Subject: [bug#53486] [PATCH] deploy: Add '--execute'. Resent-From: Ludovic =?utf-8?q?Court=C3=A8s?= Original-Sender: "Debbugs-submit" Resent-CC: guix-patches@gnu.org Resent-Date: Sun, 23 Jan 2022 21:23:01 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 53486 X-GNU-PR-Package: guix-patches X-GNU-PR-Keywords: patch To: 53486@debbugs.gnu.org Cc: Ludovic =?utf-8?q?Court=C3=A8s?= X-Debbugs-Original-To: guix-patches@gnu.org Received: via spool by submit@debbugs.gnu.org id=B.1642972929735 (code B ref -1); Sun, 23 Jan 2022 21:23:01 +0000 Received: (at submit) by debbugs.gnu.org; 23 Jan 2022 21:22:09 +0000 Received: from localhost ([127.0.0.1]:41409 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nBkJM-0000Bn-UB for submit@debbugs.gnu.org; Sun, 23 Jan 2022 16:22:09 -0500 Received: from lists.gnu.org ([209.51.188.17]:45184) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1nBkJL-0000Bf-4G for submit@debbugs.gnu.org; Sun, 23 Jan 2022 16:22:07 -0500 Received: from eggs.gnu.org ([209.51.188.92]:38430) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nBkJK-00069n-1A for guix-patches@gnu.org; Sun, 23 Jan 2022 16:22:06 -0500 Received: from [2001:470:142:3::e] (port=51220 helo=fencepost.gnu.org) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1nBkJF-00067w-CN; Sun, 23 Jan 2022 16:22:05 -0500 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=gnu.org; s=fencepost-gnu-org; h=MIME-Version:Date:Subject:To:From:in-reply-to: references; bh=/rXIQrFw7fEdhLRQYk3bqnv8b77EmuZzy2yEjMqvCd0=; b=Vf1Kzz82Ev3TDb CmC1z2b0D4nwfwodVgvyVkOTQ3tVuo3VcPJAVLVsUGMZ7gFIt2bdFHJff+C+3EgFQBzyGkVPKJAq1 5u+dytnzajKUme681P2aJPUnMNIn4ZwJgS0POybv+qsOpW5ft3j2jl6B5ETcP1VmH1m/MxjBCpkmI bzP2IkTPVyzeCY9QLQLEUBHSvZ5YAnonjeMXpjple/EtB4DZmTmCzc7jwg8t/ZPq49qmkcEgGS0lL G3jizEmt+uMUC8i5NAWC5FV91JiJJQTfd2ffILZhRM/OYNzRhfMw7e8TQUas/vC4knYzBI2iT/Csn JDqPOR6+jX9m+o1H0txw==; Received: from 91-160-117-201.subs.proxad.net ([91.160.117.201]:60142 helo=gnu.org) by fencepost.gnu.org with esmtpsa (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1nBkJA-0006H8-Ca; Sun, 23 Jan 2022 16:21:59 -0500 From: Ludovic =?utf-8?q?Court=C3=A8s?= Date: Sun, 23 Jan 2022 22:21:47 +0100 Message-Id: <20220123212147.17855-1-ludo@gnu.org> X-Mailer: git-send-email 2.34.0 MIME-Version: 1.0 X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: guix-patches@gnu.org List-Id: List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: guix-patches-bounces+patchwork=mira.cbaines.net@gnu.org Sender: "Guix-patches" X-getmail-retrieved-from-mailbox: Patches * 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 : • ‘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’. base-commit: ee6bf00b2d89f6acab55b7a82896d99e39c1229b 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 ;;; Copyright © 2019 Jakob L. Kreuze -;;; Copyright © 2020, 2021 Ludovic Courtès +;;; Copyright © 2020-2022 Ludovic Courtès ;;; ;;; 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))))))))))