diff options
Diffstat (limited to 'gnu/tests/ssh.scm')
| -rw-r--r-- | gnu/tests/ssh.scm | 109 |
1 files changed, 76 insertions, 33 deletions
diff --git a/gnu/tests/ssh.scm b/gnu/tests/ssh.scm index 456476e69d..c1582c4737 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. ;;; @@ -54,10 +55,12 @@ (services (cons service (operating-system-user-services %base-os))))) -(define (run-ssh-test name ssh-service pid-file) +(define* (run-ssh-test name ssh-service pid-file #:key (sftp? #f)) "Run a test of an OS running SSH-SERVICE, which writes its PID to PID-FILE. SSH-SERVICE must be configured to listen on port 22 and to allow for root and -empty-password logins." +empty-password logins. + +When SFTP? is true, run an SFTP server test." (mlet* %store-monad ((os -> (marionette-operating-system (os-with-service ssh-service) #:imported-modules '((gnu services herd) @@ -80,7 +83,8 @@ empty-password logins." (ice-9 match) (ssh session) (ssh auth) - (ssh channel)) + (ssh channel) + (ssh sftp)) (define marionette ;; Enable TCP forwarding of the guest's port 22. @@ -101,6 +105,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 +176,34 @@ 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 + (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")))))) + + ;; Connect to the guest over SFTP. Make sure we can write and + ;; read a file there. + (unless #$sftp? + (test-skip 1)) + (test-equal "SFTP file writing and reading" '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) + (let ((sftp-session (make-sftp-session session)) + (witness "/root/sftp-witness")) + (call-with-remote-output-file sftp-session witness + (cut display "hello" <>)) + (call-with-remote-input-file sftp-session witness + read))))) (test-end) (exit (= (test-runner-fail-count (test-runner-current)) 0))))) @@ -179,7 +221,8 @@ empty-password logins." (openssh-configuration (permit-root-login #t) (allow-empty-passwords? #t))) - "/var/run/sshd.pid")))) + "/var/run/sshd.pid" + #:sftp? #t)))) (define %test-dropbear (system-test |