summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/guix.texi10
-rw-r--r--gnu/machine/ssh.scm34
2 files changed, 31 insertions, 13 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index 5d18e44f91..ea603ab56a 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -35682,6 +35682,16 @@ returned by @command{guix describe}) to determine whether commits
currently in use are descendants of those deployed. When this is not
the case and @code{allow-downgrades?} is false, it raises an error.
This ensures you do not accidentally downgrade remote machines.
+
+@item @code{safety-checks?} (default: @code{#t})
+Whether to perform ``safety checks'' before deployment. This includes
+verifying that devices and file systems referred to in the operating
+system configuration actually exist on the target machine, and making
+sure that Linux modules required to access storage devices at boot time
+are listed in the @code{initrd-modules} field of the operating system.
+
+These safety checks ensure that you do not inadvertently deploy a system
+that would fail to boot. Be careful before turning them off!
@end table
@end deftp
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm
index 22688f46f4..0dc8933c82 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -93,6 +93,8 @@
(default #t))
(allow-downgrades? machine-ssh-configuration-allow-downgrades? ; boolean
(default #f))
+ (safety-checks? machine-ssh-configuration-safety-checks? ;boolean
+ (default #t))
(port machine-ssh-configuration-port ; integer
(default 22))
(user machine-ssh-configuration-user ; string
@@ -240,18 +242,21 @@ exist on the machine."
(raise (formatted-message (G_ "no file system with UUID '~a'")
(uuid->string (file-system-device fs)))))))
- (append (map check-literal-file-system
- (filter (lambda (fs)
- (string? (file-system-device fs)))
- file-systems))
- (map check-labeled-file-system
- (filter (lambda (fs)
- (file-system-label? (file-system-device fs)))
- file-systems))
- (map check-uuid-file-system
- (filter (lambda (fs)
- (uuid? (file-system-device fs)))
- file-systems))))
+ (if (machine-ssh-configuration-safety-checks?
+ (machine-configuration machine))
+ (append (map check-literal-file-system
+ (filter (lambda (fs)
+ (string? (file-system-device fs)))
+ file-systems))
+ (map check-labeled-file-system
+ (filter (lambda (fs)
+ (file-system-label? (file-system-device fs)))
+ file-systems))
+ (map check-uuid-file-system
+ (filter (lambda (fs)
+ (uuid? (file-system-device fs)))
+ file-systems)))
+ '()))
(define (machine-check-initrd-modules machine)
"Return a list of <remote-assertion> that raise a '&message' error condition
@@ -291,7 +296,10 @@ not available in the initrd."
(file-system-device fs)
missing)))))
- (map missing-modules file-systems))
+ (if (machine-ssh-configuration-safety-checks?
+ (machine-configuration machine))
+ (map missing-modules file-systems)
+ '()))
(define* (machine-check-forward-update machine)
"Check whether we are making a forward update for MACHINE. Depending on its