guix system: 'reconfigure' disallows downgrades by default.
This is similar to what 9744cc7b46
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'.
master
parent
a620c9d51d
commit
8e31736b0a
|
@ -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
|
||||
|
|
|
@ -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
|
||||
|
@ -926,6 +928,9 @@ Some ACTIONS support additional ARGS.\n"))
|
|||
(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 @@ 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?)
|
||||
|
|
|
@ -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)))
|
||||
|
|
Reference in New Issue