ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-12-24 05:18:07 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

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}) @item @code{options} (default: @code{#f})
This is either @code{#f}, or a string denoting mount options. 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}) @item @code{needed-for-boot?} (default: @code{#f})
This Boolean value indicates whether the file system is needed when This Boolean value indicates whether the file system is needed when
booting. If that is true, then the file system is mounted when the booting. If that is true, then the file system is mounted when the

97
gnu/services/base.scm
View file

@ -222,57 +222,60 @@ (define (file-system-dmd-service file-system)
(check? (file-system-check? file-system)) (check? (file-system-check? file-system))
(create? (file-system-create-mount-point? file-system)) (create? (file-system-create-mount-point? file-system))
(dependencies (file-system-dependencies file-system))) (dependencies (file-system-dependencies file-system)))
(list (dmd-service (if (file-system-mount? file-system)
(provision (list (file-system->dmd-service-name file-system))) (list
(requirement `(root-file-system (dmd-service
,@(map dependency->dmd-service-name dependencies))) (provision (list (file-system->dmd-service-name file-system)))
(documentation "Check, mount, and unmount the given file system.") (requirement `(root-file-system
(start #~(lambda args ,@(map dependency->dmd-service-name dependencies)))
;; FIXME: Use or factorize with 'mount-file-system'. (documentation "Check, mount, and unmount the given file system.")
(let ((device (canonicalize-device-spec #$device '#$title)) (start #~(lambda args
(flags #$(mount-flags->bit-mask ;; FIXME: Use or factorize with 'mount-file-system'.
(file-system-flags file-system)))) (let ((device (canonicalize-device-spec #$device '#$title))
#$(if create? (flags #$(mount-flags->bit-mask
#~(mkdir-p #$target) (file-system-flags file-system))))
#~#t) #$(if create?
#$(if check? #~(mkdir-p #$target)
#~(begin #~#t)
;; Make sure fsck.ext2 & co. can be found. #$(if check?
(setenv "PATH" #~(begin
(string-append ;; Make sure fsck.ext2 & co. can be found.
#$e2fsprogs "/sbin:" (setenv "PATH"
"/run/current-system/profile/sbin:" (string-append
(getenv "PATH"))) #$e2fsprogs "/sbin:"
(check-file-system device #$type)) "/run/current-system/profile/sbin:"
#~#t) (getenv "PATH")))
(check-file-system device #$type))
#~#t)
(mount device #$target #$type flags (mount device #$target #$type flags
#$(file-system-options file-system)) #$(file-system-options file-system))
;; For read-only bind mounts, an extra remount is needed, ;; For read-only bind mounts, an extra remount is
;; as per <http://lwn.net/Articles/281157/>, which still ;; needed, as per <http://lwn.net/Articles/281157/>,
;; applies to Linux 4.0. ;; which still applies to Linux 4.0.
(when (and (= MS_BIND (logand flags MS_BIND)) (when (and (= MS_BIND (logand flags MS_BIND))
(= MS_RDONLY (logand flags MS_RDONLY))) (= MS_RDONLY (logand flags MS_RDONLY)))
(mount device #$target #$type (mount device #$target #$type
(logior MS_BIND MS_REMOUNT MS_RDONLY)))) (logior MS_BIND MS_REMOUNT MS_RDONLY))))
#t)) #t))
(stop #~(lambda args (stop #~(lambda args
;; Normally there are no processes left at this point, so ;; Normally there are no processes left at this point, so
;; TARGET can be safely unmounted. ;; TARGET can be safely unmounted.
;; Make sure PID 1 doesn't keep TARGET busy. ;; Make sure PID 1 doesn't keep TARGET busy.
(chdir "/") (chdir "/")
(umount #$target) (umount #$target)
#f)) #f))
;; We need an additional module. ;; We need an additional module.
(modules `(((gnu build file-systems) (modules `(((gnu build file-systems)
#:select (check-file-system canonicalize-device-spec)) #:select (check-file-system canonicalize-device-spec))
,@%default-modules)) ,@%default-modules))
(imported-modules `((gnu build file-systems) (imported-modules `((gnu build file-systems)
,@%default-imported-modules)))))) ,@%default-imported-modules))))
'())))
(define file-system-service-type (define file-system-service-type
;; TODO(?): Make this an extensible service that takes <file-system> objects ;; 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 All the services that spawn processes must depend on this one so that they are
stopped before 'kill' is called." stopped before 'kill' is called."
(service user-processes-service-type (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 @@ (define-module (gnu system file-systems)
file-system-needed-for-boot? file-system-needed-for-boot?
file-system-flags file-system-flags
file-system-options file-system-options
file-system-mount?
file-system-check? file-system-check?
file-system-create-mount-point? file-system-create-mount-point?
file-system-dependencies file-system-dependencies
@ -93,6 +94,8 @@ (define-record-type* <file-system> file-system
(default '())) (default '()))
(options file-system-options ; string or #f (options file-system-options ; string or #f
(default #f)) (default #f))
(mount? file-system-mount? ; Boolean
(default #t))
(needed-for-boot? %file-system-needed-for-boot? ; Boolean (needed-for-boot? %file-system-needed-for-boot? ; Boolean
(default #f)) (default #f))
(check? file-system-check? ; Boolean (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 "Return a list corresponding to file-system FS that can be passed to the
initrd code." initrd code."
(match fs (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?)))) (list device title mount-point type flags options check?))))
(define %uuid-rx (define %uuid-rx