summaryrefslogtreecommitdiff
path: root/gnu/machine/ssh.scm
diff options
context:
space:
mode:
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 22688f46f4b..0dc8933c82f 100644
--- a/gnu/machine/ssh.scm
+++ b/gnu/machine/ssh.scm
@@ -93,6 +93,8 @@
93 (default #t)) 93 (default #t))
94 (allow-downgrades? machine-ssh-configuration-allow-downgrades? ; boolean 94 (allow-downgrades? machine-ssh-configuration-allow-downgrades? ; boolean
95 (default #f)) 95 (default #f))
96 (safety-checks? machine-ssh-configuration-safety-checks? ;boolean
97 (default #t))
96 (port machine-ssh-configuration-port ; integer 98 (port machine-ssh-configuration-port ; integer
97 (default 22)) 99 (default 22))
98 (user machine-ssh-configuration-user ; string 100 (user machine-ssh-configuration-user ; string
@@ -240,18 +242,21 @@ exist on the machine."
240 (raise (formatted-message (G_ "no file system with UUID '~a'") 242 (raise (formatted-message (G_ "no file system with UUID '~a'")
241 (uuid->string (file-system-device fs))))))) 243 (uuid->string (file-system-device fs)))))))
242 244
243 (append (map check-literal-file-system 245 (if (machine-ssh-configuration-safety-checks?
244 (filter (lambda (fs) 246 (machine-configuration machine))
245 (string? (file-system-device fs))) 247 (append (map check-literal-file-system
246 file-systems)) 248 (filter (lambda (fs)
247 (map check-labeled-file-system 249 (string? (file-system-device fs)))
248 (filter (lambda (fs) 250 file-systems))
249 (file-system-label? (file-system-device fs))) 251 (map check-labeled-file-system
250 file-systems)) 252 (filter (lambda (fs)
251 (map check-uuid-file-system 253 (file-system-label? (file-system-device fs)))
252 (filter (lambda (fs) 254 file-systems))
253 (uuid? (file-system-device fs))) 255 (map check-uuid-file-system
254 file-systems)))) 256 (filter (lambda (fs)
257 (uuid? (file-system-device fs)))
258 file-systems)))
259 '()))
255 260
256(define (machine-check-initrd-modules machine) 261(define (machine-check-initrd-modules machine)
257 "Return a list of <remote-assertion> that raise a '&message' error condition 262 "Return a list of <remote-assertion> that raise a '&message' error condition
@@ -291,7 +296,10 @@ not available in the initrd."
291 (file-system-device fs) 296 (file-system-device fs)
292 missing))))) 297 missing)))))
293 298
294 (map missing-modules file-systems)) 299 (if (machine-ssh-configuration-safety-checks?
300 (machine-configuration machine))
301 (map missing-modules file-systems)
302 '()))
295 303
296(define* (machine-check-forward-update machine) 304(define* (machine-check-forward-update machine)
297 "Check whether we are making a forward update for MACHINE. Depending on its 305 "Check whether we are making a forward update for MACHINE. Depending on its