guix-bioinformatics
/
guix
mirror of http://git.savannah.gnu.org/git/guix.git
3
0
Fork 0
Code Issues Projects Releases Wiki Activity
Browse Source

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.
wip-mediagoblin
Ludovic Courtès 7 years ago
parent
e43e84ba7a
commit
be21979d85
3 changed files with 65 additions and 53 deletions
Whitespace
Show all changes Ignore whitespace when comparing lines Ignore changes in amount of whitespace Ignore changes in whitespace at EOL
Split View
Diff Options
Show Stats Download Patch File Download Diff File
  1. 6
      doc/guix.texi
  2. 107
      gnu/services/base.scm
  3. 5
      gnu/system/file-systems.scm

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

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

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

Write Preview
Loading…
Cancel
Save