diff options
author | Ludovic Courtès <ludo@gnu.org> | 2018-03-07 10:00:07 +0100 |
---|---|---|
committer | Ludovic Courtès <ludo@gnu.org> | 2018-03-07 11:22:42 +0100 |
commit | 6c4458172d12dbda969c2eae5b3b6be19a068780 (patch) | |
tree | 6f1421d919d64a8aaa0eb9c816a9c8463748f4c9 /gnu/services/base.scm | |
parent | 366ddc1ac549efee9acd1fddd30c9baee89ec18a (diff) | |
download | guix-6c4458172d12dbda969c2eae5b3b6be19a068780.tar guix-6c4458172d12dbda969c2eae5b3b6be19a068780.tar.gz |
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.
Diffstat (limited to 'gnu/services/base.scm')
-rw-r--r-- | gnu/services/base.scm | 64 |
1 files changed, 30 insertions, 34 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm index 69e211ffa3..be30f2d9c3 100644 --- a/gnu/services/base.scm +++ b/gnu/services/base.scm @@ -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)) ;;; |