[shepherd] 06/08: service: Turn 'stop' method into a procedure.

[Ludovic Courtès]

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

commit 553810beec572cd997a0c1b2299f036734e7ce49
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Wed Apr 12 21:49:26 2023 +0200

    service: Turn 'stop' method into a procedure.
    
    * modules/shepherd/service.scm (stop): Rename to...
    (stop-service): ... this.  Turn into a procedure.
    (stop): Define as a deprecated method.
    (perform-service-action, deregister-service)
    (shutdown-services): Use 'stop-service' instead of 'stop'.
    * modules/shepherd/service/repl.scm (run-client-repl): Likewise.
    * modules/shepherd.scm (call-with-server-socket)
    (handle-SIGINT, process-command, process-textual-commands): Likewise.
    * doc/shepherd.texi (Methods of services): Update accordingly.
    (Service Convenience): Remove 'stop'.
---
 doc/shepherd.texi                 | 20 ++++++--------
 modules/shepherd.scm              | 11 +++++---
 modules/shepherd/service.scm      | 58 ++++++++++++++++++++-------------------
 modules/shepherd/service/repl.scm |  2 +-
 4 files changed, 46 insertions(+), 45 deletions(-)

diff --git a/doc/shepherd.texi b/doc/shepherd.texi
index f9f634b..0368d35 100644
--- a/doc/shepherd.texi
+++ b/doc/shepherd.texi
@@ -739,14 +739,14 @@ 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
-depend in it first, so they can be shutdown cleanly.  If this will
-fail, it will continue anyway.  Stopping of services should usually
-succeed, though.  Otherwise, the behaviour is very similar to the
-@code{start} method.  The return value is also the new running
-value, thus @code{#f} if the service was stopped.
-@end deffn
+@defun stop-service @var{service} . @var{args}
+Stop @var{service} and any service that depends on it.  Return the list of
+canonical names for all of the services that have been stopped (including
+transitive dependent services).
+
+If @var{service} is not running, print a warning and return its canonical name
+in a list.
+@end defun
 
 @defun perform-service-action @var{service} @var{the-action} . @var{args}
 Perform @var{the-action} (a symbol such as @code{'restart} or @code{'status})
@@ -828,10 +828,6 @@ This procedure can be useful in a configuration file 
because it lets you
 interact right away with shepherd using the @command{herd} command.
 @end deffn
 
-@deffn {method} stop (obj <symbol>)
-Stop a registered service providing @var{obj}.
-@end deffn
-
 @deffn {procedure} for-each-service proc
 Call @var{proc}, a procedure taking one argument, once for each
 registered service.
diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index 1db2ae9..c2e478c 100644
--- a/modules/shepherd.scm
+++ b/modules/shepherd.scm
@@ -75,7 +75,7 @@ socket file at FILE-NAME upon exit of PROC.  Return the 
values of PROC."
                                    (strerror (system-error-errno args)))
                      ;; Stop services that were started from the config file
                      ;; and quit.
-                     (stop 'root)))))))
+                     (stop-service root-service)))))))
     (unwind-protect (proc sock)
                     (begin
                       (close sock)
@@ -122,7 +122,7 @@ already ~a threads running, disabling 'signalfd' support")
    (lambda ()
      (catch 'quit
        (lambda ()
-         (stop root-service))
+         (stop-service root-service))
        quit-exception-handler))))
 
 (define (signal-handler signal)
@@ -520,7 +520,10 @@ fork in the child process."
                                      (service-canonical-name service))
                         service)
                       (apply start-service service args)))
-                 ((stop) (apply stop service-symbol args))
+                 ((stop)
+                  (if (service-stopped? service)
+                      '()
+                      (apply stop-service service args)))
 
                  ;; XXX: This used to return a list of action results, on the
                  ;; grounds that there could be several services called NAME.
