3 files changed, 36 insertions(+), 2 deletions(-)

M gnu/services/base.scm
M gnu/system.scm
M gnu/system/install.scm

@@ 38,6 38,7 @@
   #:use-module (ice-9 format)
   #:export (root-file-system-service
             file-system-service
+            user-unmount-service
             device-mapping-service
             swap-service
             user-processes-service


@@ 145,6 146,33 @@ names such as device-mapping services."
                 (umount #$target)
                 #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."
+  (with-monad %store-monad
+    (return
+     (service
+      (documentation "Unmount manually-mounted file systems.")
+      (provision '(user-unmount))
+      (start #~(const #t))
+      (stop #~(lambda args
+                (define (known? mount-point)
+                  (member mount-point
+                          (cons* "/proc" "/sys"
+                                 '#$known-mount-points)))
+
+                (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 %do-not-kill-file
   ;; Name of the file listing PIDs of processes that must survive when halting
   ;; the system.  Typical example is user-space file systems.

@@ 269,16 269,20 @@ from the initrd."
   "Return the list of essential services for OS.  These are special services
 that implement part of what's declared in OS are responsible for low-level
 bookkeeping."
+  (define known-fs
+    (map file-system-mount-point (operating-system-file-systems os)))
+
   (mlet* %store-monad ((mappings  (device-mapping-services os))
                        (root-fs   (root-file-system-service))
                        (other-fs  (other-file-system-services os))
+                       (unmount   (user-unmount-service known-fs))
                        (swaps     (swap-services os))
                        (procs     (user-processes-service
                                    (map (compose first service-provision)
                                         other-fs)))
                        (host-name (host-name-service
                                    (operating-system-host-name os))))
-    (return (cons* host-name procs root-fs
+    (return (cons* host-name procs root-fs unmount
                    (append other-fs mappings swaps)))))
 
 (define (operating-system-services os)

@@ 112,7 112,9 @@ 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.
+                       ;; since 'user-processes' doesn't depend on us.  The
+                       ;; 'user-unmount' service will unmount TARGET
+                       ;; eventually.
                        (delete-file-recursively
                         (string-append target #$%backing-directory))))))))