aboutsummaryrefslogtreecommitdiff
path: root/src/org/euandre
diff options
context:
space:
mode:
Diffstat (limited to 'src/org/euandre')
-rw-r--r--src/org/euandre/packages.scm161
-rw-r--r--src/org/euandre/queue.scm185
-rw-r--r--src/org/euandre/services.scm518
3 files changed, 766 insertions, 98 deletions
diff --git a/src/org/euandre/packages.scm b/src/org/euandre/packages.scm
index e30cce4..98459f0 100644
--- a/src/org/euandre/packages.scm
+++ b/src/org/euandre/packages.scm
@@ -1,11 +1,16 @@
(define-module (org euandre packages)
+ #:use-module ((guix licenses) #:prefix licenses:)
+ #:use-module ((org euandre queue) #:prefix q:)
+ #:use-module (gnu packages)
#:use-module (gnu packages guile)
#:use-module (gnu packages texinfo)
- #:use-module ((guix licenses) #:prefix licenses:)
+ #:use-module (guix build-system gnu)
+ #:use-module (guix download)
#:use-module (guix gexp)
#:use-module (guix packages)
- #:use-module (guix download)
- #:use-module (guix build-system gnu))
+ #:use-module (guix utils))
+
+
(define-public git-permalink-0-1-0
(package
@@ -200,6 +205,145 @@ file in the repository.")
"5e8e65015a77ed7606c6cfbd2d1cedc79e42a6a5"
"1dramr7p5ncbnna0v3ncaa77rm1c8vzxw5si4n6d3rr0ji2v48ac"))
+(define-public syskeep
+ (pkg
+ "syskeep"
+ "41ff39d838d8ad44c9da24f8b4cfc2e71a5ed739"
+ "0an4i8682jjqazw95lkxb0vr98y2cn0bbqm53vr585s7j0n6zi6r"))
+
+
+
+(define (format-inputs l)
+ (map (lambda (p)
+ (list (package-name p)
+ p
+ "out"))
+ l))
+
+(define (normalize-inputs l)
+ (map (compose (lambda (l)
+ (cons (package-name (car l))
+ l))
+ list
+ specification->package+output
+ symbol->string)
+ l))
+
+(define (go-package name inputs version checksum)
+ (package
+ (name name)
+ (version version)
+ (source
+ (origin
+ (method url-fetch)
+ (uri
+ (string-append "https://papo.im/git/"
+ name
+ "/snapshot/"
+ name
+ "-"
+ version
+ ".tar.xz"))
+ (sha256
+ (base32 checksum))))
+ (build-system gnu-build-system)
+ (arguments
+ (list
+ #:strip-binaries? #f
+ #:make-flags
+ #~(list
+ "-e"
+ (string-append "PREFIX=" #$output)
+ (string-append "VERSION=" #$version)
+ (string-append "CC=" #$(cc-for-target)))
+ #:phases
+ #~(modify-phases %standard-phases
+ (delete 'configure)
+ (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 q:go-full))
+ inputs))
+ (native-search-paths
+ (list
+ (search-path-specification
+ (variable "GOLIBPACKPATH")
+ (files
+ (list "lib/go")))))
+ (synopsis #f) ;; FIXME: get
+ (description #f) ;; from
+ (home-page #f) ;; tarball!
+ (license licenses:agpl3+)))
+
+
+(define-public gobang
+ (go-package
+ "gobang"
+ '()
+ "b1bed38e5e0a261616343c7555962162416c28e2"
+ "1h937x3clk3xydvl7876qd3b6plapjsnxmdlyan1iydmh6ym7vg0"))
+
+(define-public golite
+ (go-package
+ "golite"
+ (normalize-inputs '(sqlite))
+ "b31e279bade22276f27f4990b7564a2114f3058a"
+ "14q9bhkw1v60mby187balwnnwyz2ig8hi03v5f2nm8p3m8sl5ykd"))
+
+(define-public binder
+ (go-package
+ "binder"
+ (append (format-inputs (list gobang))
+ (normalize-inputs '(eut socat lsof)))
+ "aa44df7545e13f6d2bb5ea088786d14f4a31a04d"
+ "15zdcvx1gxlzz3g7gasckna3xfrf0c6yd8pvii169ivgm0rrbpll"))
+
+(define-public wscat
+ (go-package "wscat"
+ (append (format-inputs (list gobang))
+ (normalize-inputs '(eut)))
+ "00f822df8bcecc3b40bdc39f0cd5dfb6d1efc45e"
+ "0ypj05w6kh7dd55qn0gfc1fdiyy5kfalypxm5dhsbmqkzk09m3id"))
+
+(define-public glaze
+ (go-package
+ "glaze"
+ (append (format-inputs (list gobang))
+ (normalize-inputs '(eut)))
+ "ebe6b2ae31145fd3534a0fb583410ce2cd8e8d69"
+ "0r0lsfx5g6crgyrzf8kqid3370lvyq0h573qbcpzl6mcm57nc9hj"))
+
+(define-public untls
+ (go-package
+ "untls"
+ (append (format-inputs (list gobang))
+ (normalize-inputs '(eut)))
+ "3833dbae57bcf87a33ecbb38fb877861fb1c8d63"
+ "0pxmqhzy4286w3aivq1qykqdr4mcd6b3p7q9frbnwlqmk5gfp36z"))
+
+(define-public papod
+ (go-package
+ "papod"
+ (append (format-inputs (list gobang golite))
+ (normalize-inputs '(sqlite sqlite:static)))
+ "db0315223571daaf43ab5e8456bed7f3d7f9dafa"
+ "19dr8w1hpi9h8rjad9dwb0s6r41xgj1x4m4j7yndchikwrwg4lgx"))
+
+
+
(list
git-permalink-0-1-0
git-permalink-0-2-0
@@ -209,4 +353,13 @@ file in the repository.")
cage
nicely
q
- guile-heredoc)
+ syskeep
+ guile-heredoc
+
+ gobang
+ golite
+ binder
+ glaze
+ untls
+ wscat
+ papod)
diff --git a/src/org/euandre/queue.scm b/src/org/euandre/queue.scm
index ce5fdec..c0189c4 100644
--- a/src/org/euandre/queue.scm
+++ b/src/org/euandre/queue.scm
@@ -7,41 +7,12 @@
#: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 golang)
- #: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>
shadow-group-configuration
@@ -184,10 +155,32 @@
dovecot-accounts
dovecot-activation
dovecot-shepherd-service
- dovecot-service-type
-
-
- cgit-pre-configuration))
+ dovecot-service-type))
+(use-package-modules
+ admin
+ check
+ cyrus-sasl
+ dbm
+ golang
+ m4
+ mail
+ onc-rpc
+ perl
+ python-build
+ python-crypto
+ python-web
+ python-xyz
+ ssh
+ time
+ tls
+ version-control)
+(use-service-modules
+ certbot
+ cgit
+ mail
+ shepherd
+ ssh
+ web)
@@ -379,7 +372,7 @@ information on a large group of binary files.")
(home-page "https://distfiles.gentoo.org/distfiles/pax-utils-1.3.7.tar.xz")
(license license:gpl2)))
-(define-public (hunspell-dictionary-utf8 dict-name)
+(define (hunspell-dictionary-utf8 dict-name)
(package
(name (string-append "hunspell-dict-" dict-name "-utf8"))
(version "630b34e6f8f3cbe7aa7b27b6d8ab118e27252fd1")
@@ -421,7 +414,7 @@ information on a large group of binary files.")
(define-public hunspell-dict-eo-utf8 (hunspell-dictionary-utf8 "eo"))
(define-public hunspell-dict-es-utf8 (hunspell-dictionary-utf8 "es"))
-(define-public python-pytest-tornado5
+(define python-pytest-tornado5
(package
(name "python-pytest-tornado5")
(version "2.0.0")
@@ -442,26 +435,7 @@ information on a large group of binary files.")
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
+(define python-ordereddict
(package
(name "python-ordereddict")
(version "1.1")
@@ -484,7 +458,7 @@ simplify testing of asynchronous tornado applications.")
collections.OrderedDict that works in Python 2.4-2.6.")
(license #f)))
-(define-public python-funcsigs
+(define python-funcsigs
(package
(name "python-funcsigs")
(version "1.0.2")
@@ -507,7 +481,7 @@ collections.OrderedDict that works in Python 2.4-2.6.")
"Python function signatures from PEP362 for Python 2.6, 2.7 and 3.2+")
(license #f)))
-(define-public python-apscheduler
+(define python-apscheduler
(package
(name "python-apscheduler")
(version "3.9.1")
@@ -553,10 +527,11 @@ collections.OrderedDict that works in Python 2.4-2.6.")
(base32 "1rbdyr1f9mndlh83in47k8if65yp9n1dy4px2wipbf0qyjv5zxfs"))))
(build-system python-build-system)
(arguments
- `(#:tests? #f
- #:phases
- (modify-phases %standard-phases
- (delete 'sanity-check))))
+ (list
+ #:tests? #f
+ #:phases
+ #~(modify-phases %standard-phases
+ (delete 'sanity-check))))
(native-inputs
(list python-apscheduler))
(propagated-inputs
@@ -937,7 +912,7 @@ keyfile ~a/private.key
#~(lambda _
(format #t "~a~%" #$config-file)))))))))))
-(define-public dkimproxyout-service-type
+(define dkimproxyout-service-type
(service-type
(name 'dkimproxyout)
(extensions
@@ -1137,6 +1112,10 @@ setgid_group = ~a
header_checks = regexp:{ { /^Received:.*/ IGNORE }, { /^X-Originating-IP:.*/ IGNORE } }
mail_spool_directory = ~a
+
+message_size_limit = 102400000
+mailbox_size_limit = 5120000000
+
~a~a"
queue-directory
@@ -1673,33 +1652,6 @@ as-is, it creates a Dovecot server that and serve and authenticate IMAP
connections correctly.")))
-(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"))))
-
(define setenvfmt "Environment variable `~a' set to `~a'.~%")
(define-public go-full
@@ -1733,17 +1685,62 @@ connections correctly.")))
(string-append #$output "/lib/go/pkg"))))
(delete 'strip)))))))
+(define-public 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"))))
+
+(define-public (tld-certbot-configuration tld)
+ (certbot-configuration
+ (email (string-append "root@" tld))
+ (certificates
+ (list
+ (certificate-configuration
+ (domains (list tld))))))) ;; FIXME: SIGHUP nginx/untls
+
+(define-public (openssh-default-configuration authorized-keys)
+ (openssh-configuration
+ (openssh openssh-sans-x)
+ (password-authentication? #f)
+ (authorized-keys authorized-keys)
+ (extra-content "MaxSessions 20
+ClientAliveInterval 30
+ClientAliveCountMax 23
+SetEnv GIT_CONFIG_GLOBAL=/etc/gitconfig")))
+
(list
- go-full
+ postfix
+ mailutils-sendmail
+ rottlog-mailutils-sendmail
pax-utils
hunspell-dict-en-utf8
hunspell-dict-pt-utf8
hunspell-dict-fr-utf8
hunspell-dict-eo-utf8
hunspell-dict-es-utf8
- mailutils-sendmail
- rottlog-mailutils-sendmail
- postfix
- python-telegram-bot)
+ python-telegram-bot
+ go-full)
diff --git a/src/org/euandre/services.scm b/src/org/euandre/services.scm
new file mode 100644
index 0000000..4b62fc9
--- /dev/null
+++ b/src/org/euandre/services.scm
@@ -0,0 +1,518 @@
+(define-module (org euandre services)
+ #:use-module ((org euandre packages) #:prefix pkg:)
+ #:use-module ((org euandre queue) #:prefix q:)
+ #:use-module ((ice-9 match) #:prefix m:)
+ #:use-module ((ice-9 popen) #:prefix popen:)
+ #:use-module ((ice-9 textual-ports) #:prefix textual-ports:)
+ #:use-module ((gnu build linux-container) #:prefix container:)
+ #:use-module ((srfi srfi-1) #:prefix s1:)
+ #:use-module ((xyz euandreh heredoc) #:prefix heredoc:)
+ #:use-module (gnu)
+ #:use-module (guix build utils)
+ #:use-module (guix least-authority)
+ #:use-module (guix records)
+ #:export (<syskeep-configuration>
+ syskeep-configuration
+ make-syskeep-configuration
+ syskeep-configuration?
+ syskeep-configuration-package
+ syskeep-configuration-log-file
+
+ <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-extra-mappings
+
+ <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-extra-mappings
+
+ <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-extra-mappings
+
+ <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-extra-mappings
+
+ <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-extra-mappings))
+(use-package-modules
+ admin
+ version-control)
+(use-service-modules
+ admin
+ mcron
+ shepherd)
+
+
+
+(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 (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") 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 (string-append "/etc/" name)))
+ (list
+ name
+ (computed-file
+ (string-append "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)
+ (map
+ tuple->entry
+ (map (lambda (path)
+ (list path package))
+ paths)))
+
+(define-public (package-set symbols records)
+ (append
+ records
+ (map
+ (compose list specification->package+output symbol->string)
+ symbols)))
+
+(define-public skeletons
+ (etc-entries
+ pkg:syskeep
+ '(".profile")))
+
+(define-public base-services
+ (modify-services %base-services
+ (rottlog-service-type config =>
+ (rottlog-configuration
+ (inherit config)
+ (rc-file
+ (file-append q:rottlog-mailutils-sendmail "/etc/rc"))))))
+
+
+
+(define-record-type* <syskeep-configuration>
+ syskeep-configuration
+ make-syskeep-configuration
+ syskeep-configuration?
+ (package syskeep-configuration-package (default pkg:syskeep))
+ (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
+ guile-heredoc
+ acl
+ bind:utils
+ knot:tools
+ file
+ git
+ lsof
+ moreutils
+ mailutils-sendmail
+ curl
+ make
+ borg
+ rsync
+ sqlite
+ strace
+ rlwrap
+ trash-cli
+ tree)
+ (list
+ 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 check")
+ #~(job "0 1 * * *" "cronjob env BORG_REPO=/mnt/backup/borg backup -q cron")
+ #~(job "0 2 * * *" "cronjob backup -q cron")
+ #~(job "0 3 * * 0" "cronjob gc")
+ #~(job "0 4 * * *" "cronjob reconfigure -U"))))
+
+(define (syskeep-etc-files config)
+ (match-record config <syskeep-configuration>
+ (package)
+ (etc-entries
+ package
+ '("rc"
+ "known_hosts"
+ "ssh.conf"
+ "init.scm"
+ "gitconfig"))))
+
+(define (syskeep-accounts config)
+ (match-record config <syskeep-configuration>
+ ()
+ (list
+ (user-account
+ (name "git")
+ (group "git")
+ (system? #t)
+ (comment "External SSH Git user")
+ (home-directory "/src/ĝit")
+ (create-home-directory? #f)
+ (shell
+ (file-append git "/bin/git-shell")))
+ (user-group
+ (name "git")
+ (system? #t)))))
+
+(define-public syskeep-service-type
+ (service-type
+ (name 'syskeep)
+ (extensions
+ (list
+ (service-extension rottlog-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 profile-service-type
+ syskeep-profile)))
+ (default-value (syskeep-configuration))
+ (description "Common configuration of maintained servers.")))
+
+
+
+(define-record-type* <binder-configuration>
+ binder-configuration
+ make-binder-configuration
+ binder-configuration?
+ (name binder-configuration-name (default "binder"))
+ (package binder-configuration-package (default pkg: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"))
+ (extra-mappings binder-configuration-extra-mappings (default '())))
+
+(define-record-type* <glaze-configuration>
+ glaze-configuration
+ make-glaze-configuration
+ glaze-configuration?
+ (name glaze-configuration-name (default "glaze"))
+ (package glaze-configuration-package (default pkg: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 #f))
+ (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"))
+ (extra-mappings glaze-configuration-extra-mappings (default '())))
+
+(define-record-type* <untls-configuration>
+ untls-configuration
+ make-untls-configuration
+ untls-configuration?
+ (name untls-configuration-name (default "untls"))
+ (package untls-configuration-package (default pkg: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"))
+ (extra-mappings untls-configuration-extra-mappings (default '())))
+
+(define-record-type* <wscat-configuration>
+ wscat-configuration
+ make-wscat-configuration
+ wscat-configuration?
+ (name wscat-configuration-name (default "wscat"))
+ (package wscat-configuration-package (default pkg: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"))
+ (extra-mappings wscat-configuration-extra-mappings (default '())))
+
+(define-record-type* <papod-configuration>
+ papod-configuration
+ make-papod-configuration
+ papod-configuration?
+ (name papod-configuration-name (default "papod"))
+ (package papod-configuration-package (default pkg: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"))
+ (extra-mappings papod-configuration-extra-mappings (default '())))
+
+
+(define-public (profile-for type)
+ (lambda (config)
+ (m:match config
+ (($ type _name package)
+ (list package)))))
+
+(define-public (rotations-for type)
+ (lambda (config)
+ (m:match config
+ (($ type _name _package _user _group log-file)
+ (list
+ (log-rotation
+ (frequency 'weekly)
+ (files (list log-file))
+ (options '("rotate 5200"))))))))
+
+(define-public (activation-for type)
+ (lambda (config)
+ (m:match config
+ (($ type name _package user _group 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-public (accounts-for type)
+ (lambda (config)
+ (m:match 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")
+ (shell
+ (file-append shadow "/sbin/nologin"))))))))
+
+(define-public (shepherd-services-for type)
+ (lambda (config)
+ (m:match config
+ (($ type name package user group log-file data-directory _run-directory run-in-container? container-name extra-mappings)
+ (list
+ (shepherd-service
+ (provision (list (string->symbol name)))
+ (requirement '())
+ (start
+ #~(make-forkexec-constructor ;; FIXME: add #:resource-limits
+ (list
+ #$(let ((bin (file-append package (string-append "/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
+ (append
+ (if data-directory
+ (list
+ (file-system-mapping
+ (source data-directory)
+ (target source)
+ (writable? #t)))
+ (list))
+ extra-mappings)))))
+ #:user #$user
+ #:group #$group
+ #:log-file #$log-file
+ #:directory #$data-directory))
+ (stop #~(make-kill-destructor SIGKILL))
+ (documentation
+ (fmt "The Shepherd service that runs the server via \"~a\"." name))))))))
+
+(define-public (service-type-for name type config extensions)
+ (service-type
+ (name name)
+ (extensions
+ (append
+ (list
+ (service-extension shepherd-root-service-type
+ (shepherd-services-for type))
+ (service-extension profile-service-type
+ (profile-for type))
+ (service-extension activation-service-type
+ (activation-for type))
+ (service-extension account-service-type
+ (accounts-for type))
+ (service-extension rottlog-service-type
+ (rotations-for 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 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 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-public papod-service-type
+ (service-type-for 'papod <papod-configuration> (papod-configuration) '()))
generated by cgit v1.2.3 (git 2.46.2) at 2024-10-30 06:14:19 +0000