Implement support for SSL client certificates.

This fixes #308 by automatically using the PostgreSQL Client Side SSL
files as documented in the following reference:

  http://www.postgresql.org/docs/current/static/libpq-ssl.html#LIBPQ-SSL-FILE-USAGE

This uses the Postmodern special support for it. Unfortunately couldn't
test it locally other than it doesn't break non-ssl connections. Pushing
to have user feedback.

src/package.lisp

@@ -100,6 +100,7 @@
 	   #:format-interval
 	   #:camelCase-to-colname
            #:unquote
+           #:expand-user-homedir-pathname
 
            ;; threads
            #:make-kernel

src/pgsql/queries.lisp

@@ -22,6 +22,10 @@
           (pgconn-table-name clone) (pgconn-table-name c))
     clone))
 
+(defmethod ssl-enable-p ((pgconn pgsql-connection))
+  "Return non-nil when the connection uses SSL"
+  (member (pgconn-use-ssl pgconn) '(:try :yes)))
+
 (defun new-pgsql-connection (pgconn)
   "Prepare a new connection object with all the same properties as pgconn,
    so as to avoid stepping on it's handle"
@@ -34,6 +38,16 @@
                  :use-ssl (pgconn-use-ssl pgconn)
                  :table-name (pgconn-table-name pgconn)))
 
+;;;
+;;; Implement SSL Client Side certificates
+;;; http://www.postgresql.org/docs/current/static/libpq-ssl.html#LIBPQ-SSL-FILE-USAGE
+;;;
+(defvar *pgsql-client-certificate* "~/.postgresql/postgresql.crt"
+  "File where to read the PostgreSQL Client Side SSL Certificate.")
+
+(defvar *pgsql-client-key* "~/.postgresql/postgresql.key"
+  "File where to read the PostgreSQL Client Side SSL Private Key.")
+
 ;;;
 ;;; We need to distinguish some special cases of PostgreSQL errors within
 ;;; Class 53 — Insufficient Resources: in case of "too many connections" we
@@ -58,25 +72,33 @@
 
 (defmethod open-connection ((pgconn pgsql-connection) &key username)
   "Open a PostgreSQL connection."
-  (flet ((connect (pgconn username)
-           (handler-case
-               (pomo:connect (db-name pgconn)
-                             (or username (db-user pgconn))
-                             (db-pass pgconn)
-                             (let ((host (db-host pgconn)))
-                               (if (and (consp host) (eq :unix (car host)))
-                                   :unix
-                                   host))
-                             :port (db-port pgconn)
-                             :use-ssl (or (pgconn-use-ssl pgconn) :no))
-             ((or too-many-connections configuration-limit-exceeded) (e)
-               (log-message :error
-                            "Failed to connect to ~a: ~a; will try again in ~fs"
-                            pgconn e *retry-connect-delay*)
-               (sleep *retry-connect-delay*)))))
-    (loop :while (null (conn-handle pgconn))
-       :repeat *retry-connect-times*
-       :do (setf (conn-handle pgconn) (connect pgconn username))))
+  (let* ((crt-file (expand-user-homedir-pathname *pgsql-client-certificate*))
+         (key-file (expand-user-homedir-pathname *pgsql-client-key*))
+         (pomo::*ssl-certificate-file* (when (and (ssl-enable-p pgconn)
+                                                  (probe-file crt-file))
+                                         crt-file))
+         (pomo::*ssl-key-file*         (when (and (ssl-enable-p pgconn)
+                                                  (probe-file key-file))
+                                         key-file)))
+    (flet ((connect (pgconn username)
+             (handler-case
+                 (pomo:connect (db-name pgconn)
+                               (or username (db-user pgconn))
+                               (db-pass pgconn)
+                               (let ((host (db-host pgconn)))
+                                 (if (and (consp host) (eq :unix (car host)))
+                                     :unix
+                                     host))
+                               :port (db-port pgconn)
+                               :use-ssl (or (pgconn-use-ssl pgconn) :no))
+               ((or too-many-connections configuration-limit-exceeded) (e)
+                 (log-message :error
+                              "Failed to connect to ~a: ~a; will try again in ~fs"
+                              pgconn e *retry-connect-delay*)
+                 (sleep *retry-connect-delay*)))))
+      (loop :while (null (conn-handle pgconn))
+         :repeat *retry-connect-times*
+         :do (setf (conn-handle pgconn) (connect pgconn username)))))
   (unless (conn-handle pgconn)
     (error "Failed ~d times to connect to ~a" *retry-connect-times* pgconn))
   pgconn)

src/utils/utils.lisp

@@ -33,3 +33,24 @@
       (if (char= quote (aref string 0) (aref string (1- l)))
           (subseq string 1 (1- l))
           string))))
+
+;;;
+;;; Process ~/ references at run-time (not at compile time!)
+;;;
+(defun expand-user-homedir-pathname (namestring)
+  "Expand NAMESTRING replacing leading ~ with (user-homedir-pathname)"
+  (typecase namestring
+    (pathname namestring)
+    (string
+     (cond ((or (string= "~" namestring) (string= "~/" namestring))
+            (user-homedir-pathname))
+
+           ((and (<= 2 (length namestring))
+                 (char= #\~ (aref namestring 0))
+                 (char= #\/ (aref namestring 1)))
+            (uiop:merge-pathnames*
+             (uiop:parse-unix-namestring (subseq namestring 2))
+             (user-homedir-pathname)))
+
+           (t
+            (uiop:parse-unix-namestring namestring))))))