(define-module (org euandre packages)
#:use-module ((gnu build linux-container) #:prefix container:)
#:use-module ((guix licenses) #:prefix licenses:)
#:use-module ((guix transformations) #:prefix transformations:)
#:use-module ((ice-9 match) #:prefix m:)
#:use-module ((ice-9 textual-ports) #:prefix textual-ports:)
#:use-module ((org euandre queue) #:prefix q:)
#:use-module ((srfi srfi-1) #:prefix s1:)
#:use-module (gnu)
#:use-module (guix build-system gnu)
#:use-module (guix git-download)
#:use-module (guix least-authority)
#:use-module (guix packages)
#:use-module (guix records)
#:use-module (guix utils)
#:export (<syskeep-configuration>
syskeep-configuration
make-syskeep-configuration
syskeep-configuration?
syskeep-configuration-package
syskeep-configuration-log-file
<transactor-configuration>
transactor-configuration
make-transactor-configuration
transactor-configuration?
transactor-configuration-package
transactor-configuration-user
transactor-configuration-group
transactor-configuration-port
transactor-configuration-log-file
transactor-configuration-data-directory
transactor-configuration-run-in-container?
transactor-configuration-container-name
<git-configuration>
git-configuration
make-git-configuration
git-configuration?
git-configuration-package
git-configuration-user
git-configuration-group
git-configuration-export-all?
git-configuration-base-path
git-configuration-user-path
git-configuration-run-in-container?
git-configuration-container-name
<binder-configuration>
binder-configuration
make-binder-configuration
binder-configuration?
binder-configuration-name
binder-configuration-package
binder-configuration-user
binder-configuration-group
binder-configuration-log-file
binder-configuration-data-directory
binder-configuration-run-directory
binder-configuration-run-in-container?
binder-configuration-container-name
binder-configuration-options
binder-configuration-listen-socket
binder-configuration-upstream-socket
<glaze-configuration>
glaze-configuration
make-glaze-configuration
glaze-configuration?
glaze-configuration-name
glaze-configuration-package
glaze-configuration-user
glaze-configuration-group
glaze-configuration-log-file
glaze-configuration-data-directory
glaze-configuration-run-directory
glaze-configuration-run-in-container?
glaze-configuration-container-name
glaze-configuration-options
glaze-configuration-listen-socket
glaze-configuration-upstream-socket
<hsts-configuration>
hsts-configuration
make-hsts-configuration
hsts-configuration?
hsts-configuration-name
hsts-configuration-package
hsts-configuration-user
hsts-configuration-group
hsts-configuration-log-file
hsts-configuration-data-directory
hsts-configuration-run-directory
hsts-configuration-run-in-container?
hsts-configuration-container-name
hsts-configuration-options
hsts-configuration-listen-socket
hsts-configuration-upstream-socket
<untls-configuration>
untls-configuration
make-untls-configuration
untls-configuration?
untls-configuration-name
untls-configuration-package
untls-configuration-user
untls-configuration-group
untls-configuration-log-file
untls-configuration-data-directory
untls-configuration-run-directory
untls-configuration-run-in-container?
untls-configuration-container-name
untls-configuration-options
untls-configuration-listen-socket
untls-configuration-upstream-socket
<wscat-configuration>
wscat-configuration
make-wscat-configuration
wscat-configuration?
wscat-configuration-name
wscat-configuration-package
wscat-configuration-user
wscat-configuration-group
wscat-configuration-log-file
wscat-configuration-data-directory
wscat-configuration-run-directory
wscat-configuration-run-in-container?
wscat-configuration-container-name
wscat-configuration-options
wscat-configuration-listen-socket
wscat-configuration-upstream-socket
<cicd-configuration>
cicd-configuration
make-cicd-configuration
cicd-configuration?
cicd-configuration-name
cicd-configuration-package
cicd-configuration-user
cicd-configuration-group
cicd-configuration-log-file
cicd-configuration-data-directory
cicd-configuration-run-directory
cicd-configuration-run-in-container?
cicd-configuration-container-name
<papod-configuration>
papod-configuration
make-papod-configuration
papod-configuration?
papod-configuration-name
papod-configuration-package
papod-configuration-user
papod-configuration-group
papod-configuration-log-file
papod-configuration-data-directory
papod-configuration-run-directory
papod-configuration-run-in-container?
papod-configuration-container-name
papod-configuration-options
papod-configuration-listen-socket
papod-configuration-upstream-socket
fmt
str
service-type-for))
(use-package-modules
admin
base
bittorrent
gawk
guile
java
sqlite
texinfo
version-control)
(use-service-modules
admin
mcron
shepherd
sysctl)
(define-public (mklist x)
(if (not x)
'()
(if (pair? x)
x
(list x))))
(define-public (slurp path)
(call-with-input-file
path
textual-ports:get-string-all))
(define-public (str . rest)
(apply string-append rest))
(define-public (fmt . rest)
(apply format #f rest))
(define-public mktorrent-latest
((transformations:options->transformation
'((with-commit . "mktorrent=de7d011b35458de1472665f50b96c9cf6c303f39")))
mktorrent))
(define-public (pkg name version checksum)
(package
(name name)
(version version)
(source
(origin
(method git-fetch)
(uri
(git-reference
(url
(str "git://euandre.org/" name))
(commit version)))
(sha256
(base32 checksum))
(file-name
(git-file-name name version))))
(build-system gnu-build-system)
(arguments
(list
#:strip-binaries? #f
#:make-flags
#~(list
"-e"
(string-append "CC=" #$(cc-for-target))
(string-append "PREFIX=" #$output)
(string-append "VERSION=" #$version))
#:phases
#~(modify-phases %standard-phases
(delete 'configure))))
(synopsis #f) ;; FIXME: get
(description #f) ;; from tarball!
(home-page (str "https://euandre.org/s/" name "/"))
(license licenses:agpl3+)))
(define-public eut
(pkg
"eut"
"ec7e36c2eb4a05c188fd222a1a775ef6f55be6b8"
"1knz14jkx8yc7fv5m2apshfsn3xym55vb78wx3kgq061jy58nxfd"))
(define-public remembering
(pkg
"remembering"
"e1570edd3cdaa040f9664adb315f72e33f8b67c2"
"0y20flrbjh5gbbzl7h3rimg8jwy2ikgkj03yxclj8qg8mq2f9f4a"))
(define-public cage
(pkg
"cage"
"c0482531fc16a55715b759b695d27d555d927ab8"
"1v5m7xqfb14y283mlc2kd714hnih1dwcmjcf4i6j52pphjscilys"))
(define-public nicely
(pkg
"nicely"
"8c963ba56495a382480ab96423df22beb19cb592"
"0c9vqjxlh4gjh09pavs5dscgxcnbii7jp1d8v0jhq3qjz9lf3k2w"))
(define-public q
(pkg
"q"
"d13bcb36bc84de95ebb9e8c27605c09b08c35cc5"
"1jbg9f6dwkkcjxbhc3a1pnaas6xgd1f0hiv95h6hchgs88phwssl"))
(define-public syskeep
(pkg
"syskeep"
"2215cc0999e43b32751bc493f2fe9d2e8c822170"
"0p38fb8m35kjp9fj7bmwcayf9r4638q5fcin18ny7y65scij4jbb"))
(define-public backupit
(pkg
"backupit"
"331f37ba29b1cb317b9bf1984e0efce40b14c03f"
"1zhwp1widxghjimg838fp7mffrsj97a5w22fy0ydr0pzh3rjzs23"))
(define-public cicd
(pkg
"cicd"
"63d46fe31f3ae7b7eed1a2c801448160fe9e77d8"
"00brrbm6s45nqpbw2sigcwjwj2dgyl0rvagmgrgj930y9qv2nn31"))
(define-public guile-heredoc
(package
(inherit
(pkg
"guile-heredoc"
"065435cdce609604e33b879b9be3e81ab89f3e7b"
"179qq17mgi4kakhj9w1dk26afljh5yad4j9ih9d8wms70x6h211m"))
(native-inputs
(list
guile-3.0
texinfo))))
(define-public adoc
(package
(inherit
(pkg
"adoc"
"fab32a816259c943802ffa4c041ac63ac34e646a"
"04sk5bafw2h969v4fl9qzc67m4sjdlrw87xdliv7rny7v9d53zi8"))
(propagated-inputs
(append
(format-inputs (list eut))
(normalize-inputs '(ruby-asciidoctor tidy-html))))))
(define-public eslaides
(pkg
"eslaides"
"40eb0452fd7689d1c40e4d53c1473fd42195cc49"
"0g4qdcfmk8asi1fzr1yk8khpngg9cg21i14xblxfisqsfaq5jycb"))
(define-public mkwb
(package
(inherit
(pkg
"mkwb"
"1c36a265c6b34c28c424eb0bc11ba3b0f9b932d0"
"1w8f3rsncxrb383i7pwg8bxrijvvg7q2l6b0fgjfdv1rs4xzlmqw"))
(propagated-inputs
(format-inputs (list eut adoc eslaides)))))
(define-public (mkwbsite pkg)
(package
(inherit pkg)
(native-inputs
(append
(format-inputs (list mkwb mktorrent-latest))
(normalize-inputs '(gnupg jq rsync po4a gettext ghostscript moreutils))))
(arguments
(substitute-keyword-arguments (package-arguments pkg)
((#:phases phases)
#~(modify-phases #$phases
(add-before 'build 'sethome-ghostscript
(lambda _
(setenv "HOME" (getcwd))))))))))
(define-public euandre.org
(mkwbsite
(pkg
"euandre.org"
"6e493d66649925fccaa351f65ee6cac2dedf264f"
"05isnj2mmwg6k1qd94r3yaycy556f5d7br3f2vdmriqazrgj0grg")))
(define-public papo.im
(mkwbsite
(pkg
"papo.im"
"fa07fa576e07b4cc6b7c9123bd3a6c91e6afc609"
"084w89v15nmr45nv9av8pz7iq99aw3ggaxr0gzqfjbskb3wvvkml")))
(define-public datomic
(let ((p (pkg
"datomic"
"13edba0fa2bd4c3847160809499ce837f52d1264"
"158sqawmbszawa132bhfghzlkhd3b0bicdg5dr93v56vvm4i25kl")))
(package
(inherit p)
(arguments
(substitute-keyword-arguments (package-arguments p)
((#:phases phases)
#~(modify-phases #$phases
(add-after 'install 'wrap-program
(lambda* _
(wrap-program
(string-append #$output "/bin/transactor")
`("PATH" ":" =
(,(string-append #$coreutils "/bin")
,(string-append #$gawk "/bin")
,(string-append #$openjdk23 "/bin")
,(string-append #$sed "/bin")
,(string-append #$sqlite-next "/bin")))))))))))))
(define-public (format-inputs l)
(map (lambda (p)
(list (package-name p)
p
"out"))
l))
(define-public (normalize-inputs l)
(map (compose (lambda (l)
(cons (package-name (car l))
l))
list
specification->package+output
symbol->string)
l))
(define-public (gopkgbs name inputs version checksum)
(let ((p (pkg name version checksum)))
(package
(inherit p)
(arguments
(substitute-keyword-arguments (package-arguments p)
((#:phases phases)
#~(modify-phases #$phases
(add-before 'build 'setenv-golang
(lambda _
(define (path->flags option)
(let ((search-path (getenv "GOLIBPACKPATH")))
(string-join
(map (lambda (path)
(string-append option " " path))
(if search-path
(string-split search-path #\:)
'()))
" ")))
(setenv "GOCFLAGS" (path->flags "-I"))
(setenv "GOLDFLAGS" (path->flags "-L"))))))))
(native-inputs
(append
(format-inputs
(list
eut
q:gol))
(normalize-inputs
'(gettext
po4a
ruby-asciidoctor))
inputs))
(native-search-paths
(list
(search-path-specification
(variable "GOLIBPACKPATH")
(files
(list "lib/go"))))))))
(define-public gotext
(gopkgbs
"gotext"
(format-inputs (list))
"25af4baaab8db74ba809c863e93dd56e6ffb23ed"
"1cwh5fc45dii6mpg4fr6a3fdqy37ib63ax8srfhr9jwzw6majha2"))
(define-public uuid
(gopkgbs
"uuid"
(format-inputs (list gotext))
"8cba50466b837d2f4149ca22d6645f6d6127c63a"
"139d8vwd9l6hha2cc5skhh799c5b0n1l0dkp8r8m6nisla8bpals"))
(define-public gobang
(gopkgbs
"gobang"
(format-inputs (list gotext uuid))
"79011564903bd53bb036dea4c1f0745e40efb73c"
"1rjnvz2wznkxcdhdf0h6mvza2wj2hpirb4vzjxs49g7mfhsp394h"))
(define-public (gopkg name inputs version checksum)
(gopkgbs
name
(append inputs (format-inputs (list gotext uuid gobang)))
version
checksum))
(define-public pds
(gopkg
"pds"
(format-inputs (list))
"aa855d0dc1c62094d0fbf750f60b5b9f776b47d2"
"0k10pqqz0pmd4w7lq4qnwr96fl3vhi3c0b4f41knwaslr2lv17xl"))
(define-public urubu
(gopkg
"urubu"
(format-inputs (list))
"b2351328e54d4793d6691382079a9895dc84696d"
"1aqrg165qsi0pfihjqndjzqrdd4ipjydjm71rzccz34xf7k7m3ch"))
(define-public stm
(gopkg
"stm"
(format-inputs (list pds))
"cb89a691031acd7beac798a74d174b572b22319e"
"1ld84nchnbh7g1dcjw2hvzpqwlpa450rs3i3i0x918911264wcv9"))
(define-public scrypt
(gopkg
"scrypt"
(format-inputs (list q:scryptkdf))
"6071b32e9a6ab214a18c7ef7ffe59c0d6d68e9ca"
"0iv4lalmrn3hb71wzrgqgji72f4dwklbaphj3h8nj6lr1zpjzvyq"))
(define-public golite
(gopkg
"golite"
(format-inputs (list q:sqlitex))
"170dfdf2783c8c2431861f77193c92f40860ea07"
"13y9vzxhr8jn7px2sgfgjapykr258q12ckf458qi0rkcma1vsz59"))
(define-public fiinha
(gopkg
"fiinha"
(format-inputs (list q:sqlitex golite))
"24fafda1fe9e962c8e508220c7023dabd5407e4a"
"1h4ig562flpqsxi52h04npj0nm6038chby8nd2lb8vj1nhiq77al"))
(define-public cracha
(gopkg
"cracha"
(format-inputs (list q:sqlitex golite q:scryptkdf scrypt fiinha))
"84865499aa10aa42c8b9ac06325a05dd8354f458"
"0hsnw1rng4ccdmgp4vfgn8jnyp05mqs5z7qvw7micia07li73m70"))
(define-public binder
(gopkg
"binder"
(normalize-inputs '(socat lsof))
"a45f1e444f6f053635315c8f6fad6ad465f8b0dc"
"0vwmhb76cw499751228jkd6057bj57wkg1jlwal13mm4x0453mjv"))
(define-public glaze
(gopkg
"glaze"
(format-inputs (list))
"24e540da26aad0fb6fc6a8845b1cf83757b15dd0"
"0idyds5wh9rzav7n8q64gwhlsjrzh0kgwp98rwq5rkrc08dqv3sb"))
(define-public hsts
(gopkg
"hsts"
(format-inputs (list))
"783845f84860968dd5e0f971fea42045c8b8e58c"
"0c17x9mdka213fkkccxff1wld38qhpfr8gs2h3kzg0s8wnnfvn42"))
(define-public untls
(gopkg
"untls"
(format-inputs (list))
"b66067d503bac4cfeda83331e045d9c79d8b43c1"
"09pmvaw6rslvasaa6k598aki6c01anfgazzzkcggisdj775wl6in"))
(define-public wscat
(gopkg
"wscat"
(format-inputs (list))
"9cc15130935dfaa6b58231ec708a2c71e54c3968"
"1z85p3v40368jyphip067rlx1m1gpmbvh5d4rjvx1lz81ncpsyf8"))
(define-public gistatic
(gopkg
"gistatic"
(format-inputs (list))
"1eec478135876b7f325c507d1284aa5782bad09d"
"1hsdqaszkr52cy80yid5i7r7fa4crc7qkpd5mglzbd9v4v2sispy"))
(define-public chat.papo.im
(package
(inherit
(pkg
"chat.papo.im"
"f9c959b2d8e36460395a425a51d480fac635c5ec"
"0h2y0kdfzpsgi64zi7brnj1p0dqz0fx4ksvy57wakr7pvv6rpf64"))
(native-inputs
(normalize-inputs '(node)))))
(define-public papod
(gopkg
"papod"
(format-inputs
(list stm pds golite q:sqlitex scrypt q:scryptkdf fiinha cracha))
"3da803b0ff65cf2af71b810ec8fbd28307280d79"
"1ppg1hg9qlkxg7mzsca0j3wdml5773s2x2h8d1j25hk7cg8kqiaj"))
(define-public (user-accounts users)
(map (lambda (user)
(let ((name (s1:first user))
(comment (s1:second user))
(groups (s1:third user)))
(user-account
(name name)
(comment comment)
(group "users")
(supplementary-groups groups))))
users))
(define-public (users->keys users)
(let ((users-with-keys (filter (compose not null? cdddr)
users)))
(append
(map (lambda (user)
(let ((name (s1:first user))
(key (s1:fourth user)))
`(,name ,(plain-file (str name "-id_rsa.pub")
(slurp key)))))
users-with-keys)
`(("git" ,@(map (lambda (user)
(let ((name (s1:first user))
(key (s1:fourth user)))
(plain-file (str name "-git-id_rsa.pub")
(slurp key))))
users-with-keys))))))
(define (tuple->entry tuple)
(let* ((name (s1:first tuple))
(package (s1:second tuple))
(path (str "/etc/" name)))
(list
name
(computed-file
(str "syskeep-" name)
#~(begin
(use-modules
((ice-9 textual-ports) #:prefix textual-ports:))
(define (slurp p)
(call-with-input-file p textual-ports:get-string-all))
(define (spit p s)
(call-with-output-file
p
(lambda (port)
(display s port))))
(spit #$output
(slurp #$(file-append package path))))))))
(define (etc-entries package paths)
(let ((tuples (map (lambda (path)
(list path package))
paths)))
(map tuple->entry tuples)))
(define-public (package-set symbols records)
(append
%base-packages
records
(map
(compose list specification->package+output symbol->string)
symbols)))
(define-public skeletons
(etc-entries
syskeep
'(".profile")))
(define-public base-services
(append
(list
#;
(service fail2ban-service-type))
%base-services))
(define-public (activation-gexp name user log-file data-directory run-directory)
#~(begin
(use-modules (guix build utils))
(when #$log-file
(format (current-error-port)
"Creating ~a log directory for \"~a\".~%" #$name #$log-file)
(mkdir-p (dirname #$log-file))
(when (not (file-exists? #$log-file))
(call-with-output-file #$log-file (const #t)))
(chmod #$log-file #o644))
(let ((user (getpwnam #$user)))
(when #$data-directory
(format (current-error-port)
"Creating ~a data directory \"~a\".~%" #$name #$data-directory)
(mkdir-p #$data-directory)
(chown #$data-directory (passwd:uid user) (passwd:gid user))
(chmod #$data-directory #o750))
(when #$run-directory
(format (current-error-port)
"Creating ~a run directory \"~a\".~%" #$name #$run-directory)
(mkdir-p #$run-directory)
(chown #$run-directory (passwd:uid user) (passwd:gid user))
(chmod #$run-directory #o755)))))
(define-record-type* <syskeep-configuration>
syskeep-configuration
make-syskeep-configuration
syskeep-configuration?
(package syskeep-configuration-package (default syskeep))
(tld syskeep-configuration-tld (default #f))
(secrets-user syskeep-configuration-secrets-user (default "secrets-keeper"))
(secrets-group syskeep-configuration-secrets-group (default "secrets-keeper"))
(become-secrets-group syskeep-configuration-become-secrets-group (default "become-secrets-keeper"))
(log-file syskeep-configuration-log-file (default "/var/log/cronjobs/cronjobs.log")))
(define (syskeep-profile config)
(match-record config <syskeep-configuration>
(package)
(package-set
'(parted
glibc-locales
guile-heredoc
acl
bind:utils
knot:tools
certbot
jq
file
git
lsof
moreutils
mailutils-sendmail
curl
make
borg
pv
rsync
sqlite
strace
rlwrap
trash-cli
tree)
(list
uuid
backupit
eut
nicely
package))))
(define (syskeep-rotations config)
(match-record config <syskeep-configuration>
(log-file)
(list
#;
(log-rotation
(frequency 'weekly)
(files (list log-file))
(options '("rotate 52"))))))
(define (syskeep-cronjobs config)
(match-record config <syskeep-configuration>
()
(list
#~(job "0 0 * * *" "cronjob env BORG_REPO=/mnt/backup/borg backupit -q -t cron")
#~(job "0 1 * * *" "cronjob backupit -q -t cron")
#~(job "0 2 * * *" "cronjob reconfigure")
#~(job "0 3 * * 0" "cronjob gc")
#~(job "0 4 * * *" "cronjob guix pull -v3")
#~(job "0 5 * * 0" "cronjob reconfigure")
#~(job "0 5 * * *" "cronjob check"))))
(define (syskeep-etc-files config)
(match-record config <syskeep-configuration>
(package)
(etc-entries
package
'("rc.sh"
"backupit.txt"
"ssh.conf"
"init.scm"
"gitconfig"))))
(define (syskeep-accounts config)
(match-record config <syskeep-configuration>
(secrets-user secrets-group become-secrets-group)
(list
(user-account
(name secrets-user)
(group secrets-group)
(system? #t)
(comment "System account used to manage production secrets")
(home-directory "/var/empty")
(create-home-directory? #f)
(shell
(file-append shadow "/sbin/nologin")))
(user-group
(name secrets-group)
(system? #t))
(user-group
(name become-secrets-group)
(system? #t)))))
(define (syskeep-activation config)
(match-record config <syskeep-configuration>
(tld log-file)
(let ((privkey-path (fmt "../../opt/secrets/root@~a.id_rsa.txt" tld)))
#~(begin
#$(activation-gexp "syskeep" "root" log-file #f #f)
(define (dir target)
(format (current-error-port)
"Creating directory: \"~a\".~%" target)
(mkdir-p target))
(define (link from to)
(format (current-error-port)
"Symlink: \"~a\" -> \"~a\".~%" to from)
(when (file-exists? to)
(delete-file to))
(symlink from to))
(dir "/var/crash")
(chmod "/var/crash" #o777)
(link "mnt/production/opt" "/opt")
(link "mnt/production/srv" "/srv")
(link "../mnt/production/mail" "/var/mail")
(dir "/root/.ssh")
(link #$privkey-path "/root/.ssh/id_rsa")
(link "../../etc/ssh.conf" "/root/.ssh/config")
(link "../../etc/id_rsa.pub" "/root/.ssh/id_rsa.pub")
(link "../../etc/known_hosts" "/root/.ssh/known_hosts")))))
(define-public (syskeep-sysctl _config)
'(("kernel/core_pattern" . "/var/crash/core-%t-%e-%p-%s-%u-%g")))
(define-public syskeep-sudoers-file
(plain-file "sudoers-syskeep" "\
root ALL=(ALL) ALL
%wheel ALL= ALL
%wheel ALL= NOPASSWD: /run/current-system/profile/bin/reconfigure, /run/current-system/profile/bin/herd, /run/current-system/profile/bin/repo
%become-secrets-keeper ALL=(secrets-keeper) NOPASSWD: /run/current-system/profile/bin/rsync, /run/current-system/profile/bin/setfacl, /run/current-system/profile/bin/rm
%git ALL=(cicd) NOPASSWD: /run/current-system/profile/bin/cicd
"))
(define-public syskeep-service-type
(service-type
(name 'syskeep)
(extensions
(list
(service-extension log-rotation-service-type
syskeep-rotations)
(service-extension mcron-service-type
syskeep-cronjobs)
(service-extension etc-service-type
syskeep-etc-files)
(service-extension account-service-type
syskeep-accounts)
(service-extension activation-service-type
syskeep-activation)
(service-extension sysctl-service-type
syskeep-sysctl)
(service-extension profile-service-type
syskeep-profile)))
(default-value (syskeep-configuration))
(description "Common configuration of maintained servers.")))
(define-record-type* <transactor-configuration>
transactor-configuration
make-transactor-configuration
transactor-configuration?
(package transactor-configuration-package (default datomic))
(user transactor-configuration-user (default "transactor"))
(group transactor-configuration-group (default "peer"))
(port transactor-configuration-port (default 50200))
(log-file transactor-configuration-log-file (default "/var/log/transactor/transactor.log"))
(base-directory transactor-configuration-data-directory (default "/var/lib/transactor"))
(run-in-container? transactor-configuration-run-in-container? (default #t))
(container-name transactor-configuration-container-name (default "datomic-container")))
(define-public (transactor-command config)
(match-record config <transactor-configuration>
(package user group base-directory run-in-container? container-name)
(let ((bin (file-append package "/bin/transactor")))
(if (not run-in-container?)
bin
(least-authority-wrapper
bin
#:user user
#:group group
#:directory base-directory
#:name container-name
#:namespaces (s1:fold delq container:%namespaces '(net))
#:preserved-environment-variables
'()
#:mappings
(list
(file-system-mapping
(source base-directory)
(target source)
(writable? #t))))))))
(define-public (transactor-shepherd-services config)
(match-record config <transactor-configuration>
(port user group log-file base-directory)
(list
(shepherd-service
(provision '(transactor))
(requirement '())
(start
#~(make-forkexec-constructor
(list #$(transactor-command config)
"-p" (number->string #$port)
(string-append #$base-directory "/data/storage.db"))
#:user #$user
#:group #$group
#:log-file #$log-file
#:directory #$base-directory))
(stop #~(make-kill-destructor))
(documentation "Daemon transactor process.")))))
(define-public (transactor-activation config)
(match-record config <transactor-configuration>
(user log-file base-directory)
#~(begin
(use-modules
(guix build utils))
(format
(current-error-port)
"Creating Transactor data directories under: \"~a\".~%"
#$base-directory)
(mkdir-p/perms (string-append #$base-directory "/data")
(getpwnam #$user)
#o750)
(mkdir-p/perms (string-append #$base-directory "/backup")
(getpwnam #$user)
#o750)
(format
(current-error-port)
"Creating Transactor log directory for \"~a\".~%"
#$log-file)
(mkdir-p (dirname #$log-file))
(when (not (file-exists? #$log-file))
(call-with-output-file #$log-file (const #t)))
(chmod #$log-file #o644))))
(define-public (transactor-accounts config)
(match-record config <transactor-configuration>
(user group)
(list
(user-account
(name user)
(group group)
(comment "Datomic transactor system user")
(create-home-directory? #f)
(shell
(file-append shadow "/sbin/nologin"))
(system? #t))
(user-group
(name group)
(system? #t)))))
(define (transactor-cronjobs config)
(match-record config <transactor-configuration>
(base-directory)
(let ((from (string-append base-directory "/data/storage.db"))
(to (string-append base-directory "/backup")))
(list
#~(job "0 23 * * *" (format #f "cronjob datomic backup ~a ~a" #$from #$to))
#~(job "0 6 * * *" (format #f "cronjob datomic gc ~a" #$from))))))
(define-public transactor-service-type
(service-type
(name 'transactor)
(extensions
(list
(service-extension shepherd-root-service-type
transactor-shepherd-services)
(service-extension activation-service-type
transactor-activation)
(service-extension account-service-type
transactor-accounts)
(service-extension mcron-service-type
transactor-cronjobs)
(service-extension profile-service-type
(compose list transactor-configuration-package))))
(default-value (transactor-configuration))
(description "Transactor service.")))
(define-record-type* <git-configuration>
git-configuration
make-git-configuration
git-configuration?
(package git-configuration-package (default git))
(user git-configuration-user (default "git"))
(group git-configuration-group (default "git"))
(export-all? git-configuration-export-all? (default #f))
(base-path git-configuration-base-path (default "/srv/git"))
(user-path git-configuration-user-path (default #f))
(run-in-container? git-configuration-run-in-container? (default #f))
(container-name git-configuration-container-name (default "git-container"))
(run-server? git-configuration-run-server? (default #f)))
(define-public (git-command config)
(match-record config <git-configuration>
(package user group base-path run-in-container? container-name)
(let ((bin (file-append package "/bin/git")))
(if (not run-in-container?)
bin
(least-authority-wrapper
bin
#:user user
#:group group
#:name container-name
#:directory base-path
#:preserved-environment-variables
'()
#:mappings
(list
(file-system-mapping
(source base-path)
(target source)
(writable? #t))))))))
(define-public (git-shepherd-services config)
(match-record config <git-configuration>
(user group export-all? base-path user-path run-server?)
(if (not run-server?)
(list)
(list
(shepherd-service
(provision '(git))
(requirement '(networking))
(start
#~(make-forkexec-constructor
(list #$(git-command config)
"daemon" "--syslog" "--reuseaddr"
#$@(mklist (and export-all? "--export-all"))
#$@(mklist (and base-path (str "--base-path=" base-path)))
#$@(mklist (and user-path (str "--user-path=" user-path))))
#:user #$user
#:group #$group))
(documentation "Daemon process of the git:// protocol."))))))
(define-public (git-accounts config)
(match-record config <git-configuration>
(user group base-path)
(list
(user-account
(name user)
(group group)
(system? #t)
(comment "External SSH Git service user")
(home-directory base-path)
(create-home-directory? #f))
(user-group
(name group)
(system? #t)))))
(define-public git-service-type
(service-type
(name 'git)
(extensions
(list
(service-extension shepherd-root-service-type
git-shepherd-services)
(service-extension account-service-type
git-accounts)
(service-extension profile-service-type
(compose list git-configuration-package))))
(default-value (git-configuration))
(description "Better git:// service.")))
(define-record-type* <binder-configuration>
binder-configuration
make-binder-configuration
binder-configuration?
(name binder-configuration-name (default "binder"))
(package binder-configuration-package (default binder))
(user binder-configuration-user (default "binder"))
(group binder-configuration-group (default "binder"))
(log-file binder-configuration-log-file (default "/var/log/binder/binder.log"))
(data-directory binder-configuration-data-directory (default #f))
(run-directory binder-configuration-run-directory (default "/var/run/binder"))
(run-in-container? binder-configuration-run-in-container? (default #t))
(container-name binder-configuration-container-name (default "binder-container"))
(options binder-configuration-options (default '()))
(listen-socket binder-configuration-listen-socket (default "0.0.0.0:4443"))
(upstream-socket binder-configuration-upstream-socket (default "/var/run/untls/untls.socket")))
(define-record-type* <glaze-configuration>
glaze-configuration
make-glaze-configuration
glaze-configuration?
(name glaze-configuration-name (default "glaze"))
(package glaze-configuration-package (default glaze))
(user glaze-configuration-user (default "glaze"))
(group glaze-configuration-group (default "glaze"))
(log-file glaze-configuration-log-file (default "/var/log/glaze/glaze.log"))
(data-directory glaze-configuration-data-directory (default "/var/lib/glaze"))
(run-directory glaze-configuration-run-directory (default "/var/run/glaze"))
(run-in-container? glaze-configuration-run-in-container? (default #t))
(container-name glaze-configuration-container-name (default "glaze-container"))
(options glaze-configuration-options (default '()))
(listen-socket glaze-configuration-listen-socket (default "/var/run/glaze/glaze.socket"))
(upstream-socket glaze-configuration-upstream-socket (default #f)))
(define-record-type* <hsts-configuration>
hsts-configuration
make-hsts-configuration
hsts-configuration?
(name hsts-configuration-name (default "hsts"))
(package hsts-configuration-package (default hsts))
(user hsts-configuration-user (default "hsts"))
(group hsts-configuration-group (default "hsts"))
(log-file hsts-configuration-log-file (default "/var/log/hsts/hsts.log"))
(data-directory hsts-configuration-data-directory (default #f))
(run-directory hsts-configuration-run-directory (default "/var/run/hsts"))
(run-in-container? hsts-configuration-run-in-container? (default #t))
(container-name hsts-configuration-container-name (default "hsts-container"))
(options hsts-configuration-options (default '()))
(listen-socket hsts-configuration-listen-socket (default "/var/run/hsts/hsts.socket"))
(upstream-socket hsts-configuration-upstream-socket (default #f)))
(define-record-type* <untls-configuration>
untls-configuration
make-untls-configuration
untls-configuration?
(name untls-configuration-name (default "untls"))
(package untls-configuration-package (default untls))
(user untls-configuration-user (default "untls"))
(group untls-configuration-group (default "untls"))
(log-file untls-configuration-log-file (default "/var/log/untls/untls.log"))
(data-directory untls-configuration-data-directory (default #f))
(run-directory untls-configuration-run-directory (default "/var/run/untls"))
(run-in-container? untls-configuration-run-in-container? (default #t))
(container-name untls-configuration-container-name (default "untls-container"))
(options untls-configuration-options (default '()))
(listen-socket untls-configuration-listen-socket (default "/var/run/untls/untls.socket"))
(upstream-socket untls-configuration-upstream-socket (default #f)))
(define-record-type* <wscat-configuration>
wscat-configuration
make-wscat-configuration
wscat-configuration?
(name wscat-configuration-name (default "wscat"))
(package wscat-configuration-package (default wscat))
(user wscat-configuration-user (default "wscat"))
(group wscat-configuration-group (default "wscat"))
(log-file wscat-configuration-log-file (default "/var/log/wscat/wscat.log"))
(data-directory wscat-configuration-data-directory (default #f))
(run-directory wscat-configuration-run-directory (default "/var/run/wscat"))
(run-in-container? wscat-configuration-run-in-container? (default #t))
(container-name wscat-configuration-container-name (default "wscat-container"))
(options wscat-configuration-options (default '()))
(listen-socket wscat-configuration-listen-socket (default "/var/run/wscat/wscat.socket"))
(upstream-socket wscat-configuration-upstream-socket (default "/var/run/papod/papod.socket")))
(define-public (profile-for config-type)
(lambda (config)
(m:match config
(($ config-type _name package)
(list package)))))
(define-public (rotations-for config-type)
(lambda (config)
(m:match config
(($ config-type _name _package _user _group log-file)
(list
#;
(log-rotation
(frequency 'weekly)
(files (list log-file))
(options '("rotate 5200"))))))))
(define-public (activation-for config-type)
(lambda (config)
(m:match config
(($ config-type name _package user _group log-file data-directory
run-directory)
(activation-gexp name user log-file data-directory run-directory)))))
(define-public (accounts-for config-type)
(lambda (config)
(m:match config
(($ config-type name _package user group)
(list
(user-group
(name group)
(system? #t))
(user-account
(name user)
(group group)
(system? #t)
(comment (format #f "The user for runtime execution of ~a code" name))
(home-directory "/var/empty")
(create-home-directory? #f)
(shell
(file-append shadow "/sbin/nologin"))))))))
(define-public (cmd-for config-type config)
(m:match config
(($ config-type name package user group _log-file data-directory
_run-directory run-in-container? container-name)
(let ((bin (file-append package (str "/bin/" name))))
(if (not run-in-container?)
bin
(least-authority-wrapper
bin
#:user user
#:group group
#:name container-name
#:directory (or data-directory "/")
#:preserved-environment-variables
'()
#:mappings
(mklist
(and data-directory
(file-system-mapping
(source data-directory)
(target source)
(writable? #t))))))))))
(define-public (shepherd-services-for config-type)
(lambda (config)
(m:match config
(($ config-type name _package user group log-file data-directory
_run-directory _run-in-container? _container-name options
listen-socket upstream-socket)
(list
(shepherd-service
(provision (list (string->symbol name)))
(requirement '(networking))
(auto-start? #f)
(start
#~(make-forkexec-constructor
(list #$(cmd-for config-type config)
#$@options
#$@(mklist listen-socket)
#$@(mklist upstream-socket))
#:user #$user
#:group #$group
#:log-file #$log-file
#:directory #$data-directory))
(documentation
(fmt "The Shepherd service that runs the server via \"~a\"." name))))))))
(define-public (service-type-for name config-type config extensions)
(service-type
(name name)
(extensions
(append
(list
(service-extension shepherd-root-service-type
(shepherd-services-for config-type))
(service-extension profile-service-type
(profile-for config-type))
(service-extension activation-service-type
(activation-for config-type))
(service-extension account-service-type
(accounts-for config-type))
(service-extension log-rotation-service-type
(rotations-for config-type)))
extensions))
(default-value config)
(description
(fmt "The top-level generic system service, generated for ~a code.
It includes:
- the Shepherd service for starting, stopping and reloading the service;
- activation script for setting up the initial directories and permissions;
- the group and account for running the production service;
- log management (storage and rotation) for logs produced by the running services.
The default configuration should provide sane values for all of these."
name))))
(define-public (without-shepherd-services lst)
(filter (lambda (extension)
(not (eq? shepherd-root-service-type
(service-extension-target extension))))
lst))
(define-public (replacing-shepherd-services service fn)
(service-type
(inherit service)
(extensions
(append
(without-shepherd-services
(service-type-extensions service))
(list
(service-extension shepherd-root-service-type
fn))))))
(define-public (with-services-from-args service config-type args)
(replacing-shepherd-services
service
(lambda (config)
(m:match config
(($ config-type _name _package user group log-file data-directory)
(map (lambda (tuple)
(let ((provision (s1:first tuple))
(args (s1:second tuple)))
(shepherd-service
(provision provision)
(requirement '(networking))
(auto-start? #f)
(start
#~(make-forkexec-constructor
(list #$(cmd-for config-type config)
#$@args)
#:user #$user
#:group #$group
#:log-file #$log-file
#:directory #$data-directory)))))
args))))))
(define-public binder-service-type
(service-type-for 'binder <binder-configuration> (binder-configuration) '()))
(define-public glaze-service-type
(service-type-for 'glaze <glaze-configuration> (glaze-configuration) '()))
(define-public hsts-service-type
(service-type-for 'hsts <hsts-configuration> (hsts-configuration) '()))
(define-public untls-service-type
(service-type-for 'untls <untls-configuration> (untls-configuration) '()))
(define-public wscat-service-type
(service-type-for 'wscat <wscat-configuration> (wscat-configuration) '()))
(define-record-type* <cicd-configuration>
cicd-configuration
make-cicd-configuration
cicd-configuration?
(name cicd-configuration-name (default "cicd"))
(package cicd-configuration-package (default cicd))
(user cicd-configuration-user (default "cicd"))
(group cicd-configuration-group (default "cicd"))
(log-file cicd-configuration-log-file (default "/var/log/cicd/cicd.log"))
(data-directory cicd-configuration-data-directory (default "/var/lib/cicd"))
(run-directory cicd-configuration-run-directory (default "/var/run/cicd"))
(run-in-container? cicd-configuration-run-in-container? (default #f))
(container-name cicd-configuration-container-name (default "cicd")))
(define (cicd-profile config)
(match-record config <cicd-configuration>
(package)
(list
q
package)))
(define (cicd-shepherd-services config)
(match-record config <cicd-configuration>
(user group log-file data-directory)
(list
(shepherd-service
(provision '(cicd))
(requirement '())
(auto-start? #f)
(start
#~(make-forkexec-constructor
(list
#$(cmd-for <cicd-configuration> config)
"daemon")
#:user #$user
#:group #$group
#:log-file #$log-file
#:directory #$data-directory))
(documentation "The background daemon service that powers the CI.")))))
(define-public cicd-service-type
(service-type
(name 'cicd)
(extensions
(list
(service-extension shepherd-root-service-type
cicd-shepherd-services)
(service-extension profile-service-type
cicd-profile)
(service-extension activation-service-type
(activation-for <cicd-configuration>))
(service-extension account-service-type
(accounts-for <cicd-configuration>))
(service-extension log-rotation-service-type
(rotations-for <cicd-configuration>))))
(default-value (cicd-configuration))
(description (fmt "The CI agent service that backs a Git server."))))
(define-record-type* <papod-configuration>
papod-configuration
make-papod-configuration
papod-configuration?
(name papod-configuration-name
(default "papod"))
(package papod-configuration-package
(default papod))
(user papod-configuration-user
(default "papod"))
(group papod-configuration-group
(default "papod"))
(log-file papod-configuration-log-file
(default "/var/log/papod/papod.log"))
(data-directory papod-configuration-data-directory
(default "/var/lib/papod"))
(run-directory papod-configuration-run-directory
(default "/var/run/papod"))
(run-in-container? papod-configuration-run-in-container?
(default #t))
(container-name papod-configuration-container-name
(default "papod-container"))
(options papod-configuration-options
(default '()))
(listen-socket papod-configuration-listen-socket
(default "/var/run/papod/papod.socket"))
(upstream-socket papod-configuration-upstream-socket
(default #f)))
#;
(define-public papod-service-type
(pkg:service-type-for 'papod
<papod-configuration>
(papod-configuration)
'()))
(list
mktorrent-latest
remembering
eut
cage
backupit
nicely
syskeep
q
cicd
guile-heredoc
adoc
eslaides
mkwb
euandre.org
datomic
gotext
uuid
gobang
pds
stm
golite
binder
glaze
hsts
untls
wscat
gistatic
urubu
fiinha
cracha
papo.im
chat.papo.im
papod)
