Merge branch 'wallet'
This commit is contained in:
Michael R. Mauger
commit
3700375334
3 changed files with 283 additions and 15 deletions
46
etc/NEWS
46
etc/NEWS
|
|
@ -515,27 +515,45 @@ end.
|
|||
|
||||
** SQL
|
||||
|
||||
*** Installation of 'sql-indent' from ELPA is strongly encouraged.
|
||||
This package support sophisticated rules for properly indenting SQL
|
||||
statements. SQL is not like other programming languages like C, Java,
|
||||
or Python where code is sparse and rules for formatting are fairly
|
||||
well established. Instead SQL is more like COBOL (from which it came)
|
||||
and code tends to be very dense and line ending decisions driven by
|
||||
syntax and line length considerations to make readable code.
|
||||
Experienced SQL developers may prefer to rely upon existing Emacs
|
||||
facilities for formatting code but the 'sql-indent' package provides
|
||||
facilities to aid more casual SQL developers layout queries and
|
||||
complex expressions.
|
||||
*** SQL Indent Minor Mode
|
||||
|
||||
*** 'sql-use-indent-support' (default t) enables SQL indention support.
|
||||
SQL Mode now supports the ELPA 'sql-indent' package for assisting
|
||||
sophisticated SQL indenting rules. Note, however, that SQL is not
|
||||
like other programming languages like C, Java, or Python where code is
|
||||
sparse and rules for formatting are fairly well established. Instead
|
||||
SQL is more like COBOL (from which it came) and code tends to be very
|
||||
dense and line ending decisions driven by syntax and line length
|
||||
considerations to make readable code. Experienced SQL developers may
|
||||
prefer to rely upon existing Emacs facilities for formatting code but
|
||||
the 'sql-indent' package provides facilities to aid more casual SQL
|
||||
developers layout queries and complex expressions.
|
||||
|
||||
**** 'sql-use-indent-support' (default t) enables SQL indention support.
|
||||
The 'sql-indent' package from ELPA must be installed to get the
|
||||
indentation support in 'sql-mode' and 'sql-interactive-mode'.
|
||||
|
||||
*** 'sql-mode-hook' and 'sql-interactive-mode-hook' changed.
|
||||
**** 'sql-mode-hook' and 'sql-interactive-mode-hook' changed.
|
||||
Both hook variables have had 'sql-indent-enable' added to their
|
||||
default values. If youhave existing customizations to these variables,
|
||||
default values. If you have existing customizations to these variables,
|
||||
you should make sure that the new default entry is included.
|
||||
|
||||
*** Connection Wallet
|
||||
|
||||
Database passwords can now by stored in NETRC or JSON data files that
|
||||
may optionally be encrypted. When establishing an interactive session
|
||||
with the database via 'sql-connect' or a product specific function,
|
||||
like 'sql-mysql' or 'my-postgres', the password wallet will be
|
||||
searched for the password. The 'sql-product', 'sql-server',
|
||||
'sql-database', and the 'sql-username' will be used to identify the
|
||||
appropriate authorization. This eliminates the discouraged practice of
|
||||
embedding database passwords in your Emacs initialization.
|
||||
|
||||
See the `auth-source' module for complete documentation on the file
|
||||
formats. By default, the wallet file is expected to be in the
|
||||
`user-emacs-directory', named 'sql-wallet' or '.sql-wallet', with
|
||||
'.json' (JSON) or no (NETRC) suffix. Both file formats can optionally
|
||||
be encrypted with GPG by adding an additional '.gpg' suffix.
|
||||
|
||||
** Term
|
||||
|
||||
---
|
||||
|
|
|
|||
|
|
@ -748,6 +748,126 @@ The package must be available to be loaded and activated."
|
|||
(when (sql-is-indent-available)
|
||||
(sqlind-minor-mode (if sql-use-indent-support +1 -1))))
|
||||
|
||||
;; Secure Password wallet
|
||||
|
||||
(require 'auth-source)
|
||||
|
||||
(defun sql-auth-source-search-wallet (wallet product user server database port)
|
||||
"Read auth source WALLET to locate the USER secret.
|
||||
Sets `auth-sources' to WALLET and uses `auth-source-search' to locate the entry.
|
||||
The DATABASE and SERVER are concatenated with a slash between them as the
|
||||
host key."
|
||||
(let* ((auth-sources wallet)
|
||||
host
|
||||
secret h-secret sd-secret)
|
||||
|
||||
;; product
|
||||
(setq product (symbol-name product))
|
||||
|
||||
;; user
|
||||
(setq user (unless (string-empty-p user) user))
|
||||
|
||||
;; port
|
||||
(setq port
|
||||
(when (and port (numberp port) (not (zerop port)))
|
||||
(number-to-string port)))
|
||||
|
||||
;; server
|
||||
(setq server (unless (string-empty-p server) server))
|
||||
|
||||
;; database
|
||||
(setq database (unless (string-empty-p database) database))
|
||||
|
||||
;; host
|
||||
(setq host (if server
|
||||
(if database
|
||||
(concat server "/" database)
|
||||
server)
|
||||
database))
|
||||
|
||||
;; Perform search
|
||||
(dolist (s (auth-source-search :max 1000))
|
||||
(when (and
|
||||
;; Is PRODUCT specified, in the enty, and they are equal
|
||||
(if product
|
||||
(if (plist-member s :product)
|
||||
(equal (plist-get s :product) product)
|
||||
t)
|
||||
t)
|
||||
;; Is USER specified, in the entry, and they are equal
|
||||
(if user
|
||||
(if (plist-member s :user)
|
||||
(equal (plist-get s :user) user)
|
||||
t)
|
||||
t)
|
||||
;; Is PORT specified, in the entry, and they are equal
|
||||
(if port
|
||||
(if (plist-member s :port)
|
||||
(equal (plist-get s :port) port)
|
||||
t)
|
||||
t))
|
||||
;; Is HOST specified, in the entry, and they are equal
|
||||
;; then the H-SECRET list
|
||||
(if (and host
|
||||
(plist-member s :host)
|
||||
(equal (plist-get s :host) host))
|
||||
(push s h-secret)
|
||||
;; Are SERVER and DATABASE specified, present, and equal
|
||||
;; then the SD-SECRET list
|
||||
(if (and server
|
||||
(plist-member s :server)
|
||||
database
|
||||
(plist-member s :database)
|
||||
(equal (plist-get s :server) server)
|
||||
(equal (plist-get s :database) database))
|
||||
(push s sd-secret)
|
||||
;; Is SERVER specified, in the entry, and they are equal
|
||||
;; then the base SECRET list
|
||||
(if (and server
|
||||
(plist-member s :server)
|
||||
(equal (plist-get s :server) server))
|
||||
(push s secret)
|
||||
;; Is DATABASE specified, in the entry, and they are equal
|
||||
;; then the base SECRET list
|
||||
(if (and database
|
||||
(plist-member s :database)
|
||||
(equal (plist-get s :database) database))
|
||||
(push s secret)))))))
|
||||
(setq secret (or h-secret sd-secret secret))
|
||||
|
||||
;; If we found a single secret, return the password
|
||||
(when (= 1 (length secret))
|
||||
(setq secret (car secret))
|
||||
(if (plist-member secret :secret)
|
||||
(plist-get secret :secret)
|
||||
nil))))
|
||||
|
||||
(defcustom sql-password-wallet
|
||||
(let (wallet w)
|
||||
(dolist (ext '(".json.gpg" ".gpg" ".json" "") wallet)
|
||||
(unless wallet
|
||||
(setq w (locate-user-emacs-file (concat "sql-wallet" ext)
|
||||
(concat ".sql-wallet" ext)))
|
||||
(when (file-exists-p w)
|
||||
(setq wallet w)))))
|
||||
"Identification of the password wallet.
|
||||
See `sql-password-search-wallet-function' to understand how this value
|
||||
is used to locate the password wallet."
|
||||
:type `(plist-get (symbol-plist 'auth-sources) 'custom-type)
|
||||
:group 'SQL
|
||||
:version "27.1")
|
||||
|
||||
(defvar sql-password-search-wallet-function #'sql-auth-source-search-wallet
|
||||
"Function to handle the lookup of the database password.
|
||||
The specified function will be called as:
|
||||
(wallet-func WALLET PRODUCT USER SERVER DATABASE PORT)
|
||||
|
||||
It is expected to return either a string containing the password,
|
||||
a function returning the password, or nil, If you want to support
|
||||
another format of password file, then implement a different
|
||||
search wallet function and identify the location of the password
|
||||
store with `sql-password-wallet'.")
|
||||
|
||||
;; misc customization of sql.el behavior
|
||||
|
||||
(defcustom sql-electric-stuff nil
|
||||
|
|
@ -3199,6 +3319,10 @@ symbol `password', for the server if it contains the symbol
|
|||
`database'. The members of WHAT are processed in the order in
|
||||
which they are provided.
|
||||
|
||||
If the `sql-password-wallet' is non-nil and WHAT contains the
|
||||
`password' token, then the `password' token will be pushed to the
|
||||
end to be sure that all of the values can be fed to the wallet.
|
||||
|
||||
Each token may also be a list with the token in the car and a
|
||||
plist of options as the cdr. The following properties are
|
||||
supported:
|
||||
|
|
@ -3210,6 +3334,15 @@ supported:
|
|||
|
||||
In order to ask the user for username, password and database, call the
|
||||
function like this: (sql-get-login \\='user \\='password \\='database)."
|
||||
|
||||
;; Push the password to the end if we have a wallet
|
||||
(when (and sql-password-wallet
|
||||
(fboundp sql-password-search-wallet-function)
|
||||
(member 'password what))
|
||||
(setq what (append (cl-delete 'password what)
|
||||
'(password))))
|
||||
|
||||
;; Prompt for each parameter
|
||||
(dolist (w what)
|
||||
(let ((plist (cdr-safe w)))
|
||||
(pcase (or (car-safe w) w)
|
||||
|
|
@ -3218,7 +3351,19 @@ function like this: (sql-get-login \\='user \\='password \\='database)."
|
|||
|
||||
('password
|
||||
(setq-default sql-password
|
||||
(read-passwd "Password: " nil (sql-default-value 'sql-password))))
|
||||
(if (and sql-password-wallet
|
||||
(fboundp sql-password-search-wallet-function))
|
||||
(let ((password (funcall sql-password-search-wallet-function
|
||||
sql-password-wallet
|
||||
sql-product
|
||||
sql-user
|
||||
sql-server
|
||||
sql-database
|
||||
sql-port)))
|
||||
(if password
|
||||
password
|
||||
(read-passwd "Password: " nil (sql-default-value 'sql-password))))
|
||||
(read-passwd "Password: " nil (sql-default-value 'sql-password)))))
|
||||
|
||||
('server
|
||||
(sql-get-login-ext 'sql-server "Server: " 'sql-server-history plist))
|
||||
|
|
@ -4481,6 +4626,10 @@ the call to \\[sql-product-interactive] with
|
|||
(or sql-default-directory
|
||||
default-directory)))
|
||||
|
||||
;; The password wallet returns a function which supplies the password.
|
||||
(when (functionp sql-password)
|
||||
(setq sql-password (funcall sql-password)))
|
||||
|
||||
;; Call the COMINT service
|
||||
(funcall (sql-get-product-feature product :sqli-comint-func)
|
||||
product
|
||||
|
|
|
|||
|
|
@ -53,5 +53,106 @@
|
|||
(error "some error"))))
|
||||
(should-not (sql-postgres-list-databases))))
|
||||
|
||||
(defvar sql-test-login-params nil)
|
||||
(defmacro with-sql-test-connect-harness (id login-params connection expected)
|
||||
"Set-up and tear-down SQL connect related test.
|
||||
|
||||
Identify tests by ID. Set :sql-login dialect attribute to
|
||||
LOGIN-PARAMS. Provide the CONNECTION parameters and the EXPECTED
|
||||
string of values passed to the comint function for validation."
|
||||
(declare (indent 2))
|
||||
`(cl-letf
|
||||
((sql-test-login-params ' ,login-params)
|
||||
((symbol-function 'sql-comint-test)
|
||||
(lambda (product options &optional buf-name)
|
||||
(with-current-buffer (get-buffer-create buf-name)
|
||||
(insert (pp-to-string (list product options sql-user sql-password sql-server sql-database))))))
|
||||
((symbol-function 'sql-run-test)
|
||||
(lambda (&optional buffer)
|
||||
(interactive "P")
|
||||
(sql-product-interactive 'sqltest buffer)))
|
||||
(sql-user nil)
|
||||
(sql-server nil)
|
||||
(sql-database nil)
|
||||
(sql-product-alist
|
||||
'((ansi)
|
||||
(sqltest
|
||||
:name "SqlTest"
|
||||
:sqli-login sql-test-login-params
|
||||
:sqli-comint-func sql-comint-test)))
|
||||
(sql-connection-alist
|
||||
'((,(format "test-%s" id)
|
||||
,@connection)))
|
||||
(sql-password-wallet
|
||||
(list
|
||||
(make-temp-file
|
||||
"sql-test-netrc" nil nil
|
||||
(mapconcat #'identity
|
||||
'("machine aMachine user aUserName password \"netrc-A aPassword\""
|
||||
"machine aServer user aUserName password \"netrc-B aPassword\""
|
||||
"machine aMachine server aServer user aUserName password \"netrc-C aPassword\""
|
||||
"machine aMachine database aDatabase user aUserName password \"netrc-D aPassword\""
|
||||
"machine aDatabase user aUserName password \"netrc-E aPassword\""
|
||||
"machine aMachine server aServer database aDatabase user aUserName password \"netrc-F aPassword\""
|
||||
"machine \"aServer/aDatabase\" user aUserName password \"netrc-G aPassword\""
|
||||
) "\n")))))
|
||||
|
||||
(let* ((connection ,(format "test-%s" id))
|
||||
(buffername (format "*SQL: ERT TEST <%s>*" connection)))
|
||||
(when (get-buffer buffername)
|
||||
(kill-buffer buffername))
|
||||
(sql-connect connection buffername)
|
||||
(should (get-buffer buffername))
|
||||
(should (string-equal (with-current-buffer buffername (buffer-string)) ,expected))
|
||||
(when (get-buffer buffername)
|
||||
(kill-buffer buffername))
|
||||
(delete-file (car sql-password-wallet)))))
|
||||
|
||||
(ert-deftest sql-test-connect ()
|
||||
"Test of basic `sql-connect'."
|
||||
(with-sql-test-connect-harness 1 (user password server database)
|
||||
((sql-product 'sqltest)
|
||||
(sql-user "aUserName")
|
||||
(sql-password "test-1 aPassword")
|
||||
(sql-server "aServer")
|
||||
(sql-database "aDatabase"))
|
||||
"(sqltest nil \"aUserName\" \"test-1 aPassword\" \"aServer\" \"aDatabase\")\n"))
|
||||
|
||||
(ert-deftest sql-test-connect-password-func ()
|
||||
"Test of password function."
|
||||
(with-sql-test-connect-harness 2 (user password server database)
|
||||
((sql-product 'sqltest)
|
||||
(sql-user "aUserName")
|
||||
(sql-password (lambda () (concat [?t ?e ?s ?t ?- ?2 ?\s
|
||||
?a ?P ?a ?s ?s ?w ?o ?r ?d])))
|
||||
(sql-server "aServer")
|
||||
(sql-database "aDatabase"))
|
||||
"(sqltest nil \"aUserName\" \"test-2 aPassword\" \"aServer\" \"aDatabase\")\n"))
|
||||
|
||||
(ert-deftest sql-test-connect-wallet-server-database ()
|
||||
"Test of password function."
|
||||
(with-sql-test-connect-harness 3 (user password server database)
|
||||
((sql-product 'sqltest)
|
||||
(sql-user "aUserName")
|
||||
(sql-server "aServer")
|
||||
(sql-database "aDatabase"))
|
||||
"(sqltest nil \"aUserName\" \"netrc-G aPassword\" \"aServer\" \"aDatabase\")\n"))
|
||||
|
||||
(ert-deftest sql-test-connect-wallet-database ()
|
||||
"Test of password function."
|
||||
(with-sql-test-connect-harness 4 (user password database)
|
||||
((sql-product 'sqltest)
|
||||
(sql-user "aUserName")
|
||||
(sql-database "aDatabase"))
|
||||
"(sqltest nil \"aUserName\" \"netrc-E aPassword\" nil \"aDatabase\")\n"))
|
||||
|
||||
(ert-deftest sql-test-connect-wallet-server ()
|
||||
"Test of password function."
|
||||
(with-sql-test-connect-harness 5 (user password server)
|
||||
((sql-product 'sqltest)
|
||||
(sql-user "aUserName")
|
||||
(sql-server "aServer"))
|
||||
"(sqltest nil \"aUserName\" \"netrc-B aPassword\" \"aServer\" nil)\n"))
|
||||
|
||||
(provide 'sql-tests)
|
||||
;;; sql-tests.el ends here
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue