me/guix
Archived
1
0
Fork 0
Code Activity

machine: ssh: Add 'safety-checks?' field.

Browse source 
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.
This commit is contained in:
Ludovic Courtès 2022-01-16 15:51:13 +01:00
parent 86e782e2b6
commit 084b76a70a
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
2 changed files with 31 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

10
doc/guix.texi
View file

@ -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

34
gnu/machine/ssh.scm
View file

@ -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