services: hurd-vm: Resurrect system-test by using raw disk-image.

[jackhill/guix/guix.git] / gnu / tests / mail.scm

diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm
index bb446da..a50fb1d 100644 (file)
--- a/gnu/tests/mail.scm
+++ b/gnu/tests/mail.scm
@@ -1,11 +1,11 @@
 ;;; GNU Guix --- Functional package management for GNU
 ;;; Copyright © 2016 Sou Bunnbu <iyzsong@member.fsf.org>
 ;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au>
-;;; Copyright © 2017 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2017, 2020 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Oleg Pykhalov <go.wigust@gmail.com>
 ;;; Copyright © 2018 Clément Lassieur <clement@lassieur.org>
 ;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
-;;; Copyright © 2019 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2019, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -26,8 +26,11 @@
   #:use-module (gnu tests)
   #:use-module (gnu packages mail)
   #:use-module (gnu system)
+  #:use-module (gnu system accounts)
+  #:use-module (gnu system shadow)
   #:use-module (gnu system vm)
   #:use-module (gnu services)
+  #:use-module (gnu services base)
   #:use-module (gnu services getmail)
   #:use-module (gnu services mail)
   #:use-module (gnu services networking)
@@ -47,7 +50,8 @@
              (config-file
               (plain-file "smtpd.conf" "
 listen on 0.0.0.0
-accept from any for local deliver to mbox
+action inbound mbox
+match from any for local action inbound
 "))))))
 
 (define (run-opensmtpd-test)
@@ -95,8 +99,8 @@ accept from any for local deliver to mbox
 
           (test-assert "mbox is empty"
             (marionette-eval
-             '(and (file-exists? "/var/mail")
-                   (not (file-exists? "/var/mail/root")))
+             '(and (file-exists? "/var/spool/mail")
+                   (not (file-exists? "/var/spool/mail/root")))
              marionette))
 
           (test-eq "accept an email"
@@ -136,16 +140,21 @@ accept from any for local deliver to mbox
                              (ice-9 rdelim))
 
                 (define (queue-empty?)
-                  (eof-object?
-                   (read-line
-                    (open-input-pipe
-                     (string-append #$(file-append opensmtpd "/sbin/smtpctl")
-                                    " show queue")))))
-
-                (let wait ()
-                  (if (queue-empty?)
-                      (file-exists? "/var/mail/root")
-                      (begin (sleep 1) (wait)))))
+                  (let* ((pipe (open-pipe* OPEN_READ
+                                           #$(file-append opensmtpd
+                                                          "/sbin/smtpctl")
+                                           "show" "queue"))
+                         (line (read-line pipe)))
+                    (close-pipe pipe)
+                    (eof-object? line)))
+
+                (let wait ((n 20))
+                  (cond ((queue-empty?)
+                         (file-exists? "/var/spool/mail/root"))
+                        ((zero? n)
+                         (error "root mailbox didn't show up"))
+                        (else
+                         (sleep 1) (wait (- n 1))))))
              marionette))
 
           (test-end)
@@ -403,43 +412,55 @@ Subject: Hello Nice to meet you!")
    (value (run-dovecot-test))))
 
 (define %getmail-os
-  (simple-operating-system
-   (service dhcp-client-service-type)
-   (service dovecot-service-type
-            (dovecot-configuration
-             (disable-plaintext-auth? #f)
-             (ssl? "no")
-             (auth-mechanisms '("anonymous" "plain"))
-             (auth-anonymous-username "alice")
-             (mail-location
-              (string-append "maildir:~/Maildir"
-                             ":INBOX=~/Maildir/INBOX"
-                             ":LAYOUT=fs"))))
-   (service getmail-service-type
-            (list
-             (getmail-configuration
-              (name 'test)
-              (user "alice")
-              (directory "/var/lib/getmail/alice")
-              (idle '("TESTBOX"))
-              (rcfile
-               (getmail-configuration-file
-                (retriever
-                 (getmail-retriever-configuration
-                  (type "SimpleIMAPRetriever")
-                  (server "localhost")
-                  (username "alice")
-                  (port 143)
-                  (extra-parameters
-                   '((password . "testpass")
-                     (mailboxes . ("TESTBOX"))))))
-                (destination
-                 (getmail-destination-configuration
-                  (type "Maildir")
-                  (path "/home/alice/TestMaildir/")))
-                (options
-                 (getmail-options-configuration
-                  (read-all #f))))))))))
+  (operating-system
+    (inherit (simple-operating-system))
+
+    ;; Set a password for the user account; the test needs it.
+    (users (cons (user-account
+                  (name "alice")
+                  (password (crypt "testpass" "$6$abc"))
+                  (comment "Bob's sister")
+                  (group "users")
+                  (supplementary-groups '("wheel" "audio" "video")))
+                 %base-user-accounts))
+
+    (services (cons* (service dhcp-client-service-type)
+                     (service dovecot-service-type
+                              (dovecot-configuration
+                               (disable-plaintext-auth? #f)
+                               (ssl? "no")
+                               (auth-mechanisms '("anonymous" "plain"))
+                               (auth-anonymous-username "alice")
+                               (mail-location
+                                (string-append "maildir:~/Maildir"
+                                               ":INBOX=~/Maildir/INBOX"
+                                               ":LAYOUT=fs"))))
+                     (service getmail-service-type
+                              (list
+                               (getmail-configuration
+                                (name 'test)
+                                (user "alice")
+                                (directory "/var/lib/getmail/alice")
+                                (idle '("TESTBOX"))
+                                (rcfile
+                                 (getmail-configuration-file
+                                  (retriever
+                                   (getmail-retriever-configuration
+                                    (type "SimpleIMAPRetriever")
+                                    (server "localhost")
+                                    (username "alice")
+                                    (port 143)
+                                    (extra-parameters
+                                     '((password . "testpass")
+                                       (mailboxes . ("TESTBOX"))))))
+                                  (destination
+                                   (getmail-destination-configuration
+                                    (type "Maildir")
+                                    (path "/home/alice/TestMaildir/")))
+                                  (options
+                                   (getmail-options-configuration
+                                    (read-all #f))))))))
+                     %base-services))))
 
 (define (run-getmail-test)
   "Return a test of an OS running Getmail service."
@@ -482,11 +503,6 @@ Subject: Hello Nice to meet you!")
                 (start-service 'dovecot))
              marionette))
 
-          (test-assert "set password for alice"
-            (marionette-eval
-             '(system "echo -e \"testpass\ntestpass\" | passwd alice")
-             marionette))
-
           ;; Wait for getmail to be up and running.
           (test-assert "getmail-test running"
             (marionette-eval