[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[shepherd] 04/08: service: Catch exceptions of essential tasks.
From: |
Ludovic Courtès |
Subject: |
[shepherd] 04/08: service: Catch exceptions of essential tasks. |
Date: |
Sat, 25 Mar 2023 17:53:06 -0400 (EDT) |
civodul pushed a commit to branch master
in repository shepherd.
commit f56c5872b36d740583e9e99d9df65e99e9875c56
Author: Ludovic Courtès <ludo@gnu.org>
AuthorDate: Sat Mar 25 18:38:57 2023 +0100
service: Catch exceptions of essential tasks.
* modules/shepherd/service.scm (essential-task-launcher): New procedure.
(spawn-process-monitor, spawn-service-registry): Define in terms of
'essential-task-launcher'.
---
modules/shepherd/service.scm | 49 +++++++++++++++++++++++++++-----------------
1 file changed, 30 insertions(+), 19 deletions(-)
diff --git a/modules/shepherd/service.scm b/modules/shepherd/service.scm
index 7cd36fd..5b9ae19 100644
--- a/modules/shepherd/service.scm
+++ b/modules/shepherd/service.scm
@@ -998,16 +998,36 @@ requests arriving on @var{channel}."
(put-message reply (vlist->list registered))
(loop registered)))))
-(define (spawn-service-registry)
- "Spawn a new service monitor fiber and return a channel to send it requests."
- (define channel
- (make-channel))
+(define (essential-task-launcher name proc)
+ "Return a thunk that runs @var{proc} in a fiber, endlessly (an essential
+task is one that should never fail)."
+ (lambda ()
+ (define channel
+ (make-channel))
- (spawn-fiber
- (lambda ()
- (service-registry channel)))
+ (spawn-fiber
+ (lambda ()
+ ;; PROC should never return. If it does, log the problem and
+ ;; desperately attempt to restart it.
+ (let loop ()
+ (catch #t
+ (lambda ()
+ (proc channel)
+ (local-output (l10n "Essential task ~a exited unexpectedly.")
+ name))
+ (lambda args
+ (local-output
+ (l10n "Uncaught exception in essential task ~a: ~s")
+ name args)))
- channel)
+ ;; Restarting is not enough to recover because all state has been
+ ;; lost, but it might be enough to halt the system.
+ (loop))))
+
+ channel))
+
+(define spawn-service-registry
+ (essential-task-launcher 'service-registry service-registry))
(define current-registry-channel
;; The channel to communicate with the current service monitor.
@@ -2207,17 +2227,8 @@ otherwise by updating its state."
(put-message reply 0)
(loop waiters)))))))
-(define (spawn-process-monitor)
- "Spawn a process monitoring fiber and return a channel to communicate with
-it."
- (define channel
- (make-channel))
-
- (spawn-fiber
- (lambda ()
- (process-monitor channel)))
-
- channel)
+(define spawn-process-monitor
+ (essential-task-launcher 'process-monitor process-monitor))
(define current-process-monitor
;; Channel to communicate with the process monitoring fiber.
- [shepherd] branch master updated (e2d324e -> 353a91b), Ludovic Courtès, 2023/03/25
- [shepherd] 04/08: service: Catch exceptions of essential tasks.,
Ludovic Courtès <=
- [shepherd] 02/08: shepherd: Define and use 'replace-core-bindings!'., Ludovic Courtès, 2023/03/25
- [shepherd] 07/08: service: Make 'launch-service' private., Ludovic Courtès, 2023/03/25
- [shepherd] 05/08: service: 'make-systemd-constructor' supports starting processes eagerly., Ludovic Courtès, 2023/03/25
- [shepherd] 01/08: shepherd: Replace 'primitive-load' with a Scheme implementation., Ludovic Courtès, 2023/03/25
- [shepherd] 06/08: service: Remove redundant condition in 'start'., Ludovic Courtès, 2023/03/25
- [shepherd] 08/08: service: Print "already running" message in 'launch-service', not 'start'., Ludovic Courtès, 2023/03/25
- [shepherd] 03/08: repl: Delete socket before starting., Ludovic Courtès, 2023/03/25