Merge branch 'master' into core-updates

1 files changed, 194 insertions, 194 deletions

diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm
index 247f4f667f..312df9b1cd 100644
--- a/gnu/tests/mail.scm
+++ b/gnu/tests/mail.scm
@@ -1,6 +1,7 @@
 ;;; 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>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -25,7 +26,6 @@
   #:use-module (gnu services mail)
   #:use-module (gnu services networking)
   #:use-module (guix gexp)
-  #:use-module (guix monads)
   #:use-module (guix store)
   #:use-module (ice-9 ftw)
   #:export (%test-opensmtpd
@@ -44,105 +44,105 @@ accept from any for local deliver to mbox
 
 (define (run-opensmtpd-test)
   "Return a test of an OS running OpenSMTPD service."
-  (mlet* %store-monad ((command (system-qemu-image/shared-store-script
-                                 (marionette-operating-system
-                                  %opensmtpd-os
-                                  #:imported-modules '((gnu services herd)))
-                                 #:graphic? #f)))
-    (define test
-      (with-imported-modules '((gnu build marionette))
-        #~(begin
-            (use-modules (rnrs base)
-                         (srfi srfi-64)
-                         (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))))
-
-            (mkdir #$output)
-            (chdir #$output)
-
-            (test-begin "opensmptd")
-
-            (test-assert "service is running"
-              (marionette-eval
-               '(begin
-                  (use-modules (gnu services herd))
-                  (start-service 'smtpd)
-                  #t)
-               marionette))
-
-            (test-assert "mbox is empty"
-              (marionette-eval
-               '(and (file-exists? "/var/mail")
-                     (not (file-exists? "/var/mail/root")))
-               marionette))
-
-            (test-eq "accept an email"
-              #t
-              (let* ((smtp (socket AF_INET SOCK_STREAM 0))
-                     (addr (make-socket-address AF_INET INADDR_LOOPBACK 1025)))
-                (connect smtp addr)
-                ;; Be greeted.
-                (read-reply-code smtp)             ;220
-                ;; Greet the server.
-                (write-line "EHLO somehost" smtp)
-                (read-reply-code smtp)             ;250
-                ;; Set sender email.
-                (write-line "MAIL FROM: <someone>" smtp)
-                (read-reply-code smtp)             ;250
-                ;; Set recipient email.
-                (write-line "RCPT TO: <root>" smtp)
-                (read-reply-code smtp)             ;250
-                ;; Send message.
-                (write-line "DATA" smtp)
-                (read-reply-code smtp)             ;354
-                (write-line "Subject: Hello" smtp)
-                (newline smtp)
-                (write-line "Nice to meet you!" smtp)
-                (write-line "." smtp)
-                (read-reply-code smtp)             ;250
-                ;; Say goodbye.
-                (write-line "QUIT" smtp)
-                (read-reply-code smtp)             ;221
-                (close smtp)
-                #t))
-
-            (test-assert "mail arrived"
-              (marionette-eval
-               '(begin
-                  (use-modules (ice-9 popen)
-                               (ice-9 rdelim))
-
-                  (define (queue-empty?)
-                    (eof-object?
-                     (read-line
-                      (open-input-pipe "smtpctl show queue"))))
-
-                  (let wait ()
-                    (if (queue-empty?)
-                        (file-exists? "/var/mail/root")
-                        (begin (sleep 1) (wait)))))
-               marionette))
-
-            (test-end)
-            (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
-
-    (gexp->derivation "opensmtpd-test" test)))
+  (define vm
+    (virtual-machine
+     (operating-system (marionette-operating-system
+                        %opensmtpd-os
+                        #:imported-modules '((gnu services herd))))
+     (port-forwardings '((1025 . 25)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (rnrs base)
+                       (srfi srfi-64)
+                       (ice-9 rdelim)
+                       (ice-9 regex)
+                       (gnu build marionette))
+
+          (define marionette
+            (make-marionette '(#$vm)))
+
+          (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))))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "opensmptd")
+
+          (test-assert "service is running"
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'smtpd)
+                #t)
+             marionette))
+
+          (test-assert "mbox is empty"
+            (marionette-eval
+             '(and (file-exists? "/var/mail")
+                   (not (file-exists? "/var/mail/root")))
+             marionette))
+
+          (test-eq "accept an email"
+            #t
+            (let* ((smtp (socket AF_INET SOCK_STREAM 0))
+                   (addr (make-socket-address AF_INET INADDR_LOOPBACK 1025)))
+              (connect smtp addr)
+              ;; Be greeted.
+              (read-reply-code smtp)              ;220
+              ;; Greet the server.
+              (write-line "EHLO somehost" smtp)
+              (read-reply-code smtp)              ;250
+              ;; Set sender email.
+              (write-line "MAIL FROM: <someone>" smtp)
+              (read-reply-code smtp)              ;250
+              ;; Set recipient email.
+              (write-line "RCPT TO: <root>" smtp)
+              (read-reply-code smtp)              ;250
+              ;; Send message.
+              (write-line "DATA" smtp)
+              (read-reply-code smtp)              ;354
+              (write-line "Subject: Hello" smtp)
+              (newline smtp)
+              (write-line "Nice to meet you!" smtp)
+              (write-line "." smtp)
+              (read-reply-code smtp)              ;250
+              ;; Say goodbye.
+              (write-line "QUIT" smtp)
+              (read-reply-code smtp)              ;221
+              (close smtp)
+              #t))
+
+          (test-assert "mail arrived"
+            (marionette-eval
+             '(begin
+                (use-modules (ice-9 popen)
+                             (ice-9 rdelim))
+
+                (define (queue-empty?)
+                  (eof-object?
+                   (read-line
+                    (open-input-pipe "smtpctl show queue"))))
+
+                (let wait ()
+                  (if (queue-empty?)
+                      (file-exists? "/var/mail/root")
+                      (begin (sleep 1) (wait)))))
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "opensmtpd-test" test))
 
 (define %test-opensmtpd
   (system-test
@@ -179,100 +179,100 @@ acl_check_data:
 
 (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 vm
+    (virtual-machine
+     (operating-system (marionette-operating-system
+                        %exim-os
+                        #:imported-modules '((gnu services herd))))
+     (port-forwardings '((1025 . 25)))))
+
+  (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 '(#$vm)))
+
+          (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