diff --git a/.guix/modules/tiedote-md-service.scm b/.guix/modules/tiedote-md-service.scm new file mode 100644 index 0000000..eacb4f4 --- /dev/null +++ b/.guix/modules/tiedote-md-service.scm @@ -0,0 +1,142 @@ +(define-module (tiedote-md-service) + #:use-module (gnu services configuration) + #:use-module (gnu services shepherd) + #:use-module (gnu services base) + #:use-module (gnu system shadow) + #:use-module (gnu services) + #:use-module (guix records) + #:use-module (guix gexp) + #:use-module (tiedote-md-package) + #:use-module (gnu packages bash) + #:export (tiedote.md-configuration + tiedote.md-service-type)) + +(define-maybe string) + +(define-configuration/no-serialization tiedote.md-configuration + (email-address + (string) + "Email address to send messages as. Mail to this address must be routed to +the tiedote.md user on this system.") + (sender-name + (string) + "Name to send messages as.") + (remote-url + (string) + "URL of the Git repository to mirror.") + (remote-branch + maybe-string + "Git branch to read messages from.") + (sendmail-path + (string "/run/privileged/bin/sendmail") + "Path to a sendmail compatible mailing executable.") + (webhook-port + (integer 3000) + "Port to listen on for webhook notifications.") + (socket-path + (string "/run/tiedote.md/acid.sock") + "Socket on which tiedote.md should listen on.") + (state-directory + (string "/var/lib/tiedote.md") + "Directory for persistent storage.")) + +(define (tiedote.md-accounts config) + (match-record config + (state-directory) + (list (user-group + (name "tiedote.md") + (system? #t)) + (user-account + (name "tiedote.md") + (system? #t) + (group "tiedote.md") + (comment "Tiedote.md service user") + (home-directory state-directory) + (shell (file-append bash-minimal "/bin/bash")))))) + +(define (make-tiedote.md-server-script config) + (match-record config + (socket-path email-address sender-name webhook-port sendmail-path + remote-branch remote-url state-directory) + (program-file "tiedote.md-server" + #~(begin + ; use utf8 before starting tiedote.md to be able to pass utf characters as arguments + (setlocale LC_ALL "C.UTF-8") + ; use utf8 after exec so that ghc text library doesn't crash from IO + (setenv "LANG" "C.UTF-8") + (let ((tiedote.md #$(file-append tiedote-md "/bin/tiedote.md")) + (repo-path (string-append #$state-directory "/git-repo"))) + (apply execl + `(,tiedote.md + ,tiedote.md + "--address" #$email-address + "--sender-name" #$sender-name + "--sendmail" #$sendmail-path + "--socket" #$socket-path + "server" + "--repository" ,repo-path + "--port" #$(number->string webhook-port) + "--remote-url" #$remote-url + ,@(if #$(maybe-value-set? remote-branch) + (list "--remote-branch" #$remote-branch) + '())))))))) + +(define (tiedote.md-shepherd-service config) + (match-record config + (state-directory socket-path) + (list (shepherd-service + (documentation "A simple mass email system") + (requirement '(networking user-processes)) + (provision '(tiedote.md)) + (start #~(let* ((user (getpw "tiedote.md")) + (uid (passwd:uid user)) + (gid (passwd:gid user)) + (socket-directory (dirname #$socket-path))) + (begin + (mkdir-p socket-directory) + (chown socket-directory uid gid) + (make-forkexec-constructor (list #$(make-tiedote.md-server-script config)) + #:user "tiedote.md" + #:group "tiedote.md" + #:environment-variables + (cons* "GIT_SSL_CAINFO=/etc/ssl/certs/ca-certificates.crt" + (default-environment-variables)) + #:directory #$state-directory)))) + (stop #~(make-kill-destructor)))))) + +(define (tiedote.md-activation config) + (match-record config + (state-directory email-address sender-name sendmail-path socket-path) + (let* ((tiedote.md (file-append tiedote-md "/bin/tiedote.md")) + (receive-exec (list tiedote.md ; file to exec + tiedote.md ; arg $0 + "--address" email-address + "--sender-name" sender-name + "--sendmail" sendmail-path + "--socket" socket-path + "receive")) + (receive-script (program-file "tiedote.md-receive" + #~(begin + (setlocale LC_ALL "C.UTF-8") + (setenv "LANG" "C.UTF-8") + (apply execl '#$receive-exec)))) + (forward-file (mixed-text-file "dot-forward" "|" receive-script))) + #~(let* ((.forward (string-append #$state-directory "/.forward")) + (user (getpw "tiedote.md")) + (uid (passwd:uid user)) + (gid (passwd:gid user))) + (if (file-exists? .forward) + (delete-file .forward)) + ; smtpd does not follow symbolic links and requires .forward files to + ; be owned by the recipient + (copy-file #$forward-file .forward) + (chown .forward uid gid))))) + +(define tiedote.md-service-type + (service-type + (name 'tiedote.md) + (extensions + (list (service-extension account-service-type tiedote.md-accounts) + (service-extension activation-service-type tiedote.md-activation) + (service-extension shepherd-root-service-type tiedote.md-shepherd-service))) + (description "A simple mass email system")))