mirror of
https://git.savannah.gnu.org/git/guix.git
synced 2025-01-18 21:46:35 +01:00
ssh: Move 'open-ssh-session' to (guix ssh).
* guix/scripts/copy.scm (%compression, open-ssh-session): Move to... * guix/ssh.scm: ... here. Use '&message' conditions instead of calling 'leave'.
This commit is contained in:
parent
ba97e454bf
commit
615c5298f7
2 changed files with 49 additions and 43 deletions
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -25,9 +25,6 @@ (define-module (guix scripts copy)
|
|||
#:use-module (guix derivations)
|
||||
#:use-module (guix scripts build)
|
||||
#:use-module ((guix scripts archive) #:select (options->derivations+files))
|
||||
#:use-module (ssh session)
|
||||
#:use-module (ssh auth)
|
||||
#:use-module (ssh key)
|
||||
#:use-module (srfi srfi-1)
|
||||
#:use-module (srfi srfi-11)
|
||||
#:use-module (srfi srfi-37)
|
||||
|
@ -40,42 +37,6 @@ (define-module (guix scripts copy)
|
|||
;;; Exchanging store items over SSH.
|
||||
;;;
|
||||
|
||||
(define %compression
|
||||
"zlib@openssh.com,zlib")
|
||||
|
||||
(define* (open-ssh-session host #:key user port)
|
||||
"Open an SSH session for HOST and return it. When USER and PORT are #f, use
|
||||
default values or whatever '~/.ssh/config' specifies; otherwise use them.
|
||||
Throw an error on failure."
|
||||
(let ((session (make-session #:user user
|
||||
#:host host
|
||||
#:port port
|
||||
#:timeout 10 ;seconds
|
||||
;; #:log-verbosity 'protocol
|
||||
|
||||
;; We need lightweight compression when
|
||||
;; exchanging full archives.
|
||||
#:compression %compression
|
||||
#:compression-level 3)))
|
||||
|
||||
;; Honor ~/.ssh/config.
|
||||
(session-parse-config! session)
|
||||
|
||||
(match (connect! session)
|
||||
('ok
|
||||
;; Use public key authentication, via the SSH agent if it's available.
|
||||
(match (userauth-public-key/auto! session)
|
||||
('success
|
||||
session)
|
||||
(x
|
||||
(disconnect! session)
|
||||
(leave (_ "SSH authentication failed for '~a': ~a~%")
|
||||
host (get-error session)))))
|
||||
(x
|
||||
;; Connection failed or timeout expired.
|
||||
(leave (_ "SSH connection to '~a' failed: ~a~%")
|
||||
host (get-error session))))))
|
||||
|
||||
(define (ssh-spec->user+host+port spec)
|
||||
"Parse SPEC, a string like \"user@host:port\" or just \"host\", and return
|
||||
three values: the user name (or #f), the host name, and the TCP port
|
||||
|
|
51
guix/ssh.scm
51
guix/ssh.scm
|
@ -1,5 +1,5 @@
|
|||
;;; GNU Guix --- Functional package management for GNU
|
||||
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
|
||||
;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
|
||||
;;;
|
||||
;;; This file is part of GNU Guix.
|
||||
;;;
|
||||
|
@ -18,7 +18,10 @@
|
|||
|
||||
(define-module (guix ssh)
|
||||
#:use-module (guix store)
|
||||
#:autoload (guix ui) (N_)
|
||||
#:use-module ((guix ui) #:select (_ N_))
|
||||
#:use-module (ssh session)
|
||||
#:use-module (ssh auth)
|
||||
#:use-module (ssh key)
|
||||
#:use-module (ssh channel)
|
||||
#:use-module (ssh popen)
|
||||
#:use-module (ssh session)
|
||||
|
@ -29,7 +32,8 @@ (define-module (guix ssh)
|
|||
#:use-module (srfi srfi-35)
|
||||
#:use-module (ice-9 match)
|
||||
#:use-module (ice-9 binary-ports)
|
||||
#:export (connect-to-remote-daemon
|
||||
#:export (open-ssh-session
|
||||
connect-to-remote-daemon
|
||||
send-files
|
||||
retrieve-files
|
||||
remote-store-host
|
||||
|
@ -43,6 +47,47 @@ (define-module (guix ssh)
|
|||
;;;
|
||||
;;; Code:
|
||||
|
||||
(define %compression
|
||||
"zlib@openssh.com,zlib")
|
||||
|
||||
(define* (open-ssh-session host #:key user port
|
||||
(compression %compression))
|
||||
"Open an SSH session for HOST and return it. When USER and PORT are #f, use
|
||||
default values or whatever '~/.ssh/config' specifies; otherwise use them.
|
||||
Throw an error on failure."
|
||||
(let ((session (make-session #:user user
|
||||
#:host host
|
||||
#:port port
|
||||
#:timeout 10 ;seconds
|
||||
;; #:log-verbosity 'protocol
|
||||
|
||||
;; We need lightweight compression when
|
||||
;; exchanging full archives.
|
||||
#:compression compression
|
||||
#:compression-level 3)))
|
||||
|
||||
;; Honor ~/.ssh/config.
|
||||
(session-parse-config! session)
|
||||
|
||||
(match (connect! session)
|
||||
('ok
|
||||
;; Use public key authentication, via the SSH agent if it's available.
|
||||
(match (userauth-public-key/auto! session)
|
||||
('success
|
||||
session)
|
||||
(x
|
||||
(disconnect! session)
|
||||
(raise (condition
|
||||
(&message
|
||||
(message (format #f (_ "SSH authentication failed for '~a': ~a~%")
|
||||
host (get-error session)))))))))
|
||||
(x
|
||||
;; Connection failed or timeout expired.
|
||||
(raise (condition
|
||||
(&message
|
||||
(message (format #f (_ "SSH connection to '~a' failed: ~a~%")
|
||||
host (get-error session))))))))))
|
||||
|
||||
(define* (connect-to-remote-daemon session
|
||||
#:optional
|
||||
(socket-name "/var/guix/daemon-socket/socket"))
|
||||
|
|
Loading…
Reference in a new issue