services: Add epicyon-service-type.

* gnu/services/web.scm (define-module): Use `util-linux' from `(gnu packages
  linux)'.
  [#:export]: Export new service type as well as configuration constructor,
  predicate and getters.
  (<epicyon-configuration>): New variable.
  (epicyon-activation): New procedure.
  (%epicyon-passwd): New variable.
  (%ensure-epicyon-overlay-unmounted): New variable.
  (epicyon-shepherd-services): New procedure.
  (epicyon-service-type): New variable.

Change-Id: I9e786594b75b588099d3b9f6b0ab5663903c9db4

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
 ;;;