X-Git-Url: https://jxself.org/git/?p=8sync.git;a=blobdiff_plain;f=8sync%2Factors.scm;h=0c50446d8c1a4ac9b8aaec5328247edd9ef8f4da;hp=1d8e6023aa3b19bcb8350e4ee35d759cc3f59021;hb=04cb3218619e5fd734dd0644e734b3fe506caf00;hpb=84a19e7d4cb97e00a64191e1ecfcf984ffae52d1 diff --git a/8sync/actors.scm b/8sync/actors.scm index 1d8e602..0c50446 100644 --- a/8sync/actors.scm +++ b/8sync/actors.scm @@ -779,17 +779,32 @@ its '*cleanup* action handler." ;;; ========================= (define* (run-hive hive initial-tasks - #:key (cleanup #t)) - "Start up an agenda and run HIVE in it with INITIAL-TASKS." + #:key (cleanup #t) + (handle-signals (list SIGINT SIGTERM))) + "Start up an agenda and run HIVE in it with INITIAL-TASKS. + +Keyword arguments: + - #:cleanup: Whether to run *cleanup* on all actors. + - #:handle-sigactions: a list of signals to set up interrupt + handlers for, so cleanup sill still happen as expected. + Defaults to a list of SIGINT and SIGTERM." (dynamic-wind (const #f) (lambda () - (let* ((queue (list->q - (cons (bootstrap-message hive (actor-id hive) '*init-all*) - initial-tasks))) - (agenda (make-agenda #:pre-unwind-handler print-error-and-continue - #:queue queue))) - (run-agenda agenda))) + (define (run-it escape) + (define (handle-signal signum) + (restore-signals) + (escape signum)) + (for-each (lambda (signum) + (sigaction signum handle-signal)) + handle-signals) + (let* ((queue (list->q + (cons (bootstrap-message hive (actor-id hive) '*init-all*) + initial-tasks))) + (agenda (make-agenda #:pre-unwind-handler print-error-and-continue + #:queue queue))) + (run-agenda agenda))) + (call/ec run-it)) ;; Run cleanup (lambda () (when cleanup