[shepherd] 05/13: service: Turn 'start' method into a procedure.

[Ludovic Courtès]

civodul pushed a commit to branch master
in repository shepherd.

commit 0fc51b65862f1386877340550c5c0309f9af13d9
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Apr 12 19:47:45 2023 +0200

    service: Turn 'start' method into a procedure.
    
    * modules/shepherd/service.scm (start): Rename to...
    (start-service): ... this.  Turn into a procedure.
    (start): Define as a deprecated method.
    (launch-service): Remove.
    (start-in-parallel, perform-service-action, make-inetd-constructor)
    (respawn-service): Adjust to use 'start-service' instead of 'start'.
    * modules/shepherd.scm (process-command): Likewise.
    * tests/inetd.sh, tests/logging.sh, tests/pid-file.sh,
    tests/respawn.sh, tests/signals.sh, tests/status-sexp.sh: Likewise.
    * doc/shepherd.texi (Methods of services): Document 'start-service'.
    (Service Convenience): Remove 'start'.
    (Managing User Services, Monitoring Service): Update examples.
---
 doc/shepherd.texi            | 22 ++++----------
 modules/shepherd.scm         | 10 ++++--
 modules/shepherd/service.scm | 72 +++++++++++++++++++++-----------------------
 tests/inetd.sh               |  4 +--
 tests/logging.sh             |  4 +--
 tests/pid-file.sh            |  4 +--
 tests/respawn.sh             |  4 +--
 tests/signals.sh             |  4 +--
 tests/status-sexp.sh         |  2 +-
 9 files changed, 60 insertions(+), 66 deletions(-)

diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index d05b773..f9f634b 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -734,16 +734,10 @@ format for this slot.  (It actually is a hash currently.)
 @node Methods of services
 @section Methods of services
 
-@deffn {method} start (obj <service>)
-Start the service @var{obj}, including all the services it depends on.
-It tries quite hard to do this: When a service that provides a
-required symbol can not be started, it will look for another service
-that also provides this symbol, until starting one such service
-succeeds.  There is some room for theoretical improvement here, of
-course, but in practice the current strategy already works very well.
-This method returns the new ``running value'' of the service,
-@code{#f} if the service could not be started.
-@end deffn
+@defun start-service @var{service} . @var{args}
+Start @var{service} and its dependencies, passing @var{args} to its
+@code{start} method.
+@end defun
 
 @deffn {method} stop (obj <service>)
 This will stop the service @var{obj}, trying to stop services that
@@ -825,10 +819,6 @@ perform the action.  A @var{proc} has one argument, which 
will be the
 running value of the service.
 @end deffn
 
-@deffn {method} start (obj <symbol>)
-Start a registered service providing @var{obj}.
-@end deffn
-
 @deffn {procedure} start-in-the-background @var{services}
 Start the services named by @var{services}, a list of symbols, in the
 background.  In other words, this procedure returns immediately without
@@ -1343,7 +1333,7 @@ Then, individual user services can be put in
     #:respawn? #t))
 
 (register-services ssh-agent)
-(start ssh-agent)
+(start-service ssh-agent)
 @end lisp
 
 @c @@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@@
@@ -1438,7 +1428,7 @@ nothing else would look like this:
   (monitoring-service #:period (* 15 60)))
 
 ;; Start it!
-(start 'monitoring)
+(start-service (lookup-service 'monitoring))
 @end lisp
 
 Using the @code{herd} command, you can get immediate resource usage
diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index 76bf231..1db2ae9 100644
--- a/modules/shepherd.scm
+++ b/modules/shepherd.scm
@@ -410,7 +410,7 @@ fork in the child process."
 
              ;; Register and start the 'root' service.
              (register-services root-service)
-             (start root-service)
+             (start-service root-service)
 
              (catch 'quit
                (lambda ()
@@ -513,7 +513,13 @@ fork in the child process."
 
              (define result
                (case the-action
-                 ((start) (apply start service-symbol args))
+                 ((start)
+                  (if (eq? 'running (service-status service))
+                      (begin
+                        (local-output (l10n "Service ~a is already running.")
+                                     (service-canonical-name service))
+                        service)
+                      (apply start-service service args)))
                  ((stop) (apply stop service-symbol args))
 
                  ;; XXX: This used to return a list of action results, on the
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index ce8cc2f..0fea1ce 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -60,6 +60,7 @@
             service-documentation
 
             service-canonical-name
+            service-status
             service-running?
             service-stopped?
             service-enabled?
@@ -74,7 +75,7 @@
 
             enable-service
             disable-service
-            start
+            start-service
             start-in-the-background
             stop
             perform-service-action
@@ -154,6 +155,7 @@
             enabled?
             enable
             disable
+            start
             action
             action-list
             lookup-action
@@ -709,7 +711,7 @@ while starting ~a: ~s")
                                     (when (one-shot-service? service)
                                       (hashq-set! (%one-shot-services-started)
                                                   service #t))
-                                    (start service))))))
+                                    (start-service service))))))
                        (put-message channel (cons service value))))))
                 services)
       (let loop ((i (length services))
@@ -722,29 +724,30 @@ while starting ~a: ~s")
                (loop (- i 1) failures)))
             failures)))))
 
-;; Start the service, including dependencies.
-(define-method (start (obj <service>) . args)
-  (if (service-enabled? obj)
+(define (start-service service . args)
+  "Start @var{service} and its dependencies, passing @var{args} to its
+@code{start} method."
+  (if (service-enabled? service)
       ;; It is not running; go ahead and launch it.
       (let ((problems
             ;; Resolve all dependencies.
-            (start-in-parallel (service-requirement obj))))
+            (start-in-parallel (service-requirement service))))
         (define running
          (if (pair? problems)
               (for-each (lambda (problem)
                          (local-output (l10n "Service ~a depends on ~a.")
-                                       (service-canonical-name obj)
+                                       (service-canonical-name service)
                                        problem))
                         problems)
               ;; Start the service itself.
               (let ((reply (make-channel)))
-                (put-message (service-control obj) `(start ,reply))
+                (put-message (service-control service) `(start ,reply))
                 (match (get-message reply)
                   (#f
-                   ;; We lost the race: OBJ is already running.
-                   (service-running-value obj))
+                   ;; We lost the race: SERVICE is already running.
+                   (service-running-value service))
                   ((? channel? notification)
-                   ;; We won the race: we're responsible for starting OBJ
+                   ;; We won the race: we're responsible for starting SERVICE
                    ;; and sending its running value on NOTIFICATION.
                    (let ((running
                           (catch #t
@@ -755,22 +758,22 @@ while starting ~a: ~s")
                                               (%current-service-output-port))
                                              (current-error-port
                                               (%current-service-output-port)))
-                                (apply (service-start obj) args)))
+                                (apply (service-start service) args)))
                             (lambda (key . args)
                               (put-message notification #f)
-                              (report-exception 'start obj key args)))))
+                              (report-exception 'start service key args)))))
                      (put-message notification running)
                      (local-output (if running
                                       (l10n "Service ~a has been started.")
                                        (l10n "Service ~a could not be 
started."))
-                                  (service-canonical-name obj))
+                                  (service-canonical-name service))
                      running))))))
 
         running)
       (begin
         (local-output (l10n "Service ~a is currently disabled.")
-                     (service-canonical-name obj))
-        (service-running-value obj))))
+                     (service-canonical-name service))
+        (service-running-value service))))
 
 (define (replace-service old-service new-service)
   "Replace OLD-SERVICE with NEW-SERVICE in the services registry.  This
@@ -855,7 +858,8 @@ the action."
       ((restart)
        (lambda (running . args)
          (let ((stopped-services (stop service)))
-           (for-each start stopped-services)
+           (for-each (compose start-service lookup-service)
+                     stopped-services)
            #t)))
       ((status)
        ;; Return the service itself.  It is automatically converted to an sexp
@@ -1116,24 +1120,6 @@ service state and to send requests to the service 
monitor."
                  head
                  (loop (cdr lst)))))))))
 
-(define (launch-service name args)
-  "Try to start (with PROC) a service providing NAME; return #f on failure.
-Used by `start'."
-  (match (lookup-service name)
-    (#f
-     (raise (condition (&missing-service-error (name name)))))
-    (service
-     (if (eq? 'running (service-status service))
-         (begin
-           (local-output (l10n "Service ~a is already running.")
-                        (service-canonical-name service))
-           service)
-         (apply start service args)))))
-
-;; Starting by name.
-(define-method (start (obj <symbol>) . args)
-  (launch-service obj args))
-
 ;; Stopping by name.
 (define-method (stop (name <symbol>) . args)
   (match (lookup-service name)
@@ -1952,7 +1938,7 @@ The remaining arguments are as for 
@code{make-forkexec-constructor}."
                       #:termination-handler handle-child-termination
                       #:stop (make-kill-destructor))))
       (register-services service)
-      (start service)))
+      (start-service service)))
 
   (define (accept-clients server-address sock)
     ;; Return a thunk that accepts client connections from SOCK.
@@ -2402,7 +2388,7 @@ then disable it."
         (local-output (l10n "Respawning ~a.")
                       (service-canonical-name serv))
         (record-service-respawn-time serv)
-        (start serv))
+        (start-service serv))
       (begin
         (local-output (l10n "Service ~a has been disabled.")
                       (service-canonical-name serv))
@@ -2537,6 +2523,18 @@ results."
      (raise (condition (&missing-service-error (name name)))))
     (service
      (list (apply action service the-action args)))))
+(define-deprecated-method/rest (start (service <service>))
+  start-service)
+(define-method (start (name <symbol>) . args)
+  "Try to start (with PROC) a service providing NAME; return #f on failure.
+Used by `start'."
+  (match (lookup-service name)
+    (#f
+     (raise (condition (&missing-service-error (name name)))))
+    (service
+     (if (eq? 'running (service-status service))
+         service
+         (apply start service args)))))
 
 
 
diff --git a/tests/inetd.sh b/tests/inetd.sh
index c0bc53b..bd6f3e3 100644
--- a/tests/inetd.sh
+++ b/tests/inetd.sh
@@ -1,5 +1,5 @@
 # GNU Shepherd --- Test transient services.
-# Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2022, 2023 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of the GNU Shepherd.
 #
@@ -79,7 +79,7 @@ cat > "$conf" <<EOF
                                    #:max-connections 5)
    #:stop  (make-inetd-destructor)))
 
-(start 'test-inetd)
+(start-service (lookup-service 'test-inetd))
 EOF
 
 rm -f "$pid"
diff --git a/tests/logging.sh b/tests/logging.sh
index d0c0ca6..9ae7417 100644
--- a/tests/logging.sh
+++ b/tests/logging.sh
@@ -1,5 +1,5 @@
 # GNU Shepherd --- Test the logging capabilities of 
'make-forkexec-constructor'.
-# Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2022, 2023 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of the GNU Shepherd.
 #
@@ -66,7 +66,7 @@ cat > "$conf"<<EOF
    #:respawn? #f))
 
 ;; Start it upfront to make sure the logging fiber works.
-(start 'test-file-logging)
+(start-service (lookup-service 'test-file-logging))
 EOF
 
 rm -f "$pid"
diff --git a/tests/pid-file.sh b/tests/pid-file.sh
index d5fb90a..36d895a 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, 2022 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2016, 2019, 2020, 2022, 2023 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of the GNU Shepherd.
 #
@@ -95,7 +95,7 @@ cat > "$conf"<<EOF
 
 ;; Start it upfront.  This ensures the whole machinery works even
 ;; when called in a non-suspendable context (continuation barrier).
-(start 'test-works)
+(start-service (lookup-service 'test-works))
 EOF
 
 rm -f "$pid"
diff --git a/tests/respawn.sh b/tests/respawn.sh
index d9892ef..5c23b2c 100644
--- a/tests/respawn.sh
+++ b/tests/respawn.sh
@@ -1,5 +1,5 @@
 # GNU Shepherd --- Test respawnable services.
-# Copyright © 2013, 2014, 2016 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2013, 2014, 2016, 2023 Ludovic Courtès <ludo@gnu.org>
 #
 # This file is part of the GNU Shepherd.
 #
@@ -81,7 +81,7 @@ cat > "$conf"<<EOF
             #:pid-file "$PWD/$service2_pid")
    #:stop  (make-kill-destructor)
    #:respawn? #t))
-(start 'test1)
+(start-service (lookup-service 'test1))
 EOF
 
 rm -f "$pid"
diff --git a/tests/signals.sh b/tests/signals.sh
index cd25bd3..03907dc 100644
--- a/tests/signals.sh
+++ b/tests/signals.sh
@@ -1,5 +1,5 @@
 # GNU Shepherd --- Make sure SIGINT, SIGTERM, and SIGHUP are correctly handled.
-# Copyright © 2014, 2016 Ludovic Courtès <ludo@gnu.org>
+# Copyright © 2014, 2016, 2023 Ludovic Courtès <ludo@gnu.org>
 # Copyright © 2018 Carlo Zancanaro <carlo@zancanaro.id.au>
 #
 # This file is part of the GNU Shepherd.
@@ -42,7 +42,7 @@ cat > "$conf"<<EOF
                (lambda (port)
                  (display "stopped" port))))
    #:respawn? #f))
- (start 'test)
+ (start-service (lookup-service 'test))
 EOF
 
 for signal in INT TERM HUP; do
diff --git a/tests/status-sexp.sh b/tests/status-sexp.sh
index 7e2f8d9..c82e10a 100644
--- a/tests/status-sexp.sh
+++ b/tests/status-sexp.sh
@@ -45,7 +45,7 @@ cat > "$conf"<<EOF
    #:documentation "Bar!"
    #:respawn? #f))
 
-(start 'foo)
+(start-service (lookup-service 'foo))
 EOF
 
 rm -f "$pid"