diff options
Diffstat (limited to 'src/org/euandre/services.scm')
| -rw-r--r-- | src/org/euandre/services.scm | 562 |
1 files changed, 0 insertions, 562 deletions
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) '())) |