Commit 1a6bcc91 authored by Michael R. Mauger's avatar Michael R. Mauger

* lisp/progmodes/sql.el: Added password wallet using

`auth-source' package.
(sql-auth-source-search-wallet): New function.
(sql-password-wallet): New variable.
(sql-password-search-wallet-function): New variable.
(sql-get-login): Handle password wallet search.
(sql-product-interactive): Handle password function.
* test/lisp/progmodes/sql-test.el: Test wallet changes.
(sql-test-login-params): New test variable.
(with-sql-test-connect-harness): New macro to wrap test
configuration around calls to `sql-connect'.
(sql-test-connect, sql-test-connect-password-func)
(sql-test-connect-wallet-server-database)
(sql-test-connect-wallet-database)
(sql-test-connect-wallet-server): New ERT tests.
* etc/NEWS: Updated SQL Mode descriptions.
parent ed1e805a
Pipeline #814 failed with stage
in 60 minutes and 2 seconds
......@@ -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-use-indent-support' (default t) enables SQL indention support.
*** SQL Indent Minor Mode
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
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment