(define-module (org euandre queue)
#:use-module ((gnu build linux-container) #:prefix container:)
#:use-module ((guix licenses) #:prefix license:)
#:use-module ((srfi srfi-1) #:prefix srfi-1:)
#:use-module (guix build-system gnu)
#:use-module (guix build-system python)
#:use-module (guix build-system trivial)
#:use-module (guix download)
#:use-module (guix gexp)
#:use-module (guix git-download)
#:use-module (guix least-authority)
#:use-module (guix packages)
#:use-module (guix records)
#:use-module (guix utils)
#:use-module (gnu)
#:use-module (gnu packages admin)
#:use-module (gnu packages check)
#:use-module (gnu packages cpio)
#:use-module (gnu packages cups)
#:use-module (gnu packages cyrus-sasl)
#:use-module (gnu packages dbm)
#:use-module (gnu packages image)
#:use-module (gnu packages glib)
#:use-module (gnu packages gnome)
#:use-module (gnu packages mail)
#:use-module (gnu packages m4)
#:use-module (gnu packages onc-rpc)
#:use-module (gnu packages package-management)
#:use-module (gnu packages perl)
#:use-module (gnu packages python-build)
#:use-module (gnu packages python-crypto)
#:use-module (gnu packages python-web)
#:use-module (gnu packages python-xyz)
#:use-module (gnu packages time)
#:use-module (gnu packages tls)
#:use-module (gnu packages xml)
#:use-module (gnu services certbot)
#:use-module (gnu services mail)
#:use-module (gnu services shepherd)
#:use-module (gnu services web)
#:use-module (gnu system setuid)
#:export (<shadow-group-configuration>
shadow-group-configuration
shadow-group-configuration?
make-shadow-group-configuration
shadow-group-configuration-group
shadow-group-activation
shadow-group-accounts
shadow-group-service-type
<cyrus-service-configuration>
cyrus-service-configuration
cyrus-service-configuration?
make-cyrus-service-configuration
cyrus-service-configuration-name
cyrus-service-configuration-authmech
cyrus-service-configuration-log-level
cyrus-service-configuration-raw-file
<cyrus-sasl-configuration>
cyrus-sasl-configuration
cyrus-sasl-configuration?
make-cyrus-sasl-configuration
cyrus-sasl-configuration-cyrus-sasl
cyrus-sasl-configuration-authmech
cyrus-sasl-configuration-services
cyrus-sasl-configuration-state-dir
cyrus-sasl-etc-files
cyrus-sasl-activation
cyrus-sasl-accounts
cyrus-sasl-shepherd-service
cyrus-sasl-service-type
<dkimproxyout-configuration>
dkimproxyout-configuration
dkimproxyout-configuration-dkimproxy
dkimproxyout-configuration-user
dkimproxyout-configuration-group
dkimproxyout-configuration-listen
dkimproxyout-configuration-relay
dkimproxyout-configuration-domains
dkimproxyout-configuration-selector
dkimproxyout-configuration-key-size
dkimproxyout-configuration-data-directory
dkimproxyout-etc-files
dkimproxyout-accounts
dkimproxyout-activation
dkimproxyout-shepherd-service
dkimproxyout-service-type
<postfix-configuration>
postfix-configuration
make-postfix-configuration
postfix-configuration?
postfix-configuration-postfix
postfix-configuration-mail-in-home?
postfix-configuration-set-sendmail?
postfix-configuration-master.cf-file
postfix-configuration-main.cf-file
postfix-configuration-master.cf-extra
postfix-configuration-main.cf-extra
postfix-configuration-config-dirname
postfix-configuration-data-directory
postfix-configuration-queue-directory
postfix-configuration-user
postfix-configuration-group
postfix-configuration-setgid-group
postfix-configuration-root-aliases
postfix-configuration-cert-file
postfix-configuration-key-file
postfix-configuration-hostname
postfix-configuration-run-in-container?
postfix-configuration-container-name
postfix-configuration-container-namespaces
postfix-configuration-extra-mappings
postfix-aliases
postfix-accounts
postfix-activation
postfix-etc-files
postfix-setuid-programs
postfix-shepherd-service
local-postfix-service-type
internet-postfix-service-type
dovecot2-service-type
dovecot2-configuration))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; packages ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-public postfix
(package
(name "postfix")
(version "3.8-20221023")
(source
(origin
(method url-fetch)
(uri
(string-append
"http://cdn.postfix.johnriley.me/mirrors/postfix-release/experimental/postfix-"
version
".tar.gz"))
(sha256
(base32 "0aaylhn81n9z3kidx53kzf2jrilr3lgwfxsk1r4hn7nkrp62bcwm"))))
(build-system gnu-build-system)
(arguments
(list
#:tests? #f
#:modules `((srfi srfi-26)
,@%gnu-build-system-modules)
#:phases
#~(modify-phases %standard-phases
(add-before 'configure 'patch-/bin/sh
(lambda _
(substitute* (find-files "." "^Makefile")
(("/bin/sh")
(which "sh")))))
(add-before 'configure 'patch-bdb-include
(lambda* (#:key inputs #:allow-other-keys)
(substitute* "makedefs"
(("/usr/include")
(string-append (assoc-ref inputs "bdb")
"/include")))))
(add-before 'configure 'dont-hardcode-PATH
(lambda _
(substitute* '("postfix-install"
"conf/post-install")
(("^PATH=")
"# PATH="))))
(add-before 'configure 'fix-strict-PATH
(lambda _
(substitute* "src/util/sys_defs.h"
(("^#define (ROOT_PATH|_PATH_DEFPATH|_PATH_STDPATH).*")
"#define ROOT_PATH \"/run/setuid-programs:/run/current-system/profile/bin:/run/current-system/profile/sbin\"\n"))))
(add-before 'configure 'use-relative-symlink-to-store
(lambda _
(substitute* "postfix-install"
(("ln -sf")
"ln -rsf"))))
(add-before 'configure 'fix-absolute-path-to-setuid-programs
(lambda _
(substitute* "conf/postfix-script"
(("\\$command_directory/postqueue")
"/run/setuid-programs/postqueue")
(("\\$command_directory/postdrop")
"/run/setuid-programs/postdrop"))))
(add-before 'configure 'disable-warning-on-non-writable-config-files
(lambda _
(substitute* "conf/postfix-script"
(("find \\$todo \\\\\\( -perm -020 -o -perm -002 \\\\\\) \\\\\n")
" # find $todo \\( -perm -020 -o -perm -002 \\)"))))
(add-before 'configure 'disable-write-to-/etc/postfix
(lambda _
(substitute* "src/postconf/postconf_edit.c"
(("pcf_set_config_dir.*")
"return;"))))
(add-before 'configure 'setup-environment
(lambda* (#:key outputs inputs #:allow-other-keys)
(setenv "CCARGS" (string-append "-DUSE_TLS -DUSE_SASL_AUTH -DUSE_CYRUS_SASL -I"
(assoc-ref inputs "cyrus-sasl")
"/include/sasl"))
(setenv "AUXLIBS" "-lnsl -lcrypto -lssl -lsasl2")
(let* ((out (assoc-ref outputs "out"))
(bin (string-append out "/bin"))
(sbin (string-append out "/sbin"))
(lib (string-append out "/lib/postfix"))
(libexec (string-append out "/libexec/postfix"))
(etc (string-append out "/etc/postfix"))
(man (string-append out "/share/man"))
(doc (string-append out "/share/doc/postfix-" #$version))
(html (string-append doc "/html")))
(setenv "install_root" "wip-prefix")
(setenv "newaliases_path" (string-append bin "/newaliases"))
(setenv "mailq_path" (string-append bin "/mailq"))
(setenv "sendmail_path" (string-append sbin "/sendmail"))
(setenv "command_directory" sbin)
(setenv "shlib_directory" lib)
(setenv "daemon_directory" libexec)
(setenv "meta_directory" etc)
(setenv "sample_directory" etc)
(setenv "manpage_directory" man)
(setenv "readme_directory" doc)
(setenv "html_directory" html)
(setenv "sample_directory" (string-append out "/share/postfix")))))
(replace 'configure
(lambda _
(invoke "make" "makefiles"
"pie=yes"
"dynamicmaps=yes")))
(replace 'install
(lambda* (#:key outputs #:allow-other-keys)
(let ((out (assoc-ref outputs "out")))
(invoke "make" "non-interactive-package")
(delete-file-recursively "wip-prefix/var")
(copy-recursively "wip-prefix/etc" (string-append out "/etc"))
(copy-recursively (string-append "wip-prefix" out) out)))))))
(inputs
(list bdb
cyrus-sasl
libnsl
openssl
perl))
(native-inputs
(list m4))
(home-page "https://www.postfix.org")
(synopsis "sendmail compatible MTA")
(description
"Postfix is Wietse Venema's mail server that started life at IBM research
as an alternative to the widely-used Sendmail program. Now at Google, Wietse
continues to support Postfix.
Postfix attempts to be fast, easy to administer, and secure. The outside has a
definite Sendmail-ish flavor, but the inside is completely different.")
(license (list license:ibmpl1.0
license:epl2.0))))
(define-public mailutils-sendmail
(package
(inherit mailutils)
(name "mailutils-sendmail")
(arguments
(substitute-keyword-arguments (package-arguments mailutils)
((#:configure-flags flags)
#~(append '("CFLAGS=-DPATH_SENDMAIL=\\\"/run/setuid-programs/sendmail\\\"") #$flags))))))
(define-public python-pytest-tornado5
(package
(name "python-pytest-tornado5")
(version "2.0.0")
(source
(origin
(method url-fetch)
(uri
(pypi-uri "pytest-tornado5" version))
(sha256
(base32 "0qb62jw2w0xr6y942yp0qxiy755bismjfpnxaxjjm05gy2pymr8d"))))
(build-system python-build-system)
(propagated-inputs (list python-pytest python-tornado))
(home-page "https://github.com/vidartf/pytest-tornado")
(synopsis
"A py.test plugin providing fixtures and markers to simplify testing of asynchronous tornado applications.")
(description
"This package provides a py.test plugin providing fixtures and markers to
simplify testing of asynchronous tornado applications.")
(license license:asl2.0)))
;; FIXME
#;
(define-public python-futures
(package
(name "python-futures")
(version "3.3.0")
(source
(origin
(method url-fetch)
(uri
(pypi-uri "futures" version))
(sha256
(base32 "154pvaybk9ncyb1wpcnzgd7ayvvhhzk92ynsas7gadaydbvkl0vy"))))
(build-system python-build-system)
(home-page "https://github.com/agronholm/pythonfutures")
(synopsis "Backport of the concurrent.futures package from Python 3")
(description "Backport of the concurrent.futures package from Python 3")
(license #f)))
(define-public python-ordereddict
(package
(name "python-ordereddict")
(version "1.1")
(source
(origin
(method url-fetch)
(uri
(pypi-uri "ordereddict" version))
(sha256
(base32 "07qvy11nvgxpzarrni3wrww3vpc9yafgi2bch4j2vvvc42nb8d8w"))))
(build-system python-build-system)
(arguments
`(#:phases
(modify-phases %standard-phases
(delete 'sanity-check))))
(home-page "UNKNOWN")
(synopsis
"A drop-in substitute for Py2.7's new collections.OrderedDict that works in Python 2.4-2.6.")
(description "This package provides a drop-in substitute for Py2.7's new
collections.OrderedDict that works in Python 2.4-2.6.")
(license #f)))
(define-public python-funcsigs
(package
(name "python-funcsigs")
(version "1.0.2")
(source
(origin
(method url-fetch)
(uri
(pypi-uri "funcsigs" version))
(sha256
(base32 "0l4g5818ffyfmfs1a924811azhjj8ax9xd1cffr1mzd3ycn0zfx7"))))
(build-system python-build-system)
(propagated-inputs
(list python-ordereddict))
(native-inputs
(list python-unittest2))
(home-page "http://funcsigs.readthedocs.org")
(synopsis
"Python function signatures from PEP362 for Python 2.6, 2.7 and 3.2+")
(description
"Python function signatures from PEP362 for Python 2.6, 2.7 and 3.2+")
(license #f)))
(define-public python-apscheduler
(package
(name "python-apscheduler")
(version "3.9.1")
(source
(origin
(method url-fetch)
(uri
(pypi-uri "APScheduler" version))
(sha256
(base32 "1qzi1pr7q72vs49p7vr1mp350zaggs52lpq43lvqsjcmcd5mgrk5"))))
(build-system python-build-system)
(arguments
`(#:tests? #f))
(propagated-inputs
(list python-funcsigs
; python-futures
python-pytz
python-setuptools
python-six
python-tzlocal))
(native-inputs
(list python-mock
python-pytest
python-pytest-asyncio
python-pytest-cov
python-pytest-tornado5
python-setuptools-scm))
(home-page "https://github.com/agronholm/apscheduler")
(synopsis "In-process task scheduler with Cron-like capabilities")
(description "In-process task scheduler with Cron-like capabilities")
(license license:expat)))
(define-public python-telegram-bot
(package
(name "python-telegram-bot")
(version "13.12")
(source
(origin
(method url-fetch)
(uri
(pypi-uri "python-telegram-bot" version))
(sha256
(base32 "1rbdyr1f9mndlh83in47k8if65yp9n1dy4px2wipbf0qyjv5zxfs"))))
(build-system python-build-system)
(arguments
`(#:tests? #f
#:phases
(modify-phases %standard-phases
(delete 'sanity-check))))
(native-inputs
(list python-apscheduler))
(propagated-inputs
(list python-apscheduler
python-cachetools
python-certifi
python-pytz
python-tornado))
(home-page "https://python-telegram-bot.org/")
(synopsis "Python library to interface with the Telegram Bot API")
(description "We have made you a wrapper you can't refuse")
(license #f)))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;; services ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-record-type* <shadow-group-configuration>
shadow-group-configuration
make-shadow-group-configuration
shadow-group-configuration?
(group shadow-group-configuration-group (default "etc-shadow")))
(define (shadow-group-activation config)
(match-record config <shadow-group-configuration>
(group)
#~(begin
(use-modules (guix build utils))
(format (current-error-port)
"Setting ownership and permission for \"/etc/shadow\".~%")
(chown "/etc/shadow"
(passwd:uid (getpwnam "root"))
(group:gid (getgrnam #$group)))
(chmod "/etc/shadow" #o640))))
(define (shadow-group-accounts config)
(match-record config <shadow-group-configuration>
(group)
(list
(user-group
(name group)
(system? #t)))))
(define shadow-group-service-type
(service-type
(name 'shadow-group)
(extensions
(list
(service-extension activation-service-type
shadow-group-activation)
(service-extension account-service-type
shadow-group-accounts)))
(default-value (shadow-group-configuration))
(description "Provide the infrastructure to allow access to the
@file{/etc/shadow} file without requiring superuser privileges, by:
@itemize
@item adding a dedicated group to the system (default: @code{etc-shadow});
@item granting said group @emph{read-only access} to the @file{/etc/shadow}
file.
@end itemize
The goal is to allow unprivileged processes to perform password authentication
against the @file{/etc/passwd} database, by adding the @code{etc-shadow} group
to the list of supplementary groups of the user of such running process.")))
(define-record-type* <cyrus-service-configuration>
cyrus-service-configuration
make-cyrus-service-configuration
cyrus-service-configuration?
(name cyrus-service-configuration-name)
(authmech cyrus-service-configuration-authmech (default "saslauthd"))
(log-level cyrus-service-configuration-log-level (default 7))
(raw-file cyrus-service-configuration-raw-file (default #f)))
(define-record-type* <cyrus-sasl-configuration>
cyrus-sasl-configuration
make-cyrus-sasl-configuration
cyrus-sasl-configuration?
(cyrus-sasl cyrus-sasl-configuration-cyrus-sasl (default cyrus-sasl))
(user cyrus-sasl-configuration-user (default "cyrus-sasl"))
(group cyrus-sasl-configuration-group (default "cyrus-sasl"))
(supplementary-groups cyrus-sasl-configuration-supplementary-groups (default '("etc-shadow")))
(authmech cyrus-sasl-configuration-authmech (default "shadow"))
(services cyrus-sasl-configuration-services (default '()))
(config-dirname cyrus-sasl-configuration-config-dirname (default "sasl2"))
(run-directory cyrus-sasl-configuration-run-directory (default "/var/run/saslauthd"))
(run-in-container? cyrus-sasl-configuration-run-in-container? (default #t))
(container-name cyrus-sasl-configuration-container-name (default "saslauthd"))
(container-namespaces cyrus-sasl-configuration-container-namespaces (default container:%namespaces))
(extra-mappings cyrus-sasl-configuration-extra-mappings (default '())))
(define (cyrus-sasl-etc-files config)
(match-record config <cyrus-sasl-configuration>
(services config-dirname run-directory)
`((,config-dirname
,(file-union
config-dirname
(map (lambda (service-config)
(match-record service-config <cyrus-service-configuration>
(name authmech log-level raw-file)
`(,name ,(plain-file
name
(or raw-file
(format #f
"pwcheck_method: ~a~%saslauthd_path: ~a/mux~%log_level: ~a~%"
authmech
run-directory
log-level))))))
services))))))
(define (cyrus-sasl-activation config)
(match-record config <cyrus-sasl-configuration>
(user run-directory)
#~(begin
(use-modules (guix build utils))
(format (current-error-port)
"Creating Cyrus SASL socket directory: \"~a\".~%" #$run-directory)
(mkdir-p/perms #$run-directory (getpwnam #$user) #o755))))
(define (cyrus-sasl-accounts config)
(match-record config <cyrus-sasl-configuration>
(user group supplementary-groups)
(list
(user-account
(name user)
(group group)
(supplementary-groups supplementary-groups)
(comment "Cyrus SASL system user")
(home-directory "/var/empty")
(create-home-directory? #f)
(shell
(file-append shadow "/sbin/nologin"))
(system? #t))
(user-group
(name group)
(system? #t)))))
(define (cyrus-sasl-shepherd-service config)
(match-record config <cyrus-sasl-configuration>
(cyrus-sasl user group supplementary-groups authmech config-dirname run-directory
services run-in-container? container-name container-namespaces extra-mappings)
(let* ((config-dir (string-append "/etc/" config-dirname))
(bin (file-append cyrus-sasl "/sbin/saslauthd"))
(cmd (if (not run-in-container?)
bin
(least-authority-wrapper
bin
#:name container-name
#:mappings (append
(list
(file-system-mapping
(source run-directory)
(target source)
(writable? #t))
(file-system-mapping
(source "/etc/passwd")
(target source))
(file-system-mapping
(source "/etc/shadow")
(target source)))
extra-mappings)
#:namespaces container-namespaces))))
(list
(shepherd-service
(provision '(cyrus-sasl))
(documentation "FIXME:DOCUMENTATION")
(start #~(make-forkexec-constructor
(list #$cmd "-a" #$authmech "-d" "-m" #$run-directory)
#:user #$user
#:group #$group
#:supplementary-groups '(#$@supplementary-groups)))
(stop #~(make-kill-destructor))
(actions
(list
(shepherd-action
(name 'configuration)
(documentation "FIXME:DOCUMENTATION")
(procedure
#~(lambda _
(format #t "Debug procedure"))
#;(lambda _
(for-each (lambda (name)
(format #t "~a/~a~%" #$config-dir name))
(map cyrus-service-configuration-name #$services))))))))))))
(define cyrus-sasl-service-type
(service-type
(name 'cyrus-sasl)
(extensions
(list
(service-extension etc-service-type
cyrus-sasl-etc-files)
(service-extension activation-service-type
cyrus-sasl-activation)
(service-extension profile-service-type
(compose list cyrus-sasl-configuration-cyrus-sasl))
(service-extension account-service-type
cyrus-sasl-accounts)
(service-extension shepherd-root-service-type
cyrus-sasl-shepherd-service)))
(compose srfi-1:concatenate)
(extend (lambda (config services)
(cyrus-sasl-configuration
(inherit config)
(services
(append
(cyrus-sasl-configuration-services config)
services)))))
(default-value (cyrus-sasl-configuration))
(description "FIXME:DOCUMENTATION")))
(define-record-type* <dkimproxyout-configuration>
dkimproxyout-configuration
make-dkimproxyout-configuration
dkimproxyout-configuration?
(dkimproxy dkimproxyout-configuration-dkimproxy (default dkimproxy))
(user dkimproxyout-configuration-user (default "dkimproxyout"))
(group dkimproxyout-configuration-group (default "dkimproxyout"))
(config-name dkimproxyout-configuration-config-name (default "dkimproxyout.conf"))
(listen dkimproxyout-configuration-listen (default "127.0.0.1:10027"))
(relay dkimproxyout-configuration-relay (default "127.0.0.1:10028"))
(domains dkimproxyout-configuration-domains (default (list (gethostname))))
(selector dkimproxyout-configuration-selector (default "dkimproxyout"))
(key-size dkimproxyout-configuration-key-size (default 2048))
(data-directory dkimproxyout-configuration-data-directory (default "/var/lib/dkimproxyout"))
(run-in-container? dkimproxyout-configuration-run-in-container? (default #f))
(container-name dkimproxyout-configuration-container-name (default "dkimproxyout"))
(container-namespaces dkimproxyout-configuration-container-namespaces (default (srfi-1:fold delq container:%namespaces '(net))))
(extra-mappings dkimproxyout-configuration-extra-mappings (default '())))
(define (generate-out.cf config)
(match-record config <dkimproxyout-configuration>
(listen relay domains selector data-directory)
(format #f
"
listen ~a
relay ~a
domain ~a
selector ~a
signature dkim(c=relaxed/relaxed)
# FIXME:DOCUMENTATION add this to the service documentation
# the corresponding public key is available at:
# ~a/public.key
keyfile ~a/private.key
"
listen
relay
(string-join domains ",")
selector
data-directory
data-directory)))
(define (dkimproxyout-etc-files config)
(match-record config <dkimproxyout-configuration>
(config-name)
`((,config-name ,(plain-file config-name (generate-out.cf config))))))
(define (dkimproxyout-accounts config)
(match-record config <dkimproxyout-configuration>
(user group)
(list
(user-account
(name user)
(group group)
(comment "DKIMproxy.out signing system user")
(home-directory "/var/empty")
(create-home-directory? #f)
(shell
(file-append shadow "/sbin/nologin"))
(system? #t))
(user-group
(name group)
(system? #t)))))
(define (dkimproxyout-activation config)
(match-record config <dkimproxyout-configuration>
(user group data-directory key-size)
#~(begin
(use-modules (guix build utils))
(let* ((user (getpwnam #$user))
(uid (passwd:uid user))
(gid (passwd:gid user)))
(format (current-error-port)
"Creating DKIMproxy.out data directory: \"~a\".~%" #$data-directory)
(mkdir-p/perms #$data-directory user #o755)
(let ((private-key (string-append #$data-directory "/private.key"))
(public-key (string-append #$data-directory "/public.key")))
(unless (file-exists? private-key)
(format (current-error-port)
"The public/private keypair doesn't exist yet. Generating one...~%")
(cond
((zero? (system* #$(file-append openssl "/bin/openssl")
"genrsa"
"-out"
private-key
(number->string #$key-size)))
(format (current-error-port)
"DKIMproxy.out private key file created: \"~a\".~%" private-key))
(else
(format (current-error-port)
"Failed to create DKIMproxy.out private key file: \"~a\".~%" private-key))))
(invoke #$(file-append openssl "/bin/openssl")
"rsa"
"-in"
private-key
"-pubout"
"-out"
public-key)
(format (current-error-port)
"Setting permissions for the public/private DKIMproxy.out keypair: \"~a/{public,private}.key\".~%" #$data-directory)
(chown private-key uid gid)
(chown public-key uid gid)
(chmod private-key #o400)
(chmod public-key #o644))))))
(define (dkimproxyout-shepherd-service config)
(match-record config <dkimproxyout-configuration>
(dkimproxy user group config-name data-directory
run-in-container? container-name container-namespaces extra-mappings)
(let* ((config-file (string-append "/etc/" config-name))
(bin (file-append dkimproxy "/bin/dkimproxy.out"))
(cmd (if (not run-in-container?)
bin
(least-authority-wrapper
bin
#:name container-name
#:mappings (append
(list
(file-system-mapping
(source config-file)
(target source))
(file-system-mapping
(source
(string-append data-directory "/private.key"))
(target source)))
extra-mappings)
#:namespaces container-namespaces))))
(list
(shepherd-service
(provision '(dkimproxyout))
(documentation "FIXME:DOCUMENTATION")
(start #~(make-forkexec-constructor
(list #$cmd "--conf_file" #$config-file)
#:user #$user
#:group #$group))
(stop #~(make-kill-destructor))
(actions
(list
(shepherd-action
(name 'configuration)
(documentation "FIXME:DOCUMENTATION")
(procedure
#~(lambda _
(format #t "~a~%" #$config-file)))))))))))
(define-public dkimproxyout-service-type
(service-type
(name 'dkimproxyout)
(extensions
(list
(service-extension etc-service-type
dkimproxyout-etc-files)
(service-extension account-service-type
dkimproxyout-accounts)
(service-extension activation-service-type
dkimproxyout-activation)
(service-extension profile-service-type
(compose list dkimproxyout-configuration-dkimproxy))
(service-extension shepherd-root-service-type
dkimproxyout-shepherd-service)))
(default-value (dkimproxyout-configuration))
(description "FIXME:DOCUMENTATION")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Postfix ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-record-type* <postfix-configuration>
postfix-configuration
make-postfix-configuration
postfix-configuration?
(postfix postfix-configuration-postfix (default postfix))
(mail-in-home? postfix-configuration-mail-in-home? (default #f))
(set-sendmail? postfix-configuration-set-sendmail? (default #t))
(master.cf-file postfix-configuration-master.cf-file (default #f))
(main.cf-file postfix-configuration-main.cf-file (default #f))
(master.cf-extra postfix-configuration-master.cf-extra (default ""))
(main.cf-extra postfix-configuration-main.cf-extra (default ""))
(config-dirname postfix-configuration-config-dirname (default "postfix"))
(data-directory postfix-configuration-data-directory (default "/var/lib/postfix"))
(queue-directory postfix-configuration-queue-directory (default "/var/spool/postfix"))
(user postfix-configuration-user (default "postfix"))
(group postfix-configuration-group (default "postfix"))
(setgid-group postfix-configuration-setgid-group (default "postdrop"))
(root-aliases postfix-configuration-root-aliases (default '("abuse" "admin" "hostmaster" "postmaster")))
(cert-file postfix-configuration-cert-file (default #f))
(key-file postfix-configuration-key-file (default #f))
(hostname postfix-configuration-hostname (default (gethostname)))
(run-in-container? postfix-configuration-run-in-container? (default #f))
(container-name postfix-configuration-container-name (default "postfix"))
(container-namespaces postfix-configuration-container-namespaces (default (srfi-1:fold delq container:%namespaces '(net))))
(extra-mappings postfix-configuration-extra-mappings (default '())))
; FIXME: hardcoded value of dkimproxy listen and relay
(define (generate-master.cf config)
(match-record config <postfix-configuration>
(master.cf-extra)
(format #f
"
# ============================================================================================================
# service type private unpriv chroot wakeup maxproc command + args
# (yes) (yes) (no) (never) (100)
# =============================================================================================================
anvil unix - - n - 1 anvil
bounce unix - - n - 0 bounce
cleanup unix n - n - 0 cleanup
defer unix - - n - 0 bounce
discard unix - - n - - discard
error unix - - n - - error
flush unix n - n 1000? 0 flush
lmtp unix - - n - - lmtp
local unix - n n - - local
# FIXME: replace 127.0.0.1 with localhost
pickup unix n - n 60 1 pickup
-o content_filter=dksign:[127.0.0.1]:10027
proxymap unix - - n - - proxymap
proxywrite unix - - n - 1 proxymap
qmgr unix n - n 300 1 qmgr
relay unix - - n - - smtp -o syslog_name=postfix/relay
retry unix - - n - - error
rewrite unix - - n - - trivial-rewrite
scache unix - - n - 1 scache
showq unix n - n - - showq
smtp inet n - n - - smtpd -o syslog_name=postfix/smtp
smtp unix - - n - - smtp
submission inet n - n - - smtpd -o syslog_name=postfix/submission
-o smtpd_tls_security_level=encrypt
-o content_filter=dksign:[127.0.0.1]:10027
tlsmgr unix - - n 1000? 1 tlsmgr
trace unix - - n - 0 bounce
verify unix - - n - 1 verify
virtual unix - n n - - virtual
postlog unix-dgram n - n - 1 postlogd
# FIXME: doesn't work for sendmail -t in localhost
dksign unix - - n - - smtp
-o syslog_name=postfix/dkimproxyout-listen
-o smtp_send_xforward_command=yes
-o smtp_discard_ehlo_keywords=8bitmime,starttls
127.0.0.1:10028 inet n - n - - smtpd
-o syslog_name=postfix/dkimproxyout-relay
-o content_filter=
-o receive_override_options=no_unknown_recipient_checks,no_header_body_checks
-o smtpd_helo_restrictions=
-o smtpd_client_restrictions=
-o smtpd_sender_restrictions=
-o smtpd_recipient_restrictions=permit_mynetworks,reject
-o mynetworks=127.0.0.0/8
-o smtpd_authorized_xforward_hosts=127.0.0.0/8
~a
"
master.cf-extra)))
(define (cert-for prefix config)
(match-record config <postfix-configuration>
(cert-file hostname)
(or cert-file (format #f "/etc/letsencrypt/live/~a~a/fullchain.pem" prefix hostname))))
(define (key-for prefix config)
(match-record config <postfix-configuration>
(key-file hostname)
(or key-file (format #f "/etc/letsencrypt/live/~a~a/privkey.pem" prefix hostname))))
(define (generate-main.cf config)
(match-record config <postfix-configuration>
(postfix mail-in-home? queue-directory data-directory user setgid-group hostname main.cf-extra)
(format #f
"
compatibility_level = 3.6
queue_directory = ~a
data_directory = ~a
mail_owner = ~a
setgid_group = ~a
myhostname = ~a
mydestination = $myhostname, $mydomain, localhost.$mydomain, localhost
alias_maps = hash:/etc/aliases
# alias_maps = hash:/etc/aliases, static:andreh
header_checks = regexp:{ { /^Received:.*/ IGNORE }, { /^X-Originating-IP:.*/ IGNORE } }
~a
smtpd_use_tls = yes
smtpd_tls_cert_file = ~a
smtpd_tls_key_file = ~a
smtp_use_tls = $smtpd_use_tls
smtp_tls_cert_file = $smtpd_tls_cert_file
smtp_tls_key_file = $smtpd_tls_key_file
smtp_tls_security_level = may
recipient_delimiter = +
# smtpd_sasl_security_options = FIXME: deny all
smtpd_sasl_tls_security_options = noanonymous
# FIXME: shouldn't this be 'encrypt'?
smtpd_tls_security_level = may
smtpd_tls_auth_only = yes
smtpd_relay_restrictions = $smtpd_recipient_restrictions
smtpd_recipient_restrictions = permit_mynetworks,
permit_sasl_authenticated, reject_unauth_destination
smtpd_sasl_auth_enable = yes
cyrus_sasl_config_path = /etc/sasl2
debug_peer_list = 127.0.0.1
milter_default_action = accept
# smtpd_milters = FIXME
~a
"
queue-directory
data-directory
user
setgid-group
hostname
(if mail-in-home?
"home_mailbox = Mail/Inbox/"
"mail_spool_directory = /var/mail/")
(cert-for "" config)
(key-for "" config)
main.cf-extra)))
(define (postfix-etc-files config)
(match-record config <postfix-configuration>
(master.cf-file main.cf-file config-dirname)
`((,config-dirname
,(file-union
config-dirname
`(("master.cf" ,(plain-file "master.cf" (or master.cf-file (generate-master.cf config))))
("main.cf" ,(plain-file "main.cf" (or main.cf-file (generate-main.cf config))))))))))
(define (postfix-accounts config)
(match-record config <postfix-configuration>
(user group setgid-group)
(list
(user-account
(name user)
(group group)
(comment "Postfix system user")
(home-directory "/var/empty")
(create-home-directory? #f)
(shell
(file-append shadow "/sbin/nologin"))
(system? #t))
(user-group
(name group)
(system? #t))
(user-group
(name setgid-group)
(system? #t)))))
(define (postfix-setuid-programs config)
(match-record config <postfix-configuration>
(postfix setgid-group set-sendmail?)
(append
(list
(setuid-program
(program (file-append postfix "/sbin/postdrop"))
(setuid? #f)
(setgid? #t)
(group setgid-group))
(setuid-program
(program (file-append postfix "/sbin/postqueue"))
(setuid? #f)
(setgid? #t)
(group setgid-group)))
(if set-sendmail?
(list
(setuid-program
(program (file-append postfix "/sbin/sendmail"))
(setuid? #f)
(setgid? #t)
(group setgid-group)))
'()))))
;; FIXME: parameterize /var/mail
(define (postfix-activation config)
(match-record config <postfix-configuration>
(queue-directory)
#~(begin
(use-modules (guix build utils))
(let ((user (getpwnam "root")))
(format (current-error-port)
"Creating Postfix queue directory: \"~a\".~%" #$queue-directory)
(mkdir-p/perms #$queue-directory user #o755)
(format (current-error-port)
"Creating email spool director: \"/var/mail\".~%")
(mkdir-p/perms "/var/mail" user #o755)
(format (current-error-port)
"Updating /etc/aliases: FIXME.~%")
;; FIXME: add -c option
#;
(invoke #$(file-append postfix "/sbin/postalias") "/etc/aliases")))))
(define (postfix-shepherd-service config)
(match-record config <postfix-configuration>
(postfix config-dirname data-directory queue-directory
run-in-container? container-name container-namespaces extra-mappings)
(let* ((config-dir (string-append "/etc/" config-dirname))
(bin (file-append postfix "/sbin/postfix"))
(cmd (if (not run-in-container?)
bin
(least-authority-wrapper
bin
#:name container-name
#:mappings (append
(list
(file-system-mapping
(source data-directory)
(target source)
(writable? #t))
(file-system-mapping
(source queue-directory)
(target source)
(writable? #t)))
extra-mappings)
#:namespaces container-namespaces))))
(list
(shepherd-service
(provision '(postfix))
(documentation
"-
Run the Postfix MTA.
This is the entrypoint for starting the \"master\" process. Then the
\"master\" process itself takes responsability of starting all the
required daemons and commands.")
(start #~(make-forkexec-constructor
(list
#$(file-append postfix "/sbin/postfix")
"-c"
#$config-dir
"start-fg")
#:pid-file "/var/lib/postfix/master.lock"))
(stop #~(make-kill-destructor SIGKILL))
(actions
(list
(shepherd-action
(name 'configuration)
(documentation "FIXME:DOCUMENTATION")
(procedure
#~(lambda _
(format #t "~a/master.cf~%" #$config-dir)
(format #t "~a/main.cf~%" #$config-dir))))
(shepherd-action
(name 'reload)
(documentation
"
Re-read the \"master.cf\" and \"main.cf\" configuration files.
Daemon processes terminate when possible, and when restarted
use the values of the new configuration files.
This live-reload option is usually preferable over a stop/start
cycle, as it incurs in no interruption of the running service.")
(procedure
#~(lambda _
(invoke #$(file-append postfix "/sbin/postfix")
"-c"
#$config-dir
"reload")))))))))))
(define (postfix-aliases config)
(match-record config <postfix-configuration>
(root-aliases)
(map (lambda (alias)
`(,alias "root"))
root-aliases)))
(define (postfix-nginx-locations config)
(match-record config <postfix-configuration>
(hostname)
(list
(nginx-server-configuration
(server-name (list (string-append "mta-sts." hostname)))
(listen '("[::]:443 ssl http2" "443 ssl http2"))
(ssl-certificate (cert-for "mta-sts." config))
(ssl-certificate-key (key-for "mta-sts." config))
(locations
(list
(nginx-location-configuration
(uri "= /.well-known/mta-sts.txt")
(body
(list
(list "alias "
(plain-file
"mta-sts.txt"
(format #f "version: STSv1
mode: enforce
mx: ~a
max_age: 604800
"
hostname))
";"))))))))))
(define (postfix-certificates config)
(match-record config <postfix-configuration>
(hostname)
(list
(certificate-configuration
(domains (list (string-append "mta-sts." hostname)))))))
(define (postfix-sasl-services _config)
(list
(cyrus-service-configuration
(name "smtpd.conf"))))
(define local-postfix-service-extensions
(list
(service-extension etc-service-type
postfix-etc-files)
(service-extension account-service-type
postfix-accounts)
(service-extension setuid-program-service-type
postfix-setuid-programs)
(service-extension activation-service-type
postfix-activation)
(service-extension profile-service-type
(compose list postfix-configuration-postfix))
(service-extension shepherd-root-service-type
postfix-shepherd-service)))
(define local-postfix-service-type
(service-type
(name 'postfix)
(extensions local-postfix-service-extensions)
(default-value (postfix-configuration))
(description
"
Run the Postfix MTA.
This is the top-level system service for Postfix.
It includes:
- populating /etc/postfix/ with read-only configuration files;
- the user and groups used by Postfix when handling email delivery;
- the special setgid binaries for daily usage, such as \"sendmail\";
- the Shepherd service for starting, stopping and *reloading* the
service without restarting it;
- the activation script for creating the required directories and
configuring them with the correct permissions;
- the binaries in the system profile so that one doesn't need to explicilty
include the package when the service is already enabled.
An extension to the log-rotation service isn't included: the default
rottlog configuration already includes /var/log/maillog in its routine,
so it is kept out.
The defaults of <postfix-configuration> provide sane default values for
most things, such as group names, data and queue directories, etc. When
used as-is, it creates a Postfix server that sends email from local users
of the domain provided by \"/etc/hostname\".")))
(define internet-postfix-service-type
(service-type
(name 'postfix)
(extensions
(append
local-postfix-service-extensions
(list
(service-extension mail-aliases-service-type
postfix-aliases)
(service-extension nginx-service-type
postfix-nginx-locations)
(service-extension certbot-service-type
postfix-certificates)
(service-extension cyrus-sasl-service-type
postfix-sasl-services))))
(default-value (postfix-configuration))
(description
"
Run the Postfix MTA.
This is the top-level system service for Postfix.
It includes:
- populating /etc/postfix/ with read-only configuration files;
- the user and groups used by Postfix when handling email delivery;
- the special setgid binaries for daily usage, such as \"sendmail\";
- the Shepherd service for starting, stopping and *reloading* the
service without restarting it;
- the activation script for creating the required directories and
configuring them with the correct permissions;
- the binaries in the system profile so that one doesn't need to explicilty
include the package when the service is already enabled.
An extension to the log-rotation service isn't included: the default
rottlog configuration already includes /var/log/maillog in its routine,
so it is kept out.
The defaults of <postfix-configuration> provide sane default values for
most things, such as group names, data and queue directories, etc. When
used as-is, it creates a Postfix server that sends email from local users
of the domain provided by \"/etc/hostname\".")))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Dovecot ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-record-type* <dovecot2-configuration>
dovecot2-configuration
make-dovecot2-configuration
dovecot2-configuration?
(dovecot2 dovecot2-configuration-dovecot2 (default dovecot))
(mail-in-home? dovecot2-configuration-mail-in-home? (default #f))
(raw-file dovecot2-configuration-raw-file (default #f))
(extra-content dovecot2-configuration-extra-content (default ""))
(config-name dovecot2-configuration-config-name (default "dovecot2.conf"))
(user dovecot2-configuration-user (default "dovecot2"))
(group dovecot2-configuration-group (default "dovecot2"))
(auth-worker-group dovecot2-configuration-auth-worker-group (default "etc-shadow"))
(untrusted-user dovecot2-configuration-untrusted-user (default "dovenull2"))
(untrusted-group dovecot2-configuration-untrusted-group (default "dovenull2"))
(base-dir dovecot2-configuration-base-dir (default "/var/run/dovecot2"))
(state-dir dovecot2-configuration-state-dir (default "/var/lib/dovecot2"))
(hostname dovecot2-configuration-hostname (default (gethostname))))
(define (generate-dovecot-config config)
(match-record config <dovecot2-configuration>
(mail-in-home? user group auth-worker-group untrusted-user
hostname base-dir state-dir extra-content)
(format #f
"
protocols = imap
default_internal_user = ~a
default_internal_group = ~a
default_login_user = ~a
auth_mechanisms = plain login
auth_username_format = %n
passdb {
driver = shadow
}
userdb {
driver = passwd
}
service auth-worker {
group = ~a
}
ssl = required
ssl_cert = </etc/letsencrypt/live/~a/fullchain.pem
ssl_key = </etc/letsencrypt/live/~a/privkey.pem
ssl_dh = <~a/dhparam.pem
base_dir = ~a
state_dir = ~a
verbose_proctitle = yes
mail_location = maildir:~a:INBOX=~a:LAYOUT=fs
# FIXME:
# mail_plugins
namespace inbox {
inbox = yes
mailbox Drafts {
special_use = \\Drafts
auto = subscribe
}
mailbox Sent {
special_use = \\Sent
auto = subscribe
}
mailbox Archive {
special_use = \\Archive
auto = subscribe
}
mailbox Junk {
special_use = \\Junk
auto = subscribe
autoexpunge = 30d
}
mailbox Trash {
special_use = \\Trash
auto = subscribe
}
}
~a
"
user
group
untrusted-user
auth-worker-group
hostname
hostname
state-dir
base-dir
state-dir
(if mail-in-home? "~/Mail" "/var/mail/%u")
(if mail-in-home? "~/Mail/Inbox" "/var/mail/%u")
extra-content)))
(define (dovecot2-etc-files config)
(match-record config <dovecot2-configuration>
(raw-file config-name)
`((,config-name ,(plain-file config-name
(or raw-file
(generate-dovecot-config config)))))))
(define (dovecot2-accounts config)
(match-record config <dovecot2-configuration>
(user group untrusted-user untrusted-group)
(list
(user-account
(name user)
(group group)
(comment "Dovecot system user")
(home-directory "/var/empty")
(create-home-directory? #f)
(shell
(file-append shadow "/sbin/nologin"))
(system? #t))
(user-account
(name untrusted-user)
(group untrusted-group)
(comment "Dovecot user for untrusted logins")
(home-directory "/var/empty")
(create-home-directory? #f)
(shell
(file-append shadow "/sbin/nologin"))
(system? #t))
(user-group
(name group)
(system? #t))
(user-group
(name untrusted-group)
(system? #t)))))
(define (dovecot2-activation config)
(match-record config <dovecot2-configuration>
(base-dir state-dir)
#~(begin
(use-modules (guix build utils))
(let ((user (getpwnam "root")))
(format (current-error-port)
"Creating Dovecot base_dir directory: \"~a\".~%" #$base-dir)
(mkdir-p/perms #$base-dir user #o755)
(let ((dhparam.pem (string-append #$state-dir "/dhparam.pem")))
(mkdir-p/perms #$state-dir user #o755)
(unless (file-exists? dhparam.pem)
(format (current-error-port)
"dhparam.pem file doesn't exist yet. Generating one...~%")
(cond
((zero? (system* (string-append #$openssl "/bin/openssl")
"dhparam" "-out" dhparam.pem "2048"))
(format (current-error-port)
"Dovecot2 dhparam.pem file created: \"~a\".~%" dhparam.pem))
(else
(format (current-error-port)
"Failed to create dhparam.pem file: \"~a\".~%" dhparam.pem)))))))))
(define (dovecot2-shepherd-service config)
(match-record config <dovecot2-configuration>
(dovecot2 config-name)
(let ((config-file (string-append "/etc/" config-name)))
(list
(shepherd-service
(provision '(dovecot2))
(documentation "FIXME:DOCUMENTATION: heredoc syntax")
(start #~(make-forkexec-constructor
(list
#$(file-append dovecot2 "/sbin/dovecot")
"-F"
"-c"
#$config-file)))
(stop #~(make-kill-destructor))
(actions
(list
(shepherd-action
(name 'configuration)
(documentation "FIXME:DOCUMENTATION: heredoc syntax")
(procedure
#~(lambda _
(format #t "~a~%" #$config-file))))
(shepherd-action
(name 'reload)
(documentation "FIXME:DOCUMENTATION: heredoc syntax")
(procedure
#~(lambda _
(invoke #$(file-append dovecot "/bin/doveadm")
"-c"
#$config-file
"reload")))))))))))
(define dovecot2-service-type
(service-type
(name 'dovecot2)
(extensions
(list
(service-extension etc-service-type
dovecot2-etc-files)
(service-extension account-service-type
dovecot2-accounts)
(service-extension activation-service-type
dovecot2-activation)
(service-extension profile-service-type
(compose list dovecot2-configuration-dovecot2))
(service-extension shepherd-root-service-type
dovecot2-shepherd-service)))
(default-value (dovecot2-configuration))
(description "FIXME:DOCUMENTATION: heredoc syntax")))
;; FIXME
;; automate personal server with:
;; - euandreh:git-service-type
;; - euandreh:mail-service-type
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; OS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(list
mailutils-sendmail
postfix
python-telegram-bot)