@@ -542,7 +545,7 @@ would write them on the 'herd' command line."
     (if (eof-object? line)
 
         ;; Exit on `C-d'.
-        (stop root-service)
+        (stop-service root-service)
 
         (begin
           (match (string-tokenize line)
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 36fff39..ffc9cd5 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -77,7 +77,7 @@
             disable-service
             start-service
             start-in-the-background
-            stop
+            stop-service
             perform-service-action
 
             for-each-service
@@ -155,6 +155,7 @@
             enable
             disable
             start
+            stop
             action
             action-list
             lookup-action
@@ -793,23 +794,26 @@ NEW-SERVICE."
 
 ;; Stop the service, including services that depend on it.  If the
 ;; latter fails, continue anyway.  Return `#f' if it could be stopped.
-(define-method (stop (service <service>) . args)
-  "Stop SERVICE, and any services which depend on it.  Returns a list of
-canonical names for all of the services which have been stopped (including
-transitive dependent services).  This method will print a warning if SERVICE
-is not already running, and will return SERVICE's canonical name in a list."
+(define (stop-service service . args)
+  "Stop @var{service} and any service that depends on it.  Return the list of
+canonical names for all of the services that have been stopped (including
+transitive dependent services).
+
+If @var{service} is not running, print a warning and return its canonical name
+in a list."
   (if (service-stopped? service)
       (begin
         (local-output (l10n "Service ~a is not running.")
                       (service-canonical-name service))
         (list (service-canonical-name service)))
       (let ((name (service-canonical-name service))
-            (stopped-dependents (fold-services (lambda (other acc)
-                                                 (if (and (service-running? 
other)
-                                                          (required-by? 
service other))
-                                                     (append (stop other) acc)
-                                                     acc))
-                                               '())))
+            (stopped-dependents
+             (fold-services (lambda (other acc)
+                              (if (and (service-running? other)
+                                       (required-by? service other))
+                                  (append (stop-service other) acc)
+                                  acc))
+                            '())))
         ;; Stop the service itself.
         (let ((reply (make-channel)))
           (put-message (service-control service) `(stop ,reply))
@@ -856,7 +860,7 @@ the action."
       ;; Restarting is done in the obvious way.
       ((restart)
        (lambda (running . args)
-         (let ((stopped-services (stop service)))
+         (let ((stopped-services (stop-service service)))
            (for-each (compose start-service lookup-service)
                      stopped-services)
            #t)))
@@ -1119,19 +1123,6 @@ service state and to send requests to the service 
monitor."
                  head
                  (loop (cdr lst)))))))))
 
-;; Stopping by name.
-(define-method (stop (name <symbol>) . args)
-  (match (lookup-service name)
-    (#f
-     (raise (condition (&missing-service-error (name name)))))
-    (service
-     ;; XXX: This used to return a list of results, on the grounds that there
-     ;; could be several services called NAME.  Clients like 'herd' expect a
-     ;; list.
-     (if (service-stopped? service)
-         '()
-         (apply stop service args)))))
-
 (define (start-in-the-background services)
   "Start the services named by @var{services}, a list of symbols, in the
 background.  In other words, this procedure returns immediately without
@@ -2417,7 +2408,7 @@ name, or if it is the only service providing the service 
that is
 requested to be removed."
   (define (deregister service)
     (when (service-running? service)
-      (stop service))
+      (stop-service service))
     ;; Remove services provided by service from the hash table.
     (put-message (current-registry-channel)
                  `(unregister ,(list service))))
@@ -2530,6 +2521,17 @@ Used by `start'."
      (if (eq? 'running (service-status service))
          service
          (apply start service args)))))
+(define-deprecated-method/rest (stop (service <service>))
+  stop-service)
+(define-method (stop (name <symbol>) . args)
+  (match (lookup-service name)
+    (#f
+     (raise (condition (&missing-service-error (name name)))))
+    (service
+     (if (service-stopped? service)
+         '()
+         (apply stop service args)))))
+
 
 
 
@@ -2543,7 +2545,7 @@ Used by `start'."
   (for-each
    (lambda (service)
      (when (service-running? service)
-       (stop service)))
+       (stop-service service)))
    (service-list)))
 
 (define (check-for-dead-services)
diff --git a/modules/shepherd/service/repl.scm 
b/modules/shepherd/service/repl.scm
index a5f9785..4de9b66 100644
--- a/modules/shepherd/service/repl.scm
+++ b/modules/shepherd/service/repl.scm
@@ -89,7 +89,7 @@ crashes, stop @var{service}."
              (start-repl))))))
     (lambda args
       (local-output (l10n "Uncaught REPL exception: ~s.") args)))
-  (stop service))
+  (stop-service service))
 
 (define default-repl-socket-file
   ;; Default socket file for the REPL.