summary refs log tree commit diff
path: root/gnu
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
parent983906ab72307a5b848a54233b30d9744356de07 (diff)
downloadguix-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')
-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))