diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2022-01-16 15:51:13 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2022-01-16 23:56:55 +0100 |
| commit | 084b76a70a6b302529f3450e6d07f1d105a10f7d (patch) | |
| tree | ba4369076caba3d6881a5a52ff5e0528393a4c8d /gnu | |
| parent | 86e782e2b6838fe425074c2b4758633ceefb639a (diff) | |
| download | guix-084b76a70a6b302529f3450e6d07f1d105a10f7d.tar.gz | |
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')
| -rw-r--r-- | gnu/machine/ssh.scm | 34 |
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 |