mirror of
https://github.com/dimitri/pgloader.git
synced 2025-08-09 15:56:58 +02:00
f719d2976d
This feature has been asked several times, and I can't see any way to fix the GETENV parsing mess that we have. In this patch the GETENV support is retired and replaced with a templating system, using the Mustache syntax. To get back the GETENV feature, our implementation of the Mustache template system adds support for fetching the template variable values from the OS environment. Fixes #555, Fixes #609. See #500, #477, #278.
229 lines
8.5 KiB
Common Lisp
229 lines
8.5 KiB
Common Lisp
;;;
|
||
;;; The main target parsing
|
||
;;;
|
||
;;; COPY postgresql://user@localhost:5432/dbname?foo
|
||
;;;
|
||
|
||
(in-package :pgloader.parser)
|
||
|
||
;;
|
||
;; Parse PostgreSQL database connection strings
|
||
;;
|
||
;; at postgresql://[user[:password]@][netloc][:port][/dbname]?table-name
|
||
;;
|
||
;; http://www.postgresql.org/docs/9.2/static/libpq-connect.html#LIBPQ-CONNSTRING
|
||
;;
|
||
;; Also parse MySQL connection strings and syslog service definition
|
||
;; strings, using the same model.
|
||
;;
|
||
(defrule dsn-port (and ":" (* (digit-char-p character)))
|
||
(:lambda (port)
|
||
(bind (((_ digits &aux (port (coerce digits 'string))) port))
|
||
(list :port (if (null digits) digits
|
||
(parse-integer port))))))
|
||
|
||
(defrule doubled-at-sign (and "@@") (:constant "@"))
|
||
(defrule doubled-colon (and "::") (:constant ":"))
|
||
(defrule password (+ (or (not "@") doubled-at-sign)) (:text t))
|
||
(defrule username (and (or #\_ (alpha-char-p character))
|
||
(* (or (alpha-char-p character)
|
||
(digit-char-p character)
|
||
#\.
|
||
#\\
|
||
punct
|
||
doubled-at-sign
|
||
doubled-colon
|
||
)))
|
||
(:text t))
|
||
|
||
(defrule dsn-user-password (and username
|
||
(? (and ":" (? password)))
|
||
"@")
|
||
(:lambda (args)
|
||
(bind (((username &optional password) (butlast args)))
|
||
;; password looks like '(":" "password")
|
||
(list :user username :password (cadr password)))))
|
||
|
||
(defun hexdigit-char-p (character)
|
||
(member character #. (quote (coerce "0123456789abcdefABCDEF" 'list))))
|
||
|
||
(defrule ipv4-part (and (digit-char-p character)
|
||
(? (digit-char-p character))
|
||
(? (digit-char-p character))))
|
||
|
||
(defrule ipv4 (and ipv4-part "." ipv4-part "." ipv4-part "." ipv4-part)
|
||
(:lambda (ipv4)
|
||
(list :ipv4 (text ipv4))))
|
||
|
||
;;; socket directory is unix only, so we can forbid ":" on the parsing
|
||
(defun socket-directory-character-p (char)
|
||
(or (member char #.(quote (coerce "/.-_" 'list)))
|
||
(alphanumericp char)))
|
||
|
||
(defrule socket-directory (and "unix:" (* (socket-directory-character-p character)))
|
||
(:destructure (unix socket-directory)
|
||
(declare (ignore unix))
|
||
(list :unix (when socket-directory (text socket-directory)))))
|
||
|
||
(defrule network-name (and namestring (* (and "." namestring)))
|
||
(:lambda (name)
|
||
(let ((host (text name)))
|
||
(list :host (unless (string= "" host) host)))))
|
||
|
||
(defrule hostname (or ipv4 socket-directory network-name)
|
||
(:identity t))
|
||
|
||
(defun process-hostname (hostname)
|
||
(destructuring-bind (type &optional name) hostname
|
||
(ecase type
|
||
(:unix (if name (cons :unix name) :unix))
|
||
(:ipv4 name)
|
||
(:host name))))
|
||
|
||
(defrule dsn-hostname (and (? hostname) (? dsn-port))
|
||
(:lambda (host-port)
|
||
(destructuring-bind (host &optional port) host-port
|
||
(append (list :host (when host (process-hostname host)))
|
||
port))))
|
||
|
||
(defrule dsn-dbname (and "/" (? namestring))
|
||
(:destructure (slash dbname)
|
||
(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 maybe-quoted-namestring (or double-quoted-namestring
|
||
quoted-namestring
|
||
namestring))
|
||
|
||
(defrule qualified-table-name (and maybe-quoted-namestring
|
||
"."
|
||
maybe-quoted-namestring)
|
||
(:destructure (schema dot table)
|
||
(declare (ignore dot))
|
||
(cons (text schema) (text table))))
|
||
|
||
(defrule dsn-table-name (or qualified-table-name maybe-quoted-namestring)
|
||
(:lambda (name)
|
||
;; we can't make a table instance yet here, because for that we need to
|
||
;; apply-identifier-case on it, and that requires to have initialized
|
||
;; the *pgsql-reserved-keywords*, and we can't do that before parsing
|
||
;; the target database connection string, can we?
|
||
(cons :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 uri-param (+ (not "&")) (:text t))
|
||
|
||
(defmacro make-dsn-option-rule (name param &optional (rule 'uri-param) fn)
|
||
`(defrule ,name (and ,param "=" ,rule)
|
||
(:lambda (x)
|
||
(let ((cons (first (quri:url-decode-params (text x)))))
|
||
(setf (car cons) (intern (string-upcase (car cons)) "KEYWORD"))
|
||
(when ,fn
|
||
(setf (cdr cons) (funcall ,fn (cdr cons))))
|
||
cons))))
|
||
|
||
(make-dsn-option-rule dsn-option-host "host" uri-param
|
||
(lambda (hostname)
|
||
(process-hostname
|
||
(parse 'hostname
|
||
;; special case Unix Domain Socket paths
|
||
(cond ((char= (aref hostname 0) #\/)
|
||
(format nil "unix:~a" hostname))
|
||
(t hostname))))))
|
||
(make-dsn-option-rule dsn-option-port "port"
|
||
(+ (digit-char-p character))
|
||
#'parse-integer)
|
||
(make-dsn-option-rule dsn-option-dbname "dbname")
|
||
(make-dsn-option-rule dsn-option-user "user")
|
||
(make-dsn-option-rule dsn-option-pass "password")
|
||
|
||
(defrule dsn-option (or dsn-option-ssl
|
||
dsn-option-host
|
||
dsn-option-port
|
||
dsn-option-dbname
|
||
dsn-option-user
|
||
dsn-option-pass
|
||
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)))
|
||
|
||
(defrule pgsql-uri (and pgsql-prefix
|
||
(? dsn-user-password)
|
||
(? dsn-hostname)
|
||
dsn-dbname
|
||
(? dsn-options))
|
||
(:lambda (uri)
|
||
(destructuring-bind (&key type
|
||
user
|
||
password
|
||
host
|
||
port
|
||
dbname
|
||
table-name
|
||
use-ssl)
|
||
;; we want the options to take precedence over the URI components,
|
||
;; so we destructure the URI again and prepend options here.
|
||
(destructuring-bind (prefix user-pass host-port dbname options) uri
|
||
(apply #'append options prefix user-pass host-port (list dbname)))
|
||
;; Default to environment variables as described in
|
||
;; http://www.postgresql.org/docs/9.3/static/app-psql.html
|
||
(declare (ignore type))
|
||
(make-instance 'pgsql-connection
|
||
:user (or user
|
||
(getenv-default "PGUSER"
|
||
#+unix (getenv-default "USER")
|
||
#-unix (getenv-default "UserName")))
|
||
:pass (or password (getenv-default "PGPASSWORD"))
|
||
:host (or host (getenv-default "PGHOST"
|
||
#+unix :unix
|
||
#-unix "localhost"))
|
||
:port (or port (parse-integer
|
||
(getenv-default "PGPORT" "5432")))
|
||
:name (or dbname (getenv-default "PGDATABASE" user))
|
||
|
||
:use-ssl use-ssl
|
||
:table-name table-name))))
|
||
|
||
(defrule target (and kw-into pgsql-uri)
|
||
(:destructure (into target)
|
||
(declare (ignore into))
|
||
target))
|
||
|
||
|
||
(defun pgsql-connection-bindings (pg-db-uri gucs)
|
||
"Generate the code needed to set PostgreSQL connection bindings."
|
||
`((*pg-settings* (pgloader.pgsql:sanitize-user-gucs ',gucs))
|
||
(*pgsql-reserved-keywords*
|
||
(pgloader.pgsql:list-reserved-keywords ,pg-db-uri))))
|
||
|