Lisää Guix-järjestelmäpalvelu

This commit is contained in:
Saku Laesvuori 2025-04-19 14:03:39 +03:00
parent 4a27b6a66f
commit 611e7f25a8
Signed by: slaesvuo
GPG Key ID: 257D284A2A1D3A32

View File

@ -0,0 +1,113 @@
(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.")
(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 <tiedote.md-configuration>
(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 (tiedote.md-shepherd-service config)
(match-record config <tiedote.md-configuration>
(state-directory socket-path email-address sender-name port sendmail-path
remote-branch remote-url)
(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))
(repo-path (string-append #$state-directory "/git-repo")))
(begin
(mkdir-p socket-directory)
(chown socket-directory uid gid)
(make-forkexec-constructor
`(,#$(file-append tiedote.md "/bin/tiedote.md")
"--address" ,#$email-address
"--sender-name" ,#$sender-name
"--sendmail" ,#$sendmail-path
"--socket" ,#$socket-path
"--repository" ,repo-path
"--port" ,#$(number->string port)
"--remote-url" ,#$remote-url
,@(if #$(maybe-value-set? remote-branch)
(list "--remote-branch" #$remote-branch)
'())
"server")
#:user "tiedote.md"
#:group "tiedote.md"
#:directory #$state-directory))))
(stop #~(make-kill-destructor))))))
(define (tiedote.md-activation config)
(match-record config <tiedote.md-configuration>
(state-directory)
(let* ((receive-exec (list (file-append tiedote.md "/bin/tiedote.md") ; file to exec
(file-append tiedote.md "/bin/tiedote.md") ; arg $0
"--address" email-address
"--sender-name" sender-name
"--sendmail" sendmail-path
"--socket" socket-path))
(receive-script (program-file "tiedote.md-receive"
#~(apply execl #$receive-exec)))
(forward-file (mixed-text-file ".forward" "|" receive-script)))
#~(symlink #$forward-file
(string-append #$state-directory "/.forward")))))
(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")))