diff options
| author | Ludovic Courtès <ludo@gnu.org> | 2022-07-01 09:38:09 +0200 |
|---|---|---|
| committer | Ludovic Courtès <ludo@gnu.org> | 2022-07-01 12:10:28 +0200 |
| commit | 0483c71cc5aeb3b69f6deb154fe12c0b2e6dc17f (patch) | |
| tree | 6e6d54505a3e9828a328d7057ca9904054cd2311 /gnu/services | |
| parent | 4636640de8ecd9e3702bca75c9ce0649ac5d4979 (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.scm | 51 |
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 |