ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 13:28:12 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

services: Add getmail.

Browse source 
Getmail is a mail retriever written in Python, this commit adds a service-type
to run getmail. I'm looking at this, as it's a convinient way of getting
mailing list messages in to Patchwork.

I initially tried putting this in the (gnu services mail) module, but due to
also trying to use the define-configuration pattern, it conflicted with the
dovecot service.

* gnu/services/getmail.scm: New file.
* gnu/local.mk: Add it.
* gnu/tests/mail.scm (%getmail-os, %test-getmail): New variables.
(run-getmail-test): New procedure.
This commit is contained in:
Christopher Baines 2019-04-04 17:36:49 +01:00
parent 9bc1de3134
commit f6b0e1f8ff
No known key found for this signature in database
GPG key ID: 5E28A33B0B84F577
4 changed files with 849 additions and 1 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

291
doc/guix.texi
View file

@ -16716,6 +16716,297 @@ variables.
@end table
@end deftp
@subsubheading Getmail service
@cindex IMAP
@cindex POP
@deffn {Scheme Variable} getmail-service-type
This is the type of the @uref{http://pyropus.ca/software/getmail/, Getmail}
mail retriever, whose value should be an @code{getmail-configuration}.
@end deffn
Available @code{getmail-configuration} fields are:
@deftypevr {@code{getmail-configuration} parameter} symbol name
A symbol to identify the getmail service.
Defaults to @samp{"unset"}.
@end deftypevr
@deftypevr {@code{getmail-configuration} parameter} package package
The getmail package to use.
@end deftypevr
@deftypevr {@code{getmail-configuration} parameter} string user
The user to run getmail as.
Defaults to @samp{"getmail"}.
@end deftypevr
@deftypevr {@code{getmail-configuration} parameter} string group
The group to run getmail as.
Defaults to @samp{"getmail"}.
@end deftypevr
@deftypevr {@code{getmail-configuration} parameter} string directory
The getmail directory to use.
Defaults to @samp{"/var/lib/getmail/default"}.
@end deftypevr
@deftypevr {@code{getmail-configuration} parameter} getmail-configuration-file rcfile
The getmail configuration file to use.
Available @code{getmail-configuration-file} fields are:
@deftypevr {@code{getmail-configuration-file} parameter} getmail-retriever-configuration retriever
What mail account to retrieve mail from, and how to access that account.
Available @code{getmail-retriever-configuration} fields are:
@deftypevr {@code{getmail-retriever-configuration} parameter} string type
The type of mail retriever to use. Valid values include @samp{passwd}
and @samp{static}.
Defaults to @samp{"SimpleIMAPSSLRetriever"}.
@end deftypevr
@deftypevr {@code{getmail-retriever-configuration} parameter} string server
Space separated list of arguments to the userdb driver.
Defaults to @samp{unset}.
@end deftypevr
@deftypevr {@code{getmail-retriever-configuration} parameter} string username
Space separated list of arguments to the userdb driver.
Defaults to @samp{unset}.
@end deftypevr
@deftypevr {@code{getmail-retriever-configuration} parameter} non-negative-integer port
Space separated list of arguments to the userdb driver.
Defaults to @samp{#f}.
@end deftypevr
@deftypevr {@code{getmail-retriever-configuration} parameter} string password
Override fields from passwd.
Defaults to @samp{""}.
@end deftypevr
@deftypevr {@code{getmail-retriever-configuration} parameter} list password-command
Override fields from passwd.
Defaults to @samp{()}.
@end deftypevr
@deftypevr {@code{getmail-retriever-configuration} parameter} string keyfile
PEM-formatted key file to use for the TLS negotiation
Defaults to @samp{""}.
@end deftypevr
@deftypevr {@code{getmail-retriever-configuration} parameter} string certfile
PEM-formatted certificate file to use for the TLS negotiation
Defaults to @samp{""}.
@end deftypevr
@deftypevr {@code{getmail-retriever-configuration} parameter} string ca-certs
CA certificates to use
Defaults to @samp{""}.
@end deftypevr
@deftypevr {@code{getmail-retriever-configuration} parameter} parameter-alist extra-parameters
Extra retriever parameters
Defaults to @samp{()}.
@end deftypevr
@end deftypevr
@deftypevr {@code{getmail-configuration-file} parameter} getmail-destination-configuration destination
What to do with retrieved messages.
Available @code{getmail-destination-configuration} fields are:
@deftypevr {@code{getmail-destination-configuration} parameter} string type
The type of mail destination. Valid values include @samp{Maildir},
@samp{Mboxrd} and @samp{MDA_external}.
Defaults to @samp{unset}.
@end deftypevr
@deftypevr {@code{getmail-destination-configuration} parameter} string-or-filelike path
The path option for the mail destination. The behaviour depends on the
chosen type.
Defaults to @samp{""}.
@end deftypevr
@deftypevr {@code{getmail-destination-configuration} parameter} parameter-alist extra-parameters
Extra destination parameters
Defaults to @samp{()}.
@end deftypevr
@end deftypevr
@deftypevr {@code{getmail-configuration-file} parameter} getmail-options-configuration options
Configure getmail.
Available @code{getmail-options-configuration} fields are:
@deftypevr {@code{getmail-options-configuration} parameter} non-negative-integer verbose
If set to @samp{0}, getmail will only print warnings and errors. A
value of @samp{1} means that messages will be printed about retrieving
and deleting messages. If set to @samp{2}, getmail will print messages
about each of it's actions.
Defaults to @samp{1}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} boolean read-all
If true, getmail will retrieve all available messages. Otherwise it
will only retrieve messages it hasn't seen previously.
Defaults to @samp{#t}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} boolean delete
If set to true, messages will be deleted from the server after
retrieving and successfully delivering them. Otherwise, messages will
be left on the server.
Defaults to @samp{#f}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} non-negative-integer delete-after
Getmail will delete messages this number of days after seeing them, if
they have not been delivered. This means messages will be left on the
server this number of days after delivering them. A value of @samp{0}
disabled this feature.
Defaults to @samp{0}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} non-negative-integer delete-bigger-than
Delete messages larger than this of bytes after retrieving them, even if
the delete and delete-after options are disabled. A value of @samp{0}
disables this feature.
Defaults to @samp{0}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} non-negative-integer max-bytes-per-session
Retrieve messages totalling up to this number of bytes before closing
the session with the server. A value of @samp{0} disables this feature.
Defaults to @samp{0}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} non-negative-integer max-message-size
Don't retrieve messages larger than this number of bytes. A value of
@samp{0} disables this feature.
Defaults to @samp{0}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} boolean delivered-to
If true, getmail will add a Delivered-To header to messages.
Defaults to @samp{#t}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} boolean received
If set, getmail adds a Received header to the messages.
Defaults to @samp{#t}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} string message-log
Getmail will record a log of its actions to the named file. A value of
@samp{""} disables this feature.
Defaults to @samp{""}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} boolean message-log-syslog
If true, getmail will record a log of its actions using the system
logger.
Defaults to @samp{#t}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} boolean message-log-verbose
If true, getmail will log information about messages not retrieved and
the reason for not retrieving them, as well as starting and ending
information lines.
Defaults to @samp{#t}.
@end deftypevr
@deftypevr {@code{getmail-options-configuration} parameter} parameter-alist extra-parameters
Extra options to include.
Defaults to @samp{()}.
@end deftypevr
@end deftypevr
@end deftypevr
@deftypevr {@code{getmail-configuration} parameter} list idle
A list of mailboxes that getmail should wait on the server for new mail
notifications. This depends on the server supporting the IDLE
extension.
Defaults to @samp{()}.
@end deftypevr
@deftypevr {@code{getmail-configuration} parameter} list environment-variables
Environment variables to set for getmail.
Defaults to @samp{()}.
@end deftypevr
@subsubheading Mail Aliases Service
@cindex email aliases

1
gnu/local.mk
View file

@ -516,6 +516,7 @@ GNU_SYSTEM_MODULES = \
%D%/services/docker.scm \
%D%/services/authentication.scm \
%D%/services/games.scm \
%D%/services/getmail.scm \
%D%/services/kerberos.scm \
%D%/services/lirc.scm \
%D%/services/virtualization.scm \

380
gnu/services/getmail.scm Normal file
View file

@ -0,0 +1,380 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2019 Christopher Baines <mail@cbaines.net>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services getmail)
#:use-module (gnu services)
#:use-module (gnu services base)
#:use-module (gnu services configuration)
#:use-module (gnu services shepherd)
#:use-module (gnu system pam)
#:use-module (gnu system shadow)
#:use-module (gnu packages mail)
#:use-module (gnu packages admin)
#:use-module (gnu packages tls)
#:use-module (guix records)
#:use-module (guix store)
#:use-module (guix packages)
#:use-module (guix gexp)
#:use-module (ice-9 match)
#:use-module (ice-9 format)
#:use-module (srfi srfi-1)
#:export (getmail-retriever-configuration
getmail-retriever-configuration-extra-parameters
getmail-destination-configuration
getmail-options-configuration
getmail-configuration-file
getmail-configuration
getmail-service-type))
;;; Commentary:
;;;
;;; Service for the getmail mail retriever.
;;;
;;; Code:
(define (uglify-field-name field-name)
(let ((str (symbol->string field-name)))
(string-join (string-split (if (string-suffix? "?" str)
(substring str 0 (1- (string-length str)))
str)
#\-)
"_")))
(define (serialize-field field-name val)
#~(let ((val '#$val))
(format #f "~a = ~a\n"
#$(uglify-field-name field-name)
(cond
((list? val)
(string-append
"("
(string-concatenate
(map (lambda (list-val)
(format #f "\"~a\", " list-val))
val))
")"))
(else
val)))))
(define (serialize-string field-name val)
(if (string=? val "")
""
(serialize-field field-name val)))
(define (string-or-filelike? val)
(or (string? val)
(file-like? val)))
(define (serialize-string-or-filelike field-name val)
(if (equal? val "")
""
(serialize-field field-name val)))
(define (serialize-boolean field-name val)
(serialize-field field-name (if val "true" "false")))
(define (non-negative-integer? val)
(and (exact-integer? val) (not (negative? val))))
(define (serialize-non-negative-integer field-name val)
(serialize-field field-name val))
(define serialize-list serialize-field)
(define parameter-alist? list?)
(define (serialize-parameter-alist field-name val)
#~(string-append
#$@(map (match-lambda
((key . value)
(serialize-field key value)))
val)))
(define (serialize-getmail-retriever-configuration field-name val)
(serialize-configuration val getmail-retriever-configuration-fields))
(define-configuration getmail-retriever-configuration
(type
(string "SimpleIMAPSSLRetriever")
"The type of mail retriever to use. Valid values include
@samp{passwd} and @samp{static}.")
(server
(string 'unset)
"Space separated list of arguments to the userdb driver.")
(username
(string 'unset)
"Space separated list of arguments to the userdb driver.")
(port
(non-negative-integer #f)
"Space separated list of arguments to the userdb driver.")
(password
(string "")
"Override fields from passwd.")
(password-command
(list '())
"Override fields from passwd.")
(keyfile
(string "")
"PEM-formatted key file to use for the TLS negotiation")
(certfile
(string "")
"PEM-formatted certificate file to use for the TLS negotiation")
(ca-certs
(string "")
"CA certificates to use")
(extra-parameters
(parameter-alist '())
"Extra retriever parameters"))
(define (serialize-getmail-destination-configuration field-name val)
(serialize-configuration val getmail-destination-configuration-fields))
(define-configuration getmail-destination-configuration
(type
(string 'unset)
"The type of mail destination. Valid values include @samp{Maildir},
@samp{Mboxrd} and @samp{MDA_external}.")
(path
(string-or-filelike "")
"The path option for the mail destination. The behaviour depends on the
chosen type.")
(extra-parameters
(parameter-alist '())
"Extra destination parameters"))
(define (serialize-getmail-options-configuration field-name val)
(serialize-configuration val getmail-options-configuration-fields))
(define-configuration getmail-options-configuration
(verbose
(non-negative-integer 1)
"If set to @samp{0}, getmail will only print warnings and errors. A value
of @samp{1} means that messages will be printed about retrieving and deleting
messages. If set to @samp{2}, getmail will print messages about each of it's
actions.")
(read-all
(boolean #t)
"If true, getmail will retrieve all available messages. Otherwise it will
only retrieve messages it hasn't seen previously.")
(delete
(boolean #f)
"If set to true, messages will be deleted from the server after retrieving
and successfully delivering them. Otherwise, messages will be left on the
server.")
(delete-after
(non-negative-integer 0)
"Getmail will delete messages this number of days after seeing them, if
they have not been delivered. This means messages will be left on the server
this number of days after delivering them. A value of @samp{0} disabled this
feature.")
(delete-bigger-than
(non-negative-integer 0)
"Delete messages larger than this of bytes after retrieving them, even if
the delete and delete-after options are disabled. A value of @samp{0}
disables this feature.")
(max-bytes-per-session
(non-negative-integer 0)
"Retrieve messages totalling up to this number of bytes before closing the
session with the server. A value of @samp{0} disables this feature.")
(max-message-size
(non-negative-integer 0)
"Don't retrieve messages larger than this number of bytes. A value of
@samp{0} disables this feature.")
(delivered-to
(boolean #t)
"If true, getmail will add a Delivered-To header to messages.")
(received
(boolean #t)
"If set, getmail adds a Received header to the messages.")
(message-log
(string "")
"Getmail will record a log of its actions to the named file. A value of
@samp{\"\"} disables this feature.")
(message-log-syslog
(boolean #t)
"If true, getmail will record a log of its actions using the system
logger.")
(message-log-verbose
(boolean #t)
"If true, getmail will log information about messages not retrieved and the
reason for not retrieving them, as well as starting and ending information
lines.")
(extra-parameters
(parameter-alist '())
"Extra options to include."))
(define (serialize-getmail-configuration-file field-name val)
(match val
(($ <getmail-configuration-file> location
retriever destination options)
#~(string-append
"[retriever]\n"
#$(serialize-getmail-retriever-configuration #f retriever)
"\n[destination]\n"
#$(serialize-getmail-destination-configuration #f destination)
"\n[options]\n"
#$(serialize-getmail-options-configuration #f options)))))
(define-configuration getmail-configuration-file
(retriever
(getmail-retriever-configuration (getmail-retriever-configuration))
"What mail account to retrieve mail from, and how to access that account.")
(destination
(getmail-destination-configuration (getmail-destination-configuration))
"What to do with retrieved messages.")
(options
(getmail-options-configuration (getmail-options-configuration))
"Configure getmail."))
(define (serialize-symbol field-name val) "")
(define (serialize-getmail-configuration field-name val) "")
(define-configuration getmail-configuration
(name
(symbol "unset")
"A symbol to identify the getmail service.")
(package
(package getmail)
"The getmail package to use.")
(user
(string "getmail")
"The user to run getmail as.")
(group
(string "getmail")
"The group to run getmail as.")
(directory
(string "/var/lib/getmail/default")
"The getmail directory to use.")
(rcfile
(getmail-configuration-file (getmail-configuration-file))
"The getmail configuration file to use.")
(idle
(list '())
"A list of mailboxes that getmail should wait on the server for new mail
notifications. This depends on the server supporting the IDLE extension.")
(environment-variables
(list '())
"Environment variables to set for getmail."))
(define (generate-getmail-documentation)
(generate-documentation
`((getmail-configuration
,getmail-configuration-fields
(rcfile getmail-configuration-file))
(getmail-configuration-file
,getmail-configuration-file-fields
(retriever getmail-retriever-configuration)
(destination getmail-destination-configuration)
(options getmail-options-configuration))
(getmail-retriever-configuration ,getmail-retriever-configuration-fields)
(getmail-destination-configuration ,getmail-destination-configuration-fields)
(getmail-options-configuration ,getmail-options-configuration-fields))
'getmail-configuration))
(define-gexp-compiler (getmail-configuration-file-compiler
(rcfile <getmail-configuration-file>) system target)
(gexp->derivation
"getmailrc"
#~(call-with-output-file #$output
(lambda (port)
(display #$(serialize-getmail-configuration-file #f rcfile)
port)))
#:system system
#:target target))
(define (getmail-accounts configs)
(let ((users (delete-duplicates
(map getmail-configuration-user
configs)))
(groups (delete-duplicates
(map getmail-configuration-group
configs))))
(append
(map (lambda (group)
(user-group
(name group)
(system? #t)))
groups)
(map (lambda (user)
(user-account
(name user)
(group (getmail-configuration-group
(find (lambda (config)
(and
(string=? user (getmail-configuration-user config))
(getmail-configuration-group config)))
configs)))
(system? #t)
(comment "Getmail user")
(home-directory "/var/empty")
(shell (file-append shadow "/sbin/nologin"))))
users))))
(define (getmail-activation configs)
"Return the activation GEXP for CONFIGS."
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils))
#$@(map
(lambda (config)
#~(let* ((pw (getpw #$(getmail-configuration-user config)))
(uid (passwd:uid pw))
(gid (passwd:gid pw))
(getmaildir #$(getmail-configuration-directory config)))
(mkdir-p getmaildir)
(chown getmaildir uid gid)))
configs))))
(define (getmail-shepherd-services configs)
"Return a list of <shepherd-service> for CONFIGS."
(map (match-lambda
(($ <getmail-configuration> location name package
user group directory rcfile idle
environment-variables)
(shepherd-service
(documentation "Run getmail.")
(provision (list (symbol-append 'getmail- name)))
(requirement '(networking))
(start #~(make-forkexec-constructor
`(#$(file-append package "/bin/getmail")
,(string-append "--getmaildir=" #$directory)
#$@(map (lambda (idle)
(string-append "--idle=" idle))
idle)
,(string-append "--rcfile=" #$rcfile))
#:user #$user
#:group #$group
#:environment-variables
(list #$@environment-variables)
#:log-file
#$(string-append "/var/log/getmail-"
(symbol->string name)))))))
configs))
(define getmail-service-type
(service-type
(name 'getmail)
(extensions
(list (service-extension shepherd-root-service-type
getmail-shepherd-services)
(service-extension activation-service-type
getmail-activation)
(service-extension account-service-type
getmail-accounts)))
(description
"Run @command{getmail}, a mail retriever program.")
(default-value '())
(compose concatenate)
(extend append)))

178
gnu/tests/mail.scm
View file

@ -4,6 +4,7 @@
;;; Copyright © 2017 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>
;;;
;;; This file is part of GNU Guix.
;;;
@ -25,6 +26,7 @@ (define-module (gnu tests mail)
#:use-module (gnu system)
#:use-module (gnu system vm)
#:use-module (gnu services)
#:use-module (gnu services getmail)
#:use-module (gnu services mail)
#:use-module (gnu services networking)
#:use-module (guix gexp)
@ -32,7 +34,8 @@ (define-module (gnu tests mail)
#:use-module (ice-9 ftw)
#:export (%test-opensmtpd
%test-exim
%test-dovecot))
%test-dovecot
%test-getmail))
(define %opensmtpd-os
(simple-operating-system
@ -394,3 +397,176 @@ (define %test-dovecot
(name "dovecot")
(description "Connect to a running Dovecot server.")
(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))))))))))
(define (run-getmail-test)
"Return a test of an OS running Getmail service."
(define vm
(virtual-machine
(operating-system (marionette-operating-system
%getmail-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 "getmail")
;; Wait for dovecot to be up and running.
(test-assert "dovecot running"
(marionette-eval
'(begin
(use-modules (gnu services herd))
(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
'(let* ((pw (getpw "alice"))
(uid (passwd:uid pw))
(gid (passwd:gid pw)))
(use-modules (gnu services herd))
(for-each
(lambda (dir)
(mkdir dir)
(chown dir uid gid))
'("/home/alice/TestMaildir"
"/home/alice/TestMaildir/cur"
"/home/alice/TestMaildir/new"
"/home/alice/TestMaildir/tmp"
"/home/alice/TestMaildir/TESTBOX"
"/home/alice/TestMaildir/TESTBOX/cur"
"/home/alice/TestMaildir/TESTBOX/new"
"/home/alice/TestMaildir/TESTBOX/tmp"))
(start-service 'getmail-test))
marionette))
;; 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)))
(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))
(sleep 1)
(test-assert "mail arrived"
(string-contains
(marionette-eval
'(begin
(use-modules (ice-9 ftw)
(ice-9 match))
(let ((TESTBOX/new "/home/alice/TestMaildir/new/"))
(match (scandir TESTBOX/new)
(("." ".." message-file)
(call-with-input-file
(string-append TESTBOX/new message-file)
get-string-all)))))
marionette)
message))
(test-end)
(exit (= (test-runner-fail-count (test-runner-current)) 0)))))
(gexp->derivation "getmail-test" test))
(define %test-getmail
(system-test
(name "getmail")
(description "Connect to a running Getmail server.")
(value (run-getmail-test))))
%getmail-os