actors: Cleanup on signals.

* 8sync/actors.scm (run-hive): Handle signals, currently SIGINT and
SIGTERM, in a friendly way.  Will still run cleanup on actors.

diff --git a/8sync/actors.scm b/8sync/actors.scm
index 1d8e6023aa3b19bcb8350e4ee35d759cc3f59021..0c50446d8c1a4ac9b8aaec5328247edd9ef8f4da 100644 (file)
--- 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