;;; 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 Tobias Geerinckx-Rice <me@tobias.gr>
;;;
;;; 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 configuration)
#:use-module (gnu services shepherd)
#:use-module (gnu system pam)
#:use-module (gnu system shadow)
#: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))
;;; 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))
@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")
(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 "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"))
- (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)
+ (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"))
- (service-configuration (kind "dict")
+ (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
"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
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 "")
"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))))))
+ (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")))
(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
+accept from any for local deliver to mbox
+accept from local for any relay
+"))
+
+(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))))))
+
+(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 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 '()))))))
HCoop / jackhill / guix / guix.git / blobdiff