diff options
| -rw-r--r-- | gnu/local.mk | 1 | ||||
| -rw-r--r-- | gnu/services/overlayfs.scm | 72 |
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."))) |