diff options
| -rw-r--r-- | gnu/services/web.scm | 170 |
1 files changed, 170 insertions, 0 deletions
diff --git a/gnu/services/web.scm b/gnu/services/web.scm index cc6f4e6d9b..ab7d40e53c 100644 --- a/gnu/services/web.scm +++ b/gnu/services/web.scm @@ -17,6 +17,9 @@ ;;; Copyright © 2022 Simen Endsjø <simendsjo@gmail.com> ;;; Copyright © 2023 Bruno Victal <mirai@makinata.eu> ;;; Copyright © 2023 Miguel Ángel Moreno <mail@migalmoreno.com> +;;; Copyright © 2024 Wojtek Kosior <koszko@koszko.org> +;;; Additions and modifications by Wojtek Kosior are additionally +;;; dual-licensed under the Creative Commons Zero v1.0. ;;; ;;; This file is part of GNU Guix. ;;; @@ -45,6 +48,7 @@ #:use-module (gnu packages admin) #:use-module (gnu packages base) #:use-module (gnu packages databases) + #:use-module ((gnu packages linux) #:select (util-linux)) #:use-module (gnu packages web) #:use-module (gnu packages patchutils) #:use-module (gnu packages php) @@ -250,6 +254,16 @@ whoogle-configuration-port whoogle-configuration-environment-variables + epicyon-service-type + epicyon-configuration + epicyon-configuration? + epicyon-configuration-package + epicyon-configuration-port + epicyon-configuration-real-port + epicyon-configuration-domain + epicyon-configuration-registration-open? + epicyon-configuration-log-login-failures? + patchwork-database-configuration patchwork-database-configuration? patchwork-database-configuration-engine @@ -1670,6 +1684,162 @@ Whoogle.")) ;;; +;;; Epicyon +;;; + +(define-configuration/no-serialization epicyon-configuration + (package + (package epicyon) + "The Epicyon package to use.") + (port + (integer 7156) + "The port Epicyon will listen on.") + (real-port + (integer 443) + "The port under which Epicyon is accessed when proxied.") + (domain + (string "localhost") + "Domain under which Epicyon is accessed.") + (registration-open? + (boolean #t) + "Whether Epicyon will allow new users to register.") + (log-login-failures? + (boolean #t) + "Whether Epicyon will log failed login attempts.")) + +(define (epicyon-activation _) + #~(for-each mkdir-p + '("/var/lib/epicyon/upper" + "/var/lib/epicyon/work" + "/var/lib/epicyon/mount"))) + +(define %epicyon-passwd + (list (user-account + (name "epicyon") + (group "epicyon") + (system? #t) + (home-directory "/var/lib/epicyon/mount") + (shell (file-append shadow "/sbin/nologin")) + (comment "Epicyon server system user.")) + (user-group + (name "epicyon") + (system? #t)))) + +(define %ensure-epicyon-overlay-unmounted + (with-used-modules '(((srfi srfi-26) #:select (cut)) + ((ice-9 match) #:select (match-lambda)) + ((ice-9 textual-ports) #:select (get-string-all))) + #~(lambda () + (define (overlay-mounted?) + (call-with-input-file "/proc/mounts" + (compose (cut or-map (match-lambda + ((_ "/var/lib/epicyon/mount" "overlay" . _) + #t) + (_ + #f)) + <>) + (cut map (cut string-split <> #\space) <>) + (cut string-split <> #\newline) + get-string-all))) + + (define unmount (cut system* + #$(file-append util-linux "/bin/umount") + "/var/lib/epicyon/mount")) + + (letrec ((loop (lambda () + (when (overlay-mounted?) + (unmount) + (loop))))) + (loop))))) + +(define (epicyon-shepherd-services config) + (match-record config <epicyon-configuration> + (package port real-port domain registration-open? log-login-failures?) + (list + (shepherd-service + (provision '(epicyon)) + + (requirement '(networking)) + + (start (with-used-modules '(((srfi srfi-26) #:select (cut)) + ((ice-9 ftw) #:select (ftw scandir))) + #~(let ((constructor + (make-forkexec-constructor + `(#$(file-append package "/bin/epicyon") + "--port" #$(number->string real-port) + "--proxy" #$(number->string port) + "--domain" #$domain + "--registration" #$(if registration-open? + "open" + "closed") + #$@(if log-login-failures? + '("--log_login_failures") + '())) + #:user "epicyon" + #:group "epicyon" + #:directory "/var/lib/epicyon/mount"))) + + (lambda args + (#$%ensure-epicyon-overlay-unmounted) + + (define site-packages-dir + (let* ((libdir #$(file-append package "/lib")) + (subdir (car (scandir libdir + (cut string-prefix? + "python" <>))))) + ;; e.g. /gnu/store/.../lib/python3.10/site-packages + (format #f "~a/~a/site-packages" libdir subdir))) + + (define mount-opts + `(("rw") + ("upperdir" "/var/lib/epicyon/upper") + ("lowerdir" ,site-packages-dir) + ("workdir" "/var/lib/epicyon/work"))) + + (system* #$(file-append util-linux "/bin/mount") + "-t" "overlay" "dummy" "-o" + (string-join + (map (cut string-join <> "=") mount-opts) + ",") + "/var/lib/epicyon/mount") + + (let ((gid (group:gid (getgrnam "epicyon")))) + (ftw "/var/lib/epicyon/mount" + (lambda (filename statinfo flag) + (when (eq? flag 'directory) + (chown filename -1 gid) + (chmod filename #o770)) + #t))) + + (apply constructor args))))) + + (stop (with-used-modules '(((srfi srfi-26) #:select (cut))) + #~(let ((destructor (make-kill-destructor))) + (lambda args + (define results + ((compose list (cut apply destructor args)))) + + (#$%ensure-epicyon-overlay-unmounted) + + (apply values results))))) + + (documentation "Run Epicyon daemon."))))) + +(define epicyon-service-type + (service-type + (name 'epicyon) + (extensions + (list (service-extension account-service-type + (const %epicyon-passwd)) + (service-extension activation-service-type + epicyon-activation) + (service-extension shepherd-root-service-type + epicyon-shepherd-services))) + (description + "Host an instance of the Epicyon social media platform."))) + + +;;; ;;; Patchwork ;;; |