[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
02/03: file-systems: Add a 'mount?' field.
|
From: |
Ludovic Courtès |
|
Subject: |
02/03: file-systems: Add a 'mount?' field. |
|
Date: |
Mon, 21 Dec 2015 23:32:15 +0000 |
civodul pushed a commit to branch master
in repository guix.
commit be21979d85304fedd5c0fb970ffc337d220eda7a
Author: Ludovic Courtès <address@hidden>
Date: Tue Dec 22 00:25:40 2015 +0100
file-systems: Add a 'mount?' field.
Fixes <http://bugs.gnu.org/22176>.
Reported by Florian Paul Schmidt <address@hidden>.
* 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.
---
doc/guix.texi | 6 ++
gnu/services/base.scm | 107 ++++++++++++++++++++++---------------------
gnu/system/file-systems.scm | 5 ++-
3 files changed, 65 insertions(+), 53 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index a70fbe8..7665ec9 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -5936,6 +5936,12 @@ bits), and @code{no-exec} (disallow program execution.)
@item @code{options} (default: @code{#f})
This is either @code{#f}, or a string denoting mount options.
address@hidden @code{mount?} (default: @code{#t})
+This value indicates whether to automatically mount the file system when
+the system is brought up. When set to @code{#f}, the file system gets
+an entry in @file{/etc/fstab} (read by the @command{mount} command) but
+is not automatically mounted.
+
@item @code{needed-for-boot?} (default: @code{#f})
This Boolean value indicates whether the file system is needed when
booting. 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 67eeecd..25143c8 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -222,57 +222,60 @@ FILE-SYSTEM."
(check? (file-system-check? file-system))
(create? (file-system-create-mount-point? file-system))
(dependencies (file-system-dependencies file-system)))
- (list (dmd-service
- (provision (list (file-system->dmd-service-name file-system)))
- (requirement `(root-file-system
- ,@(map dependency->dmd-service-name dependencies)))
- (documentation "Check, mount, and unmount the given file system.")
- (start #~(lambda args
- ;; FIXME: Use or factorize with 'mount-file-system'.
- (let ((device (canonicalize-device-spec #$device
'#$title))
- (flags #$(mount-flags->bit-mask
- (file-system-flags file-system))))
- #$(if create?
- #~(mkdir-p #$target)
- #~#t)
- #$(if check?
- #~(begin
- ;; Make sure fsck.ext2 & co. can be found.
- (setenv "PATH"
- (string-append
- #$e2fsprogs "/sbin:"
- "/run/current-system/profile/sbin:"
- (getenv "PATH")))
- (check-file-system device #$type))
- #~#t)
-
- (mount device #$target #$type flags
- #$(file-system-options file-system))
-
- ;; For read-only bind mounts, an extra remount is
needed,
- ;; as per <http://lwn.net/Articles/281157/>, which
still
- ;; applies to Linux 4.0.
- (when (and (= MS_BIND (logand flags MS_BIND))
- (= MS_RDONLY (logand flags MS_RDONLY)))
- (mount device #$target #$type
- (logior MS_BIND MS_REMOUNT MS_RDONLY))))
- #t))
- (stop #~(lambda args
- ;; Normally there are no processes left at this point, so
- ;; TARGET can be safely unmounted.
-
- ;; Make sure PID 1 doesn't keep TARGET busy.
- (chdir "/")
-
- (umount #$target)
- #f))
-
- ;; We need an additional module.
- (modules `(((gnu build file-systems)
- #:select (check-file-system canonicalize-device-spec))
- ,@%default-modules))
- (imported-modules `((gnu build file-systems)
- ,@%default-imported-modules))))))
+ (if (file-system-mount? file-system)
+ (list
+ (dmd-service
+ (provision (list (file-system->dmd-service-name file-system)))
+ (requirement `(root-file-system
+ ,@(map dependency->dmd-service-name dependencies)))
+ (documentation "Check, mount, and unmount the given file system.")
+ (start #~(lambda args
+ ;; FIXME: Use or factorize with 'mount-file-system'.
+ (let ((device (canonicalize-device-spec #$device
'#$title))
+ (flags #$(mount-flags->bit-mask
+ (file-system-flags file-system))))
+ #$(if create?
+ #~(mkdir-p #$target)
+ #~#t)
+ #$(if check?
+ #~(begin
+ ;; Make sure fsck.ext2 & co. can be found.
+ (setenv "PATH"
+ (string-append
+ #$e2fsprogs "/sbin:"
+ "/run/current-system/profile/sbin:"
+ (getenv "PATH")))
+ (check-file-system device #$type))
+ #~#t)
+
+ (mount device #$target #$type flags
+ #$(file-system-options file-system))
+
+ ;; For read-only bind mounts, an extra remount is
+ ;; needed, as per <http://lwn.net/Articles/281157/>,
+ ;; which still applies to Linux 4.0.
+ (when (and (= MS_BIND (logand flags MS_BIND))
+ (= MS_RDONLY (logand flags MS_RDONLY)))
+ (mount device #$target #$type
+ (logior MS_BIND MS_REMOUNT MS_RDONLY))))
+ #t))
+ (stop #~(lambda args
+ ;; Normally there are no processes left at this point, so
+ ;; TARGET can be safely unmounted.
+
+ ;; Make sure PID 1 doesn't keep TARGET busy.
+ (chdir "/")
+
+ (umount #$target)
+ #f))
+
+ ;; We need an additional module.
+ (modules `(((gnu build file-systems)
+ #:select (check-file-system canonicalize-device-spec))
+ ,@%default-modules))
+ (imported-modules `((gnu build file-systems)
+ ,@%default-imported-modules))))
+ '())))
(define file-system-service-type
;; TODO(?): Make this an extensible service that takes <file-system> objects
@@ -416,7 +419,7 @@ services corresponding to FILE-SYSTEMS.
All the services that spawn processes must depend on this one so that they are
stopped before 'kill' is called."
(service user-processes-service-type
- (list file-systems grace-delay)))
+ (list (filter file-system-mount? file-systems) grace-delay)))
;;;
diff --git a/gnu/system/file-systems.scm b/gnu/system/file-systems.scm
index 0a4b385..47a3dbc 100644
--- a/gnu/system/file-systems.scm
+++ b/gnu/system/file-systems.scm
@@ -35,6 +35,7 @@
file-system-needed-for-boot?
file-system-flags
file-system-options
+ file-system-mount?
file-system-check?
file-system-create-mount-point?
file-system-dependencies
@@ -93,6 +94,8 @@
(default '()))
(options file-system-options ; string or #f
(default #f))
+ (mount? file-system-mount? ; Boolean
+ (default #t))
(needed-for-boot? %file-system-needed-for-boot? ; Boolean
(default #f))
(check? file-system-check? ; Boolean
@@ -112,7 +115,7 @@ file system."
"Return a list corresponding to file-system FS that can be passed to the
initrd code."
(match fs
- (($ <file-system> device title mount-point type flags options _ check?)
+ (($ <file-system> device title mount-point type flags options _ _ check?)
(list device title mount-point type flags options check?))))
(define %uuid-rx