From 92a8cc8928e1f5d6aa13708b35cb4551aa736a37 Mon Sep 17 00:00:00 2001
From: Frank Duncan <frank@kank.net>
Date: Fri, 17 Dec 2021 13:56:48 -0600
Subject: [PATCH] Handle shutdown gracefully

---
 src/main/aws/aws.lisp     |  7 +++++++
 src/main/local/local.lisp |  3 +++
 src/main/package.lisp     |  3 ++-
 src/main/processor.lisp   | 39 +++++++++++++++++++++++++-----------
 src/main/server.lisp      | 42 +++++++++++++++++++++++++++++++--------
 5 files changed, 73 insertions(+), 21 deletions(-)

diff --git a/src/main/aws/aws.lisp b/src/main/aws/aws.lisp
index 1d3745b..2913d32 100644
--- a/src/main/aws/aws.lisp
+++ b/src/main/aws/aws.lisp
@@ -26,6 +26,7 @@
    (values-list retn))))
 
 (defun start-shutdown-thread ()
+ (format t "Starting AWS shutdown thread~%")
  (sb-thread:make-thread
   (lambda ()
    (loop
@@ -40,6 +41,12 @@
     (sleep 30)))
   :name "AWS Shutdown Thread"))
 
+(defmethod candle:shutdown-system ((job-system (eql :aws)))
+ (format t "Shutting down AWS box for exit~%")
+ ; If there's a job going, we need to wait for it to finish
+ (sb-thread:with-mutex (*aws-mutex*))
+ (stop-aws-box))
+
 (defun aws-command (cmd &rest args)
  (with-output-to-string (out)
  (sb-ext:run-program
diff --git a/src/main/local/local.lisp b/src/main/local/local.lisp
index 8eded5a..c06bde8 100644
--- a/src/main/local/local.lisp
+++ b/src/main/local/local.lisp
@@ -27,3 +27,6 @@
        :error out-str
        :wait t)))))
   (values (zerop code) out)))
+
+; NOOP as there is no service that needs to be cleaned up
+(defmethod candle:shutdown-system ((job-system (eql :local))))
diff --git a/src/main/package.lisp b/src/main/package.lisp
index 5e2263e..f9a1d70 100644
--- a/src/main/package.lisp
+++ b/src/main/package.lisp
@@ -2,7 +2,8 @@
  (:export
   #:server #:add-project #:delete-project #:refresh-project #:list-projects
   #:project-branch-information #:run #:*candle-dir* #:*job-system* #:*candle-dir* #:failures
-  #:project-job-information #:get-job-log #:retry-job #:job-project #:project-dir #:process-job-in-system))
+  #:project-job-information #:get-job-log #:retry-job #:job-project #:project-dir #:process-job-in-system
+  #:shutdown-system))
 
 (defpackage #:candle-cli (:use :cl) (:export :run))
 (defpackage #:candle-aws (:use :cl))
diff --git a/src/main/processor.lisp b/src/main/processor.lisp
index af65aa0..0d6ec1e 100644
--- a/src/main/processor.lisp
+++ b/src/main/processor.lisp
@@ -5,20 +5,35 @@
 
 (defvar *job-system*)
 (defgeneric process-job-in-system (job-system job))
+(defgeneric shutdown-system (job-system))
 
 (defun start-processor-thread ()
- (sb-thread:make-thread
-  (lambda ()
-   (loop
-    (let
-     ((job (find :queued *all-job* :key #'job-status)))
-     (if job
-      (process-job job)
-      ; We just wait here until the processor is released, which is usually done
-      ; when a project is refreshed.
-      (sb-thread:with-mutex (*mutex*)
-       (sb-thread:condition-wait *waitq* *mutex*))))))
-  :name "Processor"))
+ (format t "Starting processor in ~(~A~) mode~%" *job-system*)
+ (let*
+  ((active t)
+   (processor-thread
+    (sb-thread:make-thread
+     (lambda ()
+      (loop
+       :while active
+       :do
+       (let
+        ((job (find :queued *all-job* :key #'job-status)))
+        (if job
+         (process-job job)
+         ; We just wait here until the processor is released, which is usually done
+         ; when a project is refreshed.
+         (sb-thread:with-mutex (*mutex*)
+          (sb-thread:condition-wait *waitq* *mutex*))))))
+     :name "Processor")))
+  (push
+   (lambda ()
+    (format t "Shutting down processor thread~%")
+    (setf active nil)
+    (awaken-processor-thread)
+    (sb-thread:join-thread processor-thread)
+    (shutdown-system *job-system*))
+   sb-ext:*exit-hooks*)))
 
 (defun awaken-processor-thread ()
  (sb-thread:with-mutex (*mutex*)
diff --git a/src/main/server.lisp b/src/main/server.lisp
index 19780e2..ffd6e82 100644
--- a/src/main/server.lisp
+++ b/src/main/server.lisp
@@ -2,22 +2,48 @@
 
 (defun server (port &optional (background t))
  (when (not *candle-dir*) (error "Need a candle dir"))
- (let
+ (let*
   ((data-dir (format nil "~Adata" *candle-dir*)))
   (ensure-directories-exist *candle-dir*)
   (ensure-directories-exist data-dir)
   (lame-db:load-known-dbs data-dir)
-  (sb-thread:make-thread
-   (lambda ()
-    (do () (nil)
-     (progn
-      (sleep (* 5 60))
-      (lame-db:save-known-dbs data-dir))))
-   :name "Save Thread")
   (format t "Starting processor in ~(~A~) mode~%" *job-system*)
+  (start-save-thread data-dir)
   (start-processor-thread)
   (communication:start-listener port background)))
 
+(defun start-save-thread (data-dir)
+ (format t "Starting Save Thread~%")
+ (let*
+  ((mutex (sb-thread:make-mutex))
+   (waitq (sb-thread:make-waitqueue))
+   (active t)
+   (save-thread
+    (sb-thread:make-thread
+     (lambda ()
+      (loop
+       :while active
+       :do
+       (sb-thread:with-mutex (mutex)
+        (sb-thread:condition-wait waitq mutex)))
+      (lame-db:save-known-dbs data-dir))
+     :name "Save Thread")))
+  (sb-thread:make-thread
+   (lambda ()
+    (loop
+     (sleep (* 1 60))
+     (sb-thread:with-mutex (mutex)
+      (sb-thread:condition-broadcast waitq))))
+   :name "Save Thread Trigger")
+  (push
+   (lambda ()
+    (format t "Shutting down save thread~%")
+    (sb-thread:with-mutex (mutex)
+     (setf active nil)
+     (sb-thread:condition-broadcast waitq))
+    (sb-thread:join-thread save-thread))
+   sb-ext:*exit-hooks*)))
+
 (defun add-project (name src)
  (when
   (not (cl-ppcre:scan "^[0-9A-Za-z-]*$" name))
-- 
2.25.1