(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 version-control) #:use-module (gnu packages xml) #:use-module (gnu services certbot) #:use-module (gnu services cgit) #:use-module (gnu services mail) #:use-module (gnu services shepherd) #:use-module (gnu services web) #:use-module (gnu system setuid) #:export ( shadow-group-configuration make-shadow-group-configuration shadow-group-configuration? shadow-group-configuration-group shadow-group-activation shadow-group-accounts shadow-group-service-type cyrus-service-configuration make-cyrus-service-configuration cyrus-service-configuration? cyrus-service-configuration-name cyrus-service-configuration-authmech cyrus-service-configuration-log-level cyrus-service-configuration-raw-file cyrus-sasl-configuration make-cyrus-sasl-configuration cyrus-sasl-configuration? cyrus-sasl-configuration-package cyrus-sasl-configuration-user cyrus-sasl-configuration-group cyrus-sasl-configuration-supplementary-groups cyrus-sasl-configuration-authmech cyrus-sasl-configuration-services cyrus-sasl-configuration-config-dirname cyrus-sasl-configuration-run-directory cyrus-sasl-configuration-run-in-container? cyrus-sasl-configuration-container-name cyrus-sasl-configuration-container-namespaces cyrus-sasl-configuration-extra-mappings cyrus-sasl-etc-files cyrus-sasl-activation cyrus-sasl-accounts cyrus-sasl-shepherd-service cyrus-sasl-service-type dkimproxyout-configuration make-dkimproxyout-configuration dkimproxyout-configuration? dkimproxyout-configuration-package dkimproxyout-configuration-user dkimproxyout-configuration-group dkimproxyout-configuration-supplementary-groups dkimproxyout-configuration-config-name dkimproxyout-configuration-listen dkimproxyout-configuration-relay dkimproxyout-configuration-domains dkimproxyout-configuration-selector dkimproxyout-configuration-key-size dkimproxyout-configuration-data-directory dkimproxyout-configuration-run-in-container? dkimproxyout-configuration-container-name dkimproxyout-configuration-container-namespaces dkimproxyout-configuration-extra-mappings dkimproxyout-etc-files dkimproxyout-accounts dkimproxyout-activation dkimproxyout-shepherd-service dkimproxyout-service-type postfix-configuration make-postfix-configuration postfix-configuration? postfix-configuration-postfix postfix-configuration-mail-in-home? postfix-configuration-enable-submission? 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 dovecot-service-type dovecot-configuration cgit-pre-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 rottlog-mailutils-sendmail (package (inherit rottlog) (name "rottlog-mailutils-sendmail") (inputs (list coreutils mailutils-sendmail)))) (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 make-shadow-group-configuration shadow-group-configuration? (group shadow-group-configuration-group (default "etc-shadow"))) (define (shadow-group-activation config) (match-record config (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 (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 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 make-cyrus-sasl-configuration cyrus-sasl-configuration? (package cyrus-sasl-configuration-package (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 (services config-dirname run-directory) `((,config-dirname ,(file-union config-dirname (map (lambda (service-config) (match-record service-config (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 (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 (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 (package user group supplementary-groups authmech config-dirname run-directory services run-in-container? container-name container-namespaces extra-mappings) (let* ((bin (file-append package "/sbin/saslauthd")) (cmd (if (not run-in-container?) bin (least-authority-wrapper bin #:name container-name #:namespaces container-namespaces #: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))))) (list (shepherd-service (provision '(cyrus-sasl)) (documentation "Run the saslauthd daemon of Cyrus SASL.") (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 "Display the name of all registered configuration files.") (procedure (let ((names (map cyrus-service-configuration-name services))) #~(lambda _ (for-each (lambda (name) (format #t "/etc/~a/~a~%" #$config-dirname name)) '#$names)))))))))))) (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-package)) (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 "Run the @code{saslauthd} daemon from the Cyrus SASL package. Services can extend @code{cyrus-sasl-service-type}, and provide their own list of @code{cyrus-service-configuration} entries to be registered in this service. For the @code{saslauthd} daemon to be able to authenticate using the \"shadow\" @code{authmech}, it needs read access to the @file{/etc/shadow} file. This is accomplished by default by adding the @code{etc-shadow} group to the list of supplementary groups of the running daemon, and by enabling the @code{shadow-group-service-type} service. By default, the daemon runs in a container."))) ;; FIXME: net namespaces only on specific ports 10027 and 10028, and only localhost (define-record-type* dkimproxyout-configuration make-dkimproxyout-configuration dkimproxyout-configuration? (package dkimproxyout-configuration-package (default dkimproxy)) (user dkimproxyout-configuration-user (default "dkimproxyout")) (group dkimproxyout-configuration-group (default "dkimproxyout")) (supplementary-groups dkimproxyout-configuration-supplementary-groups (default '())) (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 '()))) ;; # FIXME:DOCUMENTATION add this to the service documentation ;; # the corresponding public key is available at: ;; # ~a/public.key (define (generate-out.cf config) (match-record config (listen relay domains selector data-directory) (format #f "listen ~a relay ~a domain ~a selector ~a signature dkim(c=relaxed/relaxed) keyfile ~a/private.key " listen relay (string-join domains ",") selector data-directory data-directory))) (define (dkimproxyout-etc-files config) (match-record config (config-name) `((,config-name ,(plain-file config-name (generate-out.cf config)))))) (define (dkimproxyout-accounts config) (match-record config (user group supplementary-groups) (list (user-account (name user) (group group) (supplementary-groups supplementary-groups) (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 (user 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 (package user group supplementary-groups config-name data-directory run-in-container? container-name container-namespaces extra-mappings) (let* ((config-file (string-append "/etc/" config-name)) (bin (file-append package "/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 #:supplementary-groups '(#$@supplementary-groups))) (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-package)) (service-extension shepherd-root-service-type dkimproxyout-shepherd-service))) (default-value (dkimproxyout-configuration)) (description "FIXME:DOCUMENTATION"))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; Postfix ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define-record-type* postfix-configuration make-postfix-configuration postfix-configuration? (postfix postfix-configuration-postfix (default postfix)) (mail-in-home? postfix-configuration-mail-in-home? (default #f)) (enable-submission? postfix-configuration-enable-submission? (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 '()))) (define submission-config " 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") (define dksign-filter " -o content_filter=dksign:[127.0.0.1]:10027") ; FIXME: doesn't work for sendmail -t in localhost (define dksign-config " 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 ") ; FIXME: hardcoded value of dkimproxy listen and relay ; FIXME: replace 127.0.0.1 with localhost (define (generate-master.cf config) (match-record config (enable-submission? 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 pickup unix n - n 60 1 pickup~a proxymap unix - - n - - proxymap proxywrite unix - - n - 1 proxymap qmgr unix n - n 300 1 qmgr relay unix - - n - - smtp 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 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 ~a~a~a" (if enable-submission? dksign-filter "") (if enable-submission? submission-config "") (if enable-submission? dksign-config "") master.cf-extra))) (define (cert-for prefix config) (match-record config (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 (key-file hostname) (or key-file (format #f "/etc/letsencrypt/live/~a~a/privkey.pem" prefix hostname)))) (define (main.cf-internet-extra hostname cert key) ;; FIXME: shouldn't smtpd_tls_security_level be 'encrypt'? ;; smtpd_sasl_security_options = FIXME: deny all ;; smtpd_milters = FIXME (format #f " myhostname = ~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_tls_security_options = noanonymous 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 " hostname cert key)) (define main.cf-local-extra " mynetworks = 127.0.0.0/8 ") #; " sender_dependent_relayhost_maps = hash:/var/lib/private/postfix/relayhosts-maps smtp_sasl_password_maps = hash:/var/lib/private/postfix/sasl-password smtp_sasl_auth_enable = yes smtp_sasl_security_options = noanonymous smtp_tls_security_level = encrypt smtp_tls_note_starttls_offer = yes smtp_use_tls = yes smtp_sender_dependent_authentication = yes smtp_sasl_mechanism_filter = login, plain " ;; postfix -> package (define (generate-main.cf config) (match-record config (postfix mail-in-home? enable-submission? 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 header_checks = regexp:{ { /^Received:.*/ IGNORE }, { /^X-Originating-IP:.*/ IGNORE } } ~a ~a~a" queue-directory data-directory user setgid-group (if mail-in-home? "home_mailbox = Mail/Inbox/" "mail_spool_directory = /var/mail/") main.cf-extra (if enable-submission? (main.cf-internet-extra hostname (cert-for "" config) (key-for "" config)) main.cf-local-extra)))) (define (postfix-etc-files config) (match-record config (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 (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 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 (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) (unless (directory-exists? "/var/mail") (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 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 (root-aliases) (map (lambda (alias) `(,alias "root")) root-aliases))) (define (postfix-nginx-locations config) (match-record config (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 (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 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 (enable-submission? #t))) (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 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* dovecot-configuration make-dovecot-configuration dovecot-configuration? (dovecot dovecot-configuration-dovecot (default dovecot)) (mail-in-home? dovecot-configuration-mail-in-home? (default #f)) (raw-file dovecot-configuration-raw-file (default #f)) (extra-content dovecot-configuration-extra-content (default "")) (config-name dovecot-configuration-config-name (default "dovecot.conf")) (user dovecot-configuration-user (default "dovecot")) (group dovecot-configuration-group (default "dovecot")) (auth-worker-group dovecot-configuration-auth-worker-group (default "etc-shadow")) (untrusted-user dovecot-configuration-untrusted-user (default "dovenull")) (untrusted-group dovecot-configuration-untrusted-group (default "dovenull")) (base-dir dovecot-configuration-base-dir (default "/var/run/dovecot")) (state-dir dovecot-configuration-state-dir (default "/var/lib/dovecot")) (hostname dovecot-configuration-hostname (default (gethostname)))) (define (generate-dovecot-config config) (match-record config (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 = (raw-file config-name) `((,config-name ,(plain-file config-name (or raw-file (generate-dovecot-config config))))))) (define (dovecot-accounts config) (match-record config (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 (dovecot-activation config) (match-record config (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 (dovecot-shepherd-service config) (match-record config (dovecot config-name) (let ((config-file (string-append "/etc/" config-name))) (list (shepherd-service (provision '(dovecot)) (documentation "") (start #~(make-forkexec-constructor (list #$(file-append dovecot "/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 dovecot-service-type (service-type (name 'dovecot) (extensions (list (service-extension etc-service-type dovecot-etc-files) (service-extension account-service-type dovecot-accounts) (service-extension activation-service-type dovecot-activation) (service-extension profile-service-type (compose list dovecot-configuration-dovecot)) (service-extension shepherd-root-service-type dovecot-shepherd-service))) (default-value (dovecot-configuration)) (description ""))) ;; FIXME ;; automate personal server with: ;; - euandreh:git-service-type ;; - euandreh:mail-service-type ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; OS ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; (define cgit-pre-configuration (cgit-configuration (nginx '()) (source-filter (file-append cgit "/lib/cgit/filters/syntax-highlighting.py")) (about-filter (file-append cgit "/lib/cgit/filters/about-formatting.sh")) (virtual-root "/git/") (remove-suffix? #t) (nocache? #t) (enable-commit-graph? #t) (enable-follow-links? #t) (enable-index-links? #t) (enable-index-owner? #f) (enable-log-filecount? #t) (enable-log-linecount? #t) (enable-remote-branches? #t) (enable-subject-links? #t) (snapshots '("tar.gz" "tar.xz")) (root-desc "Patches welcome!") (root-title (string-append (gethostname) " repositories")) (logo "/git/static/cgit.png") (favicon "/git/static/favicon.ico") (css "/git/static/cgit.css") (extra-options '("enable-blame=1" "readme=:README.md" "readme=:README")))) (list mailutils-sendmail rottlog-mailutils-sendmail postfix python-telegram-bot)