Add support for SSL modes in the PG connection string, fix #137.

In passing, refactor the *pgconn- dynamic bindings in favor of directly
using the connection property list straight from the connection string
parser, processing it when necessary. That allows to make it simple to
add an internal :use-ssl property.

pgloader.1

@@ -1,7 +1,7 @@
 .\" generated with Ronn/v0.7.3
 .\" http://github.com/rtomayko/ronn/tree/0.7.3
 .
-.TH "PGLOADER" "1" "October 2014" "ff" ""
+.TH "PGLOADER" "1" "December 2014" "ff" ""
 .
 .SH "NAME"
 \fBpgloader\fR \- PostgreSQL data loader
@@ -278,7 +278,7 @@ The \fB<postgresql\-url>\fR parameter is expected to be given as a \fIConnection
 .
 .nf
 
-postgresql://[user[:password]@][netloc][:port][/dbname][?schema\.table]
+postgresql://[user[:password]@][netloc][:port][/dbname][?option=value&\.\.\.]
 .
 .fi
 .
@@ -337,7 +337,19 @@ Should be a proper identifier (letter followed by a mix of letters, digits and t
 When omitted, the \fIdbname\fR defaults to the value of the environment variable \fBPGDATABASE\fR, and if that is unset, to the \fIuser\fR value as determined above\.
 .
 .IP "\(bu" 4
-The only optional parameter should be a possibly qualified table name\.
+\fIoptions\fR
+.
+.IP
+The optional parameters must be supplied with the form \fBname=value\fR, and you may use several parameters by separating them away using an ampersand (\fB&\fR) character\.
+.
+.IP
+Only two options are supported here, \fItablename\fR (which might be qualified with a schema name) and \fIsslmode\fR\.
+.
+.IP
+The \fIsslmode\fR parameter values can be one of \fBdisable\fR, \fBallow\fR, \fBprefer\fR or \fBrequire\fR\.
+.
+.IP
+For backward compatibility reasons, it\'s possible to specify the \fItablename\fR option directly, without spelling out the \fBtablename=\fR parts\.
 .
 .IP "" 0
 .

pgloader.1.md

@@ -257,7 +257,7 @@ The `<postgresql-url>` parameter is expected to be given as a *Connection URI*
 as documented in the PostgreSQL documentation at
 http://www.postgresql.org/docs/9.3/static/libpq-connect.html#LIBPQ-CONNSTRING.
 
-    postgresql://[user[:password]@][netloc][:port][/dbname][?schema.table]
+    postgresql://[user[:password]@][netloc][:port][/dbname][?option=value&...]
 
 Where:
 
@@ -307,7 +307,21 @@ Where:
     variable `PGDATABASE`, and if that is unset, to the *user* value as
     determined above.
 
-  - The only optional parameter should be a possibly qualified table name.
+  - *options*
+  
+    The optional parameters must be supplied with the form `name=value`, and
+    you may use several parameters by separating them away using an
+    ampersand (`&`) character.
+    
+    Only two options are supported here, *tablename* (which might be
+    qualified with a schema name) and *sslmode*.
+    
+    The *sslmode* parameter values can be one of `disable`, `allow`,
+    `prefer` or `require`.
+    
+    For backward compatibility reasons, it's possible to specify the
+    *tablename* option directly, without spelling out the `tablename=`
+    parts.
 
 ### Regular Expressions
 

src/params.lisp

@@ -16,11 +16,7 @@
 	   #:*copy-batch-rows*
            #:*copy-batch-size*
            #:*concurrent-batches*
-	   #:*pgconn-host*
+	   #:*pgconn*
-	   #:*pgconn-port*
-	   #:*pgconn-user*
-	   #:*pgconn-pass*
-	   #:*pg-dbname*
 	   #:*pg-settings*
 	   #:*myconn-host*
 	   #:*myconn-port*
@@ -121,11 +117,16 @@
 ;;;
 ;;; PostgreSQL Connection Credentials and Session Settings
 ;;;
-(defparameter *pgconn-host* "localhost")
+(defparameter *pgconn*
-(defparameter *pgconn-port* (parse-integer (getenv-default "PGPORT" "5432")))
+  '(:type :postgresql
-(defparameter *pgconn-user* (uiop:getenv "USER"))
+    :host "localhost"
-(defparameter *pgconn-pass* "pgpass")
+    :port (parse-integer (getenv-default "PGPORT" "5432"))
-(defparameter *pg-dbname* nil)
+    :user (uiop:getenv "USER")
+    :pass "pgpass"
+    :dbname nil
+    :table-name nil
+    :use-ssl nil)
+  "Default PostgreSQL connection string.")
 (defparameter *pg-settings* nil "An alist of GUC names and values.")
 
 ;;;

src/parsers/command-db-uri.lisp

@@ -82,15 +82,46 @@
 		(declare (ignore slash))
 		(list :dbname dbname)))
 
+(defrule dsn-option-ssl-disable "disable" (:constant :no))
+(defrule dsn-option-ssl-allow   "allow"   (:constant :try))
+(defrule dsn-option-ssl-prefer  "prefer"  (:constant :try))
+(defrule dsn-option-ssl-require "require" (:constant :yes))
+
+(defrule dsn-option-ssl (and "sslmode" "=" (or dsn-option-ssl-disable
+                                               dsn-option-ssl-allow
+                                               dsn-option-ssl-prefer
+                                               dsn-option-ssl-require))
+  (:lambda (ssl)
+    (destructuring-bind (key e val) ssl
+      (declare (ignore key e))
+      (cons :use-ssl val))))
+
 (defrule qualified-table-name (and namestring "." namestring)
   (:destructure (schema dot table)
     (declare (ignore dot))
     (format nil "~a.~a" (text schema) (text table))))
 
-(defrule dsn-table-name (and "?" (or qualified-table-name namestring))
+(defrule dsn-table-name (or qualified-table-name namestring)
-  (:destructure (qm name)
+  (:lambda (name)
-    (declare (ignore qm))
+    (cons :table-name name)))
-    (list :table-name name)))
+
+(defrule dsn-option-table-name (and (? (and "tablename" "="))
+                                    dsn-table-name)
+  (:lambda (opt-tn)
+    (bind (((_ table-name) opt-tn))
+      table-name)))
+
+(defrule dsn-option (or dsn-option-ssl dsn-option-table-name))
+
+(defrule another-dsn-option (and "&" dsn-option)
+  (:lambda (source)
+    (bind (((_ option) source)) option)))
+
+(defrule dsn-options (and "?" dsn-option (* another-dsn-option))
+  (:lambda (options)
+    (destructuring-bind (qm opt1 opts) options
+      (declare (ignore qm))
+      (alexandria:alist-plist `(,opt1 ,@opts)))))
 
 (defrule pgsql-prefix (and (or "postgresql" "postgres" "pgsql") "://")
   (:constant (list :type :postgresql)))
@@ -99,7 +130,7 @@
                         (? dsn-user-password)
                         (? dsn-hostname)
                         dsn-dbname
-                        (? dsn-table-name))
+                        (? dsn-options))
   (:lambda (uri)
     (destructuring-bind (&key type
                               user
@@ -107,7 +138,8 @@
 			      host
 			      port
 			      dbname
-                              table-name)
+                              table-name
+                              use-ssl)
         (apply #'append uri)
       ;; Default to environment variables as described in
       ;;  http://www.postgresql.org/docs/9.3/static/app-psql.html
@@ -122,6 +154,7 @@
                                                      #-unix "localhost"))
             :port       (or port     (parse-integer
                                       (getenv-default "PGPORT" "5432")))
+            :use-ssl    use-ssl
             :dbname     (or dbname   (getenv-default "PGDATABASE" user))
             :table-name table-name))))
 
@@ -142,18 +175,8 @@
 
 (defun pgsql-connection-bindings (pg-db-uri gucs)
   "Generate the code needed to set PostgreSQL connection bindings."
-  (destructuring-bind (&key ((:host pghost))
+  (destructuring-bind (&key ((:dbname pgdb)) &allow-other-keys) pg-db-uri
-                            ((:port pgport))
+    `((*pgconn*      ',pg-db-uri)
-                            ((:user pguser))
-                            ((:password pgpass))
-                            ((:dbname pgdb))
-                            &allow-other-keys)
-      pg-db-uri
-    `((*pgconn-host* ',pghost)
-      (*pgconn-port* ,pgport)
-      (*pgconn-user* ,pguser)
-      (*pgconn-pass* ,pgpass)
-      (*pg-dbname*   ,pgdb)
       (*pg-settings* ',gucs)
       (pgloader.pgsql::*pgsql-reserved-keywords*
        (pgloader.pgsql:list-reserved-keywords ,pgdb)))))

src/pgsql/queries.lisp

@@ -20,59 +20,66 @@
 	     (muffle-warning))))
      (progn ,@forms)))
 
-(defmacro with-pgsql-transaction ((&key (dbname *pg-dbname*) database) &body forms)
+(defmacro with-pgsql-transaction ((&key dbname username database) &body forms)
   "Run FORMS within a PostgreSQL transaction to DBNAME, reusing DATABASE if
    given. To get the connection spec from the DBNAME, use `get-connection-spec'."
   (if database
       `(let ((pomo:*database* ,database))
 	 (handling-pgsql-notices
-	   (pomo:with-transaction ()
+               (pomo:with-transaction ()
-	     (log-message :debug "BEGIN")
+                 (log-message :debug "BEGIN")
-	     (set-session-gucs *pg-settings* :transaction t)
+                 (set-session-gucs *pg-settings* :transaction t)
-	     ,@forms)))
+                 ,@forms)))
       ;; no database given, create a new database connection
-      `(let (#+unix (cl-postgres::*unix-socket-dir* (get-unix-socket-dir))
+      `(let (#+unix (cl-postgres::*unix-socket-dir* (get-unix-socket-dir)))
-             ;; if no dbname is given at macro-expansion time, we want to
+	 (pomo:with-connection (get-connection-spec :dbname ,dbname
-             ;; use the current value of *pg-dbname* at run time
+                                                    :username ,username)
-             (*pg-dbname* (or ,dbname *pg-dbname*)))
-	 (pomo:with-connection (get-connection-spec *pg-dbname*)
 	   (log-message :debug "CONNECT")
 	   (set-session-gucs *pg-settings*)
 	   (handling-pgsql-notices ()
-				   (pomo:with-transaction ()
+               (pomo:with-transaction ()
-				     (log-message :debug "BEGIN")
+                 (log-message :debug "BEGIN")
-				     ,@forms))))))
+                 ,@forms))))))
 
 (defmacro with-pgsql-connection ((dbname) &body forms)
   "Run FROMS within a PostgreSQL connection to DBNAME. To get the connection
    spec from the DBNAME, use `get-connection-spec'."
   `(let (#+unix (cl-postgres::*unix-socket-dir*  (get-unix-socket-dir)))
-     (pomo:with-connection (get-connection-spec ,dbname)
+     (pomo:with-connection (get-connection-spec :dbname ,dbname)
-       (log-message :debug "CONNECT ~s" (get-connection-spec ,dbname))
+       (log-message :debug "CONNECT ~s" (get-connection-spec :dbname ,dbname))
        (set-session-gucs *pg-settings*)
        (handling-pgsql-notices ()
-			       ,@forms))))
+           ,@forms))))
 
 (defun get-unix-socket-dir ()
-  "When *pgcon-host* is a (cons :unix path) value, return the right value
+  "When *pgconn* host is a (cons :unix path) value, return the right value
    for cl-postgres::*unix-socket-dir*."
-  (if (and (consp *pgconn-host*)
+  (destructuring-bind (&key host &allow-other-keys) *pgconn*
-           (eq :unix (car *pgconn-host*)))
+    (if (and (consp host) (eq :unix (car host)))
-      ;; set to *pgconn-host* value
+        ;; set to *pgconn* host value
-      (directory-namestring (fad:pathname-as-directory (cdr *pgconn-host*)))
+        (directory-namestring (fad:pathname-as-directory (cdr host)))
-      ;; keep as is.
+        ;; keep as is.
-      cl-postgres::*unix-socket-dir*))
+        cl-postgres::*unix-socket-dir*)))
 
-(defun get-connection-spec (dbname &key (with-port t))
+(defun get-connection-spec (&key dbname username (with-port t))
   "pomo:with-connection and cl-postgres:open-database and open-db-writer are
    not using the same connection spec format..."
-  (let* ((host    (if (and (consp *pgconn-host*) (eq :unix (car *pgconn-host*)))
+  (destructuring-bind (&key type host port user password
-		      :unix
+                            ((:dbname pgconn-dbname))
-		      *pgconn-host*))
+                            use-ssl
-	 (conspec (list dbname *pgconn-user* *pgconn-pass* host)))
+                            table-name)
-    (if with-port
+      *pgconn*
-      (append conspec (list :port *pgconn-port*))
+    (declare (ignore type table-name))
-      (append conspec (list *pgconn-port*)))))
+    (let* ((host    (if (and (consp host) (eq :unix (car host))) :unix host))
+           (conspec (list (or dbname pgconn-dbname)
+                          (or username user)
+                          password
+                          host)))
+      (if with-port
+          (setf conspec (append conspec (list :port port)))
+          (setf conspec (append conspec (list port))))
+
+      (if use-ssl (append conspec (list :use-ssl use-ssl)) conspec))))
 
 (defun set-session-gucs (alist &key transaction database)
   "Set given GUCs to given values for the current session."
@@ -113,15 +120,14 @@
 
 (defun list-databases (&optional (username "postgres"))
   "Connect to a local database and get the database list"
-  (let* ((*pgconn-user* username))
+  (with-pgsql-transaction (:dbname "postgres" :username username)
-    (with-pgsql-transaction (:dbname "postgres")
+    (loop for (dbname) in (pomo:query
-      (loop for (dbname) in (pomo:query
+                           "select datname
-			     "select datname
                               from pg_database
                              where datname !~ 'postgres|template'")
-	 collect dbname))))
+       collect dbname)))
 
-(defun list-tables (&optional (dbname *pg-dbname*))
+(defun list-tables (&optional dbname)
   "Return an alist of tables names and list of columns to pay attention to."
   (with-pgsql-transaction (:dbname dbname)
     (loop for (relname colarray) in (pomo:query "

src/utils/report.lisp

@@ -65,7 +65,7 @@
 
 (defmacro with-stats-collection ((table-name
                                   &key
-                                  (dbname *pg-dbname*)
+                                  dbname
                                   summary
                                   use-result-as-read
                                   use-result-as-rows
@@ -73,11 +73,13 @@
 				 &body forms)
   "Measure time spent in running BODY into STATE, accounting the seconds to
    given DBNAME and TABLE-NAME"
-  (let ((result (gensym "result"))
+  (destructuring-bind (&key ((:dbname pgconn-dbname)) &allow-other-keys)
-	(secs   (gensym "secs")))
+      *pgconn*
-    `(let ((*pg-dbname* (or ,dbname *pg-dbname*)))
+    (let ((result (gensym "result"))
-       (prog2
+          (secs   (gensym "secs"))
-           (pgstate-add-table ,pgstate *pg-dbname* ,table-name)
+          (dbname (or dbname pgconn-dbname)))
+      `(prog2
+           (pgstate-add-table ,pgstate ,dbname ,table-name)
            (multiple-value-bind (,result ,secs)
                (timing ,@forms)
              (cond ((and ,use-result-as-read ,use-result-as-rows)

src/utils/threads.lisp

@@ -11,10 +11,7 @@
                             (*copy-batch-rows*    . ,*copy-batch-rows*)
                             (*copy-batch-size*    . ,*copy-batch-size*)
                             (*concurrent-batches* . ,*concurrent-batches*)
-                            (*pgconn-host*        . ',*pgconn-host*)
+                            (*pgconn*             . ',*pgconn*)
-			    (*pgconn-port*        . ,*pgconn-port*)
-			    (*pgconn-user*        . ,*pgconn-user*)
-			    (*pgconn-pass*        . ,*pgconn-pass*)
 			    (*pg-settings*        . ',*pg-settings*)
 			    (*myconn-host*        . ',*myconn-host*)
 			    (*myconn-port*        . ,*myconn-port*)