diff options
-rw-r--r-- | Makefile | 2 | ||||
-rw-r--r-- | src/org/euandre/packages.scm | 562 | ||||
-rw-r--r-- | src/org/euandre/services.scm | 562 | ||||
-rw-r--r-- | tests/internet/system.scm | 24 |
4 files changed, 574 insertions, 576 deletions
@@ -38,7 +38,7 @@ queue.scm.sentinel: src/org/euandre/queue.scm packages.scm.sentinel: src/org/euandre/queue.scm src/org/euandre/packages.scm local.scm.sentinel: src/org/euandre/queue.scm tests/local/system.scm internet.scm.sentinel: src/org/euandre/queue.scm src/org/euandre/packages.scm \ - src/org/euandre/services.scm tests/internet/system.scm + tests/internet/system.scm queue.scm.sentinel packages.scm.sentinel: Makefile rm -f `basename $@ .sentinel`* diff --git a/src/org/euandre/packages.scm b/src/org/euandre/packages.scm index b609114..6e02c43 100644 --- a/src/org/euandre/packages.scm +++ b/src/org/euandre/packages.scm @@ -1,14 +1,124 @@ (define-module (org euandre packages) #:use-module ((guix licenses) #:prefix licenses:) + #: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 (gnu packages) #:use-module (gnu packages guile) #:use-module (gnu packages texinfo) + #:use-module (guix build utils) #:use-module (guix build-system gnu) #:use-module (guix download) #:use-module (guix gexp) + #:use-module (guix least-authority) #:use-module (guix packages) - #:use-module (guix utils)) + #: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 + + <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 + 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-extra-mappings + glaze-configuration-options + glaze-configuration-listen-socket + glaze-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-extra-mappings + 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-extra-mappings + wscat-configuration-options + wscat-configuration-listen-socket + wscat-configuration-upstream-socket + + <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 + papod-configuration-options + papod-configuration-listen-socket + papod-configuration-upstream-socket)) +(use-package-modules + admin + version-control) +(use-service-modules + admin + mcron + shepherd) @@ -216,6 +326,456 @@ + + + +(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 (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 + 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 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.sh" + "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 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 '())) + (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 #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 '())) + (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* <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")) + (extra-mappings untls-configuration-extra-mappings (default '())) + (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")) + (extra-mappings wscat-configuration-extra-mappings (default '())) + (options wscat-configuration-options (default '())) + (listen-socket wscat-configuration-listen-socket (default "/var/run/wscat/wscat.socket")) + (upstream-socket wscat-configuration-upstream-socket (default #f))) + +(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")) + (extra-mappings papod-configuration-extra-mappings (default '())) + (options papod-configuration-options (default '())) + (listen-socket papod-configuration-listen-socket (default #f)) + (upstream-socket papod-configuration-upstream-socket (default #f))) + +(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 (cmd-for type config) + (m:match config + (($ type name package user group _log-file data-directory _run-directory + run-in-container? container-name extra-mappings) + (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 + (mklist + (and data-directory + (file-system-mapping + (source data-directory) + (target source) + (writable? #t)))) + extra-mappings))))))) + +(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 options + listen-socket upstream-socket) + (list + (shepherd-service + (provision (list (string->symbol name))) + (requirement '()) + (start + #~(make-forkexec-constructor ;; FIXME: add #:resource-limits + (list #$(cmd-for type config) + #$@options + #$@(mklist listen-socket) + #$@(mklist upstream-socket)) + #: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) '())) + + + (list remembering eut diff --git a/src/org/euandre/services.scm b/src/org/euandre/services.scm deleted file mode 100644 index d38110c..0000000 --- a/src/org/euandre/services.scm +++ /dev/null @@ -1,562 +0,0 @@ -(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 (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 - 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-extra-mappings - glaze-configuration-options - glaze-configuration-listen-socket - glaze-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-extra-mappings - 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-extra-mappings - wscat-configuration-options - wscat-configuration-listen-socket - wscat-configuration-upstream-socket - - <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 - papod-configuration-options - papod-configuration-listen-socket - papod-configuration-upstream-socket)) -(use-package-modules - admin - version-control) -(use-service-modules - admin - mcron - shepherd) - - - -(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 (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.sh" - "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 '())) - (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 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 '())) - (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* <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 '())) - (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 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 '())) - (options wscat-configuration-options (default '())) - (listen-socket wscat-configuration-listen-socket (default "/var/run/wscat/wscat.socket")) - (upstream-socket wscat-configuration-upstream-socket (default #f))) - -(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 '())) - (options papod-configuration-options (default '())) - (listen-socket papod-configuration-listen-socket (default #f)) - (upstream-socket papod-configuration-upstream-socket (default #f))) - -(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 (cmd-for type config) - (m:match config - (($ type name package user group _log-file data-directory _run-directory - run-in-container? container-name extra-mappings) - (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 - (mklist - (and data-directory - (file-system-mapping - (source data-directory) - (target source) - (writable? #t)))) - extra-mappings))))))) - -(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 options - listen-socket upstream-socket) - (list - (shepherd-service - (provision (list (string->symbol name))) - (requirement '()) - (start - #~(make-forkexec-constructor ;; FIXME: add #:resource-limits - (list #$(cmd-for type config) - #$@options - #$@(mklist listen-socket) - #$@(mklist upstream-socket)) - #: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) '())) diff --git a/tests/internet/system.scm b/tests/internet/system.scm index c0e5986..84471d2 100644 --- a/tests/internet/system.scm +++ b/tests/internet/system.scm @@ -1,6 +1,6 @@ (use-modules ((org euandre queue) #:prefix q:) - ((org euandre services) #:prefix serv:) + ((org euandre packages) #:prefix pkg:) (gnu)) (use-package-modules) (use-service-modules @@ -12,7 +12,7 @@ ssh) (define (path s) - (serv:str (dirname (dirname (dirname (current-filename)))) "/" s)) + (pkg:str (dirname (dirname (dirname (current-filename)))) "/" s)) (define +users+ `(("user1" "I'm a user" ()) @@ -20,30 +20,30 @@ (operating-system (host-name "a-internet-test-host") - (skeletons serv:skeletons) - (users (append (serv:user-accounts +users+) %base-user-accounts)) + (skeletons pkg:skeletons) + (users (append (pkg:user-accounts +users+) %base-user-accounts)) (services (append (list (service ntp-service-type) (service dhcp-client-service-type) (service fail2ban-service-type) - (service serv:binder-service-type) - (service serv:glaze-service-type) - (service serv:untls-service-type) - (service serv:wscat-service-type) - (service serv:papod-service-type) - (service openssh-service-type (q:openssh-default-configuration (serv:users->keys +users+))) + (service pkg:binder-service-type) + (service pkg:glaze-service-type) + (service pkg:untls-service-type) + (service pkg:wscat-service-type) + (service pkg:papod-service-type) + (service openssh-service-type (q:openssh-default-configuration (pkg:users->keys +users+))) (service certbot-service-type (q:tld-certbot-configuration "tld.local")) (service cgit-service-type q:cgit-pre-configuration) - (service serv:syskeep-service-type) + (service pkg:syskeep-service-type) (service q:shadow-group-service-type) (service q:dkimproxyout-service-type) (service q:cyrus-sasl-service-type) (service q:dovecot-service-type) (service q:internet-postfix-service-type) (service mail-aliases-service-type '())) - serv:base-services)) + pkg:base-services)) (bootloader (bootloader-configuration (bootloader grub-bootloader))) |