diff options
| author | Efraim Flashner <efraim@flashner.co.il> | 2023-01-30 11:33:18 +0200 |
|---|---|---|
| committer | Efraim Flashner <efraim@flashner.co.il> | 2023-01-30 12:39:40 +0200 |
| commit | 4cf1acc7f3033b50b0bf19e02c9f522d522d338c (patch) | |
| tree | 9fd64956ee60304c15387eb394cd649e49f01467 /gnu/machine/ssh.scm | |
| parent | edb8c09addd186d9538d43b12af74d6c7aeea082 (diff) | |
| parent | 595b53b74e3ef57a1c0c96108ba86d38a170a241 (diff) | |
| download | guix-4cf1acc7f3033b50b0bf19e02c9f522d522d338c.tar.gz | |
Merge remote-tracking branch 'origin/master' into core-updates
Conflicts: doc/guix.texi gnu/local.mk gnu/packages/admin.scm gnu/packages/base.scm gnu/packages/chromium.scm gnu/packages/compression.scm gnu/packages/databases.scm gnu/packages/diffoscope.scm gnu/packages/freedesktop.scm gnu/packages/gnome.scm gnu/packages/gnupg.scm gnu/packages/guile.scm gnu/packages/inkscape.scm gnu/packages/llvm.scm gnu/packages/openldap.scm gnu/packages/pciutils.scm gnu/packages/ruby.scm gnu/packages/samba.scm gnu/packages/sqlite.scm gnu/packages/statistics.scm gnu/packages/syndication.scm gnu/packages/tex.scm gnu/packages/tls.scm gnu/packages/version-control.scm gnu/packages/xml.scm guix/build-system/copy.scm guix/scripts/home.scm
Diffstat (limited to 'gnu/machine/ssh.scm')
| -rw-r--r-- | gnu/machine/ssh.scm | 32 |
1 files changed, 30 insertions, 2 deletions
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index 60d127340a..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)) @@ -466,7 +494,7 @@ environment type of 'managed-host." (machine-configuration machine)) (unless (file-exists? %public-key-file) (raise (formatted-message (G_ "no signing key '~a'. \ -have you run 'guix archive --generate-key?'") +Have you run 'guix archive --generate-key'?") %public-key-file))) (remote-authorize-signing-key (call-with-input-file %public-key-file (lambda (port) |