From 5b227200a9525050ce60e44e2bc899a3c2b1f018 Mon Sep 17 00:00:00 2001
From: Dimitri Fontaine <dim@tapoueh.org>
Date: Tue, 3 Oct 2017 01:23:59 +0200
Subject: [PATCH] Fix error handling at monitor thread startup.

Errors such as failing to open the log file (maybe because of bad
permissions) weren't correctly handled. This fixes the problem by handling
the conditions at the lparallel task handler level and signaling a brand new
condition up to the main outside handler.

Fixes #638.
---
 src/main.lisp          |  7 ++++++-
 src/package.lisp       |  1 +
 src/utils/monitor.lisp | 25 +++++++++++++++++++------
 3 files changed, 26 insertions(+), 7 deletions(-)

diff --git a/src/main.lisp b/src/main.lisp
index 83fd3d7..a317232 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -300,7 +300,8 @@
                 ;; meaningful backtrace to the user in case of unexpected
                 ;; conditions being signaled.
                 (handler-bind
-                    (((and condition (not (or cli-parsing-error
+                    (((and condition (not (or monitor-error
+                                              cli-parsing-error
                                               source-definition-error
                                               regression-test-error)))
                       #'(lambda (condition)
@@ -362,6 +363,10 @@
                 (format *error-output* "~%~a~%~%" c)
                 (uiop:quit +os-code-error-regress+))
 
+              (monitor-error (c)
+                (format *error-output* "~a~%" c)
+                (uiop:quit +os-code-error+))
+
               (condition (c)
                 (format *error-output* "~%What I am doing here?~%~%")
                 (format *error-output* "~a~%~%" c)
diff --git a/src/package.lisp b/src/package.lisp
index 387ec4f..726ec3f 100644
--- a/src/package.lisp
+++ b/src/package.lisp
@@ -250,6 +250,7 @@
            #:send-event
            #:start-monitor
            #:stop-monitor
+           #:monitor-error
            #:elapsed-time-since
            #:timing))
 
diff --git a/src/utils/monitor.lisp b/src/utils/monitor.lisp
index 31248e0..91af9f0 100644
--- a/src/utils/monitor.lisp
+++ b/src/utils/monitor.lisp
@@ -36,6 +36,12 @@
 (defstruct update-stats section label read rows errs secs rs ws bytes start stop)
 (defstruct bad-row section label condition data)
 
+(define-condition monitor-error (error)
+  ((root-cause :initarg :root-cause :reader monitor-real-error))
+  (:report (lambda (err stream)
+             (format stream "FATAL: Failed to start the monitor thread.~%")
+             (format stream "~%~a~%" (monitor-real-error err)))))
+
 (defun log-message (category description &rest arguments)
   "Send given message into our monitoring queue for processing."
   (when (cl-log::category-messengers category)
@@ -142,13 +148,20 @@
           *monitoring-channel* (lp:make-channel)
           *monitoring-queue*   (lq:make-queue))
 
-    ;; warm up the channel to ensure we don't loose any event
-    (lp:submit-task *monitoring-channel* '+ 1 2 3)
-    (lp:receive-result *monitoring-channel*)
+    (lp:task-handler-bind
+        ((error
+          #'(lambda (c)
+              ;; we can't log-message a monitor thread error
+              (lp:invoke-transfer-error
+               (make-instance 'monitor-error :root-cause c)))))
 
-    ;; now that we know the channel is ready, start our long-running monitor
-    (lp:submit-task *monitoring-channel* #'monitor *monitoring-queue*)
-    (send-event (make-start :start-logger start-logger))
+      ;; warm up the channel to ensure we don't loose any event
+      (lp:submit-task *monitoring-channel* '+ 1 2 3)
+      (lp:receive-result *monitoring-channel*)
+
+      ;; now that we know the channel is ready, start our long-running monitor
+      (lp:submit-task *monitoring-channel* #'monitor *monitoring-queue*)
+      (send-event (make-start :start-logger start-logger)))
 
     (values *monitoring-kernel* *monitoring-queue* *monitoring-channel*)))