civodul pushed a commit to branch wip-goopsless
in repository shepherd.
commit f74971b8a585e8154fa11687be549ba7969b18b7
Author: Ludovic Courtès <l...@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 8bb0fc1..36fff39 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
@@ -153,6 +154,7 @@
enabled?
enable
disable
+ start
action
action-list
lookup-action
@@ -708,7 +710,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))
@@ -721,29 +723,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
@@ -754,22 +757,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
@@ -854,7 +857,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
@@ -1115,24 +1119,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)
@@ -1943,7 +1929,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.
@@ -2393,7 +2379,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))
@@ -2532,6 +2518,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 <l...@gnu.org>
+# Copyright © 2022, 2023 Ludovic Courtès <l...@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 <l...@gnu.org>
+# Copyright © 2022, 2023 Ludovic Courtès <l...@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 <l...@gnu.org>
+# Copyright © 2016, 2019, 2020, 2022, 2023 Ludovic Courtès <l...@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 <l...@gnu.org>
+# Copyright © 2013, 2014, 2016, 2023 Ludovic Courtès <l...@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 <l...@gnu.org>
+# Copyright © 2014, 2016, 2023 Ludovic Courtès <l...@gnu.org>
# Copyright © 2018 Carlo Zancanaro <ca...@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"
