unofficial mirror of guix-patches@gnu.org 
 help / color / mirror / code / Atom feed
* [bug#30744] [PATCH 1/2] services: dovecot: Copy dovecot.conf to /etc/dovecot.
@ 2018-03-07 21:30 Oleg Pykhalov
  2018-03-07 21:32 ` [bug#30744] [PATCH] tests: mail: Add test for dovecot Oleg Pykhalov
  2018-03-07 23:34 ` [bug#30744] [PATCH 1/2] services: dovecot: Copy dovecot.conf to /etc/dovecot Clément Lassieur
  0 siblings, 2 replies; 10+ messages in thread
From: Oleg Pykhalov @ 2018-03-07 21:30 UTC (permalink / raw)
  To: 30744

Many Dovecot utilities compiled with assumption of ‘/etc/dovecot/dovecot.conf’
existence.

* gnu/services/mail.scm (dovecot-shepherd-service): Move config generation.
Invoke ‘dovecot’ without ‘-c’ flag.
(%dovecot-activation): Copy ‘dovecot.conf’ to ‘/etc/dovecot’.
(dovecot-service-type): Make ‘%dovecot-activation’ non-constant.
---
 gnu/services/mail.scm | 147 +++++++++++++++++++++++++-------------------------
 1 file changed, 74 insertions(+), 73 deletions(-)

diff --git a/gnu/services/mail.scm b/gnu/services/mail.scm
index ab9094273..573efa043 100644
--- a/gnu/services/mail.scm
+++ b/gnu/services/mail.scm
@@ -1435,90 +1435,91 @@ greyed out, instead of only later giving \"not selectable\" popup error.
          (home-directory "/var/empty")
          (shell (file-append shadow "/sbin/nologin")))))
 
-(define %dovecot-activation
+(define (%dovecot-activation config)
   ;; Activation gexp.
-  #~(begin
-      (use-modules (guix build utils))
-      (define (mkdir-p/perms directory owner perms)
-        (mkdir-p directory)
-        (chown "/var/run/dovecot" (passwd:uid owner) (passwd:gid owner))
-        (chmod directory perms))
-      (define (build-subject parameters)
-        (string-concatenate
-         (map (lambda (pair)
-                (let ((k (car pair)) (v (cdr pair)))
-                  (define (escape-char str chr)
-                    (string-join (string-split str chr) (string #\\ chr)))
-                  (string-append "/" k "="
-                                 (escape-char (escape-char v #\=) #\/))))
-              (filter (lambda (pair) (cdr pair)) parameters))))
-      (define* (create-self-signed-certificate-if-absent
-                #:key private-key public-key (owner (getpwnam "root"))
-                (common-name (gethostname))
-                (organization-name "GuixSD")
-                (organization-unit-name "Default Self-Signed Certificate")
-                (subject-parameters `(("CN" . ,common-name)
-                                      ("O" . ,organization-name)
-                                      ("OU" . ,organization-unit-name)))
-                (subject (build-subject subject-parameters)))
-        ;; Note that by default, OpenSSL outputs keys in PEM format.  This
-        ;; is what we want.
-        (unless (file-exists? private-key)
-          (cond
-           ((zero? (system* (string-append #$openssl "/bin/openssl")
-                            "genrsa" "-out" private-key "2048"))
-            (chown private-key (passwd:uid owner) (passwd:gid owner))
-            (chmod private-key #o400))
-           (else
-            (format (current-error-port)
-                    "Failed to create private key at ~a.\n" private-key))))
-        (unless (file-exists? public-key)
-          (cond
-           ((zero? (system* (string-append #$openssl "/bin/openssl")
-                            "req" "-new" "-x509" "-key" private-key
-                            "-out" public-key "-days" "3650"
-                            "-batch" "-subj" subject))
-            (chown public-key (passwd:uid owner) (passwd:gid owner))
-            (chmod public-key #o444))
-           (else
-            (format (current-error-port)
-                    "Failed to create public key at ~a.\n" public-key)))))
-      (let ((user (getpwnam "dovecot")))
-        (mkdir-p/perms "/var/run/dovecot" user #o755)
-        (mkdir-p/perms "/var/lib/dovecot" user #o755)
-        (mkdir-p/perms "/etc/dovecot" user #o755)
-        (mkdir-p/perms "/etc/dovecot/private" user #o700)
-        (create-self-signed-certificate-if-absent
-         #:private-key "/etc/dovecot/private/default.pem"
-         #:public-key "/etc/dovecot/default.pem"
-         #:owner (getpwnam "root")
-         #:common-name (format #f "Dovecot service on ~a" (gethostname))))))
+  (let ((config-str
+         (cond
+          ((opaque-dovecot-configuration? config)
+           (opaque-dovecot-configuration-string config))
+          (else
+           (with-output-to-string
+             (lambda ()
+               (serialize-configuration config
+                                        dovecot-configuration-fields)))))))
+    #~(begin
+        (use-modules (guix build utils))
+        (define (mkdir-p/perms directory owner perms)
+          (mkdir-p directory)
+          (chown "/var/run/dovecot" (passwd:uid owner) (passwd:gid owner))
+          (chmod directory perms))
+        (define (build-subject parameters)
+          (string-concatenate
+           (map (lambda (pair)
+                  (let ((k (car pair)) (v (cdr pair)))
+                    (define (escape-char str chr)
+                      (string-join (string-split str chr) (string #\\ chr)))
+                    (string-append "/" k "="
+                                   (escape-char (escape-char v #\=) #\/))))
+                (filter (lambda (pair) (cdr pair)) parameters))))
+        (define* (create-self-signed-certificate-if-absent
+                  #:key private-key public-key (owner (getpwnam "root"))
+                  (common-name (gethostname))
+                  (organization-name "GuixSD")
+                  (organization-unit-name "Default Self-Signed Certificate")
+                  (subject-parameters `(("CN" . ,common-name)
+                                        ("O" . ,organization-name)
+                                        ("OU" . ,organization-unit-name)))
+                  (subject (build-subject subject-parameters)))
+          ;; Note that by default, OpenSSL outputs keys in PEM format.  This
+          ;; is what we want.
+          (unless (file-exists? private-key)
+            (cond
+             ((zero? (system* (string-append #$openssl "/bin/openssl")
+                              "genrsa" "-out" private-key "2048"))
+              (chown private-key (passwd:uid owner) (passwd:gid owner))
+              (chmod private-key #o400))
+             (else
+              (format (current-error-port)
+                      "Failed to create private key at ~a.\n" private-key))))
+          (unless (file-exists? public-key)
+            (cond
+             ((zero? (system* (string-append #$openssl "/bin/openssl")
+                              "req" "-new" "-x509" "-key" private-key
+                              "-out" public-key "-days" "3650"
+                              "-batch" "-subj" subject))
+              (chown public-key (passwd:uid owner) (passwd:gid owner))
+              (chmod public-key #o444))
+             (else
+              (format (current-error-port)
+                      "Failed to create public key at ~a.\n" public-key)))))
+        (let ((user (getpwnam "dovecot")))
+          (mkdir-p/perms "/var/run/dovecot" user #o755)
+          (mkdir-p/perms "/var/lib/dovecot" user #o755)
+          (mkdir-p/perms "/etc/dovecot" user #o755)
+          (copy-file #$(plain-file "dovecot.conf" config-str)
+                     "/etc/dovecot/dovecot.conf")
+          (mkdir-p/perms "/etc/dovecot/private" user #o700)
+          (create-self-signed-certificate-if-absent
+           #:private-key "/etc/dovecot/private/default.pem"
+           #:public-key "/etc/dovecot/default.pem"
+           #:owner (getpwnam "root")
+           #:common-name (format #f "Dovecot service on ~a" (gethostname)))))))
 
 (define (dovecot-shepherd-service config)
   "Return a list of <shepherd-service> for CONFIG."
-  (let* ((config-str
-          (cond
-           ((opaque-dovecot-configuration? config)
-            (opaque-dovecot-configuration-string config))
-           (else
-            (with-output-to-string
-              (lambda ()
-                (serialize-configuration config
-                                         dovecot-configuration-fields))))))
-         (config-file (plain-file "dovecot.conf" config-str))
-         (dovecot (if (opaque-dovecot-configuration? config)
-                      (opaque-dovecot-configuration-dovecot config)
-                      (dovecot-configuration-dovecot config))))
+  (let ((dovecot (if (opaque-dovecot-configuration? config)
+                     (opaque-dovecot-configuration-dovecot config)
+                     (dovecot-configuration-dovecot config))))
     (list (shepherd-service
            (documentation "Run the Dovecot POP3/IMAP mail server.")
            (provision '(dovecot))
            (requirement '(networking))
            (start #~(make-forkexec-constructor
                      (list (string-append #$dovecot "/sbin/dovecot")
-                           "-F" "-c" #$config-file)))
+                           "-F")))
            (stop #~(make-forkexec-constructor
                     (list (string-append #$dovecot "/sbin/dovecot")
-                          "-c" #$config-file "stop")))))))
+                          "stop")))))))
 
 (define %dovecot-pam-services
   (list (unix-pam-service "dovecot")))
@@ -1533,7 +1534,7 @@ greyed out, instead of only later giving \"not selectable\" popup error.
                        (service-extension pam-root-service-type
                                           (const %dovecot-pam-services))
                        (service-extension activation-service-type
-                                          (const %dovecot-activation))))))
+                                          %dovecot-activation)))))
 
 (define* (dovecot-service #:key (config (dovecot-configuration)))
   "Return a service that runs @command{dovecot}, a mail server that can run
-- 
2.16.2

^ permalink raw reply related	[flat|nested] 10+ messages in thread

* [bug#30744] [PATCH] tests: mail: Add test for dovecot.
  2018-03-07 21:30 [bug#30744] [PATCH 1/2] services: dovecot: Copy dovecot.conf to /etc/dovecot Oleg Pykhalov
@ 2018-03-07 21:32 ` Oleg Pykhalov
  2018-03-07 23:34   ` Clément Lassieur
  2018-03-07 23:34 ` [bug#30744] [PATCH 1/2] services: dovecot: Copy dovecot.conf to /etc/dovecot Clément Lassieur
  1 sibling, 1 reply; 10+ messages in thread
From: Oleg Pykhalov @ 2018-03-07 21:32 UTC (permalink / raw)
  To: 30744

* gnu/tests/mail.scm (%dovecot-os, %test-dovecot): New variables.
(run-dovecot-test): New procedure.
---
 gnu/tests/mail.scm | 113 ++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 112 insertions(+), 1 deletion(-)

diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm
index 312df9b1c..69fe016e7 100644
--- a/gnu/tests/mail.scm
+++ b/gnu/tests/mail.scm
@@ -29,7 +29,8 @@
   #:use-module (guix store)
   #:use-module (ice-9 ftw)
   #:export (%test-opensmtpd
-            %test-exim))
+            %test-exim
+            %test-dovecot))
 
 (define %opensmtpd-os
   (simple-operating-system
@@ -279,3 +280,113 @@ acl_check_data:
    (name "exim")
    (description "Send an email to a running an Exim server.")
    (value (run-exim-test))))
+
+(define %dovecot-os
+  (simple-operating-system
+   (dhcp-client-service)
+   (dovecot-service #:config
+                    (dovecot-configuration
+                     (disable-plaintext-auth? #f)
+                     (ssl? "no")
+                     (auth-mechanisms '("anonymous"))
+                     (auth-anonymous-username "alice")
+                     (mail-location
+                      (string-append "maildir:~/Maildir"
+                                     ":INBOX=~/Maildir/INBOX"
+                                     ":LAYOUT=fs"))))))
+
+(define (run-dovecot-test)
+  "Return a test of an OS running Dovecot service."
+  (define vm
+    (virtual-machine
+     (operating-system (marionette-operating-system
+                        %dovecot-os
+                        #:imported-modules '((gnu services herd))))
+     (port-forwardings '((8143 . 143)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (ice-9 iconv)
+                       (ice-9 rdelim)
+                       (ice-9 regex)
+                       (rnrs base)
+                       (rnrs bytevectors)
+                       (srfi srfi-64))
+
+          (define marionette
+            (make-marionette '(#$vm)))
+
+          (define* (message-length message #:key (encoding "iso-8859-1"))
+            (bytevector-length (string->bytevector message encoding)))
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "dovecot")
+
+          ;; Wait for dovecot to be up and running.
+          (test-eq "dovecot running"
+            'running!
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'dovecot)
+                'running!)
+             marionette))
+
+          (sleep 1) ; give the service time to start talking
+
+          (test-eq "accept an email"
+            #t
+            (let ((imap (socket AF_INET SOCK_STREAM 0))
+                  (addr (make-socket-address AF_INET INADDR_LOOPBACK 8143))
+                  (message "From: test@example.com\n\
+Subject: Hello Nice to meet you!"))
+              (connect imap addr)
+              ;; Be greeted.
+              (read-line imap) ;OK
+              ;; Authenticate
+              (write-line "a AUTHENTICATE ANONYMOUS" imap)
+              (read-line imap) ;+
+              (write-line "c2lyaGM=" imap)
+              (read-line imap) ;OK
+              ;; Create a TESTBOX mailbox
+              (write-line "a CREATE TESTBOX" imap)
+              (read-line imap) ;OK
+              ;; Append a message to a TESTBOX mailbox
+              (write-line (format #f "a APPEND TESTBOX {~a}"
+                                  (number->string (message-length message)))
+                          imap)
+              (read-line imap) ;+
+              (write-line message imap)
+              (read-line imap) ;OK
+              ;; Logout
+              (write-line "a LOGOUT" imap)
+              (close imap)
+              #t))
+
+          (test-assert "mail arrived"
+            (marionette-eval
+             '(begin
+                (use-modules (ice-9 ftw)
+                             (ice-9 match))
+                ;; Get a message ID
+                (string->number
+                 (match (scandir "/home/alice/Maildir/TESTBOX/new/")
+                   ((_ _ message)
+                    (match (string-split message #\.)
+                      ((message-id _ _) message-id))))))
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "dovecot-test" test))
+
+(define %test-dovecot
+  (system-test
+   (name "dovecot")
+   (description "Connect to a running Dovecot server.")
+   (value (run-dovecot-test))))
-- 
2.16.2

^ permalink raw reply related	[flat|nested] 10+ messages in thread

* [bug#30744] [PATCH] tests: mail: Add test for dovecot.
  2018-03-07 21:32 ` [bug#30744] [PATCH] tests: mail: Add test for dovecot Oleg Pykhalov
@ 2018-03-07 23:34   ` Clément Lassieur
  2018-03-08  8:24     ` Oleg Pykhalov
  0 siblings, 1 reply; 10+ messages in thread
From: Clément Lassieur @ 2018-03-07 23:34 UTC (permalink / raw)
  To: Oleg Pykhalov; +Cc: 30744

Hi Oleg,

Oleg Pykhalov <go.wigust@gmail.com> writes:

> * gnu/tests/mail.scm (%dovecot-os, %test-dovecot): New variables.
> (run-dovecot-test): New procedure.
> ---
>  gnu/tests/mail.scm | 113 ++++++++++++++++++++++++++++++++++++++++++++++++++++-
>  1 file changed, 112 insertions(+), 1 deletion(-)

Thank you for these patches!

> diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm
> index 312df9b1c..69fe016e7 100644
> --- a/gnu/tests/mail.scm
> +++ b/gnu/tests/mail.scm
> @@ -29,7 +29,8 @@
>    #:use-module (guix store)
>    #:use-module (ice-9 ftw)
>    #:export (%test-opensmtpd
> -            %test-exim))
> +            %test-exim
> +            %test-dovecot))
>  
>  (define %opensmtpd-os
>    (simple-operating-system
> @@ -279,3 +280,113 @@ acl_check_data:
>     (name "exim")
>     (description "Send an email to a running an Exim server.")
>     (value (run-exim-test))))
> +
> +(define %dovecot-os
> +  (simple-operating-system
> +   (dhcp-client-service)
> +   (dovecot-service #:config
> +                    (dovecot-configuration
> +                     (disable-plaintext-auth? #f)
> +                     (ssl? "no")
> +                     (auth-mechanisms '("anonymous"))
> +                     (auth-anonymous-username "alice")
> +                     (mail-location
> +                      (string-append "maildir:~/Maildir"
> +                                     ":INBOX=~/Maildir/INBOX"
> +                                     ":LAYOUT=fs"))))))
> +
> +(define (run-dovecot-test)
> +  "Return a test of an OS running Dovecot service."
> +  (define vm
> +    (virtual-machine
> +     (operating-system (marionette-operating-system
> +                        %dovecot-os
> +                        #:imported-modules '((gnu services herd))))
> +     (port-forwardings '((8143 . 143)))))
> +
> +  (define test
> +    (with-imported-modules '((gnu build marionette))
> +      #~(begin
> +          (use-modules (gnu build marionette)
> +                       (ice-9 iconv)
> +                       (ice-9 rdelim)
> +                       (ice-9 regex)
> +                       (rnrs base)
> +                       (rnrs bytevectors)
> +                       (srfi srfi-64))
> +
> +          (define marionette
> +            (make-marionette '(#$vm)))
> +
> +          (define* (message-length message #:key (encoding "iso-8859-1"))
> +            (bytevector-length (string->bytevector message encoding)))
> +
> +          (mkdir #$output)
> +          (chdir #$output)
> +
> +          (test-begin "dovecot")
> +
> +          ;; Wait for dovecot to be up and running.
> +          (test-eq "dovecot running"
> +            'running!
> +            (marionette-eval
> +             '(begin
> +                (use-modules (gnu services herd))
> +                (start-service 'dovecot)
> +                'running!)
> +             marionette))
> +
> +          (sleep 1) ; give the service time to start talking

Here, it would probably be safer to wait for the PID file to arrive.
You could use 'wait-for-file' for this, there are examples in other
tests.  Dovecot's PID file is /var/run/dovecot/master.pid.

> +          (test-eq "accept an email"
> +            #t

Could you use 'test-assert' here?

> +            (let ((imap (socket AF_INET SOCK_STREAM 0))
> +                  (addr (make-socket-address AF_INET INADDR_LOOPBACK 8143))
> +                  (message "From: test@example.com\n\
> +Subject: Hello Nice to meet you!"))
> +              (connect imap addr)
> +              ;; Be greeted.
> +              (read-line imap) ;OK
> +              ;; Authenticate
> +              (write-line "a AUTHENTICATE ANONYMOUS" imap)
> +              (read-line imap) ;+
> +              (write-line "c2lyaGM=" imap)
> +              (read-line imap) ;OK
> +              ;; Create a TESTBOX mailbox
> +              (write-line "a CREATE TESTBOX" imap)
> +              (read-line imap) ;OK
> +              ;; Append a message to a TESTBOX mailbox
> +              (write-line (format #f "a APPEND TESTBOX {~a}"
> +                                  (number->string (message-length message)))
> +                          imap)
> +              (read-line imap) ;+
> +              (write-line message imap)
> +              (read-line imap) ;OK
> +              ;; Logout
> +              (write-line "a LOGOUT" imap)
> +              (close imap)
> +              #t))
> +
> +          (test-assert "mail arrived"
> +            (marionette-eval
> +             '(begin
> +                (use-modules (ice-9 ftw)
> +                             (ice-9 match))
> +                ;; Get a message ID
> +                (string->number
> +                 (match (scandir "/home/alice/Maildir/TESTBOX/new/")
> +                   ((_ _ message)

Could you write "." ".." here instead of _ _?  It makes it easier to
understand the code.

> +                    (match (string-split message #\.)
> +                      ((message-id _ _) message-id))))))

Here I think it would be great to compare the arrived message and the
sent message to check that they are the same.  If they are the same,
then the test succeeds.  WDYT?

> +             marionette))
> +
> +          (test-end)
> +          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
> +
> +  (gexp->derivation "dovecot-test" test))
> +
> +(define %test-dovecot
> +  (system-test
> +   (name "dovecot")
> +   (description "Connect to a running Dovecot server.")
> +   (value (run-dovecot-test))))

^ permalink raw reply	[flat|nested] 10+ messages in thread

* [bug#30744] [PATCH 1/2] services: dovecot: Copy dovecot.conf to /etc/dovecot.
  2018-03-07 21:30 [bug#30744] [PATCH 1/2] services: dovecot: Copy dovecot.conf to /etc/dovecot Oleg Pykhalov
  2018-03-07 21:32 ` [bug#30744] [PATCH] tests: mail: Add test for dovecot Oleg Pykhalov
@ 2018-03-07 23:34 ` Clément Lassieur
  1 sibling, 0 replies; 10+ messages in thread
From: Clément Lassieur @ 2018-03-07 23:34 UTC (permalink / raw)
  To: Oleg Pykhalov; +Cc: 30744

Oleg Pykhalov <go.wigust@gmail.com> writes:

> Many Dovecot utilities compiled with assumption of ‘/etc/dovecot/dovecot.conf’
> existence.
>
> * gnu/services/mail.scm (dovecot-shepherd-service): Move config generation.
> Invoke ‘dovecot’ without ‘-c’ flag.
> (%dovecot-activation): Copy ‘dovecot.conf’ to ‘/etc/dovecot’.
> (dovecot-service-type): Make ‘%dovecot-activation’ non-constant.
> ---
>  gnu/services/mail.scm | 147 +++++++++++++++++++++++++-------------------------
>  1 file changed, 74 insertions(+), 73 deletions(-)

Ok!  Thank you.

^ permalink raw reply	[flat|nested] 10+ messages in thread

* [bug#30744] [PATCH] tests: mail: Add test for dovecot.
  2018-03-07 23:34   ` Clément Lassieur
@ 2018-03-08  8:24     ` Oleg Pykhalov
  2018-03-08  8:28       ` Oleg Pykhalov
  0 siblings, 1 reply; 10+ messages in thread
From: Oleg Pykhalov @ 2018-03-08  8:24 UTC (permalink / raw)
  To: Clément Lassieur; +Cc: 30744

[-- Attachment #1: Type: text/plain, Size: 2171 bytes --]

Hello Clément,

Clément Lassieur <clement@lassieur.org> writes:

> Oleg Pykhalov <go.wigust@gmail.com> writes:
>
>> * gnu/tests/mail.scm (%dovecot-os, %test-dovecot): New variables.
>> (run-dovecot-test): New procedure.
>> ---
>>  gnu/tests/mail.scm | 113 ++++++++++++++++++++++++++++++++++++++++++++++++++++-
>>  1 file changed, 112 insertions(+), 1 deletion(-)
>
> Thank you for these patches!

Thank you for review!

[…]

>> +          (sleep 1) ; give the service time to start talking
>
> Here, it would probably be safer to wait for the PID file to arrive.
> You could use 'wait-for-file' for this, there are examples in other
> tests.  Dovecot's PID file is /var/run/dovecot/master.pid.

OK.

>> +          (test-eq "accept an email"
>> +            #t
>
> Could you use 'test-assert' here?

OK.

[…]

>> +                ;; Get a message ID
>> +                (string->number
>> +                 (match (scandir "/home/alice/Maildir/TESTBOX/new/")
>> +                   ((_ _ message)
>
> Could you write "." ".." here instead of _ _?  It makes it easier to
> understand the code.

Seems it's not possible for ".":
--8<---------------cut here---------------start------------->8---
natsu@magnolia ~/src/guix$ ./pre-inst-env make check-system TESTS="dovecot"
Compiling Scheme modules...
  LOAD     gnu/tests/mail.scm
ERROR: In procedure read:
In procedure scm_i_lreadparen: gnu/tests/mail.scm:378:28: missing close paren
make: *** [Makefile:5227: make-go] Error 1
--8<---------------cut here---------------end--------------->8---

WDYT about replacing "." (or first ‘_’) with ‘cwd’?

I also rename ‘message’ to ‘message-file’ if you don't mind.

So in the end we will have ‘(match … (cwd .. message-file) …)’.

>> +                    (match (string-split message #\.)
>> +                      ((message-id _ _) message-id))))))
>
> Here I think it would be great to compare the arrived message and the
> sent message to check that they are the same.  If they are the same,
> then the test succeeds.  WDYT?

OK.

I'll attach the patch after this email.

Oleg.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

^ permalink raw reply	[flat|nested] 10+ messages in thread

* [bug#30744] [PATCH] tests: mail: Add test for dovecot.
  2018-03-08  8:24     ` Oleg Pykhalov
@ 2018-03-08  8:28       ` Oleg Pykhalov
  2018-03-08  9:41         ` Clément Lassieur
  0 siblings, 1 reply; 10+ messages in thread
From: Oleg Pykhalov @ 2018-03-08  8:28 UTC (permalink / raw)
  To: 30744, Clément Lassieur

* gnu/tests/mail.scm (%dovecot-os, %test-dovecot): New variables.
(run-dovecot-test): New procedure.
---
 gnu/tests/mail.scm | 114 ++++++++++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 113 insertions(+), 1 deletion(-)

diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm
index 312df9b1c..77f273f8b 100644
--- a/gnu/tests/mail.scm
+++ b/gnu/tests/mail.scm
@@ -29,7 +29,8 @@
   #:use-module (guix store)
   #:use-module (ice-9 ftw)
   #:export (%test-opensmtpd
-            %test-exim))
+            %test-exim
+            %test-dovecot))
 
 (define %opensmtpd-os
   (simple-operating-system
@@ -279,3 +280,114 @@ acl_check_data:
    (name "exim")
    (description "Send an email to a running an Exim server.")
    (value (run-exim-test))))
+
+(define %dovecot-os
+  (simple-operating-system
+   (dhcp-client-service)
+   (dovecot-service #:config
+                    (dovecot-configuration
+                     (disable-plaintext-auth? #f)
+                     (ssl? "no")
+                     (auth-mechanisms '("anonymous"))
+                     (auth-anonymous-username "alice")
+                     (mail-location
+                      (string-append "maildir:~/Maildir"
+                                     ":INBOX=~/Maildir/INBOX"
+                                     ":LAYOUT=fs"))))))
+
+(define (run-dovecot-test)
+  "Return a test of an OS running Dovecot service."
+  (define vm
+    (virtual-machine
+     (operating-system (marionette-operating-system
+                        %dovecot-os
+                        #:imported-modules '((gnu services herd))))
+     (port-forwardings '((8143 . 143)))))
+
+  (define test
+    (with-imported-modules '((gnu build marionette))
+      #~(begin
+          (use-modules (gnu build marionette)
+                       (ice-9 iconv)
+                       (ice-9 rdelim)
+                       (rnrs base)
+                       (rnrs bytevectors)
+                       (srfi srfi-64))
+
+          (define marionette
+            (make-marionette '(#$vm)))
+
+          (define* (message-length message #:key (encoding "iso-8859-1"))
+            (bytevector-length (string->bytevector message encoding)))
+
+          (define message "From: test@example.com\n\
+Subject: Hello Nice to meet you!")
+
+          (mkdir #$output)
+          (chdir #$output)
+
+          (test-begin "dovecot")
+
+          ;; Wait for dovecot to be up and running.
+          (test-eq "dovecot running"
+            'running!
+            (marionette-eval
+             '(begin
+                (use-modules (gnu services herd))
+                (start-service 'dovecot)
+                'running!)
+             marionette))
+
+          ;; Give the service time to start talking.
+          (wait-for-file "/var/run/dovecot/master.pid" marionette)
+
+          (test-assert "accept an email"
+            (let ((imap (socket AF_INET SOCK_STREAM 0))
+                  (addr (make-socket-address AF_INET INADDR_LOOPBACK 8143)))
+              (connect imap addr)
+              ;; Be greeted.
+              (read-line imap) ;OK
+              ;; Authenticate
+              (write-line "a AUTHENTICATE ANONYMOUS" imap)
+              (read-line imap) ;+
+              (write-line "c2lyaGM=" imap)
+              (read-line imap) ;OK
+              ;; Create a TESTBOX mailbox
+              (write-line "a CREATE TESTBOX" imap)
+              (read-line imap) ;OK
+              ;; Append a message to a TESTBOX mailbox
+              (write-line (format #f "a APPEND TESTBOX {~a}"
+                                  (number->string (message-length message)))
+                          imap)
+              (read-line imap) ;+
+              (write-line message imap)
+              (read-line imap) ;OK
+              ;; Logout
+              (write-line "a LOGOUT" imap)
+              (close imap)
+              #t))
+
+          (test-equal "mail arrived"
+            message
+            (marionette-eval
+             '(begin
+                (use-modules (ice-9 ftw)
+                             (ice-9 match))
+                (let ((TESTBOX/new "/home/alice/Maildir/TESTBOX/new/"))
+                  (match (scandir TESTBOX/new)
+                    ((cwd .. message-file)
+                     (call-with-input-file
+                         (string-append TESTBOX/new message-file)
+                       get-string-all)))))
+             marionette))
+
+          (test-end)
+          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
+
+  (gexp->derivation "dovecot-test" test))
+
+(define %test-dovecot
+  (system-test
+   (name "dovecot")
+   (description "Connect to a running Dovecot server.")
+   (value (run-dovecot-test))))
-- 
2.16.2

^ permalink raw reply related	[flat|nested] 10+ messages in thread

* [bug#30744] [PATCH] tests: mail: Add test for dovecot.
  2018-03-08  8:28       ` Oleg Pykhalov
@ 2018-03-08  9:41         ` Clément Lassieur
  2018-03-09  9:31           ` Oleg Pykhalov
  0 siblings, 1 reply; 10+ messages in thread
From: Clément Lassieur @ 2018-03-08  9:41 UTC (permalink / raw)
  To: Oleg Pykhalov; +Cc: 30744


Oleg Pykhalov <go.wigust@gmail.com> writes:

> * gnu/tests/mail.scm (%dovecot-os, %test-dovecot): New variables.
> (run-dovecot-test): New procedure.
> ---
>  gnu/tests/mail.scm | 114 ++++++++++++++++++++++++++++++++++++++++++++++++++++-
>  1 file changed, 113 insertions(+), 1 deletion(-)
>
> diff --git a/gnu/tests/mail.scm b/gnu/tests/mail.scm
> index 312df9b1c..77f273f8b 100644
> --- a/gnu/tests/mail.scm
> +++ b/gnu/tests/mail.scm
> @@ -29,7 +29,8 @@
>    #:use-module (guix store)
>    #:use-module (ice-9 ftw)
>    #:export (%test-opensmtpd
> -            %test-exim))
> +            %test-exim
> +            %test-dovecot))
>  
>  (define %opensmtpd-os
>    (simple-operating-system
> @@ -279,3 +280,114 @@ acl_check_data:
>     (name "exim")
>     (description "Send an email to a running an Exim server.")
>     (value (run-exim-test))))
> +
> +(define %dovecot-os
> +  (simple-operating-system
> +   (dhcp-client-service)
> +   (dovecot-service #:config
> +                    (dovecot-configuration
> +                     (disable-plaintext-auth? #f)
> +                     (ssl? "no")
> +                     (auth-mechanisms '("anonymous"))
> +                     (auth-anonymous-username "alice")
> +                     (mail-location
> +                      (string-append "maildir:~/Maildir"
> +                                     ":INBOX=~/Maildir/INBOX"
> +                                     ":LAYOUT=fs"))))))
> +
> +(define (run-dovecot-test)
> +  "Return a test of an OS running Dovecot service."
> +  (define vm
> +    (virtual-machine
> +     (operating-system (marionette-operating-system
> +                        %dovecot-os
> +                        #:imported-modules '((gnu services herd))))
> +     (port-forwardings '((8143 . 143)))))
> +
> +  (define test
> +    (with-imported-modules '((gnu build marionette))
> +      #~(begin
> +          (use-modules (gnu build marionette)
> +                       (ice-9 iconv)
> +                       (ice-9 rdelim)
> +                       (rnrs base)
> +                       (rnrs bytevectors)
> +                       (srfi srfi-64))
> +
> +          (define marionette
> +            (make-marionette '(#$vm)))
> +
> +          (define* (message-length message #:key (encoding "iso-8859-1"))
> +            (bytevector-length (string->bytevector message encoding)))
> +
> +          (define message "From: test@example.com\n\
> +Subject: Hello Nice to meet you!")
> +
> +          (mkdir #$output)
> +          (chdir #$output)
> +
> +          (test-begin "dovecot")
> +
> +          ;; Wait for dovecot to be up and running.
> +          (test-eq "dovecot running"
> +            'running!
> +            (marionette-eval
> +             '(begin
> +                (use-modules (gnu services herd))
> +                (start-service 'dovecot)
> +                'running!)
> +             marionette))
> +
> +          ;; Give the service time to start talking.
> +          (wait-for-file "/var/run/dovecot/master.pid" marionette)

Could you put it in a test context (test-assert with file-exists? for
example, see tests/messaging.scm)?

> +          (test-assert "accept an email"
> +            (let ((imap (socket AF_INET SOCK_STREAM 0))
> +                  (addr (make-socket-address AF_INET INADDR_LOOPBACK 8143)))
> +              (connect imap addr)
> +              ;; Be greeted.
> +              (read-line imap) ;OK
> +              ;; Authenticate
> +              (write-line "a AUTHENTICATE ANONYMOUS" imap)
> +              (read-line imap) ;+
> +              (write-line "c2lyaGM=" imap)
> +              (read-line imap) ;OK
> +              ;; Create a TESTBOX mailbox
> +              (write-line "a CREATE TESTBOX" imap)
> +              (read-line imap) ;OK
> +              ;; Append a message to a TESTBOX mailbox
> +              (write-line (format #f "a APPEND TESTBOX {~a}"
> +                                  (number->string (message-length message)))
> +                          imap)
> +              (read-line imap) ;+
> +              (write-line message imap)
> +              (read-line imap) ;OK
> +              ;; Logout
> +              (write-line "a LOGOUT" imap)
> +              (close imap)
> +              #t))
> +
> +          (test-equal "mail arrived"
> +            message
> +            (marionette-eval
> +             '(begin
> +                (use-modules (ice-9 ftw)
> +                             (ice-9 match))
> +                (let ((TESTBOX/new "/home/alice/Maildir/TESTBOX/new/"))
> +                  (match (scandir TESTBOX/new)
> +                    ((cwd .. message-file)

You need to use double quotes, like ("." ".." message-file) I believe.

> +                     (call-with-input-file
> +                         (string-append TESTBOX/new message-file)
> +                       get-string-all)))))
> +             marionette))
> +
> +          (test-end)
> +          (exit (= (test-runner-fail-count (test-runner-current)) 0)))))
> +
> +  (gexp->derivation "dovecot-test" test))
> +
> +(define %test-dovecot
> +  (system-test
> +   (name "dovecot")
> +   (description "Connect to a running Dovecot server.")
> +   (value (run-dovecot-test))))

^ permalink raw reply	[flat|nested] 10+ messages in thread

* [bug#30744] [PATCH] tests: mail: Add test for dovecot.
  2018-03-08  9:41         ` Clément Lassieur
@ 2018-03-09  9:31           ` Oleg Pykhalov
  2018-03-09 10:16             ` Clément Lassieur
  0 siblings, 1 reply; 10+ messages in thread
From: Oleg Pykhalov @ 2018-03-09  9:31 UTC (permalink / raw)
  To: Clément Lassieur; +Cc: 30744

[-- Attachment #1: Type: text/plain, Size: 1182 bytes --]

Hello Clément,

Clément Lassieur <clement@lassieur.org> writes:

> Oleg Pykhalov <go.wigust@gmail.com> writes:

[…]

>> +          ;; Give the service time to start talking.
>> +          (wait-for-file "/var/run/dovecot/master.pid" marionette)
>
> Could you put it in a test context (test-assert with file-exists? for
> example, see tests/messaging.scm)?

OK.

I replaced ‘(wait-for-file …)’ and a comment with:
--8<---------------cut here---------------start------------->8---
;; Check Dovecot service's PID.
(test-assert "service process id"
  (let ((pid
         (number->string (wait-for-file "/var/run/dovecot/master.pid"
                                        marionette))))
    (marionette-eval `(file-exists? (string-append "/proc/" ,pid))
                     marionette)))
--8<---------------cut here---------------end--------------->8---

[…]

>> +                  (match (scandir TESTBOX/new)
>> +                    ((cwd .. message-file)
>
> You need to use double quotes, like ("." ".." message-file) I believe.

It works.  Thank you!

[…]

I think it's ready for a push to ‘origin/master’.  WDYT?

Oleg.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

^ permalink raw reply	[flat|nested] 10+ messages in thread

* [bug#30744] [PATCH] tests: mail: Add test for dovecot.
  2018-03-09  9:31           ` Oleg Pykhalov
@ 2018-03-09 10:16             ` Clément Lassieur
  2018-03-09 14:30               ` Oleg Pykhalov
  0 siblings, 1 reply; 10+ messages in thread
From: Clément Lassieur @ 2018-03-09 10:16 UTC (permalink / raw)
  To: Oleg Pykhalov; +Cc: 30744

Oleg Pykhalov <go.wigust@gmail.com> writes:

> Hello Clément,
>
> Clément Lassieur <clement@lassieur.org> writes:
>
>> Oleg Pykhalov <go.wigust@gmail.com> writes:
>
> […]
>
>>> +          ;; Give the service time to start talking.
>>> +          (wait-for-file "/var/run/dovecot/master.pid" marionette)
>>
>> Could you put it in a test context (test-assert with file-exists? for
>> example, see tests/messaging.scm)?
>
> OK.
>
> I replaced ‘(wait-for-file …)’ and a comment with:
> --8<---------------cut here---------------start------------->8---
> ;; Check Dovecot service's PID.
> (test-assert "service process id"
>   (let ((pid
>          (number->string (wait-for-file "/var/run/dovecot/master.pid"
>                                         marionette))))
>     (marionette-eval `(file-exists? (string-append "/proc/" ,pid))
>                      marionette)))
> --8<---------------cut here---------------end--------------->8---

Cool, thank you!

> […]
>
>>> +                  (match (scandir TESTBOX/new)
>>> +                    ((cwd .. message-file)
>>
>> You need to use double quotes, like ("." ".." message-file) I believe.
>
> It works.  Thank you!
>
> […]
>
> I think it's ready for a push to ‘origin/master’.  WDYT?

Sure, you can push to master :-)

^ permalink raw reply	[flat|nested] 10+ messages in thread

* [bug#30744] [PATCH] tests: mail: Add test for dovecot.
  2018-03-09 10:16             ` Clément Lassieur
@ 2018-03-09 14:30               ` Oleg Pykhalov
  0 siblings, 0 replies; 10+ messages in thread
From: Oleg Pykhalov @ 2018-03-09 14:30 UTC (permalink / raw)
  To: Clément Lassieur; +Cc: 30744, 30744-done

[-- Attachment #1: Type: text/plain, Size: 377 bytes --]

Clément Lassieur <clement@lassieur.org> writes:

[…]

>> I think it's ready for a push to ‘origin/master’.  WDYT?
>
> Sure, you can push to master :-)

Also I added a copyright line for myself in ‘gnu/tests/mail.scm’.

Pushed as:

6310dff1dc3d9a6979312f93466d58650c1fe322
a9079b488037371f90514b82961dc075ea0b3985

I'll close the bug report.

Oleg.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 832 bytes --]

^ permalink raw reply	[flat|nested] 10+ messages in thread

end of thread, other threads:[~2018-03-09 14:32 UTC | newest]

Thread overview: 10+ messages (download: mbox.gz follow: Atom feed
-- links below jump to the message on this page --
2018-03-07 21:30 [bug#30744] [PATCH 1/2] services: dovecot: Copy dovecot.conf to /etc/dovecot Oleg Pykhalov
2018-03-07 21:32 ` [bug#30744] [PATCH] tests: mail: Add test for dovecot Oleg Pykhalov
2018-03-07 23:34   ` Clément Lassieur
2018-03-08  8:24     ` Oleg Pykhalov
2018-03-08  8:28       ` Oleg Pykhalov
2018-03-08  9:41         ` Clément Lassieur
2018-03-09  9:31           ` Oleg Pykhalov
2018-03-09 10:16             ` Clément Lassieur
2018-03-09 14:30               ` Oleg Pykhalov
2018-03-07 23:34 ` [bug#30744] [PATCH 1/2] services: dovecot: Copy dovecot.conf to /etc/dovecot Clément Lassieur

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/guix.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).