Package: guix-patches;
Reported by: Oleg Pykhalov <go.wigust <at> gmail.com>
Date: Wed, 7 Mar 2018 21:32:02 UTC
Severity: normal
Tags: patch
Done: Oleg Pykhalov <go.wigust <at> gmail.com>
Bug is archived. No further changes may be made.
To add a comment to this bug, you must first unarchive it, by sending
a message to control AT debbugs.gnu.org, with unarchive 30744 in the body.
You can then email your comments to 30744 AT debbugs.gnu.org in the normal way.
Toggle the display of automated, internal messages from the tracker.
View this report as an mbox folder, status mbox, maintainer mbox
guix-patches <at> gnu.org:bug#30744; Package guix-patches.
(Wed, 07 Mar 2018 21:32:02 GMT) Full text and rfc822 format available.Oleg Pykhalov <go.wigust <at> gmail.com>:guix-patches <at> gnu.org.
(Wed, 07 Mar 2018 21:32:02 GMT) Full text and rfc822 format available.Message #5 received at submit <at> debbugs.gnu.org (full text, mbox):
From: Oleg Pykhalov <go.wigust <at> gmail.com> To: guix-patches <at> gnu.org Cc: Oleg Pykhalov <go.wigust <at> gmail.com> Subject: [PATCH 1/2] services: dovecot: Copy dovecot.conf to /etc/dovecot. Date: Thu, 8 Mar 2018 00:30:29 +0300
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
guix-patches <at> gnu.org:bug#30744; Package guix-patches.
(Wed, 07 Mar 2018 21:34:02 GMT) Full text and rfc822 format available.Message #8 received at 30744 <at> debbugs.gnu.org (full text, mbox):
From: Oleg Pykhalov <go.wigust <at> gmail.com> To: 30744 <at> debbugs.gnu.org Cc: Oleg Pykhalov <go.wigust <at> gmail.com> Subject: [PATCH] tests: mail: Add test for dovecot. Date: Thu, 8 Mar 2018 00:32:43 +0300
* 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 <at> 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
guix-patches <at> gnu.org:bug#30744; Package guix-patches.
(Wed, 07 Mar 2018 23:35:01 GMT) Full text and rfc822 format available.Message #11 received at 30744 <at> debbugs.gnu.org (full text, mbox):
From: Clément Lassieur <clement <at> lassieur.org> To: Oleg Pykhalov <go.wigust <at> gmail.com> Cc: 30744 <at> debbugs.gnu.org Subject: Re: [bug#30744] [PATCH] tests: mail: Add test for dovecot. Date: Thu, 08 Mar 2018 00:34:13 +0100
Hi Oleg,
Oleg Pykhalov <go.wigust <at> 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 <at> 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))))
guix-patches <at> gnu.org:bug#30744; Package guix-patches.
(Wed, 07 Mar 2018 23:35:02 GMT) Full text and rfc822 format available.Message #14 received at 30744 <at> debbugs.gnu.org (full text, mbox):
From: Clément Lassieur <clement <at> lassieur.org> To: Oleg Pykhalov <go.wigust <at> gmail.com> Cc: 30744 <at> debbugs.gnu.org Subject: Re: [bug#30744] [PATCH 1/2] services: dovecot: Copy dovecot.conf to /etc/dovecot. Date: Thu, 08 Mar 2018 00:34:56 +0100
Oleg Pykhalov <go.wigust <at> 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.
guix-patches <at> gnu.org:bug#30744; Package guix-patches.
(Thu, 08 Mar 2018 08:25:02 GMT) Full text and rfc822 format available.Message #17 received at 30744 <at> debbugs.gnu.org (full text, mbox):
From: Oleg Pykhalov <go.wigust <at> gmail.com> To: Clément Lassieur <clement <at> lassieur.org> Cc: 30744 <at> debbugs.gnu.org Subject: Re: [bug#30744] [PATCH] tests: mail: Add test for dovecot. Date: Thu, 08 Mar 2018 11:24:45 +0300
[Message part 1 (text/plain, inline)]
Hello Clément, Clément Lassieur <clement <at> lassieur.org> writes: > Oleg Pykhalov <go.wigust <at> 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 <at> 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.
[signature.asc (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#30744; Package guix-patches.
(Thu, 08 Mar 2018 08:30:02 GMT) Full text and rfc822 format available.Message #20 received at 30744 <at> debbugs.gnu.org (full text, mbox):
From: Oleg Pykhalov <go.wigust <at> gmail.com> To: 30744 <at> debbugs.gnu.org, Clément Lassieur <clement <at> lassieur.org> Cc: Oleg Pykhalov <go.wigust <at> gmail.com> Subject: [PATCH] tests: mail: Add test for dovecot. Date: Thu, 8 Mar 2018 11:28:55 +0300
* 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 <at> 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
guix-patches <at> gnu.org:bug#30744; Package guix-patches.
(Thu, 08 Mar 2018 09:42:01 GMT) Full text and rfc822 format available.Message #23 received at 30744 <at> debbugs.gnu.org (full text, mbox):
From: Clément Lassieur <clement <at> lassieur.org> To: Oleg Pykhalov <go.wigust <at> gmail.com> Cc: 30744 <at> debbugs.gnu.org Subject: Re: [PATCH] tests: mail: Add test for dovecot. Date: Thu, 08 Mar 2018 10:41:27 +0100
Oleg Pykhalov <go.wigust <at> 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 <at> 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))))
guix-patches <at> gnu.org:bug#30744; Package guix-patches.
(Fri, 09 Mar 2018 09:32:02 GMT) Full text and rfc822 format available.Message #26 received at 30744 <at> debbugs.gnu.org (full text, mbox):
From: Oleg Pykhalov <go.wigust <at> gmail.com> To: Clément Lassieur <clement <at> lassieur.org> Cc: 30744 <at> debbugs.gnu.org Subject: Re: [PATCH] tests: mail: Add test for dovecot. Date: Fri, 09 Mar 2018 12:31:38 +0300
[Message part 1 (text/plain, inline)]
Hello Clément,
Clément Lassieur <clement <at> lassieur.org> writes:
> Oleg Pykhalov <go.wigust <at> 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.
[signature.asc (application/pgp-signature, inline)]
guix-patches <at> gnu.org:bug#30744; Package guix-patches.
(Fri, 09 Mar 2018 10:17:01 GMT) Full text and rfc822 format available.Message #29 received at 30744 <at> debbugs.gnu.org (full text, mbox):
From: Clément Lassieur <clement <at> lassieur.org> To: Oleg Pykhalov <go.wigust <at> gmail.com> Cc: 30744 <at> debbugs.gnu.org Subject: Re: [PATCH] tests: mail: Add test for dovecot. Date: Fri, 09 Mar 2018 11:16:19 +0100
Oleg Pykhalov <go.wigust <at> gmail.com> writes:
> Hello Clément,
>
> Clément Lassieur <clement <at> lassieur.org> writes:
>
>> Oleg Pykhalov <go.wigust <at> 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 :-)
guix-patches <at> gnu.org:bug#30744; Package guix-patches.
(Fri, 09 Mar 2018 14:32:02 GMT) Full text and rfc822 format available.Message #32 received at 30744 <at> debbugs.gnu.org (full text, mbox):
From: Oleg Pykhalov <go.wigust <at> gmail.com> To: Clément Lassieur <clement <at> lassieur.org> Cc: 30744 <at> debbugs.gnu.org, 30744-done <at> debbugs.gnu.org Subject: Re: [bug#30744] [PATCH] tests: mail: Add test for dovecot. Date: Fri, 09 Mar 2018 17:30:59 +0300
[Message part 1 (text/plain, inline)]
Clément Lassieur <clement <at> 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.
[signature.asc (application/pgp-signature, inline)]
Oleg Pykhalov <go.wigust <at> gmail.com>:Oleg Pykhalov <go.wigust <at> gmail.com>:Debbugs Internal Request <help-debbugs <at> gnu.org>
to internal_control <at> debbugs.gnu.org.
(Sat, 07 Apr 2018 11:24:04 GMT) Full text and rfc822 format available.
GNU bug tracking system
Copyright (C) 1999 Darren O. Benham,
1997,2003 nCipher Corporation Ltd,
1994-97 Ian Jackson.