37 lines
1.3 KiB
Racket
37 lines
1.3 KiB
Racket
#lang syndicate
|
|
;;; SPDX-License-Identifier: LGPL-3.0-or-later
|
|
;;; SPDX-FileCopyrightText: Copyright © 2024 Tony Garnock-Jones <tonyg@leastfixedpoint.com>
|
|
|
|
(provide supervise
|
|
supervise*
|
|
|
|
default-restart-strategy)
|
|
|
|
(require syndicate/driver-support)
|
|
|
|
(define-logger syndicate/supervise)
|
|
|
|
(define-syntax-rule (supervise (main-proc-name arg ...))
|
|
(supervise* 'main-proc-name (lambda () (main-proc-name arg ...))))
|
|
|
|
(define (supervise* main-proc-name main-proc
|
|
#:restart-strategy [restart-strategy (default-restart-strategy)])
|
|
(log-syndicate/supervise-debug "supervisor starting ~a" main-proc-name)
|
|
(react
|
|
(on-stop
|
|
(when (facet-live? this-facet)
|
|
(log-syndicate/supervise-debug "supervisor noticed exit of ~a" main-proc-name)
|
|
(restart-strategy
|
|
(lambda ([new-strategy restart-strategy])
|
|
(supervise* main-proc-name main-proc #:restart-strategy new-strategy)))))
|
|
(spawn/link #:name (list 'supervised main-proc-name) (main-proc))))
|
|
|
|
(define ((default-restart-strategy [timeout-seconds 5] [plus-or-minus 1]) restart)
|
|
(react
|
|
(linked-thread
|
|
(lambda (facet)
|
|
(define t (+ timeout-seconds (* plus-or-minus (- (random) 0.5) 2)))
|
|
(log-syndicate/supervise-debug "restarting in ~v seconds" t)
|
|
(sleep t)
|
|
(turn! facet (lambda () (on-stop (restart))))))))
|