civodul pushed a commit to branch wip-fibers
in repository shepherd.
commit af3c8673fedc001e55560b8a0f94b1e422bed3bb
Author: Ludovic Courtès <l...@gnu.org>
AuthorDate: Mon Mar 21 22:50:32 2022 +0100
service: 'read-pid-file' uses (@ (guile) sleep) when it's not suspendable.
* modules/shepherd/service.scm (read-pid-file)[sleep*]: New procedure.
[try-again]: Use it instead of 'sleep'.
* tests/pid-file.sh: Call 'start' from the config file top-level. Check
that 'test-works' is running right at the beginning.
* configure.ac: Check for (fibers scheduler).
---
configure.ac | 5 +++++
modules/shepherd/service.scm | 17 ++++++++++++++++-
tests/pid-file.sh | 13 ++++++++++++-
3 files changed, 33 insertions(+), 2 deletions(-)
diff --git a/configure.ac b/configure.ac
index 1b9676c..40598ec 100644
--- a/configure.ac
+++ b/configure.ac
@@ -39,6 +39,11 @@ if test "x$have_fibers" != "xyes"; then
AC_MSG_ERROR([Fibers is missing; please install it.])
fi
+GUILE_MODULE_AVAILABLE([have_recent_fibers], [(fibers scheduler)])
+if test "x$have_recent_fibers" != "xyes"; then
+ AC_MSG_ERROR([Fibers appears to be too old; please install version 1.1.0 or
later.])
+fi
+
dnl Make sure Fibers does not create POSIX threads: since shepherd
dnl forks, it must be single-threaded.
AC_CACHE_CHECK([whether Fibers might create POSIX threads],
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 13f1a77..71e06b8 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -25,6 +25,7 @@
(define-module (shepherd service)
#:use-module (fibers)
+ #:use-module ((fibers scheduler) #:select (yield-current-task))
#:use-module (oop goops)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9)
@@ -736,12 +737,26 @@ be used if FILE might contain a PID from another PID
namespace--i.e., the
daemon writing FILE is running in a separate PID namespace."
(define start (current-time))
+ (define (sleep* n)
+ ;; In general we want to use (@ (fibers) sleep) to yield to the scheduler.
+ ;; However, this code might be non-suspendable--e.g., if the user calls
+ ;; the 'start' method right from their config file, which is loaded with
+ ;; 'primitive-load', which is a continuation barrier. Thus, this variant
+ ;; checks whether it can suspend and picks the right 'sleep'.
+ (if (yield-current-task)
+ (begin
+ (set! sleep* (@ (fibers) sleep))
+ (sleep n))
+ (begin
+ (set! sleep* (@ (guile) sleep))
+ ((@ (guile) sleep) n))))
+
(let loop ()
(define (try-again)
(and (< (current-time) (+ start max-delay))
(begin
;; FILE does not exist yet, so wait and try again.
- (sleep 1) ;yield to the Fibers scheduler
+ (sleep* 1) ;yield to the Fibers scheduler
(loop))))
(catch 'system-error
diff --git a/tests/pid-file.sh b/tests/pid-file.sh
index db11abd..5fb0f2b 100644
--- a/tests/pid-file.sh
+++ b/tests/pid-file.sh
@@ -1,5 +1,5 @@
# GNU Shepherd --- Test the #:pid-file option of 'make-forkexec-constructor'.
-# Copyright © 2016, 2019, 2020 Ludovic Courtès <l...@gnu.org>
+# Copyright © 2016, 2019, 2020, 2022 Ludovic Courtès <l...@gnu.org>
#
# This file is part of the GNU Shepherd.
#
@@ -92,6 +92,10 @@ cat > "$conf"<<EOF
#:pid-file-timeout 6)
#:stop (make-kill-destructor)
#:respawn? #f))
+
+;; Start it upfront. This ensures the whole machinery works even
+;; when called in a non-suspendable context (continuation barrier).
+(start 'test-works)
EOF
rm -f "$pid"
@@ -102,6 +106,13 @@ while ! test -f "$pid" ; do sleep 0.3 ; done
shepherd_pid="`cat $pid`"
+# This service should already be running.
+$herd status test-works | grep started
+test -f "$service_pid"
+kill -0 `cat "$service_pid"`
+$herd stop test-works
+rm "$service_pid"
+
# The service is expected to fail to start.
if $herd start test
then false; else true; fi
