[Emacs-diffs] wallet 1a6bcc9: * lisp/progmodes/sql.el: Added password wallet using

[Michael Mauger]

branch: wallet
commit 1a6bcc91e3e468e5a6d3e0b121bb675b576d3362
Author: Michael R. Mauger <address@hidden>
Commit: Michael R. Mauger <address@hidden>

    * 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.
---
 etc/NEWS                         |  48 +++++++++----
 lisp/progmodes/sql.el            | 151 ++++++++++++++++++++++++++++++++++++++-
 test/lisp/progmodes/sql-tests.el | 101 ++++++++++++++++++++++++++
 3 files changed, 284 insertions(+), 16 deletions(-)

diff --git a/etc/NEWS b/etc/NEWS
index 0cafbaa..253da49 100644
--- a/etc/NEWS
+++ b/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-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 2df6258..c72070b 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 604c021..a68f931 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