[shepherd] 02/04: service: Thread the current service to actions.

[Ludovic Courtès]

civodul pushed a commit to branch wip-logging
in repository shepherd.

commit 088997a63011ab5ce60a2735b5b3e38290d9627f
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Fri Dec 1 22:30:41 2023 +0100

    service: Thread the current service to actions.
    
    This lets actions know on behalf of which service they’re being called.
    
    * modules/shepherd/service.scm (current-service): New parameter.
    (spawn-service-controller): Parameterize it.
    (start-service, stop-service, perform-service-action): Likewise.
---
 modules/shepherd/service.scm | 21 +++++++++++++++------
 1 file changed, 15 insertions(+), 6 deletions(-)

diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index a42b063..7768d2b 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -380,6 +380,11 @@ denoting what the service provides."
                    (spawn-service-controller service))
         (slot-ref service 'control))))
 
+(define current-service
+  ;; Service currently operating.  This parameter is used to communicate the
+  ;; service handle to its 'start' and 'stop' methods and to its actions.
+  (make-parameter #f))
+
 (define (spawn-service-controller service)
   "Return a channel over which @var{service} may be controlled."
   (let ((channel (make-channel)))
@@ -390,7 +395,8 @@ denoting what the service provides."
        ;; wrong output port, it could crash and stop responding just because a
        ;; 'local-output' call raised an exception.
        (parameterize ((current-output-port (%current-service-output-port))
-                      (current-error-port (%current-service-output-port)))
+                      (current-error-port (%current-service-output-port))
+                      (current-service service))
          (service-controller service channel))))
     channel))
 
@@ -873,7 +879,8 @@ while starting ~a: ~s")
                         (parameterize ((current-output-port
                                         (%current-service-output-port))
                                        (current-error-port
-                                        (%current-service-output-port)))
+                                        (%current-service-output-port))
+                                       (current-service service))
                           (apply (service-start service) args)))
                       (lambda (key . args)
                         (put-message notification #f)
@@ -923,9 +930,10 @@ in a list."
              (catch #t
                (lambda ()
                  (define stopped?
-                   (not (apply (service-stop service)
-                               (service-running-value service)
-                               args)))
+                   (parameterize ((current-service service))
+                     (not (apply (service-stop service)
+                                 (service-running-value service)
+                                 args))))
                  (put-message notification stopped?))
                (lambda (key . args)
                  ;; Special case: 'root' may quit.
@@ -999,7 +1007,8 @@ the action."
         ;; single value.  Deal with it gracefully.
         (call-with-values
             (lambda ()
-              (apply proc (service-running-value service) args))
+              (parameterize ((current-service service))
+                (apply proc (service-running-value service) args)))
           (case-lambda
             (() *unspecified*)
             ((first . rest) first))))