From 0483c71cc5aeb3b69f6deb154fe12c0b2e6dc17f Mon Sep 17 00:00:00 2001
From: Ludovic Courtès <ludo@gnu.org>
Date: Fri, 1 Jul 2022 09:38:09 +0200
Subject: services: root-file-system: Cleanly unmount upon shutdown.

Fixes <https://issues.guix.gnu.org/56209>.
Reported by angry rectangle <angryrectangle@cock.li>.

* gnu/packages/admin.scm (shepherd-0.9)[modules, snippet]: New fields.
* gnu/services/base.scm (%root-file-system-shepherd-service): In 'stop'
method, remove 'call-with-blocked-asyncs'.  When 'mount' throws to
'system-error, call (@ (fibers) sleep) and try again.
* gnu/tests/base.scm (run-root-unmount-test): New procedure.
(%test-root-unmount): New variable.
---
 gnu/services/base.scm | 51 ++++++++++++++++++++++++++++++---------------------
 1 file changed, 30 insertions(+), 21 deletions(-)

(limited to 'gnu/services')

diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index 75a0cf69d7..27eae75c46 100644
--- a/gnu/services/base.scm
+++ b/gnu/services/base.scm
@@ -300,27 +300,36 @@ (define %root-file-system-shepherd-service
              ;; Return #f if successfully stopped.
              (sync)
 
-             (call-with-blocked-asyncs
-              (lambda ()
-                (let ((null (%make-void-port "w")))
-                  ;; Close 'shepherd.log'.
-                  (display "closing log\n")
-                  ((@ (shepherd comm) stop-logging))
-
-                  ;; Redirect the default output ports..
-                  (set-current-output-port null)
-                  (set-current-error-port null)
-
-                  ;; Close /dev/console.
-                  (for-each close-fdes '(0 1 2))
-
-                  ;; At this point, there are no open files left, so the
-                  ;; root file system can be re-mounted read-only.
-                  (mount #f "/" #f
-                         (logior MS_REMOUNT MS_RDONLY)
-                         #:update-mtab? #f)
-
-                  #f)))))
+             (let ((null (%make-void-port "w")))
+               ;; Close 'shepherd.log'.
+               (display "closing log\n")
+               ((@ (shepherd comm) stop-logging))
+
+               ;; Redirect the default output ports..
+               (set-current-output-port null)
+               (set-current-error-port null)
+
+               ;; Close /dev/console.
+               (for-each close-fdes '(0 1 2))
+
+               ;; At this point, there should be no open files left so the
+               ;; root file system can be re-mounted read-only.
+               (let loop ((n 10))
+                 (unless (catch 'system-error
+                           (lambda ()
+                             (mount #f "/" #f
+                                    (logior MS_REMOUNT MS_RDONLY)
+                                    #:update-mtab? #f)
+                             #t)
+                           (const #f))
+                   (unless (zero? n)
+                     ;; Yield to the other fibers.  That gives logging fibers
+                     ;; an opportunity to close log files so the 'mount' call
+                     ;; doesn't fail with EBUSY.
+                     ((@ (fibers) sleep) 1)
+                     (loop (- n 1)))))
+
+               #f)))
    (respawn? #f)))
 
 (define root-file-system-service-type
-- 
cgit v1.2.3