Merge branch 'master' into scratch/replace-region-contentsscratch/replace-region-contents

1 files changed, 170 insertions, 23 deletions

diff --git a/lisp/progmodes/sql.el b/lisp/progmodes/sql.el
index 6ad221295ca..9bae3d86640 100644
--- a/lisp/progmodes/sql.el
+++ b/lisp/progmodes/sql.el
@@ -237,6 +237,7 @@
 (require 'custom)
 (require 'thingatpt)
 (require 'view)
+(eval-when-compile (require 'subr-x))   ; string-empty-p
 
 (defvar font-lock-keyword-face)
 (defvar font-lock-set-defaults)
@@ -738,16 +739,131 @@ The package must be available to be loaded and activated."
   :type 'booleanp
   :version "27.1")
 
-(defun sql-is-indent-available ()
-  "Check if sql-indent module is available."
-  (when (locate-library "sql-indent")
-    (fboundp 'sqlind-minor-mode)))
-
 (defun sql-indent-enable ()
   "Enable `sqlind-minor-mode' if available and requested."
-  (when (sql-is-indent-available)
+  (when (fboundp 'sqlind-minor-mode)
     (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
@@ -804,7 +920,7 @@ Globally should be set to nil; it will be non-nil in `sql-mode',
 
 (defvaralias 'sql-pop-to-buffer-after-send-region 'sql-display-sqli-buffer-function)
 
-(defcustom sql-display-sqli-buffer-function 'display-buffer
+(defcustom sql-display-sqli-buffer-function #'display-buffer
   "Function to be called to display a SQLi buffer after `sql-send-*'.
 
 When set to a function, it will be called to display the buffer.
@@ -2929,7 +3045,7 @@ displayed."
 ;;; Motion Functions
 
 (defun sql-statement-regexp (prod)
-  (let* ((ansi-stmt (sql-get-product-feature 'ansi :statement))
+  (let* ((ansi-stmt (or (sql-get-product-feature 'ansi :statement) "select"))
          (prod-stmt (sql-get-product-feature prod  :statement)))
     (concat "^\\<"
             (if prod-stmt
@@ -3199,6 +3315,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 +3330,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 +3347,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))
@@ -3535,8 +3676,8 @@ Allows the suppression of continuation prompts.")
 
     ;; Count how many newlines in the string
     (setq sql-output-newline-count
-          (apply #'+ (mapcar (lambda (ch)
-                                (if (eq ch ?\n) 1 0)) string)))
+          (apply #'+ (mapcar (lambda (ch) (if (eq ch ?\n) 1 0))
+                             string)))
 
     ;; Send the string
     (comint-simple-send proc string)))
@@ -4086,7 +4227,7 @@ must tell Emacs.  Here's how to do that in your init file:
   ;; Set syntax and font-face highlighting
   ;; Catch changes to sql-product and highlight accordingly
   (sql-set-product (or sql-product 'ansi)) ; Fixes bug#13591
-  (add-hook 'hack-local-variables-hook 'sql-highlight-product t t))
+  (add-hook 'hack-local-variables-hook #'sql-highlight-product t t))
 
 
 
@@ -4094,7 +4235,7 @@ must tell Emacs.  Here's how to do that in your init file:
 
 (put 'sql-interactive-mode 'mode-class 'special)
 (put 'sql-interactive-mode 'custom-mode-group 'SQL)
-
+;; FIXME: Why not use `define-derived-mode'?
 (defun sql-interactive-mode ()
   "Major mode to use a SQL interpreter interactively.
 
@@ -4156,13 +4297,15 @@ certain length.
 
 \(add-hook \\='sql-interactive-mode-hook
     (function (lambda ()
-        (setq comint-output-filter-functions \\='comint-truncate-buffer))))
+        (setq comint-output-filter-functions #\\='comint-truncate-buffer))))
 
 Here is another example.  It will always put point back to the statement
 you entered, right above the output it created.
 
 \(setq comint-output-filter-functions
        (function (lambda (STR) (comint-show-output))))"
+  ;; FIXME: The doc above uses `setq' on `comint-output-filter-functions',
+  ;; whereas hooks should be manipulated with things like `add/remove-hook'.
   (delay-mode-hooks (comint-mode))
 
   ;; Get the `sql-product' for this interactive session.
@@ -4193,7 +4336,8 @@ you entered, right above the output it created.
   (setq local-abbrev-table sql-mode-abbrev-table)
   (setq abbrev-all-caps 1)
   ;; Exiting the process will call sql-stop.
-  (set-process-sentinel (get-buffer-process (current-buffer)) 'sql-stop)
+  (let ((proc (get-buffer-process (current-buffer))))
+    (when proc (set-process-sentinel proc #'sql-stop)))
   ;; Save the connection and login params
   (set (make-local-variable 'sql-user)       sql-user)
   (set (make-local-variable 'sql-database)   sql-database)
@@ -4211,7 +4355,7 @@ you entered, right above the output it created.
        (sql-make-alternate-buffer-name))
   ;; User stuff.  Initialize before the hook.
   (set (make-local-variable 'sql-prompt-regexp)
-       (sql-get-product-feature sql-product :prompt-regexp))
+       (or (sql-get-product-feature sql-product :prompt-regexp) "^"))
   (set (make-local-variable 'sql-prompt-length)
        (sql-get-product-feature sql-product :prompt-length))
   (set (make-local-variable 'sql-prompt-cont-regexp)
@@ -4219,7 +4363,7 @@ you entered, right above the output it created.
   (make-local-variable 'sql-output-newline-count)
   (make-local-variable 'sql-preoutput-hold)
   (add-hook 'comint-preoutput-filter-functions
-            'sql-interactive-remove-continuation-prompt nil t)
+            #'sql-interactive-remove-continuation-prompt nil t)
   (make-local-variable 'sql-input-ring-separator)
   (make-local-variable 'sql-input-ring-file-name)
   ;; Run the mode hook (along with comint's hooks).
@@ -4230,7 +4374,7 @@ you entered, right above the output it created.
             (concat "\\(" sql-prompt-regexp
                     "\\|" sql-prompt-cont-regexp "\\)")
           sql-prompt-regexp))
-  (setq left-margin sql-prompt-length)
+  (setq left-margin (or sql-prompt-length 0))
   ;; Install input sender
   (set (make-local-variable 'comint-input-sender) 'sql-input-sender)
   ;; People wanting a different history file for each
@@ -4268,8 +4412,7 @@ Sentinels will always get the two parameters PROCESS and EVENT."
   "Read a connection name."
   (let ((completion-ignore-case t))
     (completing-read prompt
-                     (mapcar (lambda (c) (car c))
-                             sql-connection-alist)
+                     (mapcar #'car sql-connection-alist)
                      nil t initial 'sql-connection-history default)))
 
 ;;;###autoload
@@ -4480,6 +4623,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
@@ -4522,7 +4669,8 @@ the call to \\[sql-product-interactive] with
               (let ((proc (get-buffer-process new-sqli-buffer))
                     (secs sql-login-delay)
                     (step 0.3))
-                (while (and (memq (process-status proc) '(open run))
+                (while (and proc
+                            (memq (process-status proc) '(open run))
                             (or (accept-process-output proc step)
                                 (<= 0.0 (setq secs (- secs step))))
                             (progn (goto-char (point-max))
@@ -5226,8 +5374,7 @@ The default comes from `process-coding-system-alist' and
 your might try undecided-dos as a coding system.  If this doesn't help,
 Try to set `comint-output-filter-functions' like this:
 
-\(setq comint-output-filter-functions (append comint-output-filter-functions
-					     \\='(comint-strip-ctrl-m)))
+\(add-hook 'comint-output-filter-functions #\\='comint-strip-ctrl-m 'append)
 
 \(Type \\[describe-mode] in the SQL buffer for a list of commands.)"
   (interactive "P")