From 743769d750d933eef70f4f148a3b7337630f4dc6 Mon Sep 17 00:00:00 2001
From: Dimitri Fontaine <dim@tapoueh.org>
Date: Wed, 21 Nov 2018 10:38:19 +0100
Subject: [PATCH] Improve handling of errors when fetching the source catalogs.

We might have MS SQL failures at this stage, or even Redshift or other
PostgreSQL variants failing to execute our catalog queries. Handle
conditions by cleanly logging them and returning from copy-database without
doing anything. That's the best we can do here.

Fixes #605, fixes #757.
---
 src/load/migrate-database.lisp | 39 ++++++++++++++++++++++------------
 1 file changed, 26 insertions(+), 13 deletions(-)

diff --git a/src/load/migrate-database.lisp b/src/load/migrate-database.lisp
index db7d096..2dee25b 100644
--- a/src/load/migrate-database.lisp
+++ b/src/load/migrate-database.lisp
@@ -319,19 +319,32 @@
 
          (copy-kernel  (make-kernel worker-count))
          (copy-channel (let ((lp:*kernel* copy-kernel)) (lp:make-channel)))
-         (catalog      (fetch-metadata
-                        copy
-                        (make-catalog
-                         :name (typecase (source-db copy)
-                                 (db-connection (db-name (source-db copy)))
-                                 (fd-connection (pathname-name
-                                                 (fd-path (source-db copy))))))
-                        :materialize-views materialize-views
-                        :create-indexes create-indexes
-                        :foreign-keys foreign-keys
-                        :only-tables only-tables
-                        :including including
-                        :excluding excluding))
+         (catalog      (handler-case
+                           (fetch-metadata
+                            copy
+                            (make-catalog
+                             :name (typecase (source-db copy)
+                                     (db-connection
+                                      (db-name (source-db copy)))
+                                     (fd-connection
+                                      (pathname-name
+                                       (fd-path (source-db copy))))))
+                            :materialize-views materialize-views
+                            :create-indexes create-indexes
+                            :foreign-keys foreign-keys
+                            :only-tables only-tables
+                            :including including
+                            :excluding excluding)
+                         (mssql::mssql-error (e)
+                           (log-message :error "MSSQL ERROR: ~a" e)
+                           (log-message :log "You might need to review the FreeTDS protocol version in your freetds.conf file, see http://www.freetds.org/userguide/choosingtdsprotocol.htm")
+                           (return-from copy-database))
+                         (condition (e)
+                           (log-message :error
+                                        "ERROR ~a: ~a"
+                                        (conn-type (source-db copy))
+                                        e)
+                           (return-from copy-database))))
          pkeys
          (writers-count (make-hash-table :size (count-tables catalog)))
          (max-indexes   (when create-indexes