summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/guix.texi35
-rw-r--r--guix/scripts/system.scm15
-rw-r--r--guix/scripts/system/reconfigure.scm97
3 files changed, 141 insertions, 6 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index b0eba017a6..fb1c66dcf4 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -28388,11 +28388,16 @@ an older system generation at boot time should you need it.
Upon completion, the new system is deployed under
@file{/run/current-system}. This directory contains @dfn{provenance
meta-data}: the list of channels in use (@pxref{Channels}) and
-@var{file} itself, when available. This information is useful should
-you later want to inspect how this particular generation was built.
+@var{file} itself, when available. You can view it by running:
-In fact, assuming @var{file} is self-contained, you can later rebuild
-generation @var{n} of your operating system with:
+@example
+guix system describe
+@end example
+
+This information is useful should you later want to inspect how this
+particular generation was built. In fact, assuming @var{file} is
+self-contained, you can later rebuild generation @var{n} of your
+operating system with:
@example
guix time-machine \
@@ -28406,6 +28411,12 @@ system is not just a binary artifact: @emph{it carries its own source}.
@xref{Service Reference, @code{provenance-service-type}}, for more
information on provenance tracking.
+By default, @command{reconfigure} @emph{prevents you from downgrading
+your system}, which could (re)introduce security vulnerabilities and
+also cause problems with ``stateful'' services such as database
+management systems. You can override that behavior by passing
+@option{--allow-downgrades}.
+
@item switch-generation
@cindex generations
Switch to an existing system generation. This action atomically
@@ -28732,6 +28743,22 @@ appear in the @code{operating-system} declaration actually exist
needed at boot time are listed in @code{initrd-modules} (@pxref{Initial
RAM Disk}). Passing this option skips these tests altogether.
+@item --allow-downgrades
+Instruct @command{guix system reconfigure} to allow system downgrades.
+
+By default, @command{reconfigure} prevents you from downgrading your
+system. It achieves that by comparing the provenance info of your
+system (shown by @command{guix system describe}) with that of your
+@command{guix} command (shown by @command{guix describe}). If the
+commits for @command{guix} are not descendants of those used for your
+system, @command{guix system reconfigure} errors out. Passing
+@option{--allow-downgrades} allows you to bypass these checks.
+
+@quotation Note
+Make sure you understand its security implications before using
+@option{--allow-downgrades}.
+@end quotation
+
@cindex on-error
@cindex on-error strategy
@cindex error strategy
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 @@ and TARGET arguments."
(define* (perform-action action os
#:key
+ (validate-reconfigure ensure-forward-reconfigure)
save-provenance?
skip-safety-checks?
install-bootloader?
@@ -778,7 +779,8 @@ static checks."
(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
@@ -927,6 +929,9 @@ Some ACTIONS support additional ARGS.\n"))
-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,
or debug) when an error occurs while reading FILE"))
@@ -981,6 +986,11 @@ Some ACTIONS support additional ARGS.\n"))
(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 @@ Some ACTIONS support additional ARGS.\n"))
(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 @@ resulting from command-line parsing."
#: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?)
diff --git a/guix/scripts/system/reconfigure.scm b/guix/scripts/system/reconfigure.scm
index 7885c33457..9013e035f7 100644
--- a/guix/scripts/system/reconfigure.scm
+++ b/guix/scripts/system/reconfigure.scm
@@ -34,9 +34,18 @@
#:use-module (guix monads)
#:use-module (guix store)
#:use-module ((guix self) #:select (make-config.scm))
+ #:autoload (guix describe) (current-profile)
+ #:use-module (guix channels)
+ #:autoload (guix git) (update-cached-checkout)
+ #:use-module (guix i18n)
+ #:use-module (guix diagnostics)
+ #:use-module ((guix utils) #:select (&fix-hint))
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-11)
+ #:use-module (srfi srfi-34)
+ #:use-module (srfi srfi-35)
+ #:use-module ((guix config) #:select (%guix-package-name))
#:export (switch-system-program
switch-to-system
@@ -44,7 +53,11 @@
upgrade-shepherd-services
install-bootloader-program
- install-bootloader))
+ install-bootloader
+
+ check-forward-update
+ ensure-forward-reconfigure
+ warn-about-backward-reconfigure))
;;; Commentary:
;;;
@@ -266,3 +279,85 @@ additional configurations specified by MENU-ENTRIES can be selected."
bootcfg-file
device
target))))))
+
+
+;;;
+;;; Downgrade detection.
+;;;
+
+(define (ensure-forward-reconfigure channel start commit relation)
+ "Raise an error if RELATION is not 'ancestor, meaning that START is not an
+ancestor of COMMIT, unless CHANNEL specifies a commit."
+ (match relation
+ ('ancestor #t)
+ ('self #t)
+ (_
+ (raise (make-compound-condition
+ (condition
+ (&message (message
+ (format #f (G_ "\
+aborting reconfiguration because commit ~a of channel '~a' is not a descendant of ~a")
+ commit (channel-name channel)
+ start)))
+ (&fix-hint
+ (hint (G_ "Use @option{--allow-downgrades} to force
+this downgrade.")))))))))
+
+(define (warn-about-backward-reconfigure channel start commit relation)
+ "Warn about non-forward updates of CHANNEL from START to COMMIT, without
+aborting."
+ (match relation
+ ((or 'ancestor 'self)
+ #t)
+ ('descendant
+ (warning (G_ "rolling back channel '~a' from ~a to ~a~%")
+ (channel-name channel) start commit))
+ ('unrelated
+ (warning (G_ "moving channel '~a' from ~a to unrelated commit ~a~%")
+ (channel-name channel) start commit))))
+
+(define (channel-relations old new)
+ "Return a list of channel/relation pairs, where each relation is a symbol as
+returned by 'commit-relation' denoting how commits of channels in OLD relate
+to commits of channels in NEW."
+ (filter-map (lambda (old)
+ (let ((new (find (lambda (channel)
+ (eq? (channel-name channel)
+ (channel-name old)))
+ new)))
+ (and new
+ (let-values (((checkout commit relation)
+ (update-cached-checkout
+ (channel-url new)
+ #:ref
+ `(commit . ,(channel-commit new))
+ #:starting-commit
+ (channel-commit old)
+ #:check-out? #f)))
+ (list new
+ (channel-commit old) (channel-commit new)
+ relation)))))
+ old))
+
+(define* (check-forward-update #:optional
+ (validate-reconfigure ensure-forward-reconfigure))
+ "Call VALIDATE-RECONFIGURE passing it, for each channel, the channel, the
+currently-deployed commit (as returned by 'guix system describe') and the
+target commit (as returned by 'guix describe')."
+ ;; TODO: Make that functionality available to 'guix deploy'.
+ (define new
+ (or (and=> (current-profile) profile-channels)
+ '()))
+
+ (define old
+ (system-provenance "/run/current-system"))
+
+ (when (null? old)
+ (warning (G_ "cannot determine provenance for /run/current-system~%")))
+ (when (and (null? new) (not (getenv "GUIX_UNINSTALLED")))
+ (warning (G_ "cannot determine provenance of ~a~%") %guix-package-name))
+
+ (for-each (match-lambda
+ ((channel old new relation)
+ (validate-reconfigure channel old new relation)))
+ (channel-relations old new)))