From 14172a3b096f96e63219034a68ff94f55d2d63f4 Mon Sep 17 00:00:00 2001
From: Wojtek Kosior <koszko@koszko.org>
Date: Mon, 22 Jan 2024 12:56:55 +0100
Subject: 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
---
 gnu/local.mk               |  1 +
 gnu/services/overlayfs.scm | 72 ++++++++++++++++++++++++++++++++++++++++++++++
 2 files changed, 73 insertions(+)
 create mode 100644 gnu/services/overlayfs.scm

(limited to 'gnu')

diff --git a/gnu/local.mk b/gnu/local.mk
index 3c64946679..f651f00eb2 100644
--- a/gnu/local.mk
+++ b/gnu/local.mk
@@ -746,6 +746,7 @@ GNU_SYSTEM_MODULES =				\
   %D%/services/shepherd.scm			\
   %D%/services/sound.scm			\
   %D%/services/herd.scm				\
+  %D%/services/overlayfs.scm			\
   %D%/services/pm.scm				\
   %D%/services/rsync.scm			\
   %D%/services/samba.scm			\
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.")))
-- 
cgit v1.2.3