From 8e31736b0a60919cc1bfc5dc22c395b09243484a Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Thu, 16 Jul 2020 00:01:17 +0200
Subject: guix system: 'reconfigure' disallows downgrades by default.

This is similar to what 9744cc7b4636fafb772c94adb8f05961b5b39f16 did for
'guix pull'.

* guix/scripts/system/reconfigure.scm (ensure-forward-reconfigure)
(warn-about-backward-reconfigure, channel-relations)
(check-forward-update): New procedures.
* guix/scripts/system.scm (perform-action): Add #:validate-reconfigure.
Call 'check-forward-update' when ACTION is 'reconfigure.
(%options, show-help): Add "--allow-downgrades".
(%default-options): Add 'validate-reconfigure' key.
(process-action): Pass #:validate-reconfigure to 'perform-action'.
* doc/guix.texi (Invoking guix system): Document 'guix system describe'
more prominently, and document '--allow-downgrades'.
---
 guix/scripts/system.scm | 15 ++++++++++++++-
 1 file changed, 14 insertions(+), 1 deletion(-)

(limited to 'guix/scripts/system.scm')

diff --git a/guix/scripts/system.scm b/guix/scripts/system.scm
index f2b4367094..79bfcd7db2 100644
--- a/guix/scripts/system.scm
+++ b/guix/scripts/system.scm
@@ -736,6 +736,7 @@ (define (local-eval exp)
 
 (define* (perform-action action os
                          #:key
+                         (validate-reconfigure ensure-forward-reconfigure)
                          save-provenance?
                          skip-safety-checks?
                          install-bootloader?
@@ -778,7 +779,8 @@ (define bootcfg
          (operating-system-bootcfg os menu-entries)))
 
   (when (eq? action 'reconfigure)
-    (maybe-suggest-running-guix-pull))
+    (maybe-suggest-running-guix-pull)
+    (check-forward-update validate-reconfigure))
 
   ;; Check whether the declared file systems exist.  This is better than
   ;; instantiating a broken configuration.  Assume that we can only check if
@@ -926,6 +928,9 @@ (define (show-help)
   (display (G_ "
   -e, --expression=EXPR  consider the operating-system EXPR evaluates to
                          instead of reading FILE, when applicable"))
+  (display (G_ "
+      --allow-downgrades for 'reconfigure', allow downgrades to earlier
+                         channel revisions"))
   (display (G_ "
       --on-error=STRATEGY
                          apply STRATEGY (one of nothing-special, backtrace,
@@ -981,6 +986,11 @@ (define %options
          (option '(#\d "derivation") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'derivations-only? #t result)))
+         (option '("allow-downgrades") #f #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'validate-reconfigure
+                               warn-about-backward-reconfigure
+                               result)))
          (option '("on-error") #t #f
                  (lambda (opt name arg result)
                    (alist-cons 'on-error (string->symbol arg)
@@ -1053,6 +1063,7 @@ (define %default-options
     (graft? . #t)
     (debug . 0)
     (verbosity . #f)                              ;default
+    (validate-reconfigure . ,ensure-forward-reconfigure)
     (file-system-type . "ext4")
     (image-size . guess)
     (install-bootloader? . #t)))
@@ -1138,6 +1149,8 @@ (define save-provenance?
                                #:use-substitutes? (assoc-ref opts 'substitutes?)
                                #:skip-safety-checks?
                                (assoc-ref opts 'skip-safety-checks?)
+                               #:validate-reconfigure
+                               (assoc-ref opts 'validate-reconfigure)
                                #:file-system-type (assoc-ref opts 'file-system-type)
                                #:image-size (assoc-ref opts 'image-size)
                                #:full-boot? (assoc-ref opts 'full-boot?)
-- 
cgit v1.2.3