aboutsummaryrefslogtreecommitdiff
path: root/gnu/machine
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2020-07-27 11:03:14 +0200
committerLudovic Courtès <ludo@gnu.org>2020-07-27 12:06:35 +0200
commita396dd01bc6e90ae512001350d1afa471e01661d (patch)
tree40aecd0a2915f01736e4ee94a7b965e801b292f9 /gnu/machine
parent9296a2e511311d23dc49c4e4b3cbb9341ea82bb3 (diff)
downloadguix-a396dd01bc6e90ae512001350d1afa471e01661d.tar.gz
guix-a396dd01bc6e90ae512001350d1afa471e01661d.zip
machine: ssh: Check for potential system downgrades.
This is a followup to 8e31736b0a60919cc1bfc5dc22c395b09243484a. * guix/scripts/system/reconfigure.scm (check-forward-update): Add #:current-channels. Use it instead of OLD. * gnu/services.scm (sexp->system-provenance): New procedure. (system-provenance): Use it. * gnu/machine/ssh.scm (<machine-ssh-configuration>)[allow-downgrades?]: New field. (machine-check-forward-update): New procedure. (check-deployment-sanity)[assertions]: Call it. * doc/guix.texi (Invoking guix deploy): Document 'allow-downgrades?' field.
Diffstat (limited to 'gnu/machine')
-rw-r--r--gnu/machine/ssh.scm32
1 files changed, 31 insertions, 1 deletions
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 641e871861..4e31baa4b9 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -24,6 +24,7 @@
#:use-module (gnu system)
#:use-module (gnu system file-systems)
#:use-module (gnu system uuid)
+ #:use-module ((gnu services) #:select (sexp->system-provenance))
#:use-module (guix diagnostics)
#:use-module (guix gexp)
#:use-module (guix i18n)
@@ -55,6 +56,7 @@
machine-ssh-configuration-host-name
machine-ssh-configuration-build-locally?
machine-ssh-configuration-authorize?
+ machine-ssh-configuration-allow-downgrades?
machine-ssh-configuration-port
machine-ssh-configuration-user
machine-ssh-configuration-host-key
@@ -83,6 +85,8 @@
(default #t))
(authorize? machine-ssh-configuration-authorize? ; boolean
(default #t))
+ (allow-downgrades? machine-ssh-configuration-allow-downgrades? ; boolean
+ (default #f))
(port machine-ssh-configuration-port ; integer
(default 22))
(user machine-ssh-configuration-user ; string
@@ -271,6 +275,27 @@ not available in the initrd."
(map missing-modules file-systems))
+(define* (machine-check-forward-update machine)
+ "Check whether we are making a forward update for MACHINE. Depending on its
+'allow-upgrades?' field, raise an error or display a warning if we are
+potentially downgrading it."
+ (define config
+ (machine-configuration machine))
+
+ (define validate-reconfigure
+ (if (machine-ssh-configuration-allow-downgrades? config)
+ warn-about-backward-reconfigure
+ ensure-forward-reconfigure))
+
+ (remote-let ((provenance #~(call-with-input-file
+ "/run/current-system/provenance"
+ read)))
+ (define channels
+ (sexp->system-provenance provenance))
+
+ (check-forward-update validate-reconfigure
+ #:current-channels channels)))
+
(define (machine-check-building-for-appropriate-system machine)
"Raise a '&message' error condition if MACHINE is configured to be built
locally and the 'system' field does not match the '%current-system' reported
@@ -289,7 +314,8 @@ by MACHINE."
'system' declaration would fail."
(define assertions
(append (machine-check-file-system-availability machine)
- (machine-check-initrd-modules machine)))
+ (machine-check-initrd-modules machine)
+ (list (machine-check-forward-update machine))))
(define aggregate-exp
;; Gather all the expressions so that a single round-trip is enough to
@@ -491,3 +517,7 @@ connection to the host.")))
for environment of type '~a'")
config
environment)))))
+
+;; Local Variables:
+;; eval: (put 'remote-let 'scheme-indent-function 1)
+;; End: