1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
5 ;;; This file is part of GNU Guix.
7 ;;; GNU Guix is free software; you can redistribute it and/or modify it
8 ;;; under the terms of the GNU General Public License as published by
9 ;;; the Free Software Foundation; either version 3 of the License, or (at
10 ;;; your option) any later version.
12 ;;; GNU Guix is distributed in the hope that it will be useful, but
13 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
14 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 ;;; GNU General Public License for more details.
17 ;;; You should have received a copy of the GNU General Public License
18 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
20 (define-module (gnu tests ssh)
21 #:use-module (gnu tests)
22 #:use-module (gnu system)
23 #:use-module (gnu system vm)
24 #:use-module (gnu services)
25 #:use-module (gnu services ssh)
26 #:use-module (gnu services networking)
27 #:use-module (gnu packages ssh)
28 #:use-module (guix gexp)
29 #:use-module (guix store)
30 #:use-module (guix monads)
31 #:export (%test-openssh
34 (define* (run-ssh-test name ssh-service pid-file #:key (sftp? #f))
35 "Run a test of an OS running SSH-SERVICE, which writes its PID to PID-FILE.
36 SSH-SERVICE must be configured to listen on port 22 and to allow for root and
37 empty-password logins.
39 When SFTP? is true, run an SFTP server test."
40 (mlet* %store-monad ((os -> (marionette-operating-system
41 (simple-operating-system
44 #:imported-modules '((gnu services herd)
46 (command (system-qemu-image/shared-store-script
49 (with-imported-modules '((gnu build marionette))
51 (eval-when (expand load eval)
52 ;; Prepare to use Guile-SSH.
54 (cons (string-append #$guile-ssh "/share/guile/site/"
58 (use-modules (gnu build marionette)
68 ;; Enable TCP forwarding of the guest's port 22.
69 (make-marionette (list #$command "-net"
70 "user,hostfwd=tcp::2222-:22")))
72 (define (wait-for-file file)
73 ;; Wait until FILE exists in the guest; 'read' its content and
77 (cond ((file-exists? ,file)
78 (call-with-input-file ,file read))
83 (error "file didn't show up" ,file))))
86 (define (make-session-for-test)
87 "Make a session with predefined parameters for a test."
88 (make-session #:user "root"
91 #:log-verbosity 'protocol))
93 (define (call-with-connected-session proc)
94 "Call the one-argument procedure PROC with a freshly created and
95 connected SSH session object, return the result of the procedure call. The
96 session is disconnected when the PROC is finished."
97 (let ((session (make-session-for-test)))
100 (let ((result (connect! session)))
101 (unless (equal? result 'ok)
102 (error "Could not connect to a server"
104 (lambda () (proc session))
105 (lambda () (disconnect! session)))))
107 (define (call-with-connected-session/auth proc)
108 "Make an authenticated session. We should be able to connect as
109 root with an empty password."
110 (call-with-connected-session
112 ;; Try the simple authentication methods. Dropbear requires
113 ;; 'none' when there are no passwords, whereas OpenSSH accepts
114 ;; 'password' with an empty password.
115 (let loop ((methods (list (cut userauth-password! <> "")
116 (cut userauth-none! <>))))
119 (error "all the authentication methods failed"))
121 (match (pk 'auth (auth session))
130 (test-begin "ssh-daemon")
132 ;; Wait for sshd to be up and running.
133 (test-eq "service running"
137 (use-modules (gnu services herd))
138 (start-service 'ssh-daemon)
142 ;; Check sshd's PID file.
143 (test-equal "sshd PID"
144 (wait-for-file #$pid-file)
147 (use-modules (gnu services herd)
150 (live-service-running
153 (live-service-provision live)))
154 (current-services))))
157 ;; Connect to the guest over SSH. Make sure we can run a shell
159 (test-equal "shell command"
161 (call-with-connected-session/auth
163 ;; FIXME: 'get-server-public-key' segfaults.
164 ;; (get-server-public-key session)
165 (let ((channel (make-channel session)))
166 (channel-open-session channel)
167 (channel-request-exec channel "echo hello > /root/witness")
168 (and (zero? (channel-get-exit-status channel))
169 (wait-for-file "/root/witness"))))))
171 ;; Connect to the guest over SFTP. Make sure we can write and
172 ;; read a file there.
175 (test-equal "SFTP file writing and reading"
177 (call-with-connected-session/auth
179 (let ((sftp-session (make-sftp-session session))
180 (witness "/root/sftp-witness"))
181 (call-with-remote-output-file sftp-session witness
182 (cut display "hello" <>))
183 (call-with-remote-input-file sftp-session witness
187 (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
189 (gexp->derivation name test)))
191 (define %test-openssh
194 (description "Connect to a running OpenSSH daemon.")
195 (value (run-ssh-test name
196 ;; Allow root logins with an empty password to
198 (service openssh-service-type
199 (openssh-configuration
200 (permit-root-login #t)
201 (allow-empty-passwords? #t)))
205 (define %test-dropbear
208 (description "Connect to a running Dropbear SSH daemon.")
209 (value (run-ssh-test name
210 (service dropbear-service-type
211 (dropbear-configuration
213 (allow-empty-passwords? #t)))
214 "/var/run/dropbear.pid"))))