summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2015-12-22 00:25:40 +0100
committerLudovic Courtès <ludo@gnu.org>2015-12-22 00:29:21 +0100
commitbe21979d85304fedd5c0fb970ffc337d220eda7a (patch)
tree412dd53a12dbd483a95e541c86e2eec6881e9f3d
parente43e84ba7a566abf3f6d552e494b34b483820a5b (diff)
file-systems: Add a 'mount?' field.
Fixes <http://bugs.gnu.org/22176>. Reported by Florian Paul Schmidt <mista.tapas@gmx.net>. * gnu/system/file-systems.scm (<file-system>)[mount?]: New field. (file-system->spec): Adjust accordingly. * gnu/services/base.scm (file-system-dmd-service): Return the empty list when FILE-SYSTEM has 'mount?' set to false. (user-processes-service): Select the subset of FILE-SYSTEMS that matches 'file-system-mount?'. * doc/guix.texi (File Systems): Document it.
-rw-r--r--doc/guix.texi6
-rw-r--r--gnu/services/base.scm107
-rw-r--r--gnu/system/file-systems.scm5
3 files changed, 65 insertions, 53 deletions
diff --git a/doc/guix.texi b/doc/guix.texi
index a70fbe86ed5..7665ec9610c 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5936,6 +5936,12 @@ bits), and @code{no-exec} (disallow program execution.)
5936@item @code{options} (default: @code{#f}) 5936@item @code{options} (default: @code{#f})
5937This is either @code{#f}, or a string denoting mount options. 5937This is either @code{#f}, or a string denoting mount options.
5938 5938
5939@item @code{mount?} (default: @code{#t})
5940This value indicates whether to automatically mount the file system when
5941the system is brought up. When set to @code{#f}, the file system gets
5942an entry in @file{/etc/fstab} (read by the @command{mount} command) but
5943is not automatically mounted.
5944
5939@item @code{needed-for-boot?} (default: @code{#f}) 5945@item @code{needed-for-boot?} (default: @code{#f})
5940This Boolean value indicates whether the file system is needed when 5946This Boolean value indicates whether the file system is needed when
5941booting. If that is true, then the file system is mounted when the 5947booting. If that is true, then the file system is mounted when the
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 67eeecdf179..25143c80a61 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -222,57 +222,60 @@ FILE-SYSTEM."
222 (check? (file-system-check? file-system)) 222 (check? (file-system-check? file-system))
223 (create? (file-system-create-mount-point? file-system)) 223 (create? (file-system-create-mount-point? file-system))
224 (dependencies (file-system-dependencies file-system))) 224 (dependencies (file-system-dependencies file-system)))
225 (list (dmd-service 225 (if (file-system-mount? file-system)
226 (provision (list (file-system->dmd-service-name file-system))) 226 (list
227 (requirement `(root-file-system 227 (dmd-service
228 ,@(map dependency->dmd-service-name dependencies))) 228 (provision (list (file-system->dmd-service-name file-system)))
229 (documentation "Check, mount, and unmount the given file system.") 229 (requirement `(root-file-system
230 (start #~(lambda args 230 ,@(map dependency->dmd-service-name dependencies)))
231 ;; FIXME: Use or factorize with 'mount-file-system'. 231 (documentation "Check, mount, and unmount the given file system.")
232 (let ((device (canonicalize-device-spec #$device '#$title)) 232 (start #~(lambda args
233 (flags #$(mount-flags->bit-mask 233 ;; FIXME: Use or factorize with 'mount-file-system'.
234 (file-system-flags file-system)))) 234 (let ((device (canonicalize-device-spec #$device '#$title))
235 #$(if create? 235 (flags #$(mount-flags->bit-mask
236 #~(mkdir-p #$target) 236 (file-system-flags file-system))))
237 #~#t) 237 #$(if create?
238 #$(if check? 238 #~(mkdir-p #$target)
239 #~(begin 239 #~#t)
240 ;; Make sure fsck.ext2 & co. can be found. 240 #$(if check?
241 (setenv "PATH" 241 #~(begin
242 (string-append 242 ;; Make sure fsck.ext2 & co. can be found.
243 #$e2fsprogs "/sbin:" 243 (setenv "PATH"
244 "/run/current-system/profile/sbin:" 244 (string-append
245 (getenv "PATH"))) 245 #$e2fsprogs "/sbin:"
246 (check-file-system device #$type)) 246 "/run/current-system/profile/sbin:"
247 #~#t) 247 (getenv "PATH")))
248 248 (check-file-system device #$type))
249 (mount device #$target #$type flags 249 #~#t)
250 #$(file-system-options file-system)) 250
251 251 (mount device #$target #$type flags
252 ;; For read-only bind mounts, an extra remount is needed, 252 #$(file-system-options file-system))
253 ;; as per <http://lwn.net/Articles/281157/>, which still 253
254 ;; applies to Linux 4.0. 254 ;; For read-only bind mounts, an extra remount is
255 (when (and (= MS_BIND (logand flags MS_BIND)) 255 ;; needed, as per <http://lwn.net/Articles/281157/>,
256 (= MS_RDONLY (logand flags MS_RDONLY))) 256 ;; which still applies to Linux 4.0.
257 (mount device #$target #$type 257 (when (and (= MS_BIND (logand flags MS_BIND))
258 (logior MS_BIND MS_REMOUNT MS_RDONLY)))) 258 (= MS_RDONLY (logand flags MS_RDONLY)))
259 #t)) 259 (mount device #$target #$type
260 (stop #~(lambda args 260 (logior MS_BIND MS_REMOUNT MS_RDONLY))))
261 ;; Normally there are no processes left at this point, so 261 #t))
262 ;; TARGET can be safely unmounted. 262 (stop #~(lambda args
263 263 ;; Normally there are no processes left at this point, so
264 ;; Make sure PID 1 doesn't keep TARGET busy. 264 ;; TARGET can be safely unmounted.
265 (chdir "/") 265
266 266 ;; Make sure PID 1 doesn't keep TARGET busy.
267 (umount #$target) 267 (chdir "/")
268 #f)) 268
269 269 (umount #$target)
270 ;; We need an additional module. 270 #f))
271 (modules `(((gnu build file-systems) 271
272 #:select (check-file-system canonicalize-device-spec)) 272 ;; We need an additional module.
273 ,@%default-modules)) 273 (modules `(((gnu build file-systems)
274 (imported-modules `((gnu build file-systems) 274 #:select (check-file-system canonicalize-device-spec))
275 ,@%default-imported-modules)))))) 275 ,@%default-modules))
276 (imported-modules `((gnu build file-systems)
277 ,@%default-imported-modules))))
278 '())))
276 279
277(define file-system-service-type 280(define file-system-service-type
278 ;; TODO(?): Make this an extensible service that takes <file-system> objects 281 ;; TODO(?): Make this an extensible service that takes <file-system> objects
@@ -416,7 +419,7 @@ services corresponding to FILE-SYSTEMS.
416All the services that spawn processes must depend on this one so that they are 419All the services that spawn processes must depend on this one so that they are
417stopped before 'kill' is called." 420stopped before 'kill' is called."
418 (service user-processes-service-type 421 (service user-processes-service-type
419 (list file-systems grace-delay))) 422 (list (filter file-system-mount? file-systems) grace-delay)))
420 423
421 424
422;;; 425;;;
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 0a4b385fe33..47a3dbc1e8b 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -35,6 +35,7 @@
35 file-system-needed-for-boot? 35 file-system-needed-for-boot?
36 file-system-flags 36 file-system-flags
37 file-system-options 37 file-system-options
38 file-system-mount?
38 file-system-check? 39 file-system-check?
39 file-system-create-mount-point? 40 file-system-create-mount-point?
40 file-system-dependencies 41 file-system-dependencies
@@ -93,6 +94,8 @@
93 (default '())) 94 (default '()))
94 (options file-system-options ; string or #f 95 (options file-system-options ; string or #f
95 (default #f)) 96 (default #f))
97 (mount? file-system-mount? ; Boolean
98 (default #t))
96 (needed-for-boot? %file-system-needed-for-boot? ; Boolean 99 (needed-for-boot? %file-system-needed-for-boot? ; Boolean
97 (default #f)) 100 (default #f))
98 (check? file-system-check? ; Boolean 101 (check? file-system-check? ; Boolean
@@ -112,7 +115,7 @@ file system."
112 "Return a list corresponding to file-system FS that can be passed to the 115 "Return a list corresponding to file-system FS that can be passed to the
113initrd code." 116initrd code."
114 (match fs 117 (match fs
115 (($ <file-system> device title mount-point type flags options _ check?) 118 (($ <file-system> device title mount-point type flags options _ _ check?)
116 (list device title mount-point type flags options check?)))) 119 (list device title mount-point type flags options check?))))
117 120
118(define %uuid-rx 121(define %uuid-rx