summaryrefslogtreecommitdiff
path: root/gnu/system/file-systems.scm
diff options
context:
space:
mode:
authorMark H Weaver <mhw@netris.org>2015-07-19 18:12:34 -0400
committerMark H Weaver <mhw@netris.org>2015-07-19 18:12:34 -0400
commit1b4e48d498a96d478baa1aae7d9c7ecdbd817d6f (patch)
tree4b650999e49a6f4d3dd116fab3f9ee8222247e07 /gnu/system/file-systems.scm
parentaa27987f71cb8afa698ede551e20b1248f160113 (diff)
parent50c7a1e297bff0935674b4f30e854a8889becfdd (diff)
Merge branch 'master' into core-updates
Diffstat (limited to 'gnu/system/file-systems.scm')
-rw-r--r--gnu/system/file-systems.scm47
1 files changed, 29 insertions, 18 deletions
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index ece8fb41e67..003eb443d15 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -37,6 +37,7 @@
37 file-system-options 37 file-system-options
38 file-system-check? 38 file-system-check?
39 file-system-create-mount-point? 39 file-system-create-mount-point?
40 file-system-dependencies
40 41
41 file-system->spec 42 file-system->spec
42 string->uuid 43 string->uuid
@@ -97,7 +98,10 @@
97 (check? file-system-check? ; Boolean 98 (check? file-system-check? ; Boolean
98 (default #t)) 99 (default #t))
99 (create-mount-point? file-system-create-mount-point? ; Boolean 100 (create-mount-point? file-system-create-mount-point? ; Boolean
100 (default #f))) 101 (default #f))
102 (dependencies file-system-dependencies ; list of strings (mount
103 ; points depended on)
104 (default '())))
101 105
102(define-inlinable (file-system-needed-for-boot? fs) 106(define-inlinable (file-system-needed-for-boot? fs)
103 "Return true if FS has the 'needed-for-boot?' flag set, or if it's the root 107 "Return true if FS has the 'needed-for-boot?' flag set, or if it's the root
@@ -153,8 +157,10 @@ UUID representation."
153 ((_ str) 157 ((_ str)
154 (string? (syntax->datum #'str)) 158 (string? (syntax->datum #'str))
155 ;; A literal string: do the conversion at expansion time. 159 ;; A literal string: do the conversion at expansion time.
156 (with-syntax ((bv (string->uuid (syntax->datum #'str)))) 160 (let ((bv (string->uuid (syntax->datum #'str))))
157 #''bv)) 161 (unless bv
162 (syntax-violation 'uuid "invalid UUID" s))
163 (datum->syntax #'str bv)))
158 ((_ str) 164 ((_ str)
159 #'(string->uuid str))))) 165 #'(string->uuid str)))))
160 166
@@ -231,21 +237,26 @@ UUID representation."
231 (flags '(read-only bind-mount)))) 237 (flags '(read-only bind-mount))))
232 238
233(define %control-groups 239(define %control-groups
234 (cons (file-system 240 (let ((parent (file-system
235 (device "cgroup") 241 (device "cgroup")
236 (mount-point "/sys/fs/cgroup") 242 (mount-point "/sys/fs/cgroup")
237 (type "tmpfs") 243 (type "tmpfs")
238 (check? #f)) 244 (check? #f))))
239 (map (lambda (subsystem) 245 (cons parent
240 (file-system 246 (map (lambda (subsystem)
241 (device "cgroup") 247 (file-system
242 (mount-point (string-append "/sys/fs/cgroup/" subsystem)) 248 (device "cgroup")
243 (type "cgroup") 249 (mount-point (string-append "/sys/fs/cgroup/" subsystem))
244 (check? #f) 250 (type "cgroup")
245 (options subsystem) 251 (check? #f)
246 (create-mount-point? #t))) 252 (options subsystem)
247 '("cpuset" "cpu" "cpuacct" "memory" "devices" "freezer" 253 (create-mount-point? #t)
248 "blkio" "perf_event" "hugetlb")))) 254
255 ;; This must be mounted after, and unmounted before the
256 ;; parent directory.
257 (dependencies (list parent))))
258 '("cpuset" "cpu" "cpuacct" "memory" "devices" "freezer"
259 "blkio" "perf_event" "hugetlb")))))
249 260
250(define %base-file-systems 261(define %base-file-systems
251 ;; List of basic file systems to be mounted. Note that /proc and /sys are 262 ;; List of basic file systems to be mounted. Note that /proc and /sys are