summaryrefslogtreecommitdiff
path: root/gnu/machine/ssh.scm
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-11-17 12:35:07 +0100
committerLudovic Courtès <ludo@gnu.org>2022-11-17 22:27:39 +0100
commit17b01d546306885ff3c07e7b6aaffb541a8b9043 (patch)
treea2498d72ed07147aec3384a892ccc3bdd871c038 /gnu/machine/ssh.scm
parent983906ab72307a5b848a54233b30d9744356de07 (diff)
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/ssh.scm')
-rw-r--r--gnu/machine/ssh.scm30
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))