aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--gnu/local.mk1
-rw-r--r--gnu/services/overlayfs.scm72
2 files changed, 73 insertions, 0 deletions
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.")))