me/guix
Archived
1
0
Fork 0
Code Activity

file-systems: Add a 'mount?' field.

Browse source 
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 2015-12-22 00:25:40 +01:00
parent e43e84ba7a
commit be21979d85
3 changed files with 60 additions and 48 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

6
doc/guix.texi
View file

@ -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

97
gnu/services/base.scm
View file

@ -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)
(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 @@ 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)))
;;;

5
gnu/system/file-systems.scm
View file

@ -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