[Top][All Lists]

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[shepherd] 25/32: service: Add #:handle-termination slot.

From: Ludovic Courtès
Subject: [shepherd] 25/32: service: Add #:handle-termination slot.
Date: Wed, 30 Mar 2022 11:01:33 -0400 (EDT)

civodul pushed a commit to branch master
in repository shepherd.

commit d250e81936bea6747b378d8839ee215235841d53
Author: Ludovic Courtès <>
AuthorDate: Mon Mar 28 16:31:00 2022 +0200

    service: Add #:handle-termination slot.
    * modules/shepherd/service.scm (<service>)[handle-termination]: New slot.
    (handle-service-termination): New procedure.
    (handle-SIGCHLD): Call it instead of 'respawn-service'.
    (default-service-termination-handler): New procedure.
    * doc/shepherd.texi (Slots of services): Document the new slot.
 doc/shepherd.texi            | 12 ++++++++++++
 modules/shepherd/service.scm | 42 ++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 52 insertions(+), 2 deletions(-)

diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index 2785bb2..7e9279f 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -704,6 +704,18 @@ should return @code{#f} if it is now possible again to 
start the
 service at a later point.  The default value is a procedure that
 returns @code{#f} and performs no further actions.
+@vindex handle-termination (slot of <service>)
+@cindex Termination of a service's process.
+The @code{handle-termination} slot contains the procedure to call when
+the process associated with a service---the process whose PID appears in
+the @code{running} slot---terminates.  It is passed the service and its
+exit status, an integer as returned by @code{waitpid} (@pxref{Processes,
+@code{waitpid},, guile, GNU Guile Reference Manual}).
+The default handler is the @code{default-service-termination-handler}
+procedure, which respawns the service if applicable.
 @vindex actions (slot of <service>)
 @cindex Actions of services
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 84c9a8b..a389802 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -81,6 +81,7 @@
+            default-service-termination-handler
@@ -177,6 +178,32 @@ respawned, shows that it has been respawned more than 
            (and (> (+ last-respawn seconds) now)
                 (loop (- times 1) rest)))))))
+(define (default-service-termination-handler service status)
+  "Handle the termination of @var{service} by respawning it if applicable.
+Log abnormal termination reported by @var{status}."
+  (unless (zero? status)
+    ;; Most likely something went wrong; log it.
+    (cond ((status:exit-val status)
+           =>
+           (lambda (code)
+             (local-output (l10n "Service ~a (PID ~a) exited with ~a.")
+                           (canonical-name service)
+                           (slot-ref service 'running) code)))
+          ((status:term-sig status)
+           =>
+           (lambda (signal)
+             (local-output (l10n "Service ~a (PID ~a) terminated with signal 
+                           (canonical-name service)
+                           (slot-ref service 'running) signal)))
+          ((status:stop-sig status)
+           =>
+           (lambda (signal)
+             (local-output (l10n "Service ~a (PID ~a) stopped with signal ~a.")
+                           (canonical-name service)
+                           (slot-ref service 'running) signal)))))
+  (respawn-service service))
 (define-class <service> ()
   ;; List of provided service-symbols.  The first one is also called
   ;; the `canonical name' and must be unique to this service.
@@ -226,6 +253,10 @@ respawned, shows that it has been respawned more than 
   ;; currently.  Otherwise, it is the value that was returned by the
   ;; procedure in the `start' slot when the service was started.
   (running #:init-value #f)
+  ;; Procedure called to notify that the process associated with this service
+  ;; (whose PID is in the 'running' slot) has terminated.
+  (handle-termination #:init-keyword #:handle-termination
+                      #:init-value default-service-termination-handler)
   ;; A description of the service.
   (docstring #:init-keyword #:docstring
             #:init-value "[No description].")
@@ -1616,7 +1647,7 @@ otherwise by updating its state."
       ((0 . _)
        ;; Nothing left to wait for.
-      ((pid . _)
+      ((pid . status)
        (let ((serv (find-service (lambda (serv)
                                    (and (enabled? serv)
                                         (match (service-running-value serv)
@@ -1627,12 +1658,19 @@ otherwise by updating its state."
          ;; SERV can be #f for instance when this code runs just after a
          ;; service's 'stop' method killed its process and completed.
          (when serv
-           (respawn-service serv))
+           (handle-service-termination serv status))
          ;; As noted in libc's manual (info "(libc) Process Completion"),
          ;; loop so we don't miss any terminated child process.
+(define (handle-service-termination service status)
+  "Handle the termination of the process associated with @var{service}, whose
+PID is in its @code{running} slot; @var{status} is the process's exit status
+as returned by @code{waitpid}.  This procedure is called right after the
+process has terminated."
+  ((slot-ref service 'handle-termination) service status))
 (define (respawn-service serv)
   "Respawn a service that has stopped running unexpectedly. If we have
 attempted to respawn the service a number of times already and it keeps dying,

reply via email to

[Prev in Thread] Current Thread [Next in Thread]