diff options
| -rw-r--r-- | gnu/tests/ssh.scm | 82 |
1 files changed, 53 insertions, 29 deletions
diff --git a/gnu/tests/ssh.scm b/gnu/tests/ssh.scm index 456476e69d..7779b71561 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 <ludo@gnu.org> +;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org> ;;; ;;; 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))))) |