ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

machine: ssh: Open a single SSH session per machine.

Browse source 
Previously, any call to 'managed-host-remote-eval' and similar would
open a new SSH session to the host.  With this change, an SSH session is
opened once, cached, and then reused by all subsequent calls to
'machine-ssh-session'.

* gnu/machine/ssh.scm (<machine-ssh-configuration>): Add
'this-machine-ssh-configuration'.
[session]: Mark as thunked and change default value to an
'open-machine-ssh-session*' call.
(open-machine-ssh-session, open-machine-ssh-session*): New procedures.
(machine-ssh-session): Replace inline code by call to
'open-machine-ssh-session'.
This commit is contained in:
Ludovic Courtès 2022-01-09 21:55:43 +01:00
parent 1684ed6537
commit 7f20e59a13
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
1 changed files with 29 additions and 15 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

44
gnu/machine/ssh.scm
View file

@ -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 @@ (define-module (gnu machine ssh)
#: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-module (gnu machine ssh)
(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 @@ (define-record-type* <machine-ssh-configuration> machine-ssh-configuration
(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))))
;;;