services: file-systems: Include 'user-file-systems' service.

Previously the KNOWN-FS value used in 'essential-services' would be
incomplete: it would lack all the file systems provided by services that
extend 'file-system-service-type' (/sys/fs/cgroup,
/proc/sys/fs/binfmt_misc, etc.)  Consequently, upon shutdown,
'user-processes' would unmount these file systems before their
corresponding service had been stopped; when their corresponding (e.g.,
'file-system-/proc/sys/fs/binfmt_misc') was stopped, its 'umount' call
would fail.

This was harmless in practice, but this patch makes sure things work as
intended and file systems are unmounted in the right order.

* gnu/services/base.scm (file-system-shepherd-services): Instantiate
'user-file-systems' Shepherd service from here.
(user-unmount-service-type, user-unmount-service): Remove.
* gnu/system.scm (essential-services): Remove call to 'user-unmount-service'.
* gnu/system/install.scm (cow-store-service-type): Adjust comment.
This commit is contained in:
Ludovic Courtès 2018-03-07 10:00:07 +01:00
parent 366ddc1ac5
commit 6c4458172d
No known key found for this signature in database
GPG Key ID: 090B11993D9AEBB5
3 changed files with 32 additions and 37 deletions

View File

@ -55,7 +55,6 @@
#:export (fstab-service-type
root-file-system-service
file-system-service-type
user-unmount-service
swap-service
user-processes-service-type
host-name-service
@ -464,7 +463,36 @@ FILE-SYSTEM."
(start #~(const #t))
(stop #~(const #f))))
(cons sink (map file-system-shepherd-service file-systems))))
(define known-mount-points
(map file-system-mount-point file-systems))
(define user-unmount
(shepherd-service
(documentation "Unmount manually-mounted file systems.")
(provision '(user-file-systems))
(start #~(const #t))
(stop #~(lambda args
(define (known? mount-point)
(member mount-point
(cons* "/proc" "/sys" '#$known-mount-points)))
;; Make sure we don't keep the user's mount points busy.
(chdir "/")
(for-each (lambda (mount-point)
(format #t "unmounting '~a'...~%" mount-point)
(catch 'system-error
(lambda ()
(umount mount-point))
(lambda args
(let ((errno (system-error-errno args)))
(format #t "failed to unmount '~a': ~a~%"
mount-point (strerror errno))))))
(filter (negate known?) (mount-points)))
#f))))
(cons* sink user-unmount
(map file-system-shepherd-service file-systems))))
(define file-system-service-type
(service-type (name 'file-systems)
@ -483,38 +511,6 @@ FILE-SYSTEM."
"Provide Shepherd services to mount and unmount the given
file systems, as well as corresponding @file{/etc/fstab} entries.")))
(define user-unmount-service-type
(shepherd-service-type
'user-file-systems
(lambda (known-mount-points)
(shepherd-service
(documentation "Unmount manually-mounted file systems.")
(provision '(user-file-systems))
(start #~(const #t))
(stop #~(lambda args
(define (known? mount-point)
(member mount-point
(cons* "/proc" "/sys" '#$known-mount-points)))
;; Make sure we don't keep the user's mount points busy.
(chdir "/")
(for-each (lambda (mount-point)
(format #t "unmounting '~a'...~%" mount-point)
(catch 'system-error
(lambda ()
(umount mount-point))
(lambda args
(let ((errno (system-error-errno args)))
(format #t "failed to unmount '~a': ~a~%"
mount-point (strerror errno))))))
(filter (negate known?) (mount-points)))
#f))))))
(define (user-unmount-service known-mount-points)
"Return a service whose sole purpose is to unmount file systems not listed
in KNOWN-MOUNT-POINTS when it is stopped."
(service user-unmount-service-type known-mount-points))
;;;

View File

@ -453,7 +453,6 @@ a container or that of a \"bare metal\" system."
(let* ((mappings (device-mapping-services os))
(root-fs (root-file-system-service))
(other-fs (non-boot-file-system-service os))
(unmount (user-unmount-service known-fs))
(swaps (swap-services os))
(procs (service user-processes-service-type))
(host-name (host-name-service (operating-system-host-name os)))
@ -478,7 +477,7 @@ a container or that of a \"bare metal\" system."
(service fstab-service-type '())
(session-environment-service
(operating-system-environment-variables os))
host-name procs root-fs unmount
host-name procs root-fs
(service setuid-program-service-type
(operating-system-setuid-programs os))
(service profile-service-type

View File

@ -133,7 +133,7 @@ the given target.")
(stop #~(lambda (target)
;; Delete the temporary directory, but leave everything
;; mounted as there may still be processes using it since
;; 'user-processes' doesn't depend on us. The 'user-unmount'
;; 'user-processes' doesn't depend on us. The 'user-file-systems'
;; service will unmount TARGET eventually.
(delete-file-recursively
(string-append target #$%backing-directory))))))))