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