diff options
Diffstat (limited to 'gnu/machine/ssh.scm')
| -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 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 |
