services: Add overlayfs-service-type.

The `overlayfs-service-type` allows overlay filesystems to be automatically
mounted upon boot and reconfiguration.

* gnu/services/overlayfs.scm: New file.
* gnu/local.ml (GNU_SYSTEM_MODULES): Add it.

Change-Id: I94bb3e3a29648faa354931f3c1cebc5947ab1d5c

1 files changed, 72 insertions, 0 deletions

diff --git a/gnu/services/overlayfs.scm b/gnu/services/overlayfs.scm
new file mode 100644
index 0000000000..223cfc1e44
--- /dev/null
+++ b/gnu/services/overlayfs.scm
@@ -0,0 +1,72 @@
+;;; SPDX-License-Identifier: CC0-1.0
+;;;
+;;; Copyright © 2023, 2024 Wojtek Kosior <koszko@koszko.org>
+;;; Additions and modifications by Wojtek Kosior are additionally
+;;; dual-licensed under the Creative Commons Zero v1.0.
+
+(define-module (gnu services overlayfs)
+  #:use-module ((srfi srfi-1) #:select (concatenate))
+  #:use-module ((guix records) #:select
+                (define-record-type* match-record-lambda))
+  #:use-module ((guix gexp) #:select (gexp))
+  #:use-module ((gnu services) #:select
+                (service-extension activation-service-type service-type))
+  #:export (overlayfs-service-type
+            overlayfs-mount-configuration
+            overlayfs-mount-configuration?
+            overlayfs-mount-configuration-lower
+            overlayfs-mount-configuration-upper
+            overlayfs-mount-configuration-work))
+
+(define-record-type* <overlayfs-mount-configuration>
+  overlayfs-mount-configuration
+  make-overlayfs-mount-configuration overlayfs-mount-configuration?
+  (upper  overlayfs-mount-configuration-upper)
+  (lower  overlayfs-mount-configuration-lower)
+  (work   overlayfs-mount-configuration-work)
+  (target overlayfs-mount-configuration-target))
+
+(define (overlayfs-activation configs)
+  #~(begin
+      (use-modules ((srfi srfi-1) #:select (filter-map))
+                   ((srfi srfi-26) #:select (cut))
+                   ((ice-9 textual-ports) #:select (get-string-all))
+                   ((ice-9 regex) #:select (string-match match:substring))
+                   ((ice-9 format) #:select (format)))
+
+      (let* ((overlay-configs
+              '#$(map (match-record-lambda <overlayfs-mount-configuration>
+                          (upper lower work target)
+                        (list upper lower work target))
+                      configs))
+
+             (current-mounts
+              (filter-map (compose (cut and=> <> (cut match:substring <> 1))
+                                   (cut string-match "^\\S+ (\\S+)" <>))
+                          (string-split (call-with-input-file "/proc/mounts"
+                                          get-string-all)
+                                        #\newline)))
+
+             (mount-overlay
+              (lambda (upper lower work target)
+                (unless (member target current-mounts)
+                  (system* "mount" "dummy" target "-t" "overlay"
+                           "-o" (format #f "~{~a=~a~^,~}"
+                                        (list "lowerdir" lower
+                                              "upperdir" upper
+                                              "workdir"  work)))))))
+
+        (for-each (lambda (config-values)
+                    (for-each mkdir-p config-values)
+                    (apply mount-overlay config-values))
+                  overlay-configs))))
+
+(define overlayfs-service-type
+  (service-type
+   (name 'overlayfs)
+   (extensions
+    (list (service-extension activation-service-type overlayfs-activation)))
+   (compose concatenate)
+   (extend append)
+   (default-value '())
+   (description "Automatically mount overlay filesystems.")))