02/08: services: file-systems: Include 'user-file-systems' service.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository guix.

commit 6c4458172d12dbda969c2eae5b3b6be19a068780
Author: Ludovic Courtès <address@hidden>
Date:   Wed Mar 7 10:00:07 2018 +0100

    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.
---
 gnu/services/base.scm  | 64 +++++++++++++++++++++++---------------------------
 gnu/system.scm         |  3 +--
 gnu/system/install.scm |  2 +-
 3 files changed, 32 insertions(+), 37 deletions(-)

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 69e211f..be30f2d 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))
 
 
 ;;;
diff --git a/gnu/system.scm b/gnu/system.scm
index 1bcc1e1..eb4b63c 100644
--- a/gnu/system.scm
+++ b/gnu/system.scm
@@ -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
diff --git a/gnu/system/install.scm b/gnu/system/install.scm
index 37c591e..97f5abe 100644
--- a/gnu/system/install.scm
+++ b/gnu/system/install.scm
@@ -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))))))))