summaryrefslogtreecommitdiff
path: root/gnu/machine/ssh.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-01-16 15:51:13 +0100
committerLudovic Courtès <ludo@gnu.org>2022-01-16 23:56:55 +0100
commit084b76a70a6b302529f3450e6d07f1d105a10f7d (patch)
treeba4369076caba3d6881a5a52ff5e0528393a4c8d /gnu/machine/ssh.scm
parent86e782e2b6838fe425074c2b4758633ceefb639a (diff)
machine: ssh: Add 'safety-checks?' field.
Fixes <https://issues.guix.gnu.org/52766>. Reported by Michael Rohleder <mike@rohleder.de>. * gnu/machine/ssh.scm (<machine-ssh-configuration>)[safety-checks?]: New field. (machine-check-file-system-availability): Return the empty list when 'safety-checks?' is false. (machine-check-initrd-modules): Likewise. * doc/guix.texi (Invoking guix deploy): Document it.
Diffstat (limited to 'gnu/machine/ssh.scm')
-rw-r--r--gnu/machine/ssh.scm34
1 files changed, 21 insertions, 13 deletions
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