01/02: services: herd: Add 'wait-for-service'.

[guix-commits]

civodul pushed a commit to branch master
in repository guix.

commit b04ae71defe0bd2a5fbd2df07d55cfe3eb40cba9
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat May 28 23:03:45 2022 +0200

    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)