diff options
author | Michael R. Mauger <michael@mauger.com> | 2019-02-18 23:15:54 -0500 |
---|---|---|
committer | Michael R. Mauger <michael@mauger.com> | 2019-02-18 23:15:54 -0500 |
commit | 1a6bcc91e3e468e5a6d3e0b121bb675b576d3362 (patch) | |
tree | ca325907ed02edcd6a463b5f5e5482bbc6f81ab9 | |
parent | ed1e805af7d4892e7354e8c9e2246d5017d4ff52 (diff) | |
download | emacs-wallet.tar.gz |
* lisp/progmodes/sql.el: Added password wallet usingwallet
`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.
-rw-r--r-- | etc/NEWS | 48 | ||||
-rw-r--r-- | lisp/progmodes/sql.el | 151 | ||||
-rw-r--r-- | test/lisp/progmodes/sql-tests.el | 101 |
3 files changed, 284 insertions, 16 deletions
@@ -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 --- diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el index 2df62585a0d..c72070b8923 100644 --- a/lisp/progmodes/sql.el +++ b/lisp/progmodes/sql.el @@ -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 diff --git a/test/lisp/progmodes/sql-tests.el b/test/lisp/progmodes/sql-tests.el index 604c02172ea..a68f9319c2f 100644 --- a/test/lisp/progmodes/sql-tests.el +++ b/test/lisp/progmodes/sql-tests.el @@ -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 |