;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2015 Andy Wingo <wingo@igalia.com>
+;;; Copyright © 2017, 2018 Clément Lassieur <clement@lassieur.org>
+;;; Copyright © 2017 Carlo Zancanaro <carlo@zancanaro.id.au>
+;;; Copyright © 2017, 2020 Tobias Geerinckx-Rice <me@tobias.gr>
+;;; Copyright © 2019 Kristofer Buffington <kristoferbuffington@gmail.com>
+;;; Copyright © 2020 Jonathan Brielmaier <jonathan.brielmaier@web.de>
;;;
;;; This file is part of GNU Guix.
;;;
(define-module (gnu services mail)
#:use-module (gnu services)
#:use-module (gnu services base)
- #:use-module (gnu services dmd)
+ #: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 dav)
#:use-module (gnu packages tls)
#:use-module (guix records)
#:use-module (guix packages)
#:use-module (guix gexp)
- #:use-module (srfi srfi-34)
- #:use-module (srfi srfi-35)
#:use-module (ice-9 match)
- #:export (&dovecot-configuation-error
- dovecot-configuration-error?
-
- dovecot-service
+ #:use-module (ice-9 format)
+ #:use-module (srfi srfi-1)
+ #:export (dovecot-service
+ dovecot-service-type
dovecot-configuration
opaque-dovecot-configuration
protocol-configuration
plugin-configuration
mailbox-configuration
- namespace-configuration))
+ namespace-configuration
+
+ opensmtpd-configuration
+ opensmtpd-configuration?
+ opensmtpd-service-type
+ %default-opensmtpd-config-file
+
+ mail-aliases-service-type
+
+ exim-configuration
+ exim-configuration?
+ exim-service-type
+ %default-exim-config-file
+
+ imap4d-configuration
+ imap4d-configuration?
+ imap4d-service-type
+ %default-imap4d-config-file
+
+ radicale-configuration
+ radicale-configuration?
+ radicale-service-type
+ %default-radicale-config-file))
;;; Commentary:
;;;
;;;
;;; Code:
-(define-condition-type &dovecot-configuration-error &error
- dovecot-configuration-error?)
-
-(define (dovecot-error message)
- (raise (condition (&message (message message))
- (&dovecot-configuration-error))))
-(define (dovecot-configuration-field-error field val)
- (dovecot-error
- (format #f "Invalid value for field ~a: ~s" field val)))
-(define (dovecot-configuration-missing-field kind field)
- (dovecot-error
- (format #f "~a configuration missing required field ~a" kind field)))
-
-(define-record-type* <configuration-field>
- configuration-field make-configuration-field configuration-field?
- (name configuration-field-name)
- (type configuration-field-type)
- (getter configuration-field-getter)
- (predicate configuration-field-predicate)
- (serializer configuration-field-serializer)
- (default-value-thunk configuration-field-default-value-thunk)
- (documentation configuration-field-documentation))
-
-(define-syntax define-configuration
- (lambda (stx)
- (define (id ctx part . parts)
- (let ((part (syntax->datum part)))
- (datum->syntax
- ctx
- (match parts
- (() part)
- (parts (symbol-append part
- (syntax->datum (apply id ctx parts))))))))
- (syntax-case stx ()
- ((_ stem (field (field-type def) doc) ...)
- (with-syntax (((field-getter ...)
- (map (lambda (field)
- (id #'stem #'stem #'- field))
- #'(field ...)))
- ((field-predicate ...)
- (map (lambda (type)
- (id #'stem type #'?))
- #'(field-type ...)))
- ((field-serializer ...)
- (map (lambda (type)
- (id #'stem #'serialize- type))
- #'(field-type ...))))
- #`(begin
- (define-record-type* #,(id #'stem #'< #'stem #'>)
- stem #,(id #'stem #'make- #'stem) #,(id #'stem #'stem #'?)
- (field field-getter (default def))
- ...)
- (define #,(id #'stem #'stem #'-fields)
- (list (configuration-field
- (name 'field)
- (type 'field-type)
- (getter field-getter)
- (predicate field-predicate)
- (serializer field-serializer)
- (default-value-thunk (lambda () def))
- (documentation doc))
- ...))))))))
-
-(define (serialize-configuration config fields)
- (for-each (lambda (field)
- ((configuration-field-serializer field)
- (configuration-field-name field)
- ((configuration-field-getter field) config)))
- fields))
-
-(define (validate-configuration config fields)
- (for-each (lambda (field)
- (let ((val ((configuration-field-getter field) config)))
- (unless ((configuration-field-predicate field) val)
- (dovecot-configuration-field-error
- (configuration-field-name field) val))))
- fields))
-
-(define (validate-package field-name package)
- (unless (package? package)
- (dovecot-configuration-field-error field-name package)))
-
(define (uglify-field-name field-name)
(let ((str (symbol->string field-name)))
(string-join (string-split (if (string-suffix? "?" str)
#\-)
"_")))
-(define (serialize-package field-name val)
- #f)
-
(define (serialize-field field-name val)
(format #t "~a=~a\n" (uglify-field-name field-name) val))
(and (string? x) (not (string-index x #\space))))
val)))
(define (serialize-space-separated-string-list field-name val)
- (serialize-field field-name (string-join val " ")))
+ (match val
+ (() #f)
+ (_ (serialize-field field-name (string-join val " ")))))
(define (comma-separated-string-list? val)
(and (list? val)
(define (free-form-fields? val)
(match val
(() #t)
- ((((? symbol?) . (? string)) . val) (free-form-fields? val))
+ ((((? symbol?) . (? string?)) . val) (free-form-fields? val))
(_ #f)))
(define (serialize-free-form-fields field-name val)
(for-each (match-lambda ((k . v) (serialize-field k v))) val))
(define (free-form-args? val)
(match val
(() #t)
- ((((? symbol?) . (? string)) . val) (free-form-args? val))
+ ((((? symbol?) . (? string?)) . val) (free-form-args? val))
(_ #f)))
(define (serialize-free-form-args field-name val)
(serialize-field field-name
(string-join
- (map (match-lambda ((k . v) (format #t "~a=~a" k v))) val)
+ (map (match-lambda ((k . v) (format #f "~a=~a" k v))) val)
" ")))
(define-configuration dict-configuration
@samp{pam}, @samp{passwd}, @samp{shadow}, @samp{bsdauth}, and
@samp{static}.")
(args
- (free-form-args '())
- "A list of key-value args to the passdb driver."))
+ (space-separated-string-list '())
+ "Space separated list of arguments to the passdb driver."))
(define (serialize-passdb-configuration field-name val)
(format #t "passdb {\n")
"The driver that the userdb should use. Valid values include
@samp{passwd} and @samp{static}.")
(args
- (free-form-args '())
- "A list of key-value args to the userdb driver.")
+ (space-separated-string-list '())
+ "Space separated list of arguments to the userdb driver.")
(override-fields
(free-form-args '())
"Override fields from passwd."))
(define-configuration unix-listener-configuration
(path
- (file-name (dovecot-configuration-missing-field 'unix-listener 'path))
- "The file name on which to listen.")
+ (string (configuration-missing-field 'unix-listener 'path))
+ "Path to the file, relative to @code{base-dir} field. This is also used as
+the section name.")
(mode
(string "0600")
"The access mode for the socket.")
(define-configuration fifo-listener-configuration
(path
- (file-name (dovecot-configuration-missing-field 'fifo-listener 'path))
- "The file name on which to listen.")
+ (string (configuration-missing-field 'fifo-listener 'path))
+ "Path to the file, relative to @code{base-dir} field. This is also used as
+the section name.")
(mode
(string "0600")
"The access mode for the socket.")
(define-configuration inet-listener-configuration
(protocol
- (string (dovecot-configuration-missing-field 'inet-listener 'protocol))
+ (string (configuration-missing-field 'inet-listener 'protocol))
"The protocol to listen for.")
(address
(string "")
"The address on which to listen, or empty for all addresses.")
(port
(non-negative-integer
- (dovecot-configuration-missing-field 'inet-listener 'port))
+ (configuration-missing-field 'inet-listener 'port))
"The port on which to listen.")
(ssl?
(boolean #t)
(serialize-fifo-listener-configuration field-name val))
((inet-listener-configuration? val)
(serialize-inet-listener-configuration field-name val))
- (else (dovecot-configuration-field-error field-name val))))
+ (else (configuration-field-error field-name val))))
(define (listener-configuration-list? val)
(and (list? val) (and-map listener-configuration? val)))
(define (serialize-listener-configuration-list field-name val)
(define-configuration service-configuration
(kind
- (string (dovecot-configuration-missing-field 'service 'kind))
+ (string (configuration-missing-field 'service 'kind))
"The service kind. Valid values include @code{director},
@code{imap-login}, @code{pop3-login}, @code{lmtp}, @code{imap},
@code{pop3}, @code{auth}, @code{auth-worker}, @code{dict},
"Listeners for the service. A listener is either an
@code{unix-listener-configuration}, a @code{fifo-listener-configuration}, or
an @code{inet-listener-configuration}.")
+ (client-limit
+ (non-negative-integer 0)
+ "Maximum number of simultaneous client connections per process. Once this
+number of connections is received, the next incoming connection will prompt
+Dovecot to spawn another process. If set to 0, @code{default-client-limit} is
+used instead.")
(service-count
(non-negative-integer 1)
"Number of connections to handle before starting a new process.
Typically the only useful values are 0 (unlimited) or 1. 1 is more
secure, but 0 is faster. <doc/wiki/LoginProcess.txt>.")
+ (process-limit
+ (non-negative-integer 0)
+ "Maximum number of processes that can exist for this service. If set to 0,
+@code{default-process-limit} is used instead.")
(process-min-avail
(non-negative-integer 0)
"Number of processes to always keep waiting for more connections.")
(define-configuration protocol-configuration
(name
- (string (dovecot-configuration-missing-field 'protocol 'name))
+ (string (configuration-missing-field 'protocol 'name))
"The name of the protocol.")
(auth-socket-path
(string "/var/run/dovecot/auth-userdb")
complex, customize the address and port fields of the
@samp{inet-listener} of the specific services you are interested in.")
- (protocols
- (protocol-configuration-list
- (list (protocol-configuration
- (name "imap"))))
- "List of protocols we want to serve. Available protocols include
-@samp{imap}, @samp{pop3}, and @samp{lmtp}.")
-
- (services
- (service-configuration-list
- (list
- (service-configuration
- (kind "imap-login")
- (listeners
- (list
- (inet-listener-configuration (protocol "imap") (port 143) (ssl? #f))
- (inet-listener-configuration (protocol "imaps") (port 993) (ssl? #t)))))
- (service-configuration
- (kind "pop3-login")
- (listeners
- (list
- (inet-listener-configuration (protocol "pop3") (port 110) (ssl? #f))
- (inet-listener-configuration (protocol "pop3s") (port 995) (ssl? #t)))))
- (service-configuration
- (kind "lmtp")
- (listeners
- (list (unix-listener-configuration (path "lmtp") (mode "0666")))))
- (service-configuration (kind "imap"))
- (service-configuration (kind "pop3"))
- (service-configuration (kind "auth")
- ;; In what could be taken to be a bug, the default value of 1 for
- ;; service-count makes it so that a PAM auth worker can't fork off
- ;; subprocesses for making blocking queries. The result is that nobody
- ;; can log in -- very secure, but not very useful! If we simply omit
- ;; the service-count, it will default to the value of
- ;; auth-worker-max-count, which is 30, instead of defaulting to 1, which
- ;; is the default for all other services. As a hack, bump this value to
- ;; 30.
- (service-count 30)
- (listeners
- (list (unix-listener-configuration (path "auth-userdb")))))
- (service-configuration (kind "auth-worker"))
- (service-configuration (kind "dict")
- (listeners (list (unix-listener-configuration (path "dict")))))))
- "List of services to enable. Available services include @samp{imap},
-@samp{imap-login}, @samp{pop3}, @samp{pop3-login}, @samp{auth}, and
-@samp{lmtp}.")
-
(dict
(dict-configuration (dict-configuration))
"Dict configuration, as created by the @code{dict-configuration}
"How long to redirect users to a specific server after it no longer
has any connections.")
- (director-doveadm-port
- (non-negative-integer 0)
- "TCP/IP port that accepts doveadm connections (instead of director
-connections) If you enable this, you'll also need to add
-@samp{inet-listener} for the port.")
-
(director-username-hash
(string "%Lu")
"How the username is translated before being hashed. Useful values
"Log unsuccessful authentication attempts and the reasons why they
failed.")
- (auth-verbose-passwords?
- (boolean #f)
+ (auth-verbose-passwords
+ (string "no")
"In case of password mismatches, log the attempted password. Valid
values are no, plain and sha1. sha1 can be useful for detecting brute
force password attempts vs. user simply trying the same password over
string, %$ contains the data we want to log.")
(mail-log-prefix
- (string "\"%s(%u): \"")
+ (string "\"%s(%u)<%{pid}><%{session}>: \"")
"Log prefix for mail processes. See doc/wiki/Variables.txt for list
of possible variables you can use.")
(mail-full-filesystem-access?
(boolean #f)
- "Allow full filesystem access to clients. There's no access checks
+ "Allow full file system access to clients. There's no access checks
other than what the operating system does for the active UID/GID. It
works with both maildir and mboxes, allowing you to prefix mailboxes
names with e.g. /path/ or ~user/.")
(mmap-disable?
(boolean #f)
"Don't use mmap() at all. This is required if you store indexes to
-shared filesystems (NFS or clustered filesystem).")
+shared file systems (NFS or clustered file system).")
(dotlock-use-excl?
(boolean #t)
updated.")
(mdbox-rotate-size
- (non-negative-integer #e2e6)
+ (non-negative-integer #e10e6)
"Maximum dbox file size until it's rotated.")
(mdbox-rotate-interval
(boolean #f)
"When creating new mdbox files, immediately preallocate their size to
@samp{mdbox-rotate-size}. This setting currently works only in Linux
-with some filesystems (ext4, xfs).")
+with some file systems (ext4, xfs).")
(mail-attachment-dir
(string "")
(mail-attachment-fs
(string "sis posix")
- "Filesystem backend to use for saving attachments:
+ "File system backend to use for saving attachments:
@table @code
@item posix
No SiS done by Dovecot (but this might help FS's own deduplication)
x500UniqueIdentifier are the usual choices. You'll also need to set
@samp{auth-ssl-username-from-cert? #t}.")
- (ssl-parameters-regenerate
- (hours 168)
- "How often to regenerate the SSL parameters file. Generation is
-quite CPU intensive operation. The value is in hours, 0 disables
-regeneration entirely.")
-
- (ssl-protocols
- (string "!SSLv2")
- "SSL protocols to use.")
+ (ssl-min-protocol
+ (string "TLSv1")
+ "Minimum SSL protocol version to accept.")
(ssl-cipher-list
- (string "ALL:!LOW:!SSLv2:!EXP:!aNULL")
+ (string "ALL:!kRSA:!SRP:!kDHd:!DSS:!aNULL:!eNULL:!EXPORT:!DES:!3DES:!MD5:!PSK:!RC4:!ADH:!LOW@STRENGTH")
"SSL ciphers to use.")
(ssl-crypto-device
"SSL crypto device to use, for valid values run \"openssl engine\".")
(postmaster-address
- (string "")
+ (string "postmaster@%d")
"Address to use when sending rejection mails.
Default is postmaster@@<your domain>. %d expands to recipient domain.")
often.")
(imap-logout-format
- (string "in=%i out=%o")
+ (string "in=%i out=%o deleted=%{deleted} expunged=%{expunged} trashed=%{trashed} hdr_count=%{fetch_hdr_count} hdr_bytes=%{fetch_hdr_bytes} body_count=%{fetch_body_count} body_bytes=%{fetch_body_bytes}")
"IMAP logout format string:
@table @code
@item %i
total number of bytes read from client
@item %o
total number of bytes sent to client.
-@end table")
+@end table
+See @file{doc/wiki/Variables.txt} for a list of all the variables you can use.")
(imap-capability
(string "")
(imap-urlauth-host
(string "")
- "Host allowed in URLAUTH URLs sent by client. \"*\" allows all.") )
+ "Host allowed in URLAUTH URLs sent by client. \"*\" allows all.")
+
+ (protocols
+ (protocol-configuration-list
+ (list (protocol-configuration
+ (name "imap"))))
+ "List of protocols we want to serve. Available protocols include
+@samp{imap}, @samp{pop3}, and @samp{lmtp}.")
+
+ (services
+ (service-configuration-list
+ (list
+ (service-configuration
+ (kind "imap-login")
+ (client-limit 0)
+ (process-limit 0)
+ (listeners
+ (list
+ (inet-listener-configuration (protocol "imap") (port 143) (ssl? #f))
+ (inet-listener-configuration (protocol "imaps") (port 993) (ssl? #t)))))
+ (service-configuration
+ (kind "pop3-login")
+ (listeners
+ (list
+ (inet-listener-configuration (protocol "pop3") (port 110) (ssl? #f))
+ (inet-listener-configuration (protocol "pop3s") (port 995) (ssl? #t)))))
+ (service-configuration
+ (kind "lmtp")
+ (client-limit 1)
+ (process-limit 0)
+ (listeners
+ (list (unix-listener-configuration (path "lmtp") (mode "0666")))))
+ (service-configuration
+ (kind "imap")
+ (client-limit 1)
+ (process-limit 1024))
+ (service-configuration
+ (kind "pop3")
+ (client-limit 1)
+ (process-limit 1024))
+ (service-configuration
+ (kind "auth")
+ (service-count 0)
+ (client-limit 0)
+ (process-limit 1)
+ (listeners
+ (list (unix-listener-configuration (path "auth-userdb")))))
+ (service-configuration
+ (kind "auth-worker")
+ (client-limit 1)
+ (process-limit 0))
+ (service-configuration
+ (kind "dict")
+ (client-limit 1)
+ (process-limit 0)
+ (listeners (list (unix-listener-configuration (path "dict")))))))
+ "List of services to enable. Available services include @samp{imap},
+@samp{imap-login}, @samp{pop3}, @samp{pop3-login}, @samp{auth}, and
+@samp{lmtp}."))
(define-configuration opaque-dovecot-configuration
(dovecot
"The dovecot package.")
(string
- (string (dovecot-configuration-missing-field 'opaque-dovecot-configuration
- 'string))
+ (string (configuration-missing-field 'opaque-dovecot-configuration
+ 'string))
"The contents of the @code{dovecot.conf} to use."))
(define %dovecot-accounts
(system? #t)
(comment "Dovecot daemon user")
(home-directory "/var/empty")
- (shell #~(string-append #$shadow "/sbin/nologin")))
+ (shell (file-append shadow "/sbin/nologin")))
(user-group (name "dovenull") (system? #t))
(user-account
(system? #t)
(comment "Dovecot daemon login user")
(home-directory "/var/empty")
- (shell #~(string-append #$shadow "/sbin/nologin")))))
+ (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))))))
-
-(define (dovecot-dmd-service config)
- "Return a list of <dmd-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))))
- (list (dmd-service
+ (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 "Guix")
+ (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 ((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)))
- (stop #~(make-forkexec-constructor
- (list (string-append #$dovecot "/sbin/dovecot")
- "-c" #$config-file "stop")))))))
+ "-F")))
+ (stop #~(lambda _
+ (invoke #$(file-append dovecot "/sbin/dovecot")
+ "stop")
+ #f))))))
(define %dovecot-pam-services
(list (unix-pam-service "dovecot")))
(define dovecot-service-type
(service-type (name 'dovecot)
(extensions
- (list (service-extension dmd-root-service-type
- dovecot-dmd-service)
+ (list (service-extension shepherd-root-service-type
+ dovecot-shepherd-service)
(service-extension account-service-type
(const %dovecot-accounts))
(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
(service dovecot-service-type config))
;; A little helper to make it easier to document all those fields.
-(define (generate-documentation)
- (define documentation
+(define (generate-dovecot-documentation)
+ (generate-documentation
`((dovecot-configuration
,dovecot-configuration-fields
(dict dict-configuration)
,service-configuration-fields
(listeners unix-listener-configuration fifo-listener-configuration
inet-listener-configuration))
- (protocol-configuration ,protocol-configuration-fields)))
- (define (generate configuration-name)
- (match (assq-ref documentation configuration-name)
- ((fields . sub-documentation)
- (format #t "\nAvailable @code{~a} fields are:\n\n" configuration-name)
- (for-each
- (lambda (f)
- (let ((field-name (configuration-field-name f))
- (field-type (configuration-field-type f))
- (field-docs (string-trim-both
- (configuration-field-documentation f)))
- (default (catch #t
- (configuration-field-default-value-thunk f)
- (lambda _ 'nope))))
- (define (escape-chars str chars escape)
- (with-output-to-string
- (lambda ()
- (string-for-each (lambda (c)
- (when (char-set-contains? chars c)
- (display escape))
- (display c))
- str))))
- (define (show-default? val)
- (or (string? default) (number? default) (boolean? default)
- (and (list? val) (and-map show-default? val))))
- (format #t "@deftypevr {@code{~a} parameter} ~a ~a\n~a\n"
- configuration-name field-type field-name field-docs)
- (when (show-default? default)
- (format #t "Defaults to @samp{~a}.\n"
- (escape-chars (format #f "~s" default)
- (char-set #\@ #\{ #\})
- #\@)))
- (for-each generate (or (assq-ref sub-documentation field-name) '()))
- (format #t "@end deftypevr\n\n")))
- fields))))
- (generate 'dovecot-configuration))
+ (protocol-configuration ,protocol-configuration-fields))
+ 'dovecot-configuration))
+
+\f
+;;;
+;;; OpenSMTPD.
+;;;
+
+(define-record-type* <opensmtpd-configuration>
+ opensmtpd-configuration make-opensmtpd-configuration
+ opensmtpd-configuration?
+ (package opensmtpd-configuration-package
+ (default opensmtpd))
+ (config-file opensmtpd-configuration-config-file
+ (default %default-opensmtpd-config-file)))
+
+(define %default-opensmtpd-config-file
+ (plain-file "smtpd.conf" "
+listen on lo
+
+action inbound mbox
+match for local action inbound
+
+action outbound relay
+match from local for any action outbound
+"))
+
+(define opensmtpd-shepherd-service
+ (match-lambda
+ (($ <opensmtpd-configuration> package config-file)
+ (list (shepherd-service
+ (provision '(smtpd))
+ (requirement '(loopback))
+ (documentation "Run the OpenSMTPD daemon.")
+ (start (let ((smtpd (file-append package "/sbin/smtpd")))
+ #~(make-forkexec-constructor
+ (list #$smtpd "-f" #$config-file)
+ #:pid-file "/var/run/smtpd.pid")))
+ (stop #~(make-kill-destructor)))))))
+
+(define %opensmtpd-accounts
+ (list (user-group
+ (name "smtpq")
+ (system? #t))
+ (user-account
+ (name "smtpd")
+ (group "nogroup")
+ (system? #t)
+ (comment "SMTP Daemon")
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))
+ (user-account
+ (name "smtpq")
+ (group "smtpq")
+ (system? #t)
+ (comment "SMTPD Queue")
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
+
+(define opensmtpd-activation
+ (match-lambda
+ (($ <opensmtpd-configuration> package config-file)
+ (let ((smtpd (file-append package "/sbin/smtpd")))
+ #~(begin
+ (use-modules (guix build utils))
+ ;; Create mbox and spool directories.
+ (mkdir-p "/var/mail")
+ (mkdir-p "/var/spool/smtpd")
+ (chmod "/var/spool/smtpd" #o711)
+ (mkdir-p "/var/spool/mail")
+ (chmod "/var/spool/mail" #o711))))))
+
+(define %opensmtpd-pam-services
+ (list (unix-pam-service "smtpd")))
+
+(define opensmtpd-service-type
+ (service-type
+ (name 'opensmtpd)
+ (extensions
+ (list (service-extension account-service-type
+ (const %opensmtpd-accounts))
+ (service-extension activation-service-type
+ opensmtpd-activation)
+ (service-extension pam-root-service-type
+ (const %opensmtpd-pam-services))
+ (service-extension profile-service-type
+ (compose list opensmtpd-configuration-package))
+ (service-extension shepherd-root-service-type
+ opensmtpd-shepherd-service)))))
+
+\f
+;;;
+;;; mail aliases.
+;;;
+
+(define (mail-aliases-etc aliases)
+ `(("aliases" ,(plain-file "aliases"
+ ;; Ideally we'd use a format string like
+ ;; "~:{~a: ~{~a~^,~}\n~}", but it gives a
+ ;; warning that I can't figure out how to fix,
+ ;; so we'll just use string-join below instead.
+ (format #f "~:{~a: ~a\n~}"
+ (map (match-lambda
+ ((alias addresses ...)
+ (list alias (string-join addresses ","))))
+ aliases))))))
+
+(define mail-aliases-service-type
+ (service-type
+ (name 'mail-aliases)
+ (extensions
+ (list (service-extension etc-service-type mail-aliases-etc)))
+ (compose concatenate)
+ (extend append)))
+
+\f
+;;;
+;;; Exim.
+;;;
+
+(define-record-type* <exim-configuration> exim-configuration
+ make-exim-configuration
+ exim-configuration?
+ (package exim-configuration-package ;<package>
+ (default exim))
+ (config-file exim-configuration-config-file ;file-like
+ (default #f)))
+
+(define %exim-accounts
+ (list (user-group
+ (name "exim")
+ (system? #t))
+ (user-account
+ (name "exim")
+ (group "exim")
+ (system? #t)
+ (comment "Exim Daemon")
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
+
+(define (exim-computed-config-file package config-file)
+ (computed-file "exim.conf"
+ #~(call-with-output-file #$output
+ (lambda (port)
+ (format port "
+exim_user = exim
+exim_group = exim
+.include ~a"
+ #$(or config-file
+ (file-append package "/etc/exim.conf")))))))
+
+(define exim-shepherd-service
+ (match-lambda
+ (($ <exim-configuration> package config-file)
+ (list (shepherd-service
+ (provision '(exim mta))
+ (documentation "Run the exim daemon.")
+ (requirement '(networking))
+ (start #~(make-forkexec-constructor
+ '(#$(file-append package "/bin/exim")
+ "-bd" "-v" "-C"
+ #$(exim-computed-config-file package config-file))))
+ (stop #~(make-kill-destructor)))))))
+
+(define exim-activation
+ (match-lambda
+ (($ <exim-configuration> package config-file)
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+
+ (let ((uid (passwd:uid (getpw "exim")))
+ (gid (group:gid (getgr "exim"))))
+ (mkdir-p "/var/spool/exim")
+ (chown "/var/spool/exim" uid gid))
+
+ (zero? (system* #$(file-append package "/bin/exim")
+ "-bV" "-C" #$(exim-computed-config-file package config-file))))))))
+
+(define exim-profile
+ (compose list exim-configuration-package))
+
+(define exim-service-type
+ (service-type
+ (name 'exim)
+ (extensions
+ (list (service-extension shepherd-root-service-type exim-shepherd-service)
+ (service-extension account-service-type (const %exim-accounts))
+ (service-extension activation-service-type exim-activation)
+ (service-extension profile-service-type exim-profile)
+ (service-extension mail-aliases-service-type (const '()))))))
+
+\f
+;;;
+;;; GNU Mailutils IMAP4 Daemon.
+;;;
+
+(define %default-imap4d-config-file
+ (plain-file "imap4d.conf" "server localhost {};\n"))
+
+(define-record-type* <imap4d-configuration>
+ imap4d-configuration make-imap4d-configuration imap4d-configuration?
+ (package imap4d-configuration-package
+ (default mailutils))
+ (config-file imap4d-configuration-config-file
+ (default %default-imap4d-config-file)))
+
+(define imap4d-shepherd-service
+ (match-lambda
+ (($ <imap4d-configuration> package config-file)
+ (list (shepherd-service
+ (provision '(imap4d))
+ (requirement '(networking syslogd))
+ (documentation "Run the imap4d daemon.")
+ (start (let ((imap4d (file-append package "/sbin/imap4d")))
+ #~(make-forkexec-constructor
+ (list #$imap4d "--daemon" "--foreground"
+ "--config-file" #$config-file))))
+ (stop #~(make-kill-destructor)))))))
+
+(define imap4d-service-type
+ (service-type
+ (name 'imap4d)
+ (description
+ "Run the GNU @command{imap4d} to serve e-mail messages through IMAP.")
+ (extensions
+ (list (service-extension
+ shepherd-root-service-type imap4d-shepherd-service)))
+ (default-value (imap4d-configuration))))
+
+\f
+;;;
+;;; Radicale.
+;;;
+
+(define-record-type* <radicale-configuration>
+ radicale-configuration make-radicale-configuration
+ radicale-configuration?
+ (package radicale-configuration-package
+ (default radicale))
+ (config-file radicale-configuration-config-file
+ (default %default-radicale-config-file)))
+
+(define %default-radicale-config-file
+ (plain-file "radicale.conf" "
+[auth]
+type = htpasswd
+htpasswd_filename = /var/lib/radicale/users
+htpasswd_encryption = plain
+
+[server]
+hosts = localhost:5232"))
+
+(define %radicale-accounts
+ (list (user-group
+ (name "radicale")
+ (system? #t))
+ (user-account
+ (name "radicale")
+ (group "radicale")
+ (system? #t)
+ (comment "Radicale Daemon")
+ (home-directory "/var/empty")
+ (shell (file-append shadow "/sbin/nologin")))))
+
+(define radicale-shepherd-service
+ (match-lambda
+ (($ <radicale-configuration> package config-file)
+ (list (shepherd-service
+ (provision '(radicale))
+ (documentation "Run the radicale daemon.")
+ (requirement '(networking))
+ (start #~(make-forkexec-constructor
+ (list #$(file-append package "/bin/radicale")
+ "-C" #$config-file)
+ #:user "radicale"
+ #:group "radicale"))
+ (stop #~(make-kill-destructor)))))))
+
+(define radicale-activation
+ (match-lambda
+ (($ <radicale-configuration> package config-file)
+ (with-imported-modules '((guix build utils))
+ #~(begin
+ (use-modules (guix build utils))
+ (let ((uid (passwd:uid (getpw "radicale")))
+ (gid (group:gid (getgr "radicale"))))
+ (mkdir-p "/var/lib/radicale/collections")
+ (chown "/var/lib/radicale" uid gid)
+ (chown "/var/lib/radicale/collections" uid gid)
+ (chmod "/var/lib/radicale" #o700)))))))
+
+(define radicale-service-type
+ (service-type
+ (name 'radicale)
+ (description "Run radicale, a small CalDAV and CardDAV server.")
+ (extensions
+ (list (service-extension shepherd-root-service-type radicale-shepherd-service)
+ (service-extension account-service-type (const %radicale-accounts))
+ (service-extension activation-service-type radicale-activation)))
+ (default-value (radicale-configuration))))
HCoop / jackhill / guix / guix.git / blobdiff