summaryrefslogtreecommitdiff
path: root/gnu/services
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2022-07-01 09:38:09 +0200
committerLudovic Courtès <ludo@gnu.org>2022-07-01 12:10:28 +0200
commit0483c71cc5aeb3b69f6deb154fe12c0b2e6dc17f (patch)
tree6e6d54505a3e9828a328d7057ca9904054cd2311 /gnu/services
parent4636640de8ecd9e3702bca75c9ce0649ac5d4979 (diff)
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.
Diffstat (limited to 'gnu/services')
-rw-r--r--gnu/services/base.scm51
1 files changed, 30 insertions, 21 deletions
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 @@ system objects.")))
;; 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