04/04: Improve the process jobs script signal handling

[Christopher Baines]

cbaines pushed a commit to branch master
in repository data-service.

commit f1d8d76c4d685bc5e938f495c762984fe2564371
Author: Christopher Baines <mail@cbaines.net>
AuthorDate: Sun Jan 9 10:30:03 2022 +0000

    Improve the process jobs script signal handling
    
    The return value of sleep is unreliable (see guile bug #53139), so use a
    signal handler instead.
---
 guix-data-service/jobs.scm | 29 +++++++++++++++++++++++++++--
 1 file changed, 27 insertions(+), 2 deletions(-)

diff --git a/guix-data-service/jobs.scm b/guix-data-service/jobs.scm
index a1828a2..25db704 100644
--- a/guix-data-service/jobs.scm
+++ b/guix-data-service/jobs.scm
@@ -19,6 +19,7 @@
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:use-module (ice-9 threads)
+  #:use-module (ice-9 atomic)
   #:use-module (guix-data-service jobs load-new-guix-revision)
   #:export (process-jobs
 
@@ -132,6 +133,18 @@
                (handle-job-failure id)))))))
      processes))
 
+  (define (stop-running-processes)
+    (hash-map->list
+     (match-lambda*
+       ((pid (start-time job-args))
+        (display
+         (simple-format
+          #f "sending SIGTERM to pid ~A\n"
+          pid)
+         (current-error-port))
+        (kill pid SIGTERM)))
+     processes))
+
   (define (fork-and-process-job job-args)
     (match (primitive-fork)
       (0
@@ -146,10 +159,23 @@
                    (list (current-time) job-args))
        #t)))
 
+  (define exit?
+    (make-atomic-box #f))
+
+  (sigaction SIGTERM
+    (lambda args
+      (simple-format (current-error-port) "exiting due to SIGTERM\n")
+      (atomic-box-set! exit? #t)))
+
   (while #t
     (kill-long-running-processes)
     (wait-on-processes)
     (display-status)
+
+    (when (atomic-box-ref exit?)
+      (stop-running-processes)
+      (exit 0))
+
     (match (fetch-new-jobs)
       (()
        ;; Nothing to do
@@ -166,5 +192,4 @@
                           max-processes))
                (fork-and-process-job (list job-id))))))
         jobs)))
-    (unless (eq? 0 (sleep 15))
-      (exit 0))))
+    (sleep 15)))