From 2b4363891c70bbf641bff8ff0a6fb7526babd5b9 Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Mon, 3 Oct 2016 15:18:51 +0200
Subject: tests: ssh: Add Dropbear test.

* gnu/tests/ssh.scm (run-ssh-test): Try authenticating with
'userauth-none!' when 'userauth-password!' fails.
(%test-dropbear): New variable.
---
 gnu/tests/ssh.scm | 46 +++++++++++++++++++++++++++++++++++-----------
 1 file changed, 35 insertions(+), 11 deletions(-)

(limited to 'gnu')

diff --git a/gnu/tests/ssh.scm b/gnu/tests/ssh.scm
index bcf7c973c4..456476e69d 100644
--- a/gnu/tests/ssh.scm
+++ b/gnu/tests/ssh.scm
@@ -31,7 +31,8 @@ (define-module (gnu tests ssh)
   #:use-module (guix gexp)
   #:use-module (guix store)
   #:use-module (guix monads)
-  #:export (%test-openssh))
+  #:export (%test-openssh
+            %test-dropbear))
 
 (define %base-os
   (operating-system
@@ -74,6 +75,7 @@ (define test
                       %load-path)))
 
             (use-modules (gnu build marionette)
+                         (srfi srfi-26)
                          (srfi srfi-64)
                          (ice-9 match)
                          (ssh session)
@@ -139,16 +141,27 @@ (define (wait-for-file file)
                                             #:log-verbosity 'protocol)))
                 (match (connect! session)
                   ('ok
-                   (match (pk 'auth (userauth-password! 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")))))))))
+                   ;; 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))))))))))
 
             (test-end)
             (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
@@ -167,3 +180,14 @@ (define %test-openssh
                                   (permit-root-login #t)
                                   (allow-empty-passwords? #t)))
                         "/var/run/sshd.pid"))))
+
+(define %test-dropbear
+  (system-test
+   (name "dropbear")
+   (description "Connect to a running Dropbear SSH daemon.")
+   (value (run-ssh-test name
+                        (service dropbear-service-type
+                                 (dropbear-configuration
+                                  (root-login? #t)
+                                  (allow-empty-passwords? #t)))
+                        "/var/run/dropbear.pid"))))
-- 
cgit v1.2.3