diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2022-11-17 12:35:07 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2022-11-17 22:27:39 +0100 |
| commit | 17b01d546306885ff3c07e7b6aaffb541a8b9043 (patch) | |
| tree | a2498d72ed07147aec3384a892ccc3bdd871c038 /gnu/machine | |
| parent | 983906ab72307a5b848a54233b30d9744356de07 (diff) | |
| download | guix-17b01d546306885ff3c07e7b6aaffb541a8b9043.tar guix-17b01d546306885ff3c07e7b6aaffb541a8b9043.tar.gz | |
machine: ssh: Validate 'system' field.
* gnu/machine/ssh.scm (<machine-ssh-configuration>)[system]: Add
'sanitize' property.
(validate-system-type): New macro.
Diffstat (limited to 'gnu/machine')
| -rw-r--r-- | gnu/machine/ssh.scm | 30 |
1 files changed, 29 insertions, 1 deletions
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index 1230b1ec0d..343cf74748 100644 --- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -42,6 +42,7 @@ #:use-module ((guix inferior) #:select (inferior-exception? inferior-exception-arguments)) + #:use-module ((guix platform) #:select (systems)) #:use-module (gcrypt pk-crypto) #:use-module (ice-9 format) #:use-module (ice-9 match) @@ -86,7 +87,8 @@ machine-ssh-configuration? this-machine-ssh-configuration (host-name machine-ssh-configuration-host-name) ; string - (system machine-ssh-configuration-system) ; string + (system machine-ssh-configuration-system ; string + (sanitize validate-system-type)) (build-locally? machine-ssh-configuration-build-locally? ; boolean (default #t)) (authorize? machine-ssh-configuration-authorize? ; boolean @@ -109,6 +111,32 @@ (host-key machine-ssh-configuration-host-key ; #f | string (default #f))) +(define-with-syntax-properties (validate-system-type (value properties)) + ;; Raise an error if VALUE is not a valid system type. + (unless (string? value) + (raise (make-compound-condition + (condition + (&error-location + (location (source-properties->location properties)))) + (formatted-message + (G_ "~a: invalid system type; must be a string") + value)))) + (unless (member value (systems)) + (raise (apply make-compound-condition + (condition + (&error-location + (location (source-properties->location properties)))) + (formatted-message (G_ "~a: unknown system type") value) + (let ((closest (string-closest value (systems) + #:threshold 5))) + (if closest + (list (condition + (&fix-hint + (hint (format #f (G_ "Did you mean @code{~a}?") + closest))))) + '()))))) + value) + (define (open-machine-ssh-session config) "Open an SSH session for CONFIG, a <machine-ssh-configuration> record." (let ((host-name (machine-ssh-configuration-host-name config)) |