diff options
| -rw-r--r-- | doc/guix.texi | 10 | ||||
| -rw-r--r-- | gnu/machine/ssh.scm | 34 |
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 |