diff options
Diffstat (limited to 'gnu/machine/ssh.scm')
| -rw-r--r-- | gnu/machine/ssh.scm | 44 |
1 files changed, 29 insertions, 15 deletions
diff --git a/gnu/machine/ssh.scm b/gnu/machine/ssh.scm index ecd02e336c..22688f46f4 100644 --- a/gnu/machine/ssh.scm +++ b/gnu/machine/ssh.scm @@ -1,6 +1,6 @@ ;;; GNU Guix --- Functional package management for GNU ;;; Copyright © 2019 Jakob L. Kreuze <zerodaysfordays@sdf.org> -;;; Copyright © 2020, 2021 Ludovic Courtès <ludo@gnu.org> +;;; Copyright © 2020-2022 Ludovic Courtès <ludo@gnu.org> ;;; ;;; This file is part of GNU Guix. ;;; @@ -26,6 +26,7 @@ #:use-module (gnu system uuid) #:use-module ((gnu services) #:select (sexp->system-provenance)) #:use-module (guix diagnostics) + #:use-module (guix memoization) #:use-module (guix gexp) #:use-module (guix i18n) #:use-module (guix modules) @@ -83,6 +84,7 @@ (define-record-type* <machine-ssh-configuration> machine-ssh-configuration make-machine-ssh-configuration machine-ssh-configuration? + this-machine-ssh-configuration (host-name machine-ssh-configuration-host-name) ; string (system machine-ssh-configuration-system) ; string (build-locally? machine-ssh-configuration-build-locally? ; boolean @@ -98,29 +100,41 @@ (identity machine-ssh-configuration-identity ; path to a private key (default #f)) (session machine-ssh-configuration-session ; session - (default #f)) + (thunked) + (default + ;; By default, open the session once and cache it. + (open-machine-ssh-session* this-machine-ssh-configuration))) (host-key machine-ssh-configuration-host-key ; #f | string (default #f))) +(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)) + (user (machine-ssh-configuration-user config)) + (port (machine-ssh-configuration-port config)) + (identity (machine-ssh-configuration-identity config)) + (host-key (machine-ssh-configuration-host-key config))) + (unless host-key + (warning (G_ "<machine-ssh-configuration> without a 'host-key' \ +is deprecated~%"))) + (open-ssh-session host-name + #:user user + #:port port + #:identity identity + #:host-key host-key))) + +(define open-machine-ssh-session* + (mlambdaq (config) + "Memoizing variant of 'open-machine-ssh-session'." + (open-machine-ssh-session config))) + (define (machine-ssh-session machine) "Return the SSH session that was given in MACHINE's configuration, or create one from the configuration's parameters if one was not provided." (maybe-raise-unsupported-configuration-error machine) (let ((config (machine-configuration machine))) (or (machine-ssh-configuration-session config) - (let ((host-name (machine-ssh-configuration-host-name config)) - (user (machine-ssh-configuration-user config)) - (port (machine-ssh-configuration-port config)) - (identity (machine-ssh-configuration-identity config)) - (host-key (machine-ssh-configuration-host-key config))) - (unless host-key - (warning (G_ "<machine-ssh-configuration> without a 'host-key' \ -is deprecated~%"))) - (open-ssh-session host-name - #:user user - #:port port - #:identity identity - #:host-key host-key))))) + (open-machine-ssh-session config)))) ;;; |