[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
03/04: tests: ssh: Abstract session connection and authentication.
From: |
Clément Lassieur |
Subject: |
03/04: tests: ssh: Abstract session connection and authentication. |
Date: |
Tue, 21 Mar 2017 15:50:36 -0400 (EDT) |
snape pushed a commit to branch master
in repository guix.
commit cfaf4d11659a6b78ef35676b4e37d6da179e5b51
Author: Clément Lassieur <address@hidden>
Date: Sun Mar 19 13:18:37 2017 +0100
tests: ssh: Abstract session connection and authentication.
* gnu/tests/ssh.scm (run-ssh-test): Introduce make-session-for-test,
call-with-connected-session and call-with-connected-session/auth.
(run-ssh-test)["connect"]: Rename to "shell command". Abstract its session
connection and authentication work into the above three functions.
---
gnu/tests/ssh.scm | 82 +++++++++++++++++++++++++++++++++++--------------------
1 file changed, 53 insertions(+), 29 deletions(-)
diff --git a/gnu/tests/ssh.scm b/gnu/tests/ssh.scm
index 456476e..7779b71 100644
--- a/gnu/tests/ssh.scm
+++ b/gnu/tests/ssh.scm
@@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <address@hidden>
+;;; Copyright © 2017 Clément Lassieur <address@hidden>
;;;
;;; This file is part of GNU Guix.
;;;
@@ -101,6 +102,47 @@ empty-password logins."
(error "file didn't show up" ,file))))
marionette))
+ (define (make-session-for-test)
+ "Make a session with predefined parameters for a test."
+ (make-session #:user "root"
+ #:port 2222
+ #:host "localhost"
+ #:log-verbosity 'protocol))
+
+ (define (call-with-connected-session proc)
+ "Call the one-argument procedure PROC with a freshly created and
+connected SSH session object, return the result of the procedure call. The
+session is disconnected when the PROC is finished."
+ (let ((session (make-session-for-test)))
+ (dynamic-wind
+ (lambda ()
+ (let ((result (connect! session)))
+ (unless (equal? result 'ok)
+ (error "Could not connect to a server"
+ session result))))
+ (lambda () (proc session))
+ (lambda () (disconnect! session)))))
+
+ (define (call-with-connected-session/auth proc)
+ "Make an authenticated session. We should be able to connect as
+root with an empty password."
+ (call-with-connected-session
+ (lambda (session)
+ ;; Try the simple authentication methods. Dropbear requires
+ ;; 'none' when there are no passwords, whereas OpenSSH accepts
+ ;; 'password' with an empty password.
+ (let loop ((methods (list (cut userauth-password! <> "")
+ (cut userauth-none! <>))))
+ (match methods
+ (()
+ (error "all the authentication methods failed"))
+ ((auth rest ...)
+ (match (pk 'auth (auth session))
+ ('success
+ (proc session))
+ ('denied
+ (loop rest)))))))))
+
(mkdir #$output)
(chdir #$output)
@@ -131,37 +173,19 @@ empty-password logins."
(current-services))))
marionette))
- ;; Connect to the guest over SSH. We should be able to connect as
- ;; "root" with an empty password. Make sure we can run a shell
+ ;; Connect to the guest over SSH. Make sure we can run a shell
;; command there.
- (test-equal "connect"
+ (test-equal "shell command"
'hello
- (let* ((session (make-session #:user "root"
- #:port 2222 #:host "localhost"
- #:log-verbosity 'protocol)))
- (match (connect! session)
- ('ok
- ;; Try the simple authentication methods. Dropbear
- ;; requires 'none' when there are no passwords, whereas
- ;; OpenSSH accepts 'password' with an empty password.
- (let loop ((methods (list (cut userauth-password! <> "")
- (cut userauth-none! <>))))
- (match methods
- (()
- (error "all the authentication methods failed"))
- ((auth rest ...)
- (match (pk 'auth (auth session))
- ('success
- ;; FIXME: 'get-server-public-key' segfaults.
- ;; (get-server-public-key session)
- (let ((channel (make-channel session)))
- (channel-open-session channel)
- (channel-request-exec channel
- "echo hello >
/root/witness")
- (and (zero? (channel-get-exit-status channel))
- (wait-for-file "/root/witness"))))
- ('denied
- (loop rest))))))))))
+ (call-with-connected-session/auth
+ (lambda (session)
+ ;; FIXME: 'get-server-public-key' segfaults.
+ ;; (get-server-public-key session)
+ (let ((channel (make-channel session)))
+ (channel-open-session channel)
+ (channel-request-exec channel "echo hello > /root/witness")
+ (and (zero? (channel-get-exit-status channel))
+ (wait-for-file "/root/witness"))))))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))