aboutsummaryrefslogtreecommitdiff
path: root/gnu/services/base.scm
diff options
context:
space:
mode:
Diffstat (limited to 'gnu/services/base.scm')
-rw-r--r--gnu/services/base.scm59
1 files changed, 36 insertions, 23 deletions
diff --git a/gnu/services/base.scm b/gnu/services/base.scm
index d58afb27e3..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
@@ -2912,8 +2921,12 @@ to handle."
(define %greetd-accounts
(list (user-account
(name "greeter")
- (group "wheel")
- (supplementary-groups '("users" "tty" "input" "video" "audio"))
+ (group "greeter")
+ ;; video group is required for graphical greeters.
+ (supplementary-groups '("video"))
+ (system? #t))
+ (user-group
+ (name "greeter")
(system? #t))))
(define %greetd-file-systems