unofficial mirror of bug-gnu-emacs@gnu.org 
 help / color / mirror / code / Atom feed
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends
@ 2022-11-03 13:51 J.P.
  0 siblings, 0 replies; 39+ messages in thread
From: J.P. @ 2022-11-03 13:51 UTC (permalink / raw)
  To: 58985; +Cc: Damien Cassou, emacs-erc

[-- Attachment #1: Type: text/plain, Size: 3979 bytes --]

Tags: patch

Hi people,

This is a belated follow-up to a brief exchange I had with Damien
earlier this year:

  https://lists.gnu.org/archive/html/bug-gnu-emacs/2022-04/msg00982.html

To recap, ERC would like to include the UNIX password store in the suite
of available back ends for its auth-source integration. To do that, we'd
need auth-source-pass to either export quite a few internal functions or
offer a bit more in the way of "standard" functionality. Thinking door
#2 the likelier, I've gone ahead and attempted a POC that mainly caters
to ERC's own requirements. (Sadly, I'm not well enough acquainted with
the library to aim much wider than that.) Regardless, I'm hoping someone
more knowledgeable will be willing to give this a think at some point.

Thanks,
J.P.


In GNU Emacs 29.0.50 (build 3, x86_64-pc-linux-gnu, GTK+ Version
 3.24.34, cairo version 1.17.6) of 2022-11-01 built on localhost
Repository revision: 9b098c903a2502df42e21fa0796aa35097ae2cfa
Repository branch: auth-source-pass-many
Windowing system distributor 'The X.Org Foundation', version 11.0.12014000
System Description: Fedora Linux 36 (Workstation Edition)

Configured using:
 'configure --enable-check-lisp-object-type --enable-checking=yes,glyphs
 'CFLAGS=-O0 -g3'
 PKG_CONFIG_PATH=:/usr/lib64/pkgconfig:/usr/share/pkgconfig
 CC=analyze-cc CXX=analyze-c++'

Configured features:
ACL CAIRO DBUS FREETYPE GIF GLIB GMP GNUTLS GPM GSETTINGS HARFBUZZ JPEG
JSON LCMS2 LIBOTF LIBSELINUX LIBSYSTEMD LIBXML2 M17N_FLT MODULES NOTIFY
INOTIFY PDUMPER PNG RSVG SECCOMP SOUND SQLITE3 THREADS TIFF
TOOLKIT_SCROLL_BARS WEBP X11 XDBE XIM XINPUT2 XPM GTK3 ZLIB

Important settings:
  value of $LANG: en_US.UTF-8
  value of $XMODIFIERS: @im=ibus
  locale-coding-system: utf-8-unix

Major mode: Lisp Interaction

Minor modes in effect:
  tooltip-mode: t
  global-eldoc-mode: t
  eldoc-mode: t
  show-paren-mode: t
  electric-indent-mode: t
  mouse-wheel-mode: t
  tool-bar-mode: t
  menu-bar-mode: t
  file-name-shadow-mode: t
  global-font-lock-mode: t
  font-lock-mode: t
  blink-cursor-mode: t
  line-number-mode: t
  indent-tabs-mode: t
  transient-mark-mode: t
  auto-composition-mode: t
  auto-encryption-mode: t
  auto-compression-mode: t

Load-path shadows:
None found.

Features:
(shadow sort mail-extr emacsbug message mailcap yank-media puny dired
dired-loaddefs rfc822 mml mml-sec password-cache epa derived epg rfc6068
epg-config gnus-util text-property-search time-date subr-x mm-decode
mm-bodies mm-encode mail-parse rfc2231 mailabbrev gmm-utils mailheader
cl-loaddefs cl-lib sendmail rfc2047 rfc2045 ietf-drums mm-util
mail-prsvr mail-utils rmc iso-transl tooltip cconv eldoc paren electric
uniquify ediff-hook vc-hooks lisp-float-type elisp-mode mwheel
term/x-win x-win term/common-win x-dnd tool-bar dnd fontset image
regexp-opt fringe tabulated-list replace newcomment text-mode lisp-mode
prog-mode register page tab-bar menu-bar rfn-eshadow isearch easymenu
timer select scroll-bar mouse jit-lock font-lock syntax font-core
term/tty-colors frame minibuffer nadvice seq simple cl-generic
indonesian philippine cham georgian utf-8-lang misc-lang vietnamese
tibetan thai tai-viet lao korean japanese eucjp-ms cp51932 hebrew greek
romanian slovak czech european ethiopic indian cyrillic chinese
composite emoji-zwj charscript charprop case-table epa-hook
jka-cmpr-hook help abbrev obarray oclosure cl-preloaded button loaddefs
theme-loaddefs faces cus-face macroexp files window text-properties
overlay sha1 md5 base64 format env code-pages mule custom widget keymap
hashtable-print-readable backquote threads dbusbind inotify lcms2
dynamic-setting system-font-setting font-render-setting cairo
move-toolbar gtk x-toolkit xinput2 x multi-tty make-network-process
emacs)

Memory information:
((conses 16 36767 7533)
 (symbols 48 5118 0)
 (strings 32 13166 1683)
 (string-bytes 1 374788)
 (vectors 16 9331)
 (vector-slots 8 148593 8753)
 (floats 8 21 21)
 (intervals 56 341 0)
 (buffers 984 11))

[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: 0001-POC-Make-auth-source-pass-behave-more-like-other-bac.patch --]
[-- Type: text/x-patch, Size: 13581 bytes --]

From dda2ccaed516afcea5f685f3b3f51849c58b197c Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Tue, 1 Nov 2022 22:46:24 -0700
Subject: [PATCH 1/2] [POC] Make auth-source-pass behave more like other
 backends

* lisp/auth-source-pass.el (auth-source-pass-standard-search): Add new
option to bring search behavior more in line with other backends.
(auth-source-pass-search): Add new keyword params `max' and `require'
and consider new option `auth-source-pass-standard-search' for dispatch.
(auth-source-pass--match-regexp, auth-source-pass--retrieve-parsed,
auth-source-pass--match-parts): Add supporting variable and helpers.
(auth-source-pass--build-result-many,
auth-source-pass--find-match-many): Add "-many" variants for existing
workhorse functions.
* test/lisp/auth-source-pass-tests.el
(auth-source-pass-standard-search--wild-port-miss-netrc,
auth-source-pass-standard-search--wild-port-miss,
auth-source-pass-standard-search--wild-port-hit-netrc,
auth-source-pass-standard-search--wild-port-hit,
auth-source-pass-standard-search--wild-port-req-miss-netrc,
auth-source-pass-standard-search--wild-port-req-miss,
auth-source-pass-standard-search--baseline,
auth-source-pass-standard-search--port-type,
auth-source-pass-standard-search--hosts-first): Add juxtaposed netrc
and standard-search pairs to demo optional extra-compliant behavior.
---
 lisp/auth-source-pass.el            |  99 +++++++++++++++++++++++-
 test/lisp/auth-source-pass-tests.el | 116 ++++++++++++++++++++++++++++
 2 files changed, 214 insertions(+), 1 deletion(-)

diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el
index 0955e2ed07..5638bdbd90 100644
--- a/lisp/auth-source-pass.el
+++ b/lisp/auth-source-pass.el
@@ -55,13 +55,23 @@ auth-source-pass-port-separator
   :type 'string
   :version "27.1")
 
+(defcustom auth-source-pass-standard-search nil
+  "Whether to use more standardized search behavior.
+When nil, the password-store backend works like it always has and
+considers at most one `:user' search parameter and returns at
+most one result.  With t, it tries to more faithfully mimic other
+auth-source backends."
+  :version "29.1"
+  :type 'boolean)
+
 (cl-defun auth-source-pass-search (&rest spec
                                          &key backend type host user port
+                                         require max
                                          &allow-other-keys)
   "Given some search query, return matching credentials.
 
 See `auth-source-search' for details on the parameters SPEC, BACKEND, TYPE,
-HOST, USER and PORT."
+HOST, USER, PORT, REQUIRE, and MAX."
   (cl-assert (or (null type) (eq type (oref backend type)))
              t "Invalid password-store search: %s %s")
   (cond ((eq host t)
@@ -70,6 +80,8 @@ auth-source-pass-search
         ((null host)
          ;; Do not build a result, as none will match when HOST is nil
          nil)
+        (auth-source-pass-standard-search
+         (auth-source-pass--build-result-many host port user require max))
         (t
          (when-let ((result (auth-source-pass--build-result host port user)))
            (list result)))))
@@ -89,6 +101,25 @@ auth-source-pass--build-result
                                     (seq-subseq retval 0 -2)) ;; remove password
         retval))))
 
+(defun auth-source-pass--build-result-many (hosts ports users require max)
+  "Return multiple `auth-source-pass--build-result' values."
+  (unless (listp hosts) (setq hosts (list hosts)))
+  (unless (listp users) (setq users (list users)))
+  (unless (listp ports) (setq ports (list ports)))
+  (let ((rv (auth-source-pass--find-match-many hosts users ports
+                                               require (or max 1))))
+    (when auth-source-debug
+      (auth-source-pass--do-debug "final result: %S" rv))
+    (if (eq auth-source-pass-standard-search 'test)
+        (reverse rv)
+      (let (out)
+        (dolist (e rv out)
+          (when-let* ((s (plist-get e :secret)) ; s not captured by closure
+                      (v (auth-source--obfuscate s)))
+            (setf (plist-get e :secret)
+                  (lambda () (auth-source--deobfuscate v))))
+          (push e out))))))
+
 ;;;###autoload
 (defun auth-source-pass-enable ()
   "Enable auth-source-password-store."
@@ -206,6 +237,72 @@ auth-source-pass--find-match
                 hosts
               (list hosts))))
 
+(defconst auth-source-pass--match-regexp
+  (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))
+
+(defun auth-source-pass--retrieve-parsed (seen path port-number-p)
+  (when-let ((m (string-match auth-source-pass--match-regexp path)))
+    (puthash path
+             (list :host (or (match-string 10 path) (match-string 11 path))
+                   :user (or (match-string 20 path) (match-string 21 path))
+                   :port (and-let* ((p (or (match-string 30 path)
+                                           (match-string 31 path)))
+                                    (n (string-to-number p)))
+                           (if (or (zerop n) (not port-number-p))
+                               (format "%s" p)
+                             n)))
+             seen)))
+
+(defun auth-source-pass--match-parts (parts key value require)
+  (let ((mv (plist-get parts key)))
+    (if (memq key require)
+        (and value (equal mv value))
+      (or (not value) (not mv) (equal mv value)))))
+
+;; For now, this ignores the contents of files and only considers path
+;;  components when matching.
+(defun auth-source-pass--find-match-many (hosts users ports require max)
+  "Return plists for valid combinations of HOSTS, USERS, PORTS.
+Each plist contains, at the very least, a host and a secret."
+  (let ((seen (make-hash-table :test #'equal))
+        (entries (auth-source-pass-entries))
+        port-number-p
+        out)
+    (catch 'done
+      (dolist (host hosts out)
+        (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)))
+              (setq port-number-p (equal 'integer (type-of port)))
+              (dolist (e entries)
+                (when-let*
+                    ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed
+                                              seen e port-number-p)))
+                     ((equal host (plist-get m :host)))
+                     ((auth-source-pass--match-parts m :port port require))
+                     ((auth-source-pass--match-parts m :user user require))
+                     (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)))
+                   out)
+                  (when (or (zerop (cl-decf max))
+                            (null (setq entries (delete e entries))))
+                    (throw 'done out)))))))))))
+
 (defun auth-source-pass--disambiguate (host &optional user port)
   "Return (HOST USER PORT) after disambiguation.
 Disambiguate between having user provided inside HOST (e.g.,
diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el
index f5147a7ce0..14d1361eae 100644
--- a/test/lisp/auth-source-pass-tests.el
+++ b/test/lisp/auth-source-pass-tests.el
@@ -488,6 +488,122 @@ auth-source-pass-prints-meaningful-debug-log
     (should (auth-source-pass--have-message-matching
              "found 2 entries matching \"gitlab.com\": (\"a/gitlab.com\" \"b/gitlab.com\")"))))
 
+
+;; FIXME move this to top of file if keeping these netrc tests
+(require 'ert-x)
+
+;; No entry has the requested port, but a result is still returned.
+
+(ert-deftest auth-source-pass-standard-search--wild-port-miss-netrc ()
+  (ert-with-temp-file netrc-file
+    :text "\
+machine x.com password a
+machine x.com port 42 password b
+"
+    (let* ((auth-sources (list netrc-file))
+           (auth-source-do-cache nil)
+           (results (auth-source-search :host "x.com" :port 22 :max 2)))
+      (dolist (result results)
+        (setf result (plist-put result :secret (auth-info-password result))))
+      (should (equal results '((:host "x.com" :secret "a")))))))
+
+(ert-deftest auth-source-pass-standard-search--wild-port-miss ()
+  (let ((auth-source-pass-standard-search 'test))
+    (auth-source-pass--with-store '(("x.com" (secret . "a"))
+                                    ("x.com:42" (secret . "b")))
+      (auth-source-pass-enable)
+      (should (equal (auth-source-search :host "x.com" :port 22 :max 2)
+                     '((:host "x.com" :secret "a")))))))
+
+;; One of two entries has the requested port, both returned
+
+(ert-deftest auth-source-pass-standard-search--wild-port-hit-netrc ()
+  (ert-with-temp-file netrc-file
+    :text "\
+machine x.com password a
+machine x.com port 42 password b
+"
+    (let* ((auth-sources (list netrc-file))
+           (auth-source-do-cache nil)
+           (results (auth-source-search :host "x.com" :port 42 :max 2)))
+      (dolist (result results)
+        (setf result (plist-put result :secret (auth-info-password result))))
+      (should (equal results '((:host "x.com" :secret "a")
+                               (:host "x.com" :port "42" :secret "b")))))))
+
+(ert-deftest auth-source-pass-standard-search--wild-port-hit ()
+  (let ((auth-source-pass-standard-search 'test))
+    (auth-source-pass--with-store '(("x.com" (secret . "a"))
+                                    ("x.com:42" (secret . "b")))
+      (auth-source-pass-enable)
+      (should (equal (auth-source-search :host "x.com" :port 42 :max 2)
+                     '((:host "x.com" :secret "a")
+                       (:host "x.com" :port 42 :secret "b")))))))
+
+;; No entry has the requested port, but :port is required, so search fails
+
+(ert-deftest auth-source-pass-standard-search--wild-port-req-miss-netrc ()
+  (ert-with-temp-file netrc-file
+    :text "\
+machine x.com password a
+machine x.com port 42 password b
+"
+    (let* ((auth-sources (list netrc-file))
+           (auth-source-do-cache nil)
+           (results (auth-source-search
+                     :host "x.com" :port 22 :require '(:port) :max 2)))
+      (should-not results))))
+
+(ert-deftest auth-source-pass-standard-search--wild-port-req-miss ()
+  (let ((auth-source-pass-standard-search 'test))
+    (auth-source-pass--with-store '(("x.com" (secret . "a"))
+                                    ("x.com:42" (secret . "b")))
+      (auth-source-pass-enable)
+      (should-not (auth-source-search
+                   :host "x.com" :port 22 :require '(:port) :max 2)))))
+
+;; A retrieved store entry mustn't be nil regardless of whether its
+;; path contains port or user components
+
+(ert-deftest auth-source-pass-standard-search--baseline ()
+  (let ((auth-source-pass-standard-search 'test))
+    (auth-source-pass--with-store '(("x.com"))
+      (auth-source-pass-enable)
+      (should-not (auth-source-search :host "x.com")))))
+
+;; Output port type (int or string) matches that of input parameter
+
+(ert-deftest auth-source-pass-standard-search--port-type ()
+  (let ((auth-source-pass-standard-search 'test))
+    (auth-source-pass--with-store '(("x.com:42" (secret . "a")))
+      (auth-source-pass-enable)
+      (should (equal (auth-source-search :host "x.com" :port 42)
+                     '((:host "x.com" :port 42 :secret "a")))))
+    (auth-source-pass--with-store '(("x.com:42" (secret . "a")))
+      (auth-source-pass-enable)
+      (should (equal (auth-source-search :host "x.com" :port "42")
+                     '((:host "x.com" :port "42" :secret "a")))))))
+
+;; The :host search param ordering more heavily influences the output
+;; because (h1, u1, p1), (h1, u1, p2), ... (hN, uN, pN); also, exact
+;; matches are not given precedence, i.e., matching store items are
+;; returned in the order encountered
+
+(ert-deftest auth-source-pass-standard-search--hosts-first ()
+  (let ((auth-source-pass-standard-search 'test))
+    (auth-source-pass--with-store '(("x.com:42/bar" (secret . "a"))
+                                    ("gnu.org" (secret . "b"))
+                                    ("x.com" (secret . "c"))
+                                    ("fake.com" (secret . "d"))
+                                    ("x.com/foo" (secret . "e")))
+      (auth-source-pass-enable)
+      (should (equal (auth-source-search :host '("x.com" "gnu.org") :max 3)
+                     ;; Notice gnu.org is never considered ^
+                     '((:host "x.com" :user "bar" :port "42" :secret "a")
+                       (:host "x.com" :secret "c")
+                       (:host "x.com" :user "foo" :secret "e")))))))
+
+
 (provide 'auth-source-pass-tests)
 
 ;;; auth-source-pass-tests.el ends here
-- 
2.38.1


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: 0002-POC-Support-auth-source-pass-in-ERC.patch --]
[-- Type: text/x-patch, Size: 10332 bytes --]

From b78670992dd10c9566e620cd016767a4b36dd10f Mon Sep 17 00:00:00 2001
From: "F. Jason Park" <jp@neverwas.me>
Date: Sun, 24 Apr 2022 06:20:09 -0700
Subject: [PATCH 2/2] [POC] 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--auth-source-pass-search,
erc-compat--auth-source-pass--build-results-many,
erc-compat--auth-source-pass--retrieve-parsed,
erc-compat--auth-source-pass-packend-parse): Copy some yet unreleased
functions from auth-source-pass that mimic the netrc backend.  Also
add forward declarations to support them.
* lisp/erc/erc.el (erc--auth-source-search): Use own auth-source-pass
erc-compat backend until 29.1 released.
* 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.
---
 doc/misc/erc.texi                   |   3 +-
 lisp/erc/erc-compat.el              | 100 ++++++++++++++++++++++++++++
 lisp/erc/erc.el                     |   7 +-
 test/lisp/erc/erc-services-tests.el |  27 +++-----
 4 files changed, 116 insertions(+), 21 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 @@ Connecting
 @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 8a00e711ac..e1e55cad99 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
@@ -156,6 +158,104 @@ erc-subseq
 		 (setq i (1+ i) start (1+ start)))
 	       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))
+
+(defun erc-compat--auth-source-pass--retrieve-parsed (seen e port-number-p)
+  (when-let ((pat (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))
+             (m (string-match pat e)))
+    (puthash e (list :host (or (match-string 10 e)
+                               (match-string 11 e))
+                     :user (or (match-string 20 e)
+                               (match-string 21 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--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))))))
+        port-number-p
+        out)
+    (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)))
+              (setq port-number-p (equal 'integer (type-of port)))
+              (dolist (e entries)
+                (when-let*
+                    ((m (or (gethash e seen)
+                            (erc-compat--auth-source-pass--retrieve-parsed
+                             seen e port-number-p)))
+                     ((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)))
+                   out)
+                  (when (or (zerop (cl-decf max))
+                            (null (setq entries (delete e entries))))
+                    (throw 'done nil)))))))))
+    (reverse out)))
+
+(cl-defun erc-compat--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--auth-source-pass--build-result-many host user port require max))
+
+(defun erc-compat--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--auth-source-pass-search))))
+
+
 (provide 'erc-compat)
 
 ;;; erc-compat.el ends here
diff --git a/lisp/erc/erc.el b/lisp/erc/erc.el
index db39e341b2..cfa69954d5 100644
--- a/lisp/erc/erc.el
+++ b/lisp/erc/erc.el
@@ -3477,7 +3477,12 @@ erc--auth-source-search
 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
+        (if (memq 'password-store auth-sources)
+            (cons #'erc-compat--auth-source-pass-backend-parse
+                  auth-source-backend-parser-functions)
+          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 8e2b8d2927..7ff2e36e77 100644
--- a/test/lisp/erc/erc-services-tests.el
+++ b/test/lisp/erc/erc-services-tests.el
@@ -469,15 +469,11 @@ erc-services-tests--asp-parse-entry
     (list (assoc 'secret (cdr found)))))
 
 (defvar erc-join-tests--auth-source-pass-entries
-  '(("irc.gnu.org:irc/#chan"
-     ("port" . "irc") ("user" . "#chan") (secret . "bar"))
-    ("my.gnu.org:irc/#chan"
-     ("port" . "irc") ("user" . "#chan") (secret . "baz"))
-    ("GNU.chat:irc/#chan"
-     ("port" . "irc") ("user" . "#chan") (secret . "foo"))))
+  '(("irc.gnu.org:irc/#chan" (secret . "bar"))
+    ("my.gnu.org:irc/#chan" (secret . "baz"))
+    ("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))
@@ -490,7 +486,6 @@ erc--auth-source-search--pass-standard
       (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))
@@ -503,19 +498,13 @@ erc--auth-source-search--pass-announced
       (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"
-            ("port" . "6697") ("user" . "#chan") (secret . "spam"))
-           ("my.gnu.org:irc/#fsf"
-            ("port" . "irc") ("user" . "#fsf") (secret . "42"))
-           ("irc.gnu.org:6667"
-            ("port" . "6667") (secret . "sesame"))
-           ("MyHost:irc"
-            ("port" . "irc") (secret . "456"))
-           ("MyHost:6667"
-            ("port" . "6667") (secret . "123"))))
+           ("GNU.chat:6697/#chan" (secret . "spam"))
+           ("my.gnu.org:irc/#fsf" (secret . "42"))
+           ("irc.gnu.org:6667" (secret . "sesame"))
+           ("MyHost:irc" (secret . "456"))
+           ("MyHost:6667" (secret . "123"))))
         (auth-sources '(password-store))
         (auth-source-do-cache nil))
 
-- 
2.38.1


^ permalink raw reply related	[flat|nested] 39+ messages in thread
end of thread, other threads:[~2022-12-07 14:30 UTC | newest]

Thread overview: 39+ messages (download: mbox.gz / follow: Atom feed)
-- links below jump to the message on this page --
     [not found] <87wn8cb0ym.fsf@neverwas.me>
2022-11-05 23:55 ` bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends J.P.
2022-11-06 11:23   ` Michael Albinus
     [not found]   ` <87pme09vis.fsf@gmx.de>
2022-11-07  5:00     ` J.P.
2022-11-09 18:21     ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
     [not found]     ` <878rkkoup4.fsf@disroot.org>
2022-11-10  5:23       ` J.P.
2022-11-10  7:12       ` Akib Azmain Turja
     [not found]       ` <87a64zo01q.fsf@neverwas.me>
2022-11-10  8:11         ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
     [not found]     ` <87a653z7dl.fsf@neverwas.me>
2022-11-07 10:33       ` Michael Albinus
     [not found]       ` <874jvbnje1.fsf@gmx.de>
2022-11-08 13:56         ` J.P.
2022-11-10  0:39           ` Björn Bidar via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-11-10  5:25             ` J.P.
     [not found]             ` <875yfnnzy6.fsf@neverwas.me>
2022-11-10 13:40               ` Björn Bidar via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-11-10 14:40                 ` J.P.
     [not found]                 ` <87pmduc1pz.fsf@neverwas.me>
2022-11-15  3:45                   ` J.P.
2022-11-09 18:25       ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
     [not found]       ` <874jv8ouh9.fsf@disroot.org>
2022-11-10  5:26         ` J.P.
2022-11-10  7:12       ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
     [not found]       ` <878rkjl1vd.fsf@disroot.org>
2022-11-10 14:38         ` J.P.
2022-11-11  3:17         ` J.P.
     [not found]         ` <877d026uym.fsf@neverwas.me>
2022-11-11 14:45           ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
     [not found]           ` <87tu35eehq.fsf@disroot.org>
2022-11-12  4:30             ` J.P.
     [not found]             ` <87bkpcu74w.fsf@neverwas.me>
2022-11-12 15:24               ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
     [not found]               ` <875yfkdwlm.fsf@disroot.org>
2022-11-13  7:26                 ` Akib Azmain Turja
2022-11-13 15:29                   ` J.P.
     [not found]                   ` <875yfiq3d8.fsf@neverwas.me>
2022-11-14  6:50                     ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
     [not found]                     ` <87mt8uvxkp.fsf@disroot.org>
2022-11-14 15:12                       ` J.P.
2022-11-14 17:49                         ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
2022-11-15  3:32                           ` J.P.
     [not found]                           ` <87a64s99ka.fsf@neverwas.me>
2022-11-18 14:14                             ` J.P.
2022-11-18 23:25                               ` Kai Tetzlaff
2022-11-19  0:35                                 ` J.P.
2022-11-19  1:02                                   ` Kai Tetzlaff
2022-11-19  3:39                                     ` J.P.
2022-11-19  4:08                                       ` J.P.
2022-11-19 14:59                                     ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors
     [not found]                             ` <87bkp4z6xg.fsf@neverwas.me>
2022-12-07 14:30                               ` J.P.
2022-11-06 14:39 ` Damien Cassou
2022-11-07  4:59   ` J.P.
2022-11-03 13:51 J.P.

Code repositories for project(s) associated with this public inbox

	https://git.savannah.gnu.org/cgit/emacs.git

This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).