blob: 223cfc1e44f4d54ec1771abdf39f4dd19cad15f4 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
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.")))
|
