Package: guix-patches;
Reported by: Arun Isaac <arunisaac <at> systemreboot.net>
Date: Tue, 7 Jan 2025 00:19:02 UTC
Severity: normal
Tags: patch
Done: Arun Isaac <arunisaac <at> systemreboot.net>
Bug is archived. No further changes may be made.
Message #38 received at 75414 <at> debbugs.gnu.org (full text, mbox):
From: Arun Isaac <arunisaac <at> systemreboot.net> To: 75414 <at> debbugs.gnu.org Cc: Arun Isaac <arunisaac <at> systemreboot.net> Subject: [PATCH v2 1/1] deploy: Add --roll-back option. Date: Thu, 27 Feb 2025 22:55:50 +0000
* guix/scripts/deploy.scm (guix-deploy): Add the --roll-back option.
(show-what-to-deploy): Add #:roll-back? argument.
(roll-back-machine*): New function.
(show-help): Document the --roll-back option.
* doc/guix.texi (Invoking guix deploy): Document the --roll-back option.
Change-Id: Ic5084f287aefb2d1d28380ca4ba1c6971cb913e7
---
doc/guix.texi | 8 +++++
guix/scripts/deploy.scm | 75 +++++++++++++++++++++++++++++++++++------
2 files changed, 72 insertions(+), 11 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index a036c85c31a..64746c7f925 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -45232,6 +45232,14 @@ Invoking guix deploy
The @command{guix deploy -x} command returns zero if and only if the
command succeeded on all the machines.
+You may also wish to roll back configurations on machines to a previous
+generation. You can do that using the @option{--roll-back} or
+@option{-r} option like so:
+
+@example
+guix deploy --roll-back @var{file}
+@end example
+
@c FIXME/TODO: Separate the API doc from the CLI doc.
Below are the data types you need to know about when writing a
diff --git a/guix/scripts/deploy.scm b/guix/scripts/deploy.scm
index 941ee199f01..e2ef0006e06 100644
--- a/guix/scripts/deploy.scm
+++ b/guix/scripts/deploy.scm
@@ -3,6 +3,7 @@
;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays <at> sdf.org>
;;; Copyright © 2020-2022 Ludovic Courtès <ludo <at> gnu.org>
;;; Copyright © 2024 Richard Sent <richard <at> freakingpenguin.com>
+;;; Copyright © 2025 Arun Isaac <arunisaac <at> systemreboot.net>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -63,6 +64,8 @@ (define (show-help)
-e, --expression=EXPR deploy the list of machines EXPR evaluates to"))
(newline)
(display (G_ "
+ -r, --roll-back switch to the previous operating system configuration"))
+ (display (G_ "
-x, --execute execute the following command on all the machines"))
(newline)
(display (G_ "
@@ -84,6 +87,9 @@ (define %options
(option '(#\n "dry-run") #f #f
(lambda (opt name arg result)
(alist-cons 'dry-run? #t result)))
+ (option '(#\r "roll-back") #f #f
+ (lambda (opt name arg result)
+ (alist-cons 'roll-back? #t result)))
(option '(#\x "execute") #f #f
(lambda (opt name arg result)
(alist-cons 'execute-command? #t result)))
@@ -118,20 +124,32 @@ (define (load-source-file file)
environment-modules))))
(load* file module)))
-(define* (show-what-to-deploy machines #:key (dry-run? #f))
- "Show the list of machines to deploy, MACHINES."
+(define* (show-what-to-deploy machines #:key (dry-run? #f) (roll-back? #f))
+ "Show the list of machines in MACHINES to deploy or roll back."
(let ((count (length machines)))
(if dry-run?
- (format (current-error-port)
- (N_ "The following ~d machine would be deployed:~%"
- "The following ~d machines would be deployed:~%"
+ (if roll-back?
+ (format (current-error-port)
+ (N_ "The following ~d machine would be rolled back:~%"
+ "The following ~d machines would be rolled back:~%"
count)
count)
- (format (current-error-port)
- (N_ "The following ~d machine will be deployed:~%"
- "The following ~d machines will be deployed:~%"
+ (format (current-error-port)
+ (N_ "The following ~d machine would be deployed:~%"
+ "The following ~d machines would be deployed:~%"
+ count)
+ count))
+ (if roll-back?
+ (format (current-error-port)
+ (N_ "The following ~d machine will be rolled back:~%"
+ "The following ~d machines will be rolled back:~%"
+ count)
count)
- count))
+ (format (current-error-port)
+ (N_ "The following ~d machine will be deployed:~%"
+ "The following ~d machines will be deployed:~%"
+ count)
+ count)))
(display (indented-string
(fill-paragraph (string-join (map machine-display-name machines)
", ")
@@ -175,6 +193,35 @@ (define (deploy-machine* store machine)
(info (G_ "successfully deployed ~a~%")
(machine-display-name machine))))
+(define (roll-back-machine* store machine)
+ "Roll back MACHINE, taking care of error handling."
+ (info (G_ "rolling back ~a...~%")
+ (machine-display-name machine))
+
+ (guard* (c
+ ;; On Guile 3.0, exceptions such as 'unbound-variable' are compound
+ ;; and include a '&message'. However, that message only contains
+ ;; the format string. Thus, special-case it here to avoid
+ ;; displaying a bare format string.
+ (((exception-predicate &exception-with-kind-and-args) c)
+ (raise c))
+
+ ((message-condition? c)
+ (leave (G_ "failed to roll back ~a: ~a~%")
+ (machine-display-name machine)
+ (condition-message c)))
+ ((formatted-message? c)
+ (leave (G_ "failed to roll back ~a: ~a~%")
+ (machine-display-name machine)
+ (apply format #f
+ (gettext (formatted-message-string c)
+ %gettext-domain)
+ (formatted-message-arguments c)))))
+ (run-with-store store (roll-back-machine machine)))
+
+ (info (G_ "successfully rolled back ~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
@@ -258,6 +305,7 @@ (define-command (guix-deploy . args)
(machines (or (and file (load-source-file file))
(and expression (read/eval expression))))
(dry-run? (assoc-ref opts 'dry-run?))
+ (roll-back? (assq-ref opts 'roll-back?))
(execute-command? (assoc-ref opts 'execute-command?)))
(when (and file expression)
(leave (G_ "both '--expression' and a deployment file were provided~%")))
@@ -292,8 +340,13 @@ (define-command (guix-deploy . args)
(_
(leave (G_ "'-x' specified but no command given~%"))))
(begin
- (show-what-to-deploy machines #:dry-run? dry-run?)
+ (show-what-to-deploy machines
+ #:dry-run? dry-run?
+ #:roll-back? roll-back?)
(unless dry-run?
(map/accumulate-builds store
- (cut deploy-machine* store <>)
+ (cut (if roll-back?
+ roll-back-machine*
+ deploy-machine*)
+ store <>)
machines)))))))))))
--
2.48.1
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.