diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2015-12-22 00:25:40 +0100 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2015-12-22 00:29:21 +0100 |
| commit | be21979d85304fedd5c0fb970ffc337d220eda7a (patch) | |
| tree | 412dd53a12dbd483a95e541c86e2eec6881e9f3d | |
| parent | e43e84ba7a566abf3f6d552e494b34b483820a5b (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.texi | 6 | ||||
| -rw-r--r-- | gnu/services/base.scm | 107 | ||||
| -rw-r--r-- | gnu/system/file-systems.scm | 5 |
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}) |
| 5937 | This is either @code{#f}, or a string denoting mount options. | 5937 | This is either @code{#f}, or a string denoting mount options. |
| 5938 | 5938 | ||
| 5939 | @item @code{mount?} (default: @code{#t}) | ||
| 5940 | This value indicates whether to automatically mount the file system when | ||
| 5941 | the system is brought up. When set to @code{#f}, the file system gets | ||
| 5942 | an entry in @file{/etc/fstab} (read by the @command{mount} command) but | ||
| 5943 | is not automatically mounted. | ||
| 5944 | |||
| 5939 | @item @code{needed-for-boot?} (default: @code{#f}) | 5945 | @item @code{needed-for-boot?} (default: @code{#f}) |
| 5940 | This Boolean value indicates whether the file system is needed when | 5946 | This Boolean value indicates whether the file system is needed when |
| 5941 | booting. If that is true, then the file system is mounted when the | 5947 | 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 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. | |||
| 416 | All the services that spawn processes must depend on this one so that they are | 419 | All the services that spawn processes must depend on this one so that they are |
| 417 | stopped before 'kill' is called." | 420 | stopped 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 |
| 113 | initrd code." | 116 | initrd 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 |
