Merge branch 'master' into core-updates

6 files changed, 177 insertions, 24 deletions

diff --git a/gnu/tests/base.scm b/gnu/tests/base.scm
index bcb8299c73..e5ac320b74 100644
--- a/gnu/tests/base.scm
+++ b/gnu/tests/base.scm
@@ -31,6 +31,7 @@
   #:use-module (gnu services networking)
   #:use-module (gnu packages imagemagick)
   #:use-module (gnu packages ocr)
+  #:use-module (gnu packages package-management)
   #:use-module (guix gexp)
   #:use-module (guix store)
   #:use-module (guix monads)
@@ -56,7 +57,7 @@ passed a gexp denoting the marionette, and it must return gexp that is
 inserted before the first test.  This is used to introduce an extra
 initialization step, such as entering a LUKS passphrase."
   (define special-files
-    (service-parameters
+    (service-value
      (fold-services (operating-system-services os)
                     #:target-type special-files-service-type)))
 
@@ -198,6 +199,28 @@ info --version")
                          ',users+homes))
                marionette)))
 
+          (test-equal "no extra home directories"
+            '()
+
+            ;; Make sure the home directories that are not supposed to be
+            ;; created are indeed not created.
+            (let ((nonexistent
+                   '#$(filter-map (lambda (user)
+                                    (and (not
+                                          (user-account-create-home-directory?
+                                           user))
+                                         (user-account-home-directory user)))
+                                  (operating-system-user-accounts os))))
+              (marionette-eval
+               `(begin
+                  (use-modules (srfi srfi-1))
+
+                  ;; Note: Do not flag "/var/empty".
+                  (filter file-exists?
+                          ',(remove (cut string-prefix? "/var/" <>)
+                                    nonexistent)))
+               marionette)))
+
           (test-equal "login on tty1"
             "root\n"
             (begin
@@ -296,28 +319,24 @@ info --version")
                                 (setlocale LC_ALL before))
                              marionette))
 
-          (test-assert "/run/current-system is a GC root"
+          (test-eq "/run/current-system is a GC root"
+            'success!
             (marionette-eval '(begin
                                 ;; Make sure the (guix …) modules are found.
-                                (eval-when (expand load eval)
-                                  (set! %load-path
-                                    (cons
-                                     (string-append
-                                      "/run/current-system/profile/share/guile/site/"
-                                      (effective-version))
-                                     %load-path))
-                                  (set! %load-compiled-path
-                                    (cons
-                                     (string-append
-                                      "/run/current-system/profile/share/guile/site/"
-                                      (effective-version))
-                                     %load-compiled-path)))
+                                ;;
+                                ;; XXX: Currently shepherd and marionette run
+                                ;; on Guile 2.0 whereas Guix is on 2.2.  Yet
+                                ;; we should be able to load the 2.0 Scheme
+                                ;; files since it's pure Scheme.
+                                (add-to-load-path
+                                 #+(file-append guix "/share/guile/site/2.2"))
 
                                 (use-modules (srfi srfi-34) (guix store))
 
                                 (let ((system (readlink "/run/current-system")))
                                   (guard (c ((nix-protocol-error? c)
-                                             (file-exists? system)))
+                                             (and (file-exists? system)
+                                                  'success!)))
                                     (with-store store
                                       (delete-paths store (list system))
                                       #f))))
diff --git a/gnu/tests/dict.scm b/gnu/tests/dict.scm
index f7a48ab634..16b6edbd9e 100644
--- a/gnu/tests/dict.scm
+++ b/gnu/tests/dict.scm
@@ -97,15 +97,16 @@
                '(begin
                   (use-modules (ice-9 rdelim))
                   (let ((sock (socket PF_INET SOCK_STREAM 0)))
-                    (let loop ()
-                      (pk 'try)
+                    (let loop ((i 0))
+                      (pk 'try i)
                       (catch 'system-error
                         (lambda ()
                           (connect sock AF_INET INADDR_LOOPBACK 2628))
                         (lambda args
                           (pk 'connection-error args)
-                          (sleep 1)
-                          (loop))))
+                          (when (< i 20)
+                            (sleep 1)
+                            (loop (+ 1 i))))))
                     (read-line sock 'concat)))
                marionette))
 
diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm
index d5c08b7f09..247f4f667f 100644
--- a/gnu/tests/mail.scm
+++ b/gnu/tests/mail.scm
@@ -1,5 +1,6 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org>
+;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,7 +27,9 @@
   #:use-module (guix gexp)
   #:use-module (guix monads)
   #:use-module (guix store)
-  #:export (%test-opensmtpd))
+  #:use-module (ice-9 ftw)
+  #:export (%test-opensmtpd
+            %test-exim))
 
 (define %opensmtpd-os
   (simple-operating-system
@@ -146,3 +149,133 @@ accept from any for local deliver to mbox
    (name "opensmtpd")
    (description "Send an email to a running OpenSMTPD server.")
    (value (run-opensmtpd-test))))
+
+
+(define %exim-os
+  (simple-operating-system
+   (dhcp-client-service)
+   (service mail-aliases-service-type '())
+   (service exim-service-type
+            (exim-configuration
+             (config-file
+              (plain-file "exim.conf" "
+primary_hostname = komputilo
+domainlist local_domains = @
+domainlist relay_to_domains =
+hostlist   relay_from_hosts = localhost
+
+never_users =
+
+acl_smtp_rcpt = acl_check_rcpt
+acl_smtp_data = acl_check_data
+
+begin acl
+
+acl_check_rcpt:
+  accept
+acl_check_data:
+  accept
+"))))))
+
+(define (run-exim-test)
+  "Return a test of an OS running an Exim service."
+  (mlet* %store-monad ((command (system-qemu-image/shared-store-script
+                                 (marionette-operating-system
+                                  %exim-os
+                                  #:imported-modules '((gnu services herd)))
+                                 #:graphic? #f)))
+    (define test
+      (with-imported-modules '((gnu build marionette)
+                               (ice-9 ftw))
+        #~(begin
+            (use-modules (rnrs base)
+                         (srfi srfi-64)
+                         (ice-9 ftw)
+                         (ice-9 rdelim)
+                         (ice-9 regex)
+                         (gnu build marionette))
+
+            (define marionette
+              (make-marionette
+               ;; Enable TCP forwarding of the guest's port 25.
+               '(#$command "-net" "user,hostfwd=tcp::1025-:25")))
+
+            (define (read-reply-code port)
+              "Read a SMTP reply from PORT and return its reply code."
+              (let* ((line      (read-line port))
+                     (mo        (string-match "([0-9]+)([ -]).*" line))
+                     (code      (string->number (match:substring mo 1)))
+                     (finished? (string= " " (match:substring mo 2))))
+                (if finished?
+                    code
+                    (read-reply-code port))))
+
+            (define smtp (socket AF_INET SOCK_STREAM 0))
+            (define addr (make-socket-address AF_INET INADDR_LOOPBACK 1025))
+
+            (mkdir #$output)
+            (chdir #$output)
+
+            (test-begin "exim")
+
+            (test-assert "service is running"
+              (marionette-eval
+               '(begin
+                  (use-modules (gnu services herd))
+                  (start-service 'exim)
+                  #t)
+               marionette))
+
+            (sleep 1) ;; give the service time to start talking
+
+            (connect smtp addr)
+            ;; Be greeted.
+            (test-eq "greeting received"
+              220 (read-reply-code smtp))
+            ;; Greet the server.
+            (write-line "EHLO somehost" smtp)
+            (test-eq "greeting successful"
+              250 (read-reply-code smtp))
+            ;; Set sender email.
+            (write-line "MAIL FROM: test@example.com" smtp)
+            (test-eq "sender set"
+              250 (read-reply-code smtp)) ;250
+            ;; Set recipient email.
+            (write-line "RCPT TO: root@komputilo" smtp)
+            (test-eq "recipient set"
+              250 (read-reply-code smtp)) ;250
+            ;; Send message.
+            (write-line "DATA" smtp)
+            (test-eq "data begun"
+              354 (read-reply-code smtp)) ;354
+            (write-line "Subject: Hello" smtp)
+            (newline smtp)
+            (write-line "Nice to meet you!" smtp)
+            (write-line "." smtp)
+            (test-eq "message sent"
+              250 (read-reply-code smtp)) ;250
+            ;; Say goodbye.
+            (write-line "QUIT" smtp)
+            (test-eq "quit successful"
+              221 (read-reply-code smtp)) ;221
+            (close smtp)
+
+            (test-eq "the email is received"
+              1
+              (marionette-eval
+               '(begin
+                  (use-modules (ice-9 ftw))
+                  (length (scandir "/var/spool/exim/msglog"
+                                   (lambda (x) (not (string-prefix? "." x))))))
+               marionette))
+
+            (test-end)
+            (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+    (gexp->derivation "exim-test" test)))
+
+(define %test-exim
+  (system-test
+   (name "exim")
+   (description "Send an email to a running an Exim server.")
+   (value (run-exim-test))))
diff --git a/gnu/tests/nfs.scm b/gnu/tests/nfs.scm
index 1f28f5a5b8..9e1ac1d55a 100644
--- a/gnu/tests/nfs.scm
+++ b/gnu/tests/nfs.scm
@@ -1,6 +1,7 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2016 John Darrington <jmd@gnu.org>
+;;; Copyright © 2017 Mathieu Othacehe <m.othacehe@gmail.com>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -19,8 +20,8 @@
 
 (define-module (gnu tests nfs)
   #:use-module (gnu tests)
+  #:use-module (gnu bootloader grub)
   #:use-module (gnu system)
-  #:use-module (gnu system grub)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system shadow)
   #:use-module (gnu system vm)
diff --git a/gnu/tests/ssh.scm b/gnu/tests/ssh.scm
index 02931e982a..5f06151081 100644
--- a/gnu/tests/ssh.scm
+++ b/gnu/tests/ssh.scm
@@ -51,7 +51,7 @@ When SFTP? is true, run an SFTP server test."
             (eval-when (expand load eval)
               ;; Prepare to use Guile-SSH.
               (set! %load-path
-                (cons (string-append #$guile-ssh "/share/guile/site/"
+                (cons (string-append #+guile2.0-ssh "/share/guile/site/"
                                      (effective-version))
                       %load-path)))
 
diff --git a/gnu/tests/web.scm b/gnu/tests/web.scm
index cdc5791237..bc7e3b89a9 100644
--- a/gnu/tests/web.scm
+++ b/gnu/tests/web.scm
@@ -19,7 +19,6 @@
 (define-module (gnu tests web)
   #:use-module (gnu tests)
   #:use-module (gnu system)
-  #:use-module (gnu system grub)
   #:use-module (gnu system file-systems)
   #:use-module (gnu system shadow)
   #:use-module (gnu system vm)