nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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.
This commit is contained in:
Clément Lassieur 2017-03-19 13:18:37 +01:00
parent 12723370e5
commit cfaf4d1165
No known key found for this signature in database
GPG Key ID: 89F96D4808F359C7
1 changed files with 53 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

72
gnu/tests/ssh.scm
View File

@ -1,5 +1,6 @@
;;; GNU Guix --- Functional package management for GNU ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org> ;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
;;; ;;;
;;; This file is part of GNU Guix. ;;; This file is part of GNU Guix.
;;; ;;;
@ -101,6 +102,47 @@ empty-password logins."
(error "file didn't show up" ,file)))) (error "file didn't show up" ,file))))
marionette)) 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) (mkdir #$output)
(chdir #$output) (chdir #$output)
@ -131,37 +173,19 @@ empty-password logins."
(current-services)))) (current-services))))
marionette)) marionette))
;; Connect to the guest over SSH. We should be able to connect as ;; Connect to the guest over SSH. Make sure we can run a shell
;; "root" with an empty password. Make sure we can run a shell
;; command there. ;; command there.
(test-equal "connect" (test-equal "shell command"
'hello 'hello
(let* ((session (make-session #:user "root" (call-with-connected-session/auth
#:port 2222 #:host "localhost" (lambda (session)
#: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. ;; FIXME: 'get-server-public-key' segfaults.
;; (get-server-public-key session) ;; (get-server-public-key session)
(let ((channel (make-channel session))) (let ((channel (make-channel session)))
(channel-open-session channel) (channel-open-session channel)
(channel-request-exec channel (channel-request-exec channel "echo hello > /root/witness")
"echo hello > /root/witness")
(and (zero? (channel-get-exit-status channel)) (and (zero? (channel-get-exit-status channel))
(wait-for-file "/root/witness")))) (wait-for-file "/root/witness"))))))
('denied
(loop rest))))))))))
(test-end) (test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0))))) (exit (= (test-runner-fail-count (test-runner-current)) 0)))))