diff options
Diffstat (limited to 'src/guix/services.scm')
| -rw-r--r-- | src/guix/services.scm | 187 |
1 files changed, 187 insertions, 0 deletions
diff --git a/src/guix/services.scm b/src/guix/services.scm new file mode 100644 index 0000000..c7d3360 --- /dev/null +++ b/src/guix/services.scm @@ -0,0 +1,187 @@ +(define-module (services) + #: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 srfi-1:) + #:use-module ((xyz euandreh heredoc) #:prefix heredoc:) + #:use-module (gnu) + #:use-module (guix build utils) + #:use-module (guix least-authority) + #:use-module (guix records)) +(use-package-modules + admin) +(use-service-modules + admin + mcron + shepherd) +(heredoc:enable-syntax) + + +(define +working-dir+ + (if (directory-exists? "/opt/deploy/current") + "/opt/deploy/current" + (canonicalize-path "."))) + +(add-to-load-path + (string-append +working-dir+ "/src/infrastructure/guix")) +(use-modules + ((packages) #:prefix packages:)) + + + +(define-record-type* <papo-configuration> + papo-configuration + make-papo-configuration + papo-configuration? + (package papo-configuration-package (default packages:papo)) + (user papo-configuration-user (default "papo")) + (group papo-configuration-group (default "papo")) + (config-dirname papo-configuration-config (default "papo")) + (port papo-configuration-port (default 6666)) + (log-file papo-configuration-log-file (default "/var/log/papo.log")) + (data-directory papo-configuration-data-directory (default "/var/lib/papo")) + (run-directory papo-configuration-run-directory (default "/var/run/papo")) + (run-in-container? papo-configuration-run-in-container? (default #t)) + (container-name papo-configuration-container-name (default "papo-container")) + (container-namespaces papo-configuration-container-namespaces (default container:%namespaces)) + (extra-mappings papo-configuration-extra-mappings (default '()))) + +(define (papo-etc-files config) + (match-record config <papo-configuration> + () + `(("papo.json" ,(plain-file "papo.json" ""))))) + +(define (papo-log-rotations config) + (match-record config <papo-configuration> + (log-file) + (list + (log-rotation + (frequency 'weekly) + (files (list log-file)) + (options '("rotate 52")))))) + +(define (papo-activation config) + (match-record config <papo-configuration> + (user log-file data-directory run-directory) + #~(begin + (use-modules (guix build utils)) + (format (current-error-port) + "Creating papo log directory for '~a'.~%" #$log-file) + (mkdir-p (dirname #$log-file)) + (when (not (file-exists? #$log-file)) + (call-with-output-file #$log-file (const #t))) + (chmod #$log-file #o644) + (let ((user (getpwnam #$user))) + (format (current-error-port) + "Creating papo data directory '~a'.~%" #$data-directory) + (mkdir-p #$data-directory) + (chown #$data-directory (passwd:uid user) (passwd:gid user)) + (chmod #$data-directory #o750) + (format (current-error-port) + "Creating papo run directory '~a'.~%" #$run-directory) + (mkdir-p #$run-directory) + (chown #$run-directory (passwd:uid user) (passwd:gid user)) + (chmod #$run-directory #o755))))) + +(define (papo-cronjobs _config) + (list)) + +(define (papo-accounts config) + (match-record config <papo-configuration> + (user group) + (list + (user-group + (name group) + (system? #t)) + (user-account + (name user) + (group group) + (system? #t) + (comment "The user for runtime execution of papo code") + (home-directory "/var/empty") + (shell + (file-append shadow "/sbin/nologin")))))) + +(define (wrapped-command config) + (match-record config <papo-configuration> + (package data-directory + run-in-container? container-name container-namespaces extra-mappings) + (let ((bin (file-append package "/bin/papo"))) + (if (not run-in-container?) + bin + (least-authority-wrapper + bin + #:name container-name + #:namespaces container-namespaces + #:directory data-directory + #:preserved-environment-variables + '() + #:mappings + (append + (list + (file-system-mapping + (source data-directory) + (target source) + (writable? #t)) + (file-system-mapping + (source (file-append glibc-locales "/lib/locale")) + (target "/run/current-system/locale"))) + extra-mappings)))))) + +(define (exec-action config . static-args) + (match-record config <papo-configuration> + (user group log-file data-directory telegram-token-file) + #~(lambda dynamic-args + (fork+exec-command + (append '(#$@static-args) dynamic-args) + #:user #$user + #:group #$group + #:directory #$data-directory + #:log-file #$log-file)))) + +(define (papo-shepherd-services config) + (let ((cmd (wrapped-command config))) + (list + (shepherd-service + (provision '(papo)) + (requirement '()) + (start (exec-action config cmd "ircd")) + (stop #~(make-kill-destructor SIGKILL)) + (documentation + #"- + The Shepherd service that runs the server via "papo-ircd"."#))))) + +(define-public papo-service-type + (service-type + (name 'papo) + (extensions + (list + (service-extension shepherd-root-service-type + papo-shepherd-services) + (service-extension etc-service-type + papo-etc-files) + (service-extension profile-service-type + (compose list papo-configuration-package)) + (service-extension activation-service-type + papo-activation) + (service-extension account-service-type + papo-accounts) + (service-extension mcron-service-type + papo-cronjobs) + (service-extension rottlog-service-type + papo-log-rotations))) + (default-value (papo-configuration)) + (description + #"- + The top-level system service for papo code. + + It includes: + - the Shepherd service for starting, stopping and reloading the + service ("papo"); + - a list of cronjobs to be added to the system for sending documents + proactively; + - activation script for setting up the initial directories and permissions; + - the "papo" group and "papo" account for running the production service; + - log management (storage and rotation) for logs produced by the running services. + + The defaults of <papo-configuration> provide sane values for all of these."#))) |