diff --git a/src/connection.lisp b/src/connection.lisp index a09848f..2b3839c 100644 --- a/src/connection.lisp +++ b/src/connection.lisp @@ -18,6 +18,9 @@ (defgeneric close-connection (connection) (:documentation "Close a connection to the data source.")) +(defgeneric check-connection (connection) + (:documentation "Check that we can actually connect.")) + (defclass fd-connection (connection) ((uri :initarg :uri :accessor fd-uri) (arch :initarg :arch :accessor fd-arch) @@ -94,6 +97,9 @@ (connection-error-user err) (connection-error-mesg err))))) +(defgeneric query (db-connection sql &key) + (:documentation "Query DB-CONNECTION with SQL query")) + (defmacro with-connection ((var connection) &body forms) "Connect to DB-CONNECTION and handle any condition when doing so, and when connected execute FORMS in a protected way so that we always disconnect @@ -120,3 +126,26 @@ (progn ,@forms) (close-connection ,var))))) +(defmethod check-connection ((fd fd-connection)) + "Check that it is possible to connect to db-connection C." + (log-message :log "Attempting to open ~a" fd) + (handler-case + (with-connection (cnx fd) + (log-message :log "Success, opened ~a." fd)) + (condition (e) + (log-message :fatal "Failed to connect to ~a: ~a" fd e)))) + +(defmethod check-connection ((c db-connection)) + "Check that it is possible to connect to db-connection C." + (log-message :log "Attempting to connect to ~a" c) + (handler-case + (with-connection (cnx c) + (log-message :log "Success, opened ~a." c) + (let ((sql "SELECT 1;")) + (log-message :log "Running a simple query: ~a" sql) + (handler-case + (query cnx sql) + (condition (e) + (log-message :fatal "SQL failed on ~a: ~a" c e))))) + (condition (e) + (log-message :fatal "Failed to connect to ~a: ~a" c e)))) diff --git a/src/main.lisp b/src/main.lisp index 64e0718..730173b 100644 --- a/src/main.lisp +++ b/src/main.lisp @@ -53,6 +53,9 @@ (("load-lisp-file" #\l) :type string :list t :optional t :documentation "Read user code from files") + ("dry-run" :type boolean + :documentation "Only check database connections, don't load anything.") + (("with") :type string :list t :optional t :documentation "Load options") @@ -188,7 +191,7 @@ (usage argv :quit t))) (destructuring-bind (&key help version quiet verbose debug logfile - list-encodings upgrade-config + list-encodings upgrade-config dry-run ((:load-lisp-file load)) client-min-messages log-min-messages summary root-dir self-upgrade @@ -257,6 +260,9 @@ (uiop:quit +os-code-error+)))) (uiop:quit +os-code-success+)) + ;; Should we run in dry-run mode? + (setf *dry-run* dry-run) + ;; Now process the arguments (when arguments ;; Start the logs system diff --git a/src/package.lisp b/src/package.lisp index 1703925..064d162 100644 --- a/src/package.lisp +++ b/src/package.lisp @@ -110,6 +110,8 @@ (defpackage #:pgloader.connection (:use #:cl #:pgloader.archive) + (:import-from #:pgloader.monitor + #:log-message) (:export #:connection #:open-connection #:close-connection @@ -119,6 +121,8 @@ #:fd-connection-error #:db-connection-error #:with-connection + #:query + #:check-connection ;; file based connections API for HTTP and Archives support #:fetch-file diff --git a/src/params.lisp b/src/params.lisp index 2767e05..50581d0 100644 --- a/src/params.lisp +++ b/src/params.lisp @@ -6,6 +6,7 @@ (defpackage #:pgloader.params (:use #:cl) (:export #:*version-string* + #:*dry-run* #:*self-upgrade-immutable-systems* #:*csv-path-root* #:*root-dir* @@ -64,6 +65,9 @@ DEFAULT if that variable isn't set" (or (uiop:getenv name) default))) +(defparameter *dry-run* nil + "Set to non-nil to only run checks about the load setup.") + ;; we can't use pgloader.utils:make-pgstate yet because params is compiled ;; first in the asd definition, we just make the symbol a special variable. (defparameter *state* nil diff --git a/src/parsers/command-copy.lisp b/src/parsers/command-copy.lisp index 88a55f0..7bff140 100644 --- a/src/parsers/command-copy.lisp +++ b/src/parsers/command-copy.lisp @@ -166,10 +166,13 @@ (:lambda (command) (bind (((source encoding fields pg-db-uri columns &key ((:copy-options options)) gucs before after) command)) - (lisp-code-for-loading-from-copy source fields pg-db-uri - :encoding encoding - :columns columns - :gucs gucs - :before before - :after after - :copy-options options)))) + (cond (*dry-run* + (lisp-code-for-csv-dry-run pg-db-uri)) + (t + (lisp-code-for-loading-from-copy source fields pg-db-uri + :encoding encoding + :columns columns + :gucs gucs + :before before + :after after + :copy-options options)))))) diff --git a/src/parsers/command-csv.lisp b/src/parsers/command-csv.lisp index 9c07637..8ea5cef 100644 --- a/src/parsers/command-csv.lisp +++ b/src/parsers/command-csv.lisp @@ -434,6 +434,14 @@ (destructuring-bind (source encoding fields target columns clauses) command `(,source ,encoding ,fields ,target ,columns ,@clauses)))) +(defun lisp-code-for-csv-dry-run (pg-db-conn) + `(lambda () + ;; CSV connection objects are not actually implementing the generic API + ;; because they support many complex options... (the file can be a + ;; pattern or standard input or inline or compressed etc). + (log-message :log "DRY RUN, only checking PostgreSQL connection.") + (check-connection ,pg-db-conn))) + (defun lisp-code-for-loading-from-csv (csv-conn fields pg-db-conn &key (encoding :utf-8) @@ -492,10 +500,13 @@ (:lambda (command) (bind (((source encoding fields pg-db-uri columns &key ((:csv-options options)) gucs before after) command)) - (lisp-code-for-loading-from-csv source fields pg-db-uri - :encoding encoding - :columns columns - :gucs gucs - :before before - :after after - :csv-options options)))) + (cond (*dry-run* + (lisp-code-for-csv-dry-run pg-db-uri)) + (t + (lisp-code-for-loading-from-csv source fields pg-db-uri + :encoding encoding + :columns columns + :gucs gucs + :before before + :after after + :csv-options options)))))) diff --git a/src/parsers/command-dbf.lisp b/src/parsers/command-dbf.lisp index 3dc958a..2ffa80d 100644 --- a/src/parsers/command-dbf.lisp +++ b/src/parsers/command-dbf.lisp @@ -81,6 +81,12 @@ (destructuring-bind (source encoding target clauses) command `(,source ,encoding ,target ,@clauses)))) +(defun lisp-code-for-dbf-dry-run (dbf-db-conn pg-db-conn) + `(lambda () + (let ((source-db (expand (fetch-file ,dbf-db-conn)))) + (check-connection source-db) + (check-connection ,pg-db-conn)))) + (defun lisp-code-for-loading-from-dbf (dbf-db-conn pg-db-conn &key (encoding :ascii) @@ -123,9 +129,12 @@ (:lambda (command) (bind (((source encoding pg-db-uri &key ((:dbf-options options)) gucs before after) command)) - (lisp-code-for-loading-from-dbf source pg-db-uri - :encoding encoding - :gucs gucs - :before before - :after after - :dbf-options options)))) + (cond (*dry-run* + (lisp-code-for-dbf-dry-run source pg-db-uri)) + (t + (lisp-code-for-loading-from-dbf source pg-db-uri + :encoding encoding + :gucs gucs + :before before + :after after + :dbf-options options)))))) diff --git a/src/parsers/command-fixed.lisp b/src/parsers/command-fixed.lisp index f82276f..18c8717 100644 --- a/src/parsers/command-fixed.lisp +++ b/src/parsers/command-fixed.lisp @@ -172,10 +172,13 @@ (:lambda (command) (bind (((source encoding fields pg-db-uri columns &key ((:fixed-options options)) gucs before after) command)) - (lisp-code-for-loading-from-fixed source fields pg-db-uri - :encoding encoding - :columns columns - :gucs gucs - :before before - :after after - :fixed-options options)))) + (cond (*dry-run* + (lisp-code-for-csv-dry-run pg-db-uri)) + (t + (lisp-code-for-loading-from-fixed source fields pg-db-uri + :encoding encoding + :columns columns + :gucs gucs + :before before + :after after + :fixed-options options)))))) diff --git a/src/parsers/command-ixf.lisp b/src/parsers/command-ixf.lisp index 9bcb104..ab0d3fa 100644 --- a/src/parsers/command-ixf.lisp +++ b/src/parsers/command-ixf.lisp @@ -82,8 +82,11 @@ (:lambda (command) (bind (((source pg-db-uri &key ((:ixf-options options)) gucs before after) command)) - (lisp-code-for-loading-from-ixf source pg-db-uri - :gucs gucs - :before before - :after after - :ixf-options options)))) + (cond (*dry-run* + (lisp-code-for-csv-dry-run pg-db-uri)) + (t + (lisp-code-for-loading-from-ixf source pg-db-uri + :gucs gucs + :before before + :after after + :ixf-options options)))))) diff --git a/src/parsers/command-mssql.lisp b/src/parsers/command-mssql.lisp index a679114..9b29732 100644 --- a/src/parsers/command-mssql.lisp +++ b/src/parsers/command-mssql.lisp @@ -139,6 +139,12 @@ ;;; LOAD DATABASE FROM mssql:// +(defun lisp-code-for-mssql-dry-run (ms-db-conn pg-db-conn) + `(lambda () + (log-message :log "DRY RUN, only checking connections.") + (check-connection ,ms-db-conn) + (check-connection ,pg-db-conn))) + (defun lisp-code-for-loading-from-mssql (ms-db-conn pg-db-conn &key gucs casts before after @@ -188,12 +194,15 @@ gucs casts before after including excluding ((:mssql-options options))) source)) - (lisp-code-for-loading-from-mssql ms-db-uri pg-db-uri - :gucs gucs - :casts casts - :before before - :after after - :mssql-options options - :including including - :excluding excluding)))) + (cond (*dry-run* + (lisp-code-for-mssql-dry-run ms-db-uri pg-db-uri)) + (t + (lisp-code-for-loading-from-mssql ms-db-uri pg-db-uri + :gucs gucs + :casts casts + :before before + :after after + :mssql-options options + :including including + :excluding excluding)))))) diff --git a/src/parsers/command-mysql.lisp b/src/parsers/command-mysql.lisp index a545676..d395d7e 100644 --- a/src/parsers/command-mysql.lisp +++ b/src/parsers/command-mysql.lisp @@ -152,6 +152,12 @@ ;;; LOAD DATABASE FROM mysql:// +(defun lisp-code-for-mysql-dry-run (my-db-conn pg-db-conn) + `(lambda () + (log-message :log "DRY RUN, only checking connections.") + (check-connection ,my-db-conn) + (check-connection ,pg-db-conn))) + (defun lisp-code-for-loading-from-mysql (my-db-conn pg-db-conn &key gucs casts views before after @@ -201,14 +207,17 @@ gucs casts views before after mysql-options including excluding decoding) source - (lisp-code-for-loading-from-mysql my-db-uri pg-db-uri - :gucs gucs - :casts casts - :views views - :before before - :after after - :mysql-options mysql-options - :including including - :excluding excluding - :decoding decoding)))) + (cond (*dry-run* + (lisp-code-for-mysql-dry-run my-db-uri pg-db-uri)) + (t + (lisp-code-for-loading-from-mysql my-db-uri pg-db-uri + :gucs gucs + :casts casts + :views views + :before before + :after after + :mysql-options mysql-options + :including including + :excluding excluding + :decoding decoding)))))) diff --git a/src/parsers/command-sqlite.lisp b/src/parsers/command-sqlite.lisp index 2052247..aa7d65f 100644 --- a/src/parsers/command-sqlite.lisp +++ b/src/parsers/command-sqlite.lisp @@ -88,6 +88,12 @@ load database (destructuring-bind (source target clauses) command `(,source ,target ,@clauses)))) +(defun lisp-code-for-sqlite-dry-run (sqlite-db-conn pg-db-conn) + `(lambda () + (log-message :log "DRY RUN, only checking connections.") + (check-connection ,sqlite-db-conn) + (check-connection ,pg-db-conn))) + (defun lisp-code-for-loading-from-sqlite (sqlite-db-conn pg-db-conn &key gucs casts @@ -119,10 +125,13 @@ load database pg-db-uri &key gucs casts sqlite-options including excluding) source - (lisp-code-for-loading-from-sqlite sqlite-uri pg-db-uri - :gucs gucs - :casts casts - :sqlite-options sqlite-options - :including including - :excluding excluding)))) + (cond (*dry-run* + (lisp-code-for-sqlite-dry-run sqlite-uri pg-db-uri)) + (t + (lisp-code-for-loading-from-sqlite sqlite-uri pg-db-uri + :gucs gucs + :casts casts + :sqlite-options sqlite-options + :including including + :excluding excluding)))))) diff --git a/src/pgsql/queries.lisp b/src/pgsql/queries.lisp index 6f3965f..c1114e6 100644 --- a/src/pgsql/queries.lisp +++ b/src/pgsql/queries.lisp @@ -45,6 +45,10 @@ (setf (conn-handle pgconn) nil) pgconn) +(defmethod query ((pgconn pgsql-connection) sql &key) + (let ((pomo:*database* (conn-handle pgconn))) + (pomo:query sql))) + (defmacro handling-pgsql-notices (&body forms) "The BODY is run within a PostgreSQL transaction where *pg-settings* have been applied. PostgreSQL warnings and errors are logged at the diff --git a/src/sources/mssql/mssql-schema.lisp b/src/sources/mssql/mssql-schema.lisp index 2c082f2..3959a92 100644 --- a/src/sources/mssql/mssql-schema.lisp +++ b/src/sources/mssql/mssql-schema.lisp @@ -29,6 +29,10 @@ (setf (conn-handle msconn) nil) msconn) +(defmethod query ((msconn mssql-connection) sql &key) + "Send SQL query to MSCONN connection." + (mssql:query sql :connection (conn-handle msconn))) + (defun mssql-query (query) "Execute given QUERY within the current *connection*, and set proper defaults for pgloader." diff --git a/src/sources/mysql/mysql-schema.lisp b/src/sources/mysql/mysql-schema.lisp index 6a968ca..3e0264a 100644 --- a/src/sources/mysql/mysql-schema.lisp +++ b/src/sources/mysql/mysql-schema.lisp @@ -73,6 +73,23 @@ (setf (conn-handle myconn) nil) myconn) +(defmethod query ((myconn mysql-connection) + sql + &key + row-fn + (as-text t) + (result-type 'list)) + "Run SQL query against MySQL connection MYCONN." + (log-message :debug "MySQL: sending query: ~a" sql) + (qmynd:mysql-query (conn-handle myconn) + sql + :row-fn row-fn + :as-text as-text + :result-type result-type)) + +;;; +;;; The generic API query is recent, used to look like this: +;;; (defun mysql-query (query &key row-fn (as-text t) (result-type 'list)) "Execute given QUERY within the current *connection*, and set proper defaults for pgloader." diff --git a/src/sources/sqlite/sqlite.lisp b/src/sources/sqlite/sqlite.lisp index 999746d..61703d5 100644 --- a/src/sources/sqlite/sqlite.lisp +++ b/src/sources/sqlite/sqlite.lisp @@ -23,6 +23,9 @@ (setf (conn-handle slconn) nil) slconn) +(defmethod query ((slconn sqlite-connection) sql &key) + (sqlite:execute-to-list (conn-handle slconn) sql)) + (defclass copy-sqlite (copy) ((db :accessor db :initarg :db)) (:documentation "pgloader SQLite Data Source"))