[INF-18346] Impove error handling to prevent thread death

1 files changed, 26 insertions, 18 deletions

diff --git a/lisp/queue/queue.lisp b/lisp/queue/queue.lisp
index da86f6c..ecd517f 100644
--- a/lisp/queue/queue.lisp
+++ b/lisp/queue/queue.lisp
@@ -62,26 +62,34 @@ names. The string is a SHA1 hash."
                (process-thread-function symbol-queue-name process-thread-name sleep-interval)))))
 
 (defun process-thread-function (symbol-queue-name process-thread-name sleep-interval)
-  (with-error-handled-thread (process-thread-name :warning)
+  (without-error-handled-thread (process-thread-name :warning)
     (labels ((do-dequeue ()
                (dequeue (eval symbol-queue-name)))
              (do-process (object)
                (bg-perform object))
              (do-sleep ()
-               (sleep sleep-interval)))
-      (loop
-            (let (object
-                  do-process-p
-                  do-sleep-p)
-              (sb-thread:with-mutex (*queue-mutex*)
-                (cond ((empty-p (eval symbol-queue-name))
-                       (setf do-sleep-p t))
-                      (t
-                       (setf object (do-dequeue))
-                       (if object
-                           (setf do-process-p t)
-                           (setf do-sleep-p t)))))
-              (when do-sleep-p
-                (do-sleep))
-              (when (and do-process-p object)
-                (do-process object)))))))
+               (sleep sleep-interval))
+             (do-loop ()
+               (handler-case
+                   (loop
+                     (let (object
+                           do-process-p
+                           do-sleep-p)
+                       (sb-thread:with-mutex (*queue-mutex*)
+                         (cond ((empty-p (eval symbol-queue-name))
+                                (setf do-sleep-p t))
+                               (t
+                                (setf object (do-dequeue))
+                                (if object
+                                    (setf do-process-p t)
+                                    (setf do-sleep-p t)))))
+                       (when do-sleep-p
+                         (do-sleep))
+                       (when (and do-process-p object)
+                         (do-process object))))
+                 (error (e)
+                   (org-ckons-core::logger e)
+                   (unless hunchentoot:*catch-errors-p*
+                     (invoke-debugger e))
+                   (do-loop)))))
+      (do-loop))))