(define-module (org euandre packages) #: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 make-syskeep-configuration syskeep-configuration? syskeep-configuration-package syskeep-configuration-log-file 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 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 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 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 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 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 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 fmt str service-type-for)) (use-package-modules admin bittorrent guile 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" "8ce7ff0c753a11f490c9e2ebb071e36ec2b0d3bb" "14yyngm3j2c8lkzzmljj57zhyw31j9rzf2sm8rf3snxqcz9wxdhc")) (define-public remembering (pkg "remembering" "e1570edd3cdaa040f9664adb315f72e33f8b67c2" "0y20flrbjh5gbbzl7h3rimg8jwy2ikgkj03yxclj8qg8mq2f9f4a")) (define-public cage (pkg "cage" "c0482531fc16a55715b759b695d27d555d927ab8" "1v5m7xqfb14y283mlc2kd714hnih1dwcmjcf4i6j52pphjscilys")) (define-public nicely (pkg "nicely" "ea9716ff211699b19493ffdcab3778b1b21c2ad3" "027vv0bgw4hd9m20bw77c14hqgh1ihvl92bvg89678zxsnmi3ai4")) (define-public q (pkg "q" "d13bcb36bc84de95ebb9e8c27605c09b08c35cc5" "1jbg9f6dwkkcjxbhc3a1pnaas6xgd1f0hiv95h6hchgs88phwssl")) (define-public syskeep (pkg "syskeep" "2215cc0999e43b32751bc493f2fe9d2e8c822170" "0p38fb8m35kjp9fj7bmwcayf9r4638q5fcin18ny7y65scij4jbb")) (define-public backupit (pkg "backupit" "3e9c89562d566e72cbaa53db3b1d0dfa8050b1f9" "0ayfp9564jggf02zniqay1sb0q0ff94zwxp6p7ps1g2ir2bxm4nm")) (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 euandre.org (let ((pkg (pkg "euandre.org" "6e493d66649925fccaa351f65ee6cac2dedf264f" "05isnj2mmwg6k1qd94r3yaycy556f5d7br3f2vdmriqazrgj0grg"))) (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 (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)) "ff638c75f4b588724b6c90345a58c7bad468a752" "1sjn4hg4agdfh84qp11jcgyspc3dlfq50ch9bkf1zapll63lrkvg")) (define-public uuid (gopkgbs "uuid" (format-inputs (list gotext)) "40039d355287b43ccd42c58443bec914c8e57067" "1sn5m1zhx2bzcd03sifn3sd546g5fbzhf9d65rgdbnqzmrk9zvzf")) (define-public gobang (gopkgbs "gobang" (format-inputs (list gotext uuid)) "bc682800eb4bc77b4e63a0cc84e69bf2b41cb624" "1x67vbb30bv2dz5c38v7h8pw6nsg750hcxmd2rdk5vfn4kgqhi0f")) (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)) "60602427e3b543502266e10ce8486ae448fe9605" "1yyan5jq59ksk4704z6yg4vjp5rkdzsjxh6vljn23vq2rrxaq503")) (define-public urubu (gopkg "urubu" (format-inputs (list)) "0a31f4cf617a1c8b0ccce4d96d314c889dea849c" "0vksj4nlllib6szxq1pnz8hi873kjlfvflibgya2bvzpmlywx56k")) (define-public stm (gopkg "stm" (format-inputs (list pds)) "093884c5fdd71d9f96e7bd1f70eef61368ad949a" "080qql9l46d2417fdp5s21aq2gk530l5ph0yg5r06y4aagag3xav")) (define-public scrypt (gopkg "scrypt" (format-inputs (list q:scryptkdf)) "16d3688f8c9f71ede4121d7d77a535c53f20ee49" "1gz6rz89vh3rkgqif1ycdgjy8r2n0znd1m65r80hipmvd54db2fl")) (define-public golite (gopkg "golite" (format-inputs (list q:sqlitex)) "3c7e8c4b1de3414e4ff43e4ba694a2b56c4be4b0" "0smzqjd5hwi8blvjpfxsw9n36fx9ifc3pr59b1gxyvzrw4k1mkax")) (define-public fiinha (gopkg "fiinha" (format-inputs (list q:sqlitex golite)) "ed6d86c6b72e4cd279600394ebf57c1bd926df85" "13nrvcparkl3xh9k04f58n7hh2c9z0zz3vpy4ld30bh7m21bhig8")) (define-public cracha (gopkg "cracha" (format-inputs (list q:sqlitex golite q:scryptkdf scrypt fiinha)) "bce8179d4ee6f1d97c9928e38d56ca053302284d" "1i069w07bvp3j9hv9m6vw25f5sx7jlrra7v0324k0dn2cwpc1vlb")) (define-public binder (gopkg "binder" (normalize-inputs '(socat lsof)) "5a6bf54df0d12d130e767d0e8ba65075d0144ae3" "1idnl0ap9qjnms0p0dj91xaj5ww1kac7qwjxjgkqqmvdjxb7a43b")) (define-public glaze (gopkg "glaze" (format-inputs (list)) "0fa2a2c8e0221beb3f356a240e10435c4afe614f" "1q99chx0c78mljh27v2ja5ksfdmq8wbairkq0ax8v8zzvyhvbi9w")) (define-public hsts (gopkg "hsts" (format-inputs (list)) "17351ac6cb396ba24a0e0c56996152c4b11e6b04" "00hr17dxrxr927n6z39lpg4xki1mfdkqzhibrcib5wj02im2zwhs")) (define-public untls (gopkg "untls" (format-inputs (list)) "99d5f060ddd22422e8404f48aa3f461540fb8250" "14qvpkb87n8nxz29bh4fd9j85yvggx5k5p32lc2ahx1wh2rmc0rn")) (define-public wscat (gopkg "wscat" (format-inputs (list)) "2f5609c616e78570bef450c18501c92f49fc77d3" "0ydm09ypwrszl0h8kx1riz1wa89bynvxyk7313v4v89nzb4s2f78")) (define-public gistatic (gopkg "gistatic" (format-inputs (list)) "fdd9d91574a486e867a88596bd98878c97177534" "1vrxma44vlvzp2dxnw254iwfvjv9wmlb74cr5lp6z3z0hz973vyx")) (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 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 (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 backupit eut nicely package)))) (define (syskeep-rotations config) (match-record config (log-file) (list #; (log-rotation (frequency 'weekly) (files (list log-file)) (options '("rotate 52")))))) (define (syskeep-cronjobs config) (match-record config () (list #~(job "0 0 * * *" "cronjob env BORG_REPO=/mnt/backup/borg backupit -q cron") #~(job "0 1 * * *" "cronjob backupit -q 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 (package) (etc-entries package '("rc.sh" "backupit.txt" "ssh.conf" "init.scm" "gitconfig")))) (define (syskeep-accounts config) (match-record config (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 (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 %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* 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 (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 (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 (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 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 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 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 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 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) '())) (define-public glaze-service-type (service-type-for 'glaze (glaze-configuration) '())) (define-public hsts-service-type (service-type-for 'hsts (hsts-configuration) '())) (define-public untls-service-type (service-type-for 'untls (untls-configuration) '())) (define-public wscat-service-type (service-type-for 'wscat (wscat-configuration) '())) (define-record-type* 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 (package) (list q package))) (define (cicd-shepherd-services config) (match-record config (user group log-file data-directory) (list (shepherd-service (provision '(cicd)) (requirement '()) (auto-start? #f) (start #~(make-forkexec-constructor (list #$(cmd-for 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 )) (service-extension account-service-type (accounts-for )) (service-extension log-rotation-service-type (rotations-for )))) (default-value (cicd-configuration)) (description (fmt "The CI agent service that backs a Git server.")))) (list mktorrent-latest remembering eut cage backupit nicely syskeep q cicd guile-heredoc adoc eslaides mkwb euandre.org gotext uuid gobang pds stm golite binder glaze hsts untls wscat gistatic urubu fiinha cracha)