mirror of
https://git.in.rschanz.org/ryan77627/guix.git
synced 2024-11-07 07:26:13 -05:00
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.
This commit is contained in:
Ludovic Courtès
parent
e43e84ba7a
commit
be21979d85
3 changed files with 60 additions and 48 deletions
|
|
@ -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.
|
||||
|
||||
@item @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
|
||||
|
|
|
|||
|
|
@ -222,57 +222,60 @@ (define (file-system-dmd-service 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)
|
||||
(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))
|
||||
(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.
|
||||
;; 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 "/")
|
||||
;; Make sure PID 1 doesn't keep TARGET busy.
|
||||
(chdir "/")
|
||||
|
||||
(umount #$target)
|
||||
#f))
|
||||
(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))))))
|
||||
;; 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 @@ (define* (user-processes-service file-systems #:key (grace-delay 4))
|
|||
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)))
|
||||
|
||||
|
||||
;;;
|
||||
|
|
|
|||
|
|
@ -35,6 +35,7 @@ (define-module (gnu system file-systems)
|
|||
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 @@ (define-record-type* <file-system> file-system
|
|||
(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 @@ (define (file-system->spec fs)
|
|||
"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
|
||||
|
|
|
|||
Loading…
Reference in a new issue