From b04ae71defe0bd2a5fbd2df07d55cfe3eb40cba9 Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Sat, 28 May 2022 23:03:45 +0200 Subject: services: herd: Add 'wait-for-service'. * gnu/services/herd.scm (wait-for-service): New procedure. --- gnu/services/herd.scm | 36 +++++++++++++++++++++++++++++++++++- 1 file changed, 35 insertions(+), 1 deletion(-) diff --git a/gnu/services/herd.scm b/gnu/services/herd.scm index 80d08f849e..a7c845b4b0 100644 --- a/gnu/services/herd.scm +++ b/gnu/services/herd.scm @@ -58,7 +58,8 @@ load-services/safe start-service stop-service - restart-service)) + restart-service + wait-for-service)) ;;; Commentary: ;;; @@ -313,6 +314,39 @@ when passed a service with an already-registered name." (with-shepherd-action name ('restart) result result)) +(define* (wait-for-service name #:key (timeout 20)) + "Wait for the service providing NAME, a symbol, to be up and running, and +return its \"running value\". Give up after TIMEOUT seconds and raise a +'&shepherd-error' exception. Raise a '&service-not-found-error' exception +when NAME is not found." + (define (relevant-service? service) + (memq name (live-service-provision service))) + + (define start + (car (gettimeofday))) + + ;; Note: As of Shepherd 0.9.1, we cannot just call the 'start' method and + ;; wait for it: it would spawn an additional elogind process. Thus, poll. + (let loop ((attempts 0)) + (define services + (current-services)) + + (define now + (car (gettimeofday))) + + (when (>= (- now start) timeout) + (raise (condition (&shepherd-error)))) ;XXX: better exception? + + (match (find relevant-service? services) + (#f + (raise (condition (&service-not-found-error + (service name))))) + (service + (or (live-service-running service) + (begin + (sleep 1) + (loop (+ attempts 1)))))))) + ;; Local Variables: ;; eval: (put 'alist-let* 'scheme-indent-function 2) ;; eval: (put 'with-shepherd 'scheme-indent-function 1) -- cgit v1.2.3