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
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
| | ;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021 raid5atemyhomework <raid5atemyhomework@protonmail.com>
;;;
;;; This file is part of GNU Guix.
;;;
;;; GNU Guix is free software; you can redistribute it and/or modify it
;;; under the terms of the GNU General Public License as published by
;;; the Free Software Foundation; either version 3 of the License, or (at
;;; your option) any later version.
;;;
;;; GNU Guix is distributed in the hope that it will be useful, but
;;; WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;;; GNU General Public License for more details.
;;;
;;; You should have received a copy of the GNU General Public License
;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
(define-module (gnu services file-systems)
#:use-module (gnu packages file-systems)
#:use-module (gnu services)
#:use-module (gnu services base)
#:use-module (gnu services linux)
#:use-module (gnu services shepherd)
#:use-module (gnu system mapped-devices)
#:use-module (guix gexp)
#:use-module (guix packages)
#:use-module (guix records)
#:export (zfs-service-type
zfs-configuration
zfs-configuration?
zfs-configuration-kernel
zfs-configuration-base-zfs
zfs-configuration-dependencies
%zfs-zvol-dependency))
(define-record-type* <zfs-configuration>
zfs-configuration make-zfs-configuration zfs-configuration?
; kernel you want to compile the base-zfs module for.
(kernel zfs-configuration-kernel)
; base package that will be compiled for the kernel
(base-zfs zfs-configuration-base-zfs
(default zfs))
; list of <mapped-device> | <file-system> we should wait for,
; before scanning for ZFS pools.
(dependencies zfs-configuration-dependencies
(default '())))
;; This is a synthetic and unusable MAPPED-DEVICE; its only use
;; is to be added as a (dependency ...) of some FILE-SYSTEM.
(define %zfs-zvol-dependency
(mapped-device
(source '())
;; The /* prevents naming conflict with non-ZFS device mappings,
;; since it is not a valid name for mapped devices, and also
;; implies "all zvols" in terms of globs.
(targets '("zvol/*"))
(type #f)))
(define (make-zfs-package conf)
(let ((base-zfs (zfs-configuration-base-zfs conf))
(kernel (zfs-configuration-kernel conf)))
(package
(inherit base-zfs)
(name (string-join (list (package-name base-zfs)
"for"
(package-name kernel)
(package-version kernel)
"version")
"-"))
(arguments (cons* #:linux kernel (package-arguments base-zfs))))))
(define (zfs-loadable-module conf)
(list (list (make-zfs-package conf) "module")))
(define (zfs-shepherd-services conf)
(let* ((zfs-package (make-zfs-package conf))
(zpool (file-append zfs-package "/sbin/zpool"))
(zfs (file-append zfs-package "/sbin/zfs"))
(zvol_wait (file-append zfs-package "/bin/zvol_wait"))
(scheme-modules `((srfi srfi-1)
(srfi srfi-34)
(srfi srfi-35)
(rnrs io ports)
,@%default-modules)))
(define zfs-scan
(shepherd-service
(provision '(zfs-scan))
(documentation "Scans for ZFS pools.")
(requirement `(kernel-module-loader
root-file-system
,@(map dependency->shepherd-service-name
(zfs-configuration-dependencies conf))))
(modules scheme-modules)
(start #~(lambda _
(guard (c ((message-condition? c)
(format (current-error-port)
"error importing zpools: ~a~%"
(condition-message c))
#f))
; TODO: optionally use a cachefile, for systems with dozens or
; hundreds of devices.
(invoke/quiet #$zpool "import" "-a" "-N"))))
(stop #~(const #t))))
(define device-mapping-zvol/*
(shepherd-service
(provision '(device-mapping-zvol/*))
(documentation "Waits for ZFS ZVOL devices to appear.")
(requirement '(zfs-scan))
(modules scheme-modules)
(start #~(lambda _
(guard (c ((message-condition? c)
(format (current-error-port)
"error waiting for zvols: ~a~%"
(condition-message c))
#f))
(invoke/quiet #$zvol_wait))))
(stop #~(const #t))))
(define zfs-automount
(shepherd-service
(provision '(zfs-automount))
(documentation "Automounts ZFS datasets.")
(requirement '(zfs-scan))
(modules scheme-modules)
(start #~(lambda _
(guard (c ((message-condition? c)
(format (current-error-port)
"error automounting zfs: ~a~$")
#f))
; (current-output-port) is typically connected to /dev/klog,
; so redirect it to (current-error-port) so that user can see
; prompts for passphrases on console
(with-output-to-port (current-error-port)
(lambda ()
(invoke #$zfs "mount" "-a" "-l"))))))
(stop #~(lambda _
;; make sure we don't keep any ZFS mountpoints busy.
(chdir "/")
;; unmount everything.
(invoke/quiet #$zfs "unmount" "-a" "-f")))))
(list zfs-scan
device-mapping-zvol/*
zfs-automount)))
(define zfs-service-type
(service-type (name 'zfs)
(extensions
(list
; install the kernel module
(service-extension kernel-loadable-module-service-type
zfs-loadable-module)
; load the kernel module
(service-extension kernel-module-loader-service-type
(const '("zfs")))
; scan ZFS pools, automount filesystem, wait for zvols.
(service-extension shepherd-root-service-type
zfs-shepherd-services)
; make sure automount occurs before file-systems target is reached
(service-extension file-systems-target-service-type
(const '(zfs-automount)))
; install ZFS management tools
(service-extension profile-service-type
(compose list make-zfs-package))
; install ZFS udev rules
(service-extension udev-service-type
(compose list make-zfs-package))))
(description
"Install ZFS, an advanced filesystem and volume manager.")))
|