[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[shepherd] 02/03: service: Controller and 'start' method inherit the rig
|
From: |
Ludovic Courtès |
|
Subject: |
[shepherd] 02/03: service: Controller and 'start' method inherit the right output port. |
|
Date: |
Mon, 13 Mar 2023 17:57:36 -0400 (EDT) |
civodul pushed a commit to branch master
in repository shepherd.
commit ceb9a8bd574cdf03d7491b9e95418352f6501582
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Mon Mar 13 22:36:01 2023 +0100
service: Controller and 'start' method inherit the right output port.
Previously, when creating and starting a service from the REPL (as shown
in the test), the controller and 'start' method would inherit
'current-output-port' from the REPL; that is, they would talk directly
over the REPL socket. Once the REPL has terminated, the controller
would find itself attempting to write messages to a closed file port.
Likewise for the service's body if it inherited current-output-port from
its 'start' method. This commit fixes that.
* modules/shepherd/comm.scm (%current-service-output-port): New
variable.
* modules/shepherd.scm (main): Parameterize it and parameterize
'current-output-port' accordingly.
* modules/shepherd/service.scm (spawn-service-controller): Parameterize
'current-output-port' and 'current-error-port'.
(start): Likewise around call to 'start'.
* tests/services/repl.sh: Add test.
---
modules/shepherd.scm | 143 ++++++++++++++++++++++---------------------
modules/shepherd/comm.scm | 6 +-
modules/shepherd/service.scm | 27 +++++---
tests/services/repl.sh | 30 +++++++++
4 files changed, 127 insertions(+), 79 deletions(-)
diff --git a/modules/shepherd.scm b/modules/shepherd.scm
index c01419b..1eae2e5 100644
--- a/modules/shepherd.scm
+++ b/modules/shepherd.scm
@@ -340,7 +340,7 @@ already ~a threads running, disabling 'signalfd' support")
(if (and (not logfile) (zero? (getuid)))
(format #f "shepherd[~d]: " (getpid))
default-logfile-date-format))
- (current-output-port
+ (%current-service-output-port
;; Send output to log and clients.
(make-shepherd-output-port
(if (and (zero? (getuid)) (not logfile))
@@ -350,78 +350,79 @@ already ~a threads running, disabling 'signalfd' support")
(%make-void-port "w")
(current-output-port)))))
- (set-port-encoding! (log-output-port) "UTF-8")
-
- (when (= 1 (getpid))
- ;; When running as PID 1, disable hard reboots upon ctrl-alt-del.
- ;; Instead, the kernel will send us SIGINT so that we can gracefully
- ;; shut down. See ctrlaltdel(8) and kernel/reboot.c.
- (catch 'system-error
- (lambda ()
- (disable-reboot-on-ctrl-alt-del))
- (lambda args
- (let ((err (system-error-errno args)))
- ;; When in a separate PID namespace, we get EINVAL (see
- ;; 'reboot_pid_ns' in kernel/pid_namespace.c.) We get EPERM in
- ;; a user namespace that lacks CAP_SYS_BOOT.
- (unless (member err (list EINVAL EPERM))
- (apply throw args)))))
-
- ;; Load the SIGSEGV/SIGABRT handler. This is what allows PID 1 to
- ;; dump core on "/", should something go wrong.
- (false-if-exception
- (dynamic-link (string-append %pkglibdir "/crash-handler"))))
-
- ;; Install signal handlers for everything but SIGCHLD, which is taken
- ;; care of in (shepherd services).
- (for-each (lambda (signal)
- (sigaction signal (signal-handler signal)))
- (delete SIGCHLD %precious-signals))
-
- ;; Run Fibers in such a way that it does not create any POSIX thread,
- ;; because POSIX threads and 'fork' cannot be used together.
- (run-fibers
- (lambda ()
- (with-service-registry
-
- ;; Register and start the 'root' service.
- (register-services root-service)
- (start root-service)
+ (parameterize ((current-output-port (%current-service-output-port)))
+ (set-port-encoding! (log-output-port) "UTF-8")
- (catch 'quit
+ (when (= 1 (getpid))
+ ;; When running as PID 1, disable hard reboots upon ctrl-alt-del.
+ ;; Instead, the kernel will send us SIGINT so that we can gracefully
+ ;; shut down. See ctrlaltdel(8) and kernel/reboot.c.
+ (catch 'system-error
(lambda ()
- (with-process-monitor
- ;; Replace the default 'system*' binding with one that
- ;; cooperates instead of blocking on 'waitpid'.
- (let ((real-system* system*)
- (real-system system))
- (set! system* (lambda command
- (spawn-command command)))
- (set! system spawn-shell-command)
-
- ;; Restore 'system*' after fork.
- (set! primitive-fork
- (let ((real-fork primitive-fork))
- (lambda ()
- (let ((result (real-fork)))
- (when (zero? result)
- (set! primitive-fork real-fork)
- (set! system* real-system*)
- (set! system real-system))
- result)))))
-
- (run-daemon #:socket-file socket-file
- #:config-file config-file
- #:pid-file pid-file
- #:signal-port signal-port
- #:poll-services? poll-services?)))
- (case-lambda
- ((key value . _)
- (primitive-exit value))
- ((key)
- (primitive-exit 0))))))
- #:parallelism 1 ;don't create POSIX threads
- #:hz 0)))) ;disable preemption, which would require POSIX threads
+ (disable-reboot-on-ctrl-alt-del))
+ (lambda args
+ (let ((err (system-error-errno args)))
+ ;; When in a separate PID namespace, we get EINVAL (see
+ ;; 'reboot_pid_ns' in kernel/pid_namespace.c.) We get EPERM in
+ ;; a user namespace that lacks CAP_SYS_BOOT.
+ (unless (member err (list EINVAL EPERM))
+ (apply throw args)))))
+
+ ;; Load the SIGSEGV/SIGABRT handler. This is what allows PID 1 to
+ ;; dump core on "/", should something go wrong.
+ (false-if-exception
+ (dynamic-link (string-append %pkglibdir "/crash-handler"))))
+
+ ;; Install signal handlers for everything but SIGCHLD, which is taken
+ ;; care of in (shepherd services).
+ (for-each (lambda (signal)
+ (sigaction signal (signal-handler signal)))
+ (delete SIGCHLD %precious-signals))
+
+ ;; Run Fibers in such a way that it does not create any POSIX thread,
+ ;; because POSIX threads and 'fork' cannot be used together.
+ (run-fibers
+ (lambda ()
+ (with-service-registry
+
+ ;; Register and start the 'root' service.
+ (register-services root-service)
+ (start root-service)
+
+ (catch 'quit
+ (lambda ()
+ (with-process-monitor
+ ;; Replace the default 'system*' binding with one that
+ ;; cooperates instead of blocking on 'waitpid'.
+ (let ((real-system* system*)
+ (real-system system))
+ (set! system* (lambda command
+ (spawn-command command)))
+ (set! system spawn-shell-command)
+
+ ;; Restore 'system*' after fork.
+ (set! primitive-fork
+ (let ((real-fork primitive-fork))
+ (lambda ()
+ (let ((result (real-fork)))
+ (when (zero? result)
+ (set! primitive-fork real-fork)
+ (set! system* real-system*)
+ (set! system real-system))
+ result)))))
+
+ (run-daemon #:socket-file socket-file
+ #:config-file config-file
+ #:pid-file pid-file
+ #:signal-port signal-port
+ #:poll-services? poll-services?)))
+ (case-lambda
+ ((key value . _)
+ (primitive-exit value))
+ ((key)
+ (primitive-exit 0))))))
+ #:parallelism 1 ;don't create POSIX threads
+ #:hz 0))))) ;disable preemption, which would require POSIX
threads
;; Start all of SERVICES, which is a list of canonical names (FIXME?),
;; but in a order where all dependencies are fulfilled before we
diff --git a/modules/shepherd/comm.scm b/modules/shepherd/comm.scm
index 0164686..2bd77e7 100644
--- a/modules/shepherd/comm.scm
+++ b/modules/shepherd/comm.scm
@@ -57,7 +57,8 @@
make-shepherd-output-port
%current-client-socket
- %current-logfile-date-format))
+ %current-logfile-date-format
+ %current-service-output-port))
;; Command for shepherd.
@@ -357,3 +358,6 @@ available."
;; It's an output-only port.
"w"))
+(define %current-service-output-port
+ ;; The output port that services should write to.
+ (make-parameter (current-output-port)))
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 5d0bcaa..b9364ac 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -293,7 +293,13 @@ Log abnormal termination reported by @var{status}."
(let ((channel (make-channel)))
(spawn-fiber
(lambda ()
- (service-controller service channel)))
+ ;; The controller writes to its current output port via 'local-output'.
+ ;; Make sure that goes to the right port. If the controller got a
+ ;; 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)))
+ (service-controller service channel))))
channel))
(define (service-controller service channel)
@@ -645,12 +651,19 @@ that could not be started."
((? channel? notification)
;; We won the race: we're responsible for starting OBJ
;; and sending its running value on NOTIFICATION.
- (let ((running (catch #t
- (lambda ()
- (apply (slot-ref obj 'start) args))
- (lambda (key . args)
- (put-message notification #f)
- (report-exception 'start obj key
args)))))
+ (let ((running
+ (catch #t
+ (lambda ()
+ ;; Make sure the 'start' method writes
+ ;; messages to the right port.
+ (parameterize ((current-output-port
+
(%current-service-output-port))
+ (current-error-port
+
(%current-service-output-port)))
+ (apply (slot-ref obj 'start) args)))
+ (lambda (key . args)
+ (put-message notification #f)
+ (report-exception 'start obj key args)))))
(put-message notification running)
(local-output (if running
(l10n "Service ~a has been started.")
diff --git a/tests/services/repl.sh b/tests/services/repl.sh
index b1bf84f..0c6bef0 100644
--- a/tests/services/repl.sh
+++ b/tests/services/repl.sh
@@ -90,6 +90,36 @@ guile -c '
'
while test $($herd status | grep '^ ' | wc -l) -ne 2; do $herd status && sleep
1; done
+
+# Register and start a service from the REPL.
+guile -c '
+(alarm 10)
+(let ((sock (socket AF_UNIX SOCK_STREAM 0)))
+ (connect sock PF_UNIX "'$repl_socket'")
+ (format #t "connected!~%> ")
+ (display
+ (object->string
+ (quote (begin
+ (use-modules (shepherd service) (shepherd service monitoring))
+ (register-services (monitoring-service #:period 2))
+ (start (quote monitoring)))))
+ sock)
+ (display ",q\n" sock)
+ (let loop ()
+ (define chr (read-char sock))
+ (unless (eof-object? chr)
+ (display chr)
+ (when (eq? chr #\newline)
+ (display "> "))
+ (loop))))
+'
+
+$herd status monitoring
+$herd status monitoring | grep "started"
+grep "heap:" "$log"
+
+$herd log monitoring | grep "heap:"
+
$herd stop repl
$herd status repl | grep "stopped"