master c5d91358b5 02/10: Support auth-source-pass in ERC

[F. Jason Park]

branch: master
commit c5d91358b594e057e37ea557923e6aa9d85b61e1
Author: F. Jason Park <jp@neverwas.me>
Commit: F. Jason Park <jp@neverwas.me>

    Support auth-source-pass in ERC
    
    * doc/misc/erc.texi: Mention that the auth-source-pass backend is
    supported.
    * lisp/erc/erc-compat.el (erc-compat--29-auth-source-pass-search,
    erc-compat--29-auth-source-pass--build-result-many,
    erc-compat--29-auth-source-pass--retrieve-parsed,
    erc-compat--29-auth-source-pass-backend-parse,
    erc-compat--auth-source-backend-parser-functions): Adapt some yet
    unreleased functions from auth-source-pass that mimic the netrc
    backend, and add forward declarations to support them.
    
    * lisp/erc/erc.el (erc--auth-source-search): Use own auth-source-pass
    erc-compat backend.
    * test/lisp/erc/erc-services-tests.el
    (erc-join-tests--auth-source-pass-entries): Remove useless items.
    (erc--auth-source-search--pass-standard,
    erc--auth-source-search--pass-announced,
    erc--auth-source-search--pass-overrides): Remove `ert-skip' guard.
    (Bug#58985.)
---
 doc/misc/erc.texi                   |   3 +-
 lisp/erc/erc-compat.el              | 117 ++++++++++++++++++++++++++++++++++++
 lisp/erc/erc.el                     |   4 +-
 test/lisp/erc/erc-services-tests.el |   3 -
 4 files changed, 122 insertions(+), 5 deletions(-)

diff --git a/doc/misc/erc.texi b/doc/misc/erc.texi
index 3db83197f9..ad35b78f0e 100644
--- a/doc/misc/erc.texi
+++ b/doc/misc/erc.texi
@@ -861,7 +861,8 @@ The default value for all three options is the function
 @code{erc-auth-source-search}.  It tries to merge relevant contextual
 parameters with those provided or discovered from the logical connection
 or the underlying transport.  Some auth-source back ends may not be
-compatible; netrc, plstore, json, and secrets are currently supported.
+compatible; netrc, plstore, json, secrets, and pass are currently
+supported.
 @end defopt
 
 @subheading Full name
diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el
index 03bd8f1352..5b54a0587a 100644
--- a/lisp/erc/erc-compat.el
+++ b/lisp/erc/erc-compat.el
@@ -32,6 +32,8 @@
 ;;; Code:
 
 (require 'compat nil 'noerror)
+(eval-when-compile (require 'cl-lib))
+
 
 ;;;###autoload(autoload 'erc-define-minor-mode "erc-compat")
 (define-obsolete-function-alias 'erc-define-minor-mode
@@ -157,6 +159,121 @@ If START or END is negative, it counts from the end."
               res))))))
 
 
+;;;; Auth Source
+
+(declare-function auth-source-pass--get-attr
+                  "auth-source-pass" (key entry-data))
+(declare-function auth-source-pass--disambiguate
+                  "auth-source-pass" (host &optional user port))
+(declare-function auth-source-backend-parse-parameters
+                  "auth-source-pass" (entry backend))
+(declare-function auth-source-backend "auth-source" (&rest slots))
+(declare-function auth-source-pass-entries "auth-source-pass" nil)
+(declare-function auth-source-pass-parse-entry "auth-source-pass" (entry))
+
+(defvar auth-sources)
+(defvar auth-source-backend-parser-functions)
+
+;; This hard codes `auth-source-pass-port-separator' to ":"
+(defun erc-compat--29-auth-source-pass--retrieve-parsed (seen e port-number-p)
+  (when (string-match (rx (or bot "/")
+                          (or (: (? (group-n 20 (+ (not (in " /@")))) "@")
+                                 (group-n 10 (+ (not (in " /:@"))))
+                                 (? ":" (group-n 30 (+ (not (in " /:"))))))
+                              (: (group-n 11 (+ (not (in " /:@"))))
+                                 (? ":" (group-n 31 (+ (not (in " /:")))))
+                                 (? "/" (group-n 21 (+ (not (in " /:")))))))
+                          eot)
+                      e)
+    (puthash e `( :host ,(or (match-string 10 e) (match-string 11 e))
+                  ,@(if-let* ((tr (match-string 21 e)))
+                        (list :user tr :suffix t)
+                      (list :user (match-string 20 e)))
+                  :port ,(and-let* ((p (or (match-string 30 e)
+                                           (match-string 31 e)))
+                                    (n (string-to-number p)))
+                           (if (or (zerop n) (not port-number-p))
+                               (format "%s" p)
+                             n)))
+             seen)))
+
+;; This looks bad, but it just inlines `auth-source-pass--find-match-many'.
+(defun erc-compat--29-auth-source-pass--build-result-many
+    (hosts users ports require max)
+  "Return a plist of HOSTS, PORTS, USERS, and secret."
+  (unless (listp hosts) (setq hosts (list hosts)))
+  (unless (listp users) (setq users (list users)))
+  (unless (listp ports) (setq ports (list ports)))
+  (unless max (setq max 1))
+  (let ((seen (make-hash-table :test #'equal))
+        (entries (auth-source-pass-entries))
+        (check (lambda (m k v)
+                 (let ((mv (plist-get m k)))
+                   (if (memq k require)
+                       (and v (equal mv v))
+                     (or (not v) (not mv) (equal mv v))))))
+        out suffixed suffixedp)
+    (catch 'done
+      (dolist (host hosts)
+        (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host)))
+          (unless (or (not (equal "443" p)) (string-prefix-p "https://"; host))
+            (setq p nil))
+          (dolist (user (or users (list u)))
+            (dolist (port (or ports (list p)))
+              (dolist (e entries)
+                (when-let*
+                    ((m (or (gethash e seen)
+                            (erc-compat--29-auth-source-pass--retrieve-parsed
+                             seen e (integerp port))))
+                     ((equal host (plist-get m :host)))
+                     ((funcall check m :port port))
+                     ((funcall check m :user user))
+                     (parsed (auth-source-pass-parse-entry e))
+                     (secret (or (auth-source-pass--get-attr 'secret parsed)
+                                 (not (memq :secret require)))))
+                  (push
+                   `( :host ,host ; prefer user-provided :host over h
+                      ,@(and-let* ((u (plist-get m :user))) (list :user u))
+                      ,@(and-let* ((p (plist-get m :port))) (list :port p))
+                      ,@(and secret (not (eq secret t)) (list :secret secret)))
+                   (if (setq suffixedp (plist-get m :suffix)) suffixed out))
+                  (unless suffixedp
+                    (when (or (zerop (cl-decf max))
+                              (null (setq entries (delete e entries))))
+                      (throw 'done out)))))
+              (setq suffixed (nreverse suffixed))
+              (while suffixed
+                (push (pop suffixed) out)
+                (when (zerop (cl-decf max))
+                  (throw 'done out))))))))
+    (reverse out)))
+
+(cl-defun erc-compat--29-auth-source-pass-search
+    (&rest spec &key host user port require max &allow-other-keys)
+  ;; From `auth-source-pass-search'
+  (cl-assert (and host (not (eq host t)))
+             t "Invalid password-store search: %s %s")
+  (erc-compat--29-auth-source-pass--build-result-many
+   host user port require max))
+
+(defun erc-compat--29-auth-source-pass-backend-parse (entry)
+  (when (eq entry 'password-store)
+    (auth-source-backend-parse-parameters
+     entry (auth-source-backend
+            :source "."
+            :type 'password-store
+            :search-function #'erc-compat--29-auth-source-pass-search))))
+
+(defun erc-compat--auth-source-backend-parser-functions ()
+  (if (memq 'password-store auth-sources)
+      (progn
+        (require 'auth-source-pass)
+        `(,@(unless (bound-and-true-p auth-source-pass-extra-query-keywords)
+              '(erc-compat--29-auth-source-pass-backend-parse))
+          ,@auth-source-backend-parser-functions))
+    auth-source-backend-parser-functions))
+
+
 ;;;; Misc 29.1
 
 (defmacro erc-compat--with-memoization (table &rest forms)
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index 6b14cf87e2..2d55e698a7 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3225,7 +3225,9 @@ host but different ports would result in the one with 
port 123 getting
 the nod.  Much the same would happen for entries sharing only a port:
 the one with host foo would win."
   (when-let*
-      ((priority (map-keys defaults))
+      ((auth-source-backend-parser-functions
+        (erc-compat--auth-source-backend-parser-functions))
+       (priority (map-keys defaults))
        (test (lambda (a b)
                (catch 'done
                  (dolist (key priority)
diff --git a/test/lisp/erc/erc-services-tests.el 
b/test/lisp/erc/erc-services-tests.el
index c22d4cf75e..7ff2e36e77 100644
--- a/test/lisp/erc/erc-services-tests.el
+++ b/test/lisp/erc/erc-services-tests.el
@@ -474,7 +474,6 @@
     ("GNU.chat:irc/#chan" (secret . "foo"))))
 
 (ert-deftest erc--auth-source-search--pass-standard ()
-  (ert-skip "Pass backend not yet supported")
   (let ((store erc-join-tests--auth-source-pass-entries)
         (auth-sources '(password-store))
         (auth-source-do-cache nil))
@@ -487,7 +486,6 @@
       (erc-services-tests--auth-source-standard #'erc-auth-source-search))))
 
 (ert-deftest erc--auth-source-search--pass-announced ()
-  (ert-skip "Pass backend not yet supported")
   (let ((store erc-join-tests--auth-source-pass-entries)
         (auth-sources '(password-store))
         (auth-source-do-cache nil))
@@ -500,7 +498,6 @@
       (erc-services-tests--auth-source-announced #'erc-auth-source-search))))
 
 (ert-deftest erc--auth-source-search--pass-overrides ()
-  (ert-skip "Pass backend not yet supported")
   (let ((store
          `(,@erc-join-tests--auth-source-pass-entries
            ("GNU.chat:6697/#chan" (secret . "spam"))