diff --git a/guix/ssh.scm b/guix/ssh.scm index 2d7ca7d01d..a9312b7c8c 100644 --- a/guix/ssh.scm +++ b/guix/ssh.scm @@ -98,7 +98,7 @@ actual key does not match." key type)))))))) (define* (open-ssh-session host #:key user port identity - host-key + host-key open-connection (compression %compression) (timeout 3600)) "Open an SSH session for HOST and return it. IDENTITY specifies the file @@ -110,6 +110,10 @@ When HOST-KEY is true, it must be a string like \"ssh-ed25519 AAAAC3Nz… root@example.org\"; the server is authenticated and an error is raised if its host key is different from HOST-KEY. +When OPEN-CONNECTION is true, it must be a two-argument procedure; it is +passed HOST and PORT and must return a socket (a file port). When +OPEN-CONNECTION is false, Guile-SSH takes care of opening the connection. + Install TIMEOUT as the maximum time in seconds after which a read or write operation on a channel of the returned session is considered as failing. @@ -134,6 +138,13 @@ Throw an error on failure." ;; Honor ~/.ssh/config. (session-parse-config! session) + (when open-connection + (let* ((sock (open-connection host port))) + ;; Since 'session-set!' doesn't increase the revealed count of SOCK + ;; (as of Guile-SSH 0.12.0), do it ourselves. + (set-port-revealed! sock 1) + (session-set! session 'fd sock))) + (match (connect! session) ('ok (if host-key diff --git a/guix/store/ssh.scm b/guix/store/ssh.scm index 09c0832505..d07f0d7467 100644 --- a/guix/store/ssh.scm +++ b/guix/store/ssh.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2017 Ludovic Courtès +;;; Copyright © 2017, 2020 Ludovic Courtès ;;; ;;; This file is part of GNU Guix. ;;; @@ -19,6 +19,7 @@ (define-module (guix store ssh) #:use-module (guix ssh) #:use-module (web uri) + #:use-module (ssh session) #:export (connect-to-daemon)) ;;; Commentary: @@ -29,11 +30,27 @@ ;;; ;;; End: +(define (open-connection host port) + "Open a connection to HOST and PORT. Use the standard SSH port if PORT is +false." + (let* ((lst (getaddrinfo host + (if port (number->string port) "ssh") + (if port AI_NUMERICSERV 0))) + (addr (addrinfo:addr (car lst))) + (sock (socket (sockaddr:fam addr) SOCK_STREAM 0))) + ;; Setting this option makes a dramatic difference because it avoids the + ;; "ACK delay" on our RPC messages. + (setsockopt sock IPPROTO_TCP TCP_NODELAY 1) + + (connect sock addr) + sock)) + (define (connect-to-daemon uri) "Connect to the SSH daemon at URI, a URI object with the 'ssh' scheme." (remote-daemon-channel (open-ssh-session (uri-host uri) #:port (or (uri-port uri) 22) - #:user (uri-userinfo uri)))) + #:user (uri-userinfo uri) + #:open-connection open-connection))) ;;; ssh.scm ends here