From e11ccf7bb74837a5b6210af33445f49a59a95bde Mon Sep 17 00:00:00 2001
From: Dimitri Fontaine <dim@tapoueh.org>
Date: Sat, 17 Jun 2017 18:38:06 +0200
Subject: [PATCH] Fix on-error-stop signaling.

To properly handle on-error-stop condition, make it a specific pgloader
condition with a specific handling behavior. In passing add some more log
messages for surprising conditions.

Fix #546.
---
 src/main.lisp                   |  2 ++
 src/params.lisp                 |  9 +++++++++
 src/pgsql/copy-from-queue.lisp  |  5 ++---
 src/sources/common/methods.lisp | 31 +++++++++++++++----------------
 4 files changed, 28 insertions(+), 19 deletions(-)

diff --git a/src/main.lisp b/src/main.lisp
index 186b3c6..4b40461 100644
--- a/src/main.lisp
+++ b/src/main.lisp
@@ -299,6 +299,7 @@
                   (handler-bind
                       ((condition
                         #'(lambda (condition)
+                            (log-message :fatal "KABOOM!")
                             (log-message :fatal "~a"
                                          (print-backtrace condition debug)))))
 
@@ -349,6 +350,7 @@
 
               (condition (c)
                 (declare (ignore c))    ; handler-bind printed it out
+                (log-message :log "What I am doing here?")
                 (sleep 0.3)             ; wait until monitor stops...
                 (uiop:quit +os-code-error+)))))
 
diff --git a/src/params.lisp b/src/params.lisp
index 9a52871..734ca10 100644
--- a/src/params.lisp
+++ b/src/params.lisp
@@ -8,6 +8,7 @@
   (:export #:*version-string*
            #:*dry-run*
            #:*on-error-stop*
+           #:on-error-stop
            #:*self-upgrade-immutable-systems*
 	   #:*fd-path-root*
 	   #:*root-dir*
@@ -78,6 +79,14 @@
 (defparameter *on-error-stop* nil
   "Set to non-nil to for pgloader to refrain from handling errors, quitting instead.")
 
+(define-condition on-error-stop ()
+  ((on-condition :initarg :on-condition :reader on-error-condition
+                 :documentation "Condition that triggered on-error-stop"))
+  (:report (lambda (condition stream)
+             (format stream
+                     "On Error Stop: ~a"
+                     (on-error-condition condition)))))
+
 (defparameter *fd-path-root* nil
   "Where to load files from, when loading from an archive or expanding regexps.")
 
diff --git a/src/pgsql/copy-from-queue.lisp b/src/pgsql/copy-from-queue.lisp
index 7f90bcc..1b70dca 100644
--- a/src/pgsql/copy-from-queue.lisp
+++ b/src/pgsql/copy-from-queue.lisp
@@ -78,9 +78,8 @@
           (if on-error-stop
               ;; re-signal the condition to upper level
               (progn
-                (log-message :fatal "~a" condition)
-                (error "Stop loading data for table ~s on first error."
-                       (format-table-name table)))
+                (log-message :error "~a" condition)
+                (signal 'on-error-stop :on-condition condition))
 
               ;; normal behavior, on-error-stop being nil
               ;; clean the current transaction before retrying new ones
diff --git a/src/sources/common/methods.lisp b/src/sources/common/methods.lisp
index c9a679d..965dfe3 100644
--- a/src/sources/common/methods.lisp
+++ b/src/sources/common/methods.lisp
@@ -154,22 +154,21 @@
                          (lq:make-queue :fixed-capacity *concurrent-batches*))))
 
     (lp:task-handler-bind
-        ((error #'(lambda (condition)
-                    (log-message :error "A thread failed with error: ~a"
-                                 condition)
-                    #-pgloader-image
-                    (if (member *client-min-messages* (list :debug :data))
-                        (lp::invoke-debugger condition)
-                        (lp::invoke-transfer-error condition))
-                    #+pgloader-image
-                    (if (member *client-min-messages* (list :debug :data))
-                        (log-message :fatal "Backtrace: ~a"
-                                     (trivial-backtrace:print-backtrace
-                                      condition
-                                      :output nil
-                                      :verbose t))
-                        (lp::invoke-transfer-error condition)))))
-      (log-message :notice "COPY ~s" table-name)
+        ((on-error-stop
+          #'(lambda (condition)
+              ;; everything has been handled already
+              (lp:invoke-transfer-error condition)))
+         (error
+          #'(lambda (condition)
+              (log-message :error "A thread failed with error: ~a" condition)
+              (if (member *client-min-messages* (list :debug :data))
+                  #-pgloader-image
+                  (log-message :error "~a"
+                               (trivial-backtrace:print-backtrace condition
+                                                                  :output nil))
+                  #+pgloader-image
+                  (lp::invoke-debugger condition))
+              (lp::invoke-transfer-error condition))))
       (log-message :notice "COPY ~a" table-name)
 
       ;; start a task to read data from the source into the queue