Merge branch 'master' into core-updates

1 files changed, 142 insertions, 148 deletions

diff --git a/gnu/tests/ssh.scm b/gnu/tests/ssh.scm
index 6abc6c2501..9247a43e6d 100644
--- a/gnu/tests/ssh.scm
+++ b/gnu/tests/ssh.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2016, 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2016, 2017, 2018 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2017 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2017 Marius Bakke <mbakke@fastmail.com>
 ;;;
@@ -49,156 +49,150 @@ When SFTP? is true, run an SFTP server test."
 
   (define test
     (with-imported-modules '((gnu build marionette))
-      #~(begin
-          (eval-when (expand load eval)
-            ;; Prepare to use Guile-SSH.
-            (set! %load-path
-              (cons (string-append #+guile-ssh "/share/guile/site/"
-                                   (effective-version))
-                    %load-path)))
-
-          (use-modules (gnu build marionette)
-                       (srfi srfi-26)
-                       (srfi srfi-64)
-                       (ice-9 match)
-                       (ssh session)
-                       (ssh auth)
-                       (ssh channel)
-                       (ssh sftp))
-
-          (define marionette
-            ;; Enable TCP forwarding of the guest's port 22.
-            (make-marionette (list #$vm)))
-
-          (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
+      (with-extensions (list guile-ssh)
+        #~(begin
+            (use-modules (gnu build marionette)
+                         (srfi srfi-26)
+                         (srfi srfi-64)
+                         (ice-9 match)
+                         (ssh session)
+                         (ssh auth)
+                         (ssh channel)
+                         (ssh sftp))
+
+            (define marionette
+              ;; Enable TCP forwarding of the guest's port 22.
+              (make-marionette (list #$vm)))
+
+            (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
+              (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)
-
-          (test-begin "ssh-daemon")
-
-          ;; Wait for sshd to be up and running.
-          (test-eq "service running"
-            'running!
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd))
-                (start-service 'ssh-daemon)
-                'running!)
-             marionette))
-
-          ;; Check sshd's PID file.
-          (test-equal "sshd PID"
-            (wait-for-file #$pid-file marionette)
-            (marionette-eval
-             '(begin
-                (use-modules (gnu services herd)
-                             (srfi srfi-1))
-
-                (live-service-running
-                 (find (lambda (live)
-                         (memq 'ssh-daemon
-                               (live-service-provision live)))
-                       (current-services))))
-             marionette))
-
-          ;; Connect to the guest over SSH.  Make sure we can run a shell
-          ;; command there.
-          (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" marionette))))))
-
-          ;; 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
-            (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)))))
-
-          ;; Connect to the guest over SSH.  Make sure we can run commands
-          ;; from the system profile.
-          (test-equal "run executables from system profile"
-            #t
-            (call-with-connected-session/auth
-             (lambda (session)
-               (let ((channel (make-channel session)))
-                 (channel-open-session channel)
-                 (channel-request-exec
-                  channel
-                  (string-append
-                   "mkdir -p /root/.guix-profile/bin && "
-                   "touch /root/.guix-profile/bin/path-witness && "
-                   "chmod 755 /root/.guix-profile/bin/path-witness"))
-                 (zero? (channel-get-exit-status channel))))))
-
-          ;; Connect to the guest over SSH.  Make sure we can run commands
-          ;; from the user profile.
-          (test-equal "run executable from user profile"
-            #t
-            (call-with-connected-session/auth
-             (lambda (session)
-               (let ((channel (make-channel session)))
-                 (channel-open-session channel)
-                 (channel-request-exec channel "path-witness")
-                 (zero? (channel-get-exit-status channel))))))
-
-          (test-end)
-          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+              (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)
+
+            (test-begin "ssh-daemon")
+
+            ;; Wait for sshd to be up and running.
+            (test-eq "service running"
+              'running!
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd))
+                  (start-service 'ssh-daemon)
+                  'running!)
+               marionette))
+
+            ;; Check sshd's PID file.
+            (test-equal "sshd PID"
+              (wait-for-file #$pid-file marionette)
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd)
+                               (srfi srfi-1))
+
+                  (live-service-running
+                   (find (lambda (live)
+                           (memq 'ssh-daemon
+                                 (live-service-provision live)))
+                         (current-services))))
+               marionette))
+
+            ;; Connect to the guest over SSH.  Make sure we can run a shell
+            ;; command there.
+            (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" marionette))))))
+
+            ;; 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
+              (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)))))
+
+            ;; Connect to the guest over SSH.  Make sure we can run commands
+            ;; from the system profile.
+            (test-equal "run executables from system profile"
+              #t
+              (call-with-connected-session/auth
+               (lambda (session)
+                 (let ((channel (make-channel session)))
+                   (channel-open-session channel)
+                   (channel-request-exec
+                    channel
+                    (string-append
+                     "mkdir -p /root/.guix-profile/bin && "
+                     "touch /root/.guix-profile/bin/path-witness && "
+                     "chmod 755 /root/.guix-profile/bin/path-witness"))
+                   (zero? (channel-get-exit-status channel))))))
+
+            ;; Connect to the guest over SSH.  Make sure we can run commands
+            ;; from the user profile.
+            (test-equal "run executable from user profile"
+              #t
+              (call-with-connected-session/auth
+               (lambda (session)
+                 (let ((channel (make-channel session)))
+                   (channel-open-session channel)
+                   (channel-request-exec channel "path-witness")
+                   (zero? (channel-get-exit-status channel))))))
+
+            (test-end)
+            (exit (= (test-runner-fail-count (test-runner-current)) 0))))))
 
   (gexp->derivation name test))