gnu: file-system-shepherd-service: Use mount-file-system.

* gnu/services/base.scm (file-system-shepherd-service): Use
  mount-file-system instead of manually mounting the file system.
This commit is contained in:
John Darrington 2016-11-29 19:33:39 +01:00 committed by David Craven
parent d24727c019
commit bf7ef1bb84
No known key found for this signature in database
GPG Key ID: C5E051C79C0BECDB
1 changed files with 9 additions and 29 deletions

View File

@ -252,6 +252,8 @@ FILE-SYSTEM."
(device (file-system-device file-system)) (device (file-system-device file-system))
(type (file-system-type file-system)) (type (file-system-type file-system))
(title (file-system-title file-system)) (title (file-system-title file-system))
(flags (file-system-flags file-system))
(options (file-system-options 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)))
@ -264,34 +266,12 @@ FILE-SYSTEM."
,@(map dependency->shepherd-service-name dependencies))) ,@(map dependency->shepherd-service-name dependencies)))
(documentation "Check, mount, and unmount the given file system.") (documentation "Check, mount, and unmount the given file system.")
(start #~(lambda args (start #~(lambda args
;; FIXME: Use or factorize with 'mount-file-system'. #$(if create?
(let ((device (canonicalize-device-spec #$device '#$title)) #~(mkdir-p #$target)
(flags #$(mount-flags->bit-mask #t)
(file-system-flags file-system)))) (mount-file-system
#$(if create? `(#$device #$title #$target #$type #$flags #$options
#~(mkdir-p #$target) #$check?) #:root "/")
#~#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)) #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
@ -305,7 +285,7 @@ FILE-SYSTEM."
;; 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 (mount-file-system))
,@%default-modules))))))) ,@%default-modules)))))))
(define file-system-service-type (define file-system-service-type