* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [not found] <87wn8cb0ym.fsf@neverwas.me> @ 2022-11-05 23:55 ` J.P. 2022-11-06 11:23 ` Michael Albinus [not found] ` <87pme09vis.fsf@gmx.de> 2022-11-06 14:39 ` Damien Cassou 1 sibling, 2 replies; 39+ messages in thread From: J.P. @ 2022-11-05 23:55 UTC (permalink / raw) To: 58985; +Cc: Damien Cassou, emacs-erc [-- Attachment #1: Type: text/plain, Size: 35 bytes --] v2. Respect existing user option. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-v1-v2.diff --] [-- Type: text/x-patch, Size: 5506 bytes --] From 9de7567ab61df0f5dda03e320c3c292c4a66ac55 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Fri, 4 Nov 2022 20:01:38 -0700 Subject: [PATCH 0/2] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (2): [POC] Make auth-source-pass behave more like other backends [POC] Support auth-source-pass in ERC doc/misc/erc.texi | 3 +- lisp/auth-source-pass.el | 105 +++++++++++++++++++- lisp/erc/erc-compat.el | 101 +++++++++++++++++++ lisp/erc/erc.el | 7 +- test/lisp/auth-source-pass-tests.el | 144 ++++++++++++++++++++++++++++ test/lisp/erc/erc-services-tests.el | 3 - 6 files changed, 357 insertions(+), 6 deletions(-) Interdiff: diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 5638bdbd90..44c47c30b7 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -101,13 +101,29 @@ auth-source-pass--build-result (seq-subseq retval 0 -2)) ;; remove password retval)))) +(defvar auth-source-pass--match-regexp nil) + +(defun auth-source-pass--match-regexp (s) + (rx-to-string ; autoloaded + `(: (or bot "/") + (or (: (? (group-n 20 (+ (not (in ?\ ?/ ?@ ,s)))) "@") + (group-n 10 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 30 (+ (not (in ?\ ?/ ,s)))))) + (: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 31 (+ (not (in ?\ ?/ ,s))))) + (? "/" (group-n 21 (+ (not (in ?\ ?/ ,s))))))) + eot) + 'no-group)) + (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)))) + (let* ((auth-source-pass--match-regexp (auth-source-pass--match-regexp + auth-source-pass-port-separator)) + (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) @@ -237,16 +253,6 @@ 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 diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index eb9cf45186..747a1152ff 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -182,6 +182,7 @@ erc-compat--with-memoization (declare-function auth-source-pass-entries "auth-source-pass" nil) (declare-function auth-source-pass-parse-entry "auth-source-pass" (entry)) +;; This basically hard codes `auth-source-pass-port-separator' to ":" (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 " /@")))) "@") diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 14d1361eae..242fc356b4 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -562,6 +562,34 @@ auth-source-pass-standard-search--wild-port-req-miss (should-not (auth-source-search :host "x.com" :port 22 :require '(:port) :max 2))))) +;; Specifying a :host without a :user finds a lone entry and does not +;; include extra fields (i.e., :port nil) in the result +;; https://lists.gnu.org/archive/html/emacs-devel/2022-11/msg00130.html + +(ert-deftest auth-source-pass-standard-search--netrc-akib () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine disroot.org user akib password b +machine z.com password c +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "disroot.org" :max 2))) + (dolist (result results) + (setf result (plist-put result :secret (auth-info-password result)))) + (should (equal results + '((:host "disroot.org" :user "akib" :secret "b"))))))) + +(ert-deftest auth-source-pass-standard-search--akib () + (let ((auth-source-pass-standard-search 'test)) + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("akib@disroot.org" (secret . "b")) + ("z.com" (secret . "c"))) + (auth-source-pass-enable) + (should (equal (auth-source-search :host "disroot.org" :max 2) + '((:host "disroot.org" :user "akib" :secret "b"))))))) + ;; A retrieved store entry mustn't be nil regardless of whether its ;; path contains port or user components -- 2.38.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0001-POC-Make-auth-source-pass-behave-more-like-other-bac.patch --] [-- Type: text/x-patch, Size: 15132 bytes --] From d623a025f40358aede9beca5313a36074bed2d98 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 | 105 +++++++++++++++++++- test/lisp/auth-source-pass-tests.el | 144 ++++++++++++++++++++++++++++ 2 files changed, 248 insertions(+), 1 deletion(-) diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 0955e2ed07..44c47c30b7 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,41 @@ auth-source-pass--build-result (seq-subseq retval 0 -2)) ;; remove password retval)))) +(defvar auth-source-pass--match-regexp nil) + +(defun auth-source-pass--match-regexp (s) + (rx-to-string ; autoloaded + `(: (or bot "/") + (or (: (? (group-n 20 (+ (not (in ?\ ?/ ?@ ,s)))) "@") + (group-n 10 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 30 (+ (not (in ?\ ?/ ,s)))))) + (: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 31 (+ (not (in ?\ ?/ ,s))))) + (? "/" (group-n 21 (+ (not (in ?\ ?/ ,s))))))) + eot) + 'no-group)) + +(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* ((auth-source-pass--match-regexp (auth-source-pass--match-regexp + auth-source-pass-port-separator)) + (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 +253,62 @@ auth-source-pass--find-match hosts (list hosts)))) +(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..242fc356b4 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -488,6 +488,150 @@ 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))))) + +;; Specifying a :host without a :user finds a lone entry and does not +;; include extra fields (i.e., :port nil) in the result +;; https://lists.gnu.org/archive/html/emacs-devel/2022-11/msg00130.html + +(ert-deftest auth-source-pass-standard-search--netrc-akib () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine disroot.org user akib password b +machine z.com password c +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "disroot.org" :max 2))) + (dolist (result results) + (setf result (plist-put result :secret (auth-info-password result)))) + (should (equal results + '((:host "disroot.org" :user "akib" :secret "b"))))))) + +(ert-deftest auth-source-pass-standard-search--akib () + (let ((auth-source-pass-standard-search 'test)) + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("akib@disroot.org" (secret . "b")) + ("z.com" (secret . "c"))) + (auth-source-pass-enable) + (should (equal (auth-source-search :host "disroot.org" :max 2) + '((:host "disroot.org" :user "akib" :secret "b"))))))) + +;; 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 #4: 0002-POC-Support-auth-source-pass-in-ERC.patch --] [-- Type: text/x-patch, Size: 9263 bytes --] From 9de7567ab61df0f5dda03e320c3c292c4a66ac55 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 | 101 ++++++++++++++++++++++++++++ lisp/erc/erc.el | 7 +- test/lisp/erc/erc-services-tests.el | 3 - 4 files changed, 109 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 @@ 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 03bd8f1352..747a1152ff 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 @@ -168,6 +170,105 @@ erc-compat--with-memoization `(cl--generic-with-memoization ,table ,@forms)) (t `(progn ,@forms)))) +;;;; 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)) + +;; This basically hard codes `auth-source-pass-port-separator' to ":" +(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 6b14cf87e2..3769e73041 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3225,7 +3225,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 c22d4cf75e..7ff2e36e77 100644 --- a/test/lisp/erc/erc-services-tests.el +++ b/test/lisp/erc/erc-services-tests.el @@ -474,7 +474,6 @@ erc-join-tests--auth-source-pass-entries ("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--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)) @@ -500,7 +498,6 @@ 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" (secret . "spam")) -- 2.38.1 ^ permalink raw reply related [flat|nested] 39+ messages in thread
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends 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> 1 sibling, 0 replies; 39+ messages in thread From: Michael Albinus @ 2022-11-06 11:23 UTC (permalink / raw) To: J.P.; +Cc: Damien Cassou, emacs-erc, 58985 "J.P." <jp@neverwas.me> writes: Hi, > v2. Respect existing user option. I'm not familiar with the auth-source-pass.el implementation, so I cannot speak too much about your patch. Reading it roughly, I haven't found serious flaws, 'tho. However :-) --8<---------------cut here---------------start------------->8--- +(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) --8<---------------cut here---------------end--------------->8--- - The name of this user option as well as its docstring are focussed on the current behavior. People won't know what "mimic other auth-source backends" would mean. Please describe the effect w/o that comparison, and pls give it a name based on its effect, and not "...-standard-search". - I'm missing the documentation in doc/misc/auth.texi and etc/NEWS. Best regards, Michael. ^ permalink raw reply [flat|nested] 39+ messages in thread
[parent not found: <87pme09vis.fsf@gmx.de>]
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [not found] ` <87pme09vis.fsf@gmx.de> @ 2022-11-07 5:00 ` J.P. [not found] ` <87a653z7dl.fsf@neverwas.me> ` (2 subsequent siblings) 3 siblings, 0 replies; 39+ messages in thread From: J.P. @ 2022-11-07 5:00 UTC (permalink / raw) To: Michael Albinus; +Cc: Damien Cassou, emacs-erc, 58985 [-- Attachment #1: Type: text/plain, Size: 1786 bytes --] Hi Michael, Michael Albinus <michael.albinus@gmx.de> writes: > I'm not familiar with the auth-source-pass.el implementation, so I > cannot speak too much about your patch. Reading it roughly, I haven't > found serious flaws, 'tho. Thanks for taking a look! > However :-) > > +(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) > > - The name of this user option as well as its docstring are focussed on > the current behavior. People won't know what "mimic other auth-source > backends" would mean. Please describe the effect w/o that comparison, > and pls give it a name based on its effect, and not "...-standard-search". I've changed the name to `auth-source-pass-extra-query-keywords' and updated the description to something hopefully more adequate. > - I'm missing the documentation in doc/misc/auth.texi and etc/NEWS. Added. BTW, I was initially thinking it'd be better to wait for a more comprehensive and maintainable solution, like something based around a larger set of common functions to be shared among the various back ends (hence the [POC] qualifier on my patches). However, I suppose such a thing could be done later, once the desired behavior is all dialed in (perhaps alongside addressing support for full CRUD operations, which are still missing, AFIAK). Anyway, I really don't know enough about pass or auth-source to commit to such an endeavor. But I've reached out to some folks who may be able to lend a hand. Thanks, J.P. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-v2-v3.diff --] [-- Type: text/x-patch, Size: 10488 bytes --] From a1701d3a7b96b6a7bb34b2a026caa6850c7574c5 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Sun, 6 Nov 2022 20:51:19 -0800 Subject: [PATCH 0/2] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (2): [POC] Make auth-source-pass behave more like other backends [POC] Support auth-source-pass in ERC doc/misc/auth.texi | 11 +++ doc/misc/erc.texi | 3 +- etc/NEWS | 8 ++ lisp/auth-source-pass.el | 109 ++++++++++++++++++++- lisp/erc/erc-compat.el | 101 +++++++++++++++++++ lisp/erc/erc.el | 7 +- test/lisp/auth-source-pass-tests.el | 144 ++++++++++++++++++++++++++++ test/lisp/erc/erc-services-tests.el | 3 - 8 files changed, 380 insertions(+), 6 deletions(-) Interdiff: diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 9dc63af6bc..222fce2058 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -526,6 +526,8 @@ The Unix password store while searching for an entry matching the @code{rms} user on host @code{gnu.org} and port @code{22}, then the entry @file{gnu.org:22/rms.gpg} is preferred over @file{gnu.org.gpg}. +However, such filtering is not applied when the option +@code{auth-source-pass-extra-parameters} is set to @code{t}. Users of @code{pass} may also be interested in functionality provided by other Emacs packages: @@ -549,6 +551,15 @@ The Unix password store port in an entry. Defaults to @samp{:}. @end defvar +@defvar auth-source-pass-extra-query-keywords +Set this to @code{t} if you encounter problems predicting the outcome +of searches relative to other auth-source backends or if you have code +that expects to query multiple backends uniformly. This tells +auth-source-pass to consider the @code{:max} and @code{:require} +keywords as well as lists containing multiple query params (for +applicable keywords). +@end defvar + @node Help for developers @chapter Help for developers diff --git a/etc/NEWS b/etc/NEWS index 89da8aa63f..776936489f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1383,6 +1383,14 @@ If non-nil and there's only one matching option, auto-select that. If non-nil, this user option describes what entries not to add to the database stored on disk. +** Auth-Source + ++++ +*** New user option 'auth-source-pass-extra-query-keywords'. +Whether to recognize additional keyword params, like ':max' and +':require', as well as accept lists of query terms paired with +applicable keywords. + ** Dired +++ diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 44c47c30b7..d9129667e1 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -55,14 +55,18 @@ 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) +(defcustom auth-source-pass-extra-query-keywords nil + "Whether to consider additional keywords when performing a query. +Specifically, when the value is t, recognize the `:max' and +`:require' keywords and accept lists of query parameters for +certain keywords, such as `:host' and `:user'. Also, wrap all +returned secrets in a function and forgo any further results +filtering unless given an applicable `:require' argument. When +this option is nil, do none of that, and enact the narrowing +behavior described toward the bottom of the Info node `(auth) The +Unix password store'." + :type 'boolean + :version "29.1") (cl-defun auth-source-pass-search (&rest spec &key backend type host user port @@ -80,7 +84,7 @@ 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-extra-query-keywords (auth-source-pass--build-result-many host port user require max)) (t (when-let ((result (auth-source-pass--build-result host port user))) @@ -126,7 +130,7 @@ auth-source-pass--build-result-many 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) + (if (eq auth-source-pass-extra-query-keywords 'test) (reverse rv) (let (out) (dolist (e rv out) diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 242fc356b4..718c7cf4ba 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -494,7 +494,7 @@ auth-source-pass-prints-meaningful-debug-log ;; No entry has the requested port, but a result is still returned. -(ert-deftest auth-source-pass-standard-search--wild-port-miss-netrc () +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss-netrc () (ert-with-temp-file netrc-file :text "\ machine x.com password a @@ -507,8 +507,8 @@ auth-source-pass-standard-search--wild-port-miss-netrc (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)) +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss () + (let ((auth-source-pass-extra-query-keywords 'test)) (auth-source-pass--with-store '(("x.com" (secret . "a")) ("x.com:42" (secret . "b"))) (auth-source-pass-enable) @@ -517,7 +517,7 @@ auth-source-pass-standard-search--wild-port-miss ;; One of two entries has the requested port, both returned -(ert-deftest auth-source-pass-standard-search--wild-port-hit-netrc () +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit-netrc () (ert-with-temp-file netrc-file :text "\ machine x.com password a @@ -531,8 +531,8 @@ auth-source-pass-standard-search--wild-port-hit-netrc (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)) +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit () + (let ((auth-source-pass-extra-query-keywords 'test)) (auth-source-pass--with-store '(("x.com" (secret . "a")) ("x.com:42" (secret . "b"))) (auth-source-pass-enable) @@ -542,7 +542,7 @@ auth-source-pass-standard-search--wild-port-hit ;; 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-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc () (ert-with-temp-file netrc-file :text "\ machine x.com password a @@ -554,8 +554,8 @@ auth-source-pass-standard-search--wild-port-req-miss-netrc :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)) +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss () + (let ((auth-source-pass-extra-query-keywords 'test)) (auth-source-pass--with-store '(("x.com" (secret . "a")) ("x.com:42" (secret . "b"))) (auth-source-pass-enable) @@ -566,7 +566,7 @@ auth-source-pass-standard-search--wild-port-req-miss ;; include extra fields (i.e., :port nil) in the result ;; https://lists.gnu.org/archive/html/emacs-devel/2022-11/msg00130.html -(ert-deftest auth-source-pass-standard-search--netrc-akib () +(ert-deftest auth-source-pass-extra-query-keywords--netrc-akib () (ert-with-temp-file netrc-file :text "\ machine x.com password a @@ -581,8 +581,8 @@ auth-source-pass-standard-search--netrc-akib (should (equal results '((:host "disroot.org" :user "akib" :secret "b"))))))) -(ert-deftest auth-source-pass-standard-search--akib () - (let ((auth-source-pass-standard-search 'test)) +(ert-deftest auth-source-pass-extra-query-keywords--akib () + (let ((auth-source-pass-extra-query-keywords 'test)) (auth-source-pass--with-store '(("x.com" (secret . "a")) ("akib@disroot.org" (secret . "b")) ("z.com" (secret . "c"))) @@ -593,16 +593,16 @@ auth-source-pass-standard-search--akib ;; 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)) +(ert-deftest auth-source-pass-extra-query-keywords--baseline () + (let ((auth-source-pass-extra-query-keywords '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)) +(ert-deftest auth-source-pass-extra-query-keywords--port-type () + (let ((auth-source-pass-extra-query-keywords '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) @@ -617,8 +617,8 @@ auth-source-pass-standard-search--port-type ;; 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)) +(ert-deftest auth-source-pass-extra-query-keywords--hosts-first () + (let ((auth-source-pass-extra-query-keywords 'test)) (auth-source-pass--with-store '(("x.com:42/bar" (secret . "a")) ("gnu.org" (secret . "b")) ("x.com" (secret . "c")) -- 2.38.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0001-POC-Make-auth-source-pass-behave-more-like-other-bac.patch --] [-- Type: text/x-patch, Size: 17563 bytes --] From 450e2f029a26b30d583afcb44e7fdd561a95c277 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-extra-query-keywords): 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-extra-query-keywords' 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-extra-query-keywords--wild-port-miss-netrc, auth-source-pass-extra-query-keywords--wild-port-miss, auth-source-pass-extra-query-keywords--wild-port-hit-netrc, auth-source-pass-extra-query-keywords--wild-port-hit, auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc, auth-source-pass-extra-query-keywords--wild-port-req-miss, auth-source-pass-extra-query-keywords--baseline, auth-source-pass-extra-query-keywords--port-type, auth-source-pass-extra-query-keywords--hosts-first): Add juxtaposed netrc and extra-query-keywords pairs to demo optional extra-compliant behavior. * doc/misc/auth.texi: Add option `auth-source-pass-extra-query-keywords' to auth-source-pass section. * etc/NEWS: Mention `auth-source-pass-extra-query-keywords' in Emacs 29.1 package changes section. --- doc/misc/auth.texi | 11 +++ etc/NEWS | 8 ++ lisp/auth-source-pass.el | 109 ++++++++++++++++++++- test/lisp/auth-source-pass-tests.el | 144 ++++++++++++++++++++++++++++ 4 files changed, 271 insertions(+), 1 deletion(-) diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 9dc63af6bc..222fce2058 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -526,6 +526,8 @@ The Unix password store while searching for an entry matching the @code{rms} user on host @code{gnu.org} and port @code{22}, then the entry @file{gnu.org:22/rms.gpg} is preferred over @file{gnu.org.gpg}. +However, such filtering is not applied when the option +@code{auth-source-pass-extra-parameters} is set to @code{t}. Users of @code{pass} may also be interested in functionality provided by other Emacs packages: @@ -549,6 +551,15 @@ The Unix password store port in an entry. Defaults to @samp{:}. @end defvar +@defvar auth-source-pass-extra-query-keywords +Set this to @code{t} if you encounter problems predicting the outcome +of searches relative to other auth-source backends or if you have code +that expects to query multiple backends uniformly. This tells +auth-source-pass to consider the @code{:max} and @code{:require} +keywords as well as lists containing multiple query params (for +applicable keywords). +@end defvar + @node Help for developers @chapter Help for developers diff --git a/etc/NEWS b/etc/NEWS index 89da8aa63f..776936489f 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1383,6 +1383,14 @@ If non-nil and there's only one matching option, auto-select that. If non-nil, this user option describes what entries not to add to the database stored on disk. +** Auth-Source + ++++ +*** New user option 'auth-source-pass-extra-query-keywords'. +Whether to recognize additional keyword params, like ':max' and +':require', as well as accept lists of query terms paired with +applicable keywords. + ** Dired +++ diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 0955e2ed07..d9129667e1 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -55,13 +55,27 @@ auth-source-pass-port-separator :type 'string :version "27.1") +(defcustom auth-source-pass-extra-query-keywords nil + "Whether to consider additional keywords when performing a query. +Specifically, when the value is t, recognize the `:max' and +`:require' keywords and accept lists of query parameters for +certain keywords, such as `:host' and `:user'. Also, wrap all +returned secrets in a function and forgo any further results +filtering unless given an applicable `:require' argument. When +this option is nil, do none of that, and enact the narrowing +behavior described toward the bottom of the Info node `(auth) The +Unix password store'." + :type 'boolean + :version "29.1") + (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 +84,8 @@ auth-source-pass-search ((null host) ;; Do not build a result, as none will match when HOST is nil nil) + (auth-source-pass-extra-query-keywords + (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 +105,41 @@ auth-source-pass--build-result (seq-subseq retval 0 -2)) ;; remove password retval)))) +(defvar auth-source-pass--match-regexp nil) + +(defun auth-source-pass--match-regexp (s) + (rx-to-string ; autoloaded + `(: (or bot "/") + (or (: (? (group-n 20 (+ (not (in ?\ ?/ ?@ ,s)))) "@") + (group-n 10 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 30 (+ (not (in ?\ ?/ ,s)))))) + (: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 31 (+ (not (in ?\ ?/ ,s))))) + (? "/" (group-n 21 (+ (not (in ?\ ?/ ,s))))))) + eot) + 'no-group)) + +(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* ((auth-source-pass--match-regexp (auth-source-pass--match-regexp + auth-source-pass-port-separator)) + (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-extra-query-keywords '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 +257,62 @@ auth-source-pass--find-match hosts (list hosts)))) +(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..718c7cf4ba 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -488,6 +488,150 @@ 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-extra-query-keywords--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-extra-query-keywords--wild-port-miss () + (let ((auth-source-pass-extra-query-keywords '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-extra-query-keywords--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-extra-query-keywords--wild-port-hit () + (let ((auth-source-pass-extra-query-keywords '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-extra-query-keywords--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-extra-query-keywords--wild-port-req-miss () + (let ((auth-source-pass-extra-query-keywords '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))))) + +;; Specifying a :host without a :user finds a lone entry and does not +;; include extra fields (i.e., :port nil) in the result +;; https://lists.gnu.org/archive/html/emacs-devel/2022-11/msg00130.html + +(ert-deftest auth-source-pass-extra-query-keywords--netrc-akib () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine disroot.org user akib password b +machine z.com password c +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "disroot.org" :max 2))) + (dolist (result results) + (setf result (plist-put result :secret (auth-info-password result)))) + (should (equal results + '((:host "disroot.org" :user "akib" :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--akib () + (let ((auth-source-pass-extra-query-keywords 'test)) + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("akib@disroot.org" (secret . "b")) + ("z.com" (secret . "c"))) + (auth-source-pass-enable) + (should (equal (auth-source-search :host "disroot.org" :max 2) + '((:host "disroot.org" :user "akib" :secret "b"))))))) + +;; A retrieved store entry mustn't be nil regardless of whether its +;; path contains port or user components + +(ert-deftest auth-source-pass-extra-query-keywords--baseline () + (let ((auth-source-pass-extra-query-keywords '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-extra-query-keywords--port-type () + (let ((auth-source-pass-extra-query-keywords '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-extra-query-keywords--hosts-first () + (let ((auth-source-pass-extra-query-keywords '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 #4: 0002-POC-Support-auth-source-pass-in-ERC.patch --] [-- Type: text/x-patch, Size: 9263 bytes --] From a1701d3a7b96b6a7bb34b2a026caa6850c7574c5 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 | 101 ++++++++++++++++++++++++++++ lisp/erc/erc.el | 7 +- test/lisp/erc/erc-services-tests.el | 3 - 4 files changed, 109 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 @@ 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 03bd8f1352..747a1152ff 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 @@ -168,6 +170,105 @@ erc-compat--with-memoization `(cl--generic-with-memoization ,table ,@forms)) (t `(progn ,@forms)))) +;;;; 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)) + +;; This basically hard codes `auth-source-pass-port-separator' to ":" +(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 6b14cf87e2..3769e73041 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3225,7 +3225,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 c22d4cf75e..7ff2e36e77 100644 --- a/test/lisp/erc/erc-services-tests.el +++ b/test/lisp/erc/erc-services-tests.el @@ -474,7 +474,6 @@ erc-join-tests--auth-source-pass-entries ("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--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)) @@ -500,7 +498,6 @@ 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" (secret . "spam")) -- 2.38.1 ^ permalink raw reply related [flat|nested] 39+ messages in thread
[parent not found: <87a653z7dl.fsf@neverwas.me>]
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [not found] ` <87a653z7dl.fsf@neverwas.me> @ 2022-11-07 10:33 ` Michael Albinus [not found] ` <874jvbnje1.fsf@gmx.de> ` (4 subsequent siblings) 5 siblings, 0 replies; 39+ messages in thread From: Michael Albinus @ 2022-11-07 10:33 UTC (permalink / raw) To: J.P.; +Cc: Damien Cassou, emacs-erc, 58985 "J.P." <jp@neverwas.me> writes: > Hi Michael, Hi, >> +(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) >> >> - The name of this user option as well as its docstring are focussed on >> the current behavior. People won't know what "mimic other auth-source >> backends" would mean. Please describe the effect w/o that comparison, >> and pls give it a name based on its effect, and not "...-standard-search". > > I've changed the name to `auth-source-pass-extra-query-keywords' and > updated the description to something hopefully more adequate. > >> - I'm missing the documentation in doc/misc/auth.texi and etc/NEWS. > > Added. Thanks. > BTW, I was initially thinking it'd be better to wait for a more > comprehensive and maintainable solution, like something based around a > larger set of common functions to be shared among the various back ends > (hence the [POC] qualifier on my patches). However, I suppose such a > thing could be done later, once the desired behavior is all dialed in > (perhaps alongside addressing support for full CRUD operations, which > are still missing, AFIAK). Anyway, I really don't know enough about pass > or auth-source to commit to such an endeavor. But I've reached out to > some folks who may be able to lend a hand. Such a change would be desirable. However, Ted, the author of auth-source.el, isn't active these days. Personally I feel responsible for the secrets backend, and I try bug fixing in the other auth-source parts. That's all. According to admin/MAINTAINERS, nobody else feels responsible for auth-source. So I doubt that such a change will happen soon. From my pov you could push the changes. But as you said the other message, you'll wait for feeback fron users. That's OK, but pls take into account that later this month an emacs-29 branch will be cut off. Feature changes shall be pushed until then. > Thanks, > J.P. Best regards, Michael. ^ permalink raw reply [flat|nested] 39+ messages in thread
[parent not found: <874jvbnje1.fsf@gmx.de>]
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [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 0 siblings, 1 reply; 39+ messages in thread From: J.P. @ 2022-11-08 13:56 UTC (permalink / raw) To: Michael Albinus; +Cc: Damien Cassou, emacs-erc, 58985 Michael Albinus <michael.albinus@gmx.de> writes: > From my pov you could push the changes. But as you said the other > message, you'll wait for feeback fron users. That's OK, but pls take > into account that later this month an emacs-29 branch will be cut > off. Feature changes shall be pushed until then. Right, good point. I guess if no one else weighs in by this time next week, we can flip a coin or something. Thanks. ^ permalink raw reply [flat|nested] 39+ messages in thread
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends 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> 0 siblings, 2 replies; 39+ messages in thread From: Björn Bidar via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2022-11-10 0:39 UTC (permalink / raw) To: J.P.; +Cc: Damien Cassou, emacs-erc, Michael Albinus, 58985 "J.P." <jp@neverwas.me> writes: > Michael Albinus <michael.albinus@gmx.de> writes: > >> From my pov you could push the changes. But as you said the other >> message, you'll wait for feeback fron users. That's OK, but pls take >> into account that later this month an emacs-29 branch will be cut >> off. Feature changes shall be pushed until then. > > Right, good point. I guess if no one else weighs in by this time next > week, we can flip a coin or something. Thanks. Sorry that I come a little late to this but will this mean the backend will act less like Passwordstore.org describes or more? I think the backend should follow the users organization of the passwordstore folder if possible. Br, Björn ^ permalink raw reply [flat|nested] 39+ messages in thread
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends 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> 1 sibling, 0 replies; 39+ messages in thread From: J.P. @ 2022-11-10 5:25 UTC (permalink / raw) To: Björn Bidar; +Cc: Damien Cassou, emacs-erc, Michael Albinus, 58985 Björn Bidar <bjorn.bidar@thaodan.de> writes: > "J.P." <jp@neverwas.me> writes: > >> Michael Albinus <michael.albinus@gmx.de> writes: >> >>> From my pov you could push the changes. But as you said the other >>> message, you'll wait for feeback fron users. That's OK, but pls take >>> into account that later this month an emacs-29 branch will be cut >>> off. Feature changes shall be pushed until then. >> >> Right, good point. I guess if no one else weighs in by this time next >> week, we can flip a coin or something. Thanks. > > Sorry that I come a little late to this but No worries at all. I know this is asking a lot, but if you get a chance, please apply the v2 patches and try them out. (Actually, you can omit the second one in the set, which only affects ERC.) > will this mean the backend will act less like Passwordstore.org > describes or more? That's a good question. My main goal thus far has been to make its query behavior as close as possible to that of the other auth-source back ends. Glancing at that web page, it seems auth-source-pass has taken some liberties WRT to query features, like drilling down into the tail of a file's contents and ascribing semantics to parts of a file name. > I think the backend should follow the users organization of the > passwordstore folder if possible. From this I'll infer that the current implementation of auth-source-pass does that sufficiently. If that's so and the changes I'm proposing threaten to interfere with that, what's your opinion on the default value of a knob to toggle the new behavior? Thanks, J.P. ^ permalink raw reply [flat|nested] 39+ messages in thread
[parent not found: <875yfnnzy6.fsf@neverwas.me>]
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [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> 0 siblings, 2 replies; 39+ messages in thread From: Björn Bidar via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2022-11-10 13:40 UTC (permalink / raw) To: J.P.; +Cc: Damien Cassou, emacs-erc, Michael Albinus, 58985 "J.P." <jp@neverwas.me> writes: > I know this is asking a lot, but if you get a chance, please apply the > v2 patches and try them out. (Actually, you can omit the second one in > the set, which only affects ERC.) I want to add I'm not an ERC user but circe user, I've got interested in the patch as I use the backend with circe, gnus, magit, elfeed and so on. >> will this mean the backend will act less like Passwordstore.org >> describes or more? > > That's a good question. My main goal thus far has been to make its query > behavior as close as possible to that of the other auth-source back > ends. Glancing at that web page, it seems auth-source-pass has taken > some liberties WRT to query features, like drilling down into the tail > of a file's contents and ascribing semantics to parts of a file name. A lot of programs don't implement the full path traversal and just end up having a static or a bogus path (e.g. those that implement Freedesktop SecretService with pass). So I favor a correct implementation, any progress is welcome. >> I think the backend should follow the users organization of the >> passwordstore folder if possible. > > From this I'll infer that the current implementation of auth-source-pass > does that sufficiently. If that's so and the changes I'm proposing > threaten to interfere with that, what's your opinion on the default > value of a knob to toggle the new behavior? Hm it depends if there are any backends that workaround that old behavior. From what I see the only difference really is that you can specify require and max. My personal bindings for circe to auth-source currently only exist of small functions: ;; Adopted from Ghub.el, refactored for use with Circe IRC (defun circe--ident (username network) (format "%s^%s" username network)) (defun circe--auth-source-get (keys &rest spec) (declare (indent 1)) (let ((plist (car (apply #'auth-source-search (append spec (list :max 1)))))) (mapcar (lambda (k) (plist-get plist k)) keys))) (defun circe-pass-get (host user &optional network) "\fn(fn host user &optional network)" (auth-source-forget (list :host host :user user :max 1)) (when network (setq user (circe--ident user network))) (let ((match (car (circe--auth-source-get (list :secret) :host host :user user)))) (cond ((null match) (error "Auth source empty for %s %s %s" host user network)) ((functionp match) (funcall match)) (t match)))) Which makes me wonder why ERC needs the different behavior but then I'm not really a good lisp programmer more a novice. Br, Björn ^ permalink raw reply [flat|nested] 39+ messages in thread
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends 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> 1 sibling, 0 replies; 39+ messages in thread From: J.P. @ 2022-11-10 14:40 UTC (permalink / raw) To: Björn Bidar; +Cc: Damien Cassou, emacs-erc, Michael Albinus, 58985 Björn Bidar <bjorn.bidar@thaodan.de> writes: > "J.P." <jp@neverwas.me> writes: > >> I know this is asking a lot, but if you get a chance, please apply the >> v2 patches and try them out. (Actually, you can omit the second one in >> the set, which only affects ERC.) > > I want to add I'm not an ERC user but circe user, I've got interested in > the patch as I use the backend with circe, gnus, magit, elfeed and so > on. All great packages! >>> will this mean the backend will act less like Passwordstore.org >>> describes or more? >> >> That's a good question. My main goal thus far has been to make its query >> behavior as close as possible to that of the other auth-source back >> ends. Glancing at that web page, it seems auth-source-pass has taken >> some liberties WRT to query features, like drilling down into the tail >> of a file's contents and ascribing semantics to parts of a file name. > > A lot of programs don't implement the full path traversal and just end > up having a static or a bogus path (e.g. those that implement > Freedesktop SecretService with pass). Interesting. I just blindly assumed auth-source-pass would be alone in that regard, but I guess not in the slightest. > So I favor a correct implementation, any progress is welcome. I don't think correctness from the passwordstore.org perspective will butt heads with auth-source's because only the latter has any concept of host, user, and port. Although, as you've noticed, my patch only addresses queries and doesn't handle writes, which may be a different animal entirely. >>> I think the backend should follow the users organization of the >>> passwordstore folder if possible. >> >> From this I'll infer that the current implementation of auth-source-pass >> does that sufficiently. If that's so and the changes I'm proposing >> threaten to interfere with that, what's your opinion on the default >> value of a knob to toggle the new behavior? > > Hm it depends if there are any backends that workaround that old behavior. > From what I see the only difference really is that you can specify > require and max. There are actually a few subtle areas where the behavior between old and new differs and maybe one or two slightly unintuitive gotchas for folks unfamiliar with how the other back ends operate. If you're curious, there's a series of side-by-side comparisons added by the first patch toward the bottom of test/lisp/auth-source-pass-tests.el Please let me know if you have any questions. > My personal bindings for circe to auth-source currently only exist of > small functions: > ;; Adopted from Ghub.el, refactored for use with Circe IRC > (defun circe--ident (username network) > (format "%s^%s" username network)) > (defun circe--auth-source-get (keys &rest spec) > (declare (indent 1)) > (let ((plist (car (apply #'auth-source-search > (append spec (list :max 1)))))) ~~~~~~ ERC would choke on this ^ > (mapcar (lambda (k) > (plist-get plist k)) > keys))) > (defun circe-pass-get (host user &optional network) > "\fn(fn host user &optional network)" > (auth-source-forget (list :host host :user user :max 1)) > (when network > (setq user (circe--ident user network))) > (let ((match (car (circe--auth-source-get (list :secret) > :host host :user user)))) > (cond ((null match) > (error "Auth source empty for %s %s %s" host user network)) > ((functionp match) > (funcall match)) (t match)))) > > > Which makes me wonder why ERC needs the different behavior but then I'm > not really a good lisp programmer more a novice. The approach is broadly similar to what you have. But ERC uses auth-source to query server passwords, network credentials, and channel keys more or less transparently, without user interaction. It overloads both :host and :user to accommodate various values based on context and doesn't rely on auth-source for narrowing. It asks for all applicable results and does its own thing from there. ^ permalink raw reply [flat|nested] 39+ messages in thread
[parent not found: <87pmduc1pz.fsf@neverwas.me>]
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [not found] ` <87pmduc1pz.fsf@neverwas.me> @ 2022-11-15 3:45 ` J.P. 0 siblings, 0 replies; 39+ messages in thread From: J.P. @ 2022-11-15 3:45 UTC (permalink / raw) To: Björn Bidar Cc: Damien Cassou, emacs-erc, Michael Albinus, Akib Azmain Turja, 58985 Hi Björn, "J.P." <jp@neverwas.me> writes: > Björn Bidar <bjorn.bidar@thaodan.de> writes: > >> "J.P." <jp@neverwas.me> writes: >> >>> From this I'll infer that the current implementation of auth-source-pass >>> does that sufficiently. If that's so and the changes I'm proposing >>> threaten to interfere with that, what's your opinion on the default >>> value of a knob to toggle the new behavior? >> >> Hm it depends if there are any backends that workaround that old behavior. >> From what I see the only difference really is that you can specify >> require and max. > > There are actually a few subtle areas where the behavior between old and > new differs and maybe one or two slightly unintuitive gotchas for folks > unfamiliar with how the other back ends operate. If you're curious, > there's a series of side-by-side comparisons added by the first patch > toward the bottom of > > test/lisp/auth-source-pass-tests.el > > Please let me know if you have any questions. I should have expressed this more clearly sooner, but I was hoping to solicit a vote from you as to whether to enable the new, more "standardized" behavior by default. If you choose to abstain, would you at least commit to trying it out before 29.1 is fully released and raising any issues that might arise as a consequence of whatever default we go with? This would allow us (me, hopefully) to fix or revert the changes if necessary. Thanks, J.P. ^ permalink raw reply [flat|nested] 39+ messages in thread
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [not found] ` <87a653z7dl.fsf@neverwas.me> 2022-11-07 10:33 ` Michael Albinus [not found] ` <874jvbnje1.fsf@gmx.de> @ 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> ` (2 subsequent siblings) 5 siblings, 0 replies; 39+ messages in thread From: Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2022-11-09 18:25 UTC (permalink / raw) To: J.P.; +Cc: Damien Cassou, emacs-erc, Michael Albinus, 58985 [-- Attachment #1: Type: text/plain, Size: 817 bytes --] "J.P." <jp@neverwas.me> writes: > --- 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 Is pass really unsupported? I have been using pass with ERC without any problem. Am I lucky? -- Akib Azmain Turja, GPG key: 70018CE5819F17A3BBA666AFE74F0EFA922AE7F5 Fediverse: akib@hostux.social Codeberg: akib emailselfdefense.fsf.org | "Nothing can be secure without encryption." [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 832 bytes --] ^ permalink raw reply [flat|nested] 39+ messages in thread
[parent not found: <874jv8ouh9.fsf@disroot.org>]
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [not found] ` <874jv8ouh9.fsf@disroot.org> @ 2022-11-10 5:26 ` J.P. 0 siblings, 0 replies; 39+ messages in thread From: J.P. @ 2022-11-10 5:26 UTC (permalink / raw) To: Akib Azmain Turja; +Cc: emacs-erc, 58985 Akib Azmain Turja <akib@disroot.org> writes: > "J.P." <jp@neverwas.me> writes: > >> --- 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 > > Is pass really unsupported? I have been using pass with ERC without any > problem. Am I lucky? It appears you are lucky. Please see toward the bottom of https://git.savannah.gnu.org/cgit/emacs.git/tree/test/lisp/erc/erc-services-tests.el?id=ef362750#n452 ^ permalink raw reply [flat|nested] 39+ messages in thread
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [not found] ` <87a653z7dl.fsf@neverwas.me> ` (3 preceding siblings ...) [not found] ` <874jv8ouh9.fsf@disroot.org> @ 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> 5 siblings, 0 replies; 39+ messages in thread From: Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2022-11-10 7:12 UTC (permalink / raw) To: J.P.; +Cc: Damien Cassou, emacs-erc, Michael Albinus, 58985 [-- Attachment #1: Type: text/plain, Size: 22054 bytes --] "J.P." <jp@neverwas.me> writes: > Hi Michael, > > Michael Albinus <michael.albinus@gmx.de> writes: > >> I'm not familiar with the auth-source-pass.el implementation, so I >> cannot speak too much about your patch. Reading it roughly, I haven't >> found serious flaws, 'tho. > > Thanks for taking a look! > >> However :-) >> >> +(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) >> >> - The name of this user option as well as its docstring are focussed on >> the current behavior. People won't know what "mimic other auth-source >> backends" would mean. Please describe the effect w/o that comparison, >> and pls give it a name based on its effect, and not "...-standard-search". > > I've changed the name to `auth-source-pass-extra-query-keywords' and > updated the description to something hopefully more adequate. > >> - I'm missing the documentation in doc/misc/auth.texi and etc/NEWS. > > Added. > > BTW, I was initially thinking it'd be better to wait for a more > comprehensive and maintainable solution, like something based around a > larger set of common functions to be shared among the various back ends > (hence the [POC] qualifier on my patches). However, I suppose such a > thing could be done later, once the desired behavior is all dialed in > (perhaps alongside addressing support for full CRUD operations, which > are still missing, AFIAK). Anyway, I really don't know enough about pass > or auth-source to commit to such an endeavor. But I've reached out to > some folks who may be able to lend a hand. > > Thanks, > J.P. > > > From 450e2f029a26b30d583afcb44e7fdd561a95c277 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-extra-query-keywords): 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-extra-query-keywords' 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-extra-query-keywords--wild-port-miss-netrc, > auth-source-pass-extra-query-keywords--wild-port-miss, > auth-source-pass-extra-query-keywords--wild-port-hit-netrc, > auth-source-pass-extra-query-keywords--wild-port-hit, > auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc, > auth-source-pass-extra-query-keywords--wild-port-req-miss, > auth-source-pass-extra-query-keywords--baseline, > auth-source-pass-extra-query-keywords--port-type, > auth-source-pass-extra-query-keywords--hosts-first): Add juxtaposed > netrc and extra-query-keywords pairs to demo optional extra-compliant > behavior. > * doc/misc/auth.texi: Add option > `auth-source-pass-extra-query-keywords' to auth-source-pass section. > * etc/NEWS: Mention `auth-source-pass-extra-query-keywords' in Emacs > 29.1 package changes section. > --- > doc/misc/auth.texi | 11 +++ > etc/NEWS | 8 ++ > lisp/auth-source-pass.el | 109 ++++++++++++++++++++- > test/lisp/auth-source-pass-tests.el | 144 ++++++++++++++++++++++++++++ > 4 files changed, 271 insertions(+), 1 deletion(-) > > diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi > index 9dc63af6bc..222fce2058 100644 > --- a/doc/misc/auth.texi > +++ b/doc/misc/auth.texi > @@ -526,6 +526,8 @@ The Unix password store > while searching for an entry matching the @code{rms} user on host > @code{gnu.org} and port @code{22}, then the entry > @file{gnu.org:22/rms.gpg} is preferred over @file{gnu.org.gpg}. > +However, such filtering is not applied when the option > +@code{auth-source-pass-extra-parameters} is set to @code{t}. > > Users of @code{pass} may also be interested in functionality provided > by other Emacs packages: > @@ -549,6 +551,15 @@ The Unix password store > port in an entry. Defaults to @samp{:}. > @end defvar > > +@defvar auth-source-pass-extra-query-keywords > +Set this to @code{t} if you encounter problems predicting the outcome > +of searches relative to other auth-source backends or if you have code > +that expects to query multiple backends uniformly. This tells > +auth-source-pass to consider the @code{:max} and @code{:require} > +keywords as well as lists containing multiple query params (for > +applicable keywords). > +@end defvar > + The name won't make much sense to the ordinary user who don't know about the API. Repeating from another message, this variable should be something like "auth-source-pass-old-search" (or even "...-obsolete-search"). > @node Help for developers > @chapter Help for developers > > diff --git a/etc/NEWS b/etc/NEWS > index 89da8aa63f..776936489f 100644 > --- a/etc/NEWS > +++ b/etc/NEWS > @@ -1383,6 +1383,14 @@ If non-nil and there's only one matching option, auto-select that. > If non-nil, this user option describes what entries not to add to the > database stored on disk. > > +** Auth-Source > + > ++++ > +*** New user option 'auth-source-pass-extra-query-keywords'. > +Whether to recognize additional keyword params, like ':max' and > +':require', as well as accept lists of query terms paired with > +applicable keywords. > + > ** Dired > > +++ > diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el > index 0955e2ed07..d9129667e1 100644 > --- a/lisp/auth-source-pass.el > +++ b/lisp/auth-source-pass.el > @@ -55,13 +55,27 @@ auth-source-pass-port-separator > :type 'string > :version "27.1") > > +(defcustom auth-source-pass-extra-query-keywords nil > + "Whether to consider additional keywords when performing a query. > +Specifically, when the value is t, recognize the `:max' and > +`:require' keywords and accept lists of query parameters for > +certain keywords, such as `:host' and `:user'. Also, wrap all > +returned secrets in a function and forgo any further results > +filtering unless given an applicable `:require' argument. When > +this option is nil, do none of that, and enact the narrowing > +behavior described toward the bottom of the Info node `(auth) The > +Unix password store'." > + :type 'boolean > + :version "29.1") > + This should be non-nil by default, since it fixes a number of bugs. We don't want to deprive users from these fixes, do we? REPEAT: The name won't make much sense to the ordinary user who don't know about the API. Repeating from another message, this variable should be something like "auth-source-pass-old-search" (or even "...-obsolete-search"). > (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 +84,8 @@ auth-source-pass-search > ((null host) > ;; Do not build a result, as none will match when HOST is nil > nil) > + (auth-source-pass-extra-query-keywords > + (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 +105,41 @@ auth-source-pass--build-result > (seq-subseq retval 0 -2)) ;; remove password > retval)))) LGTM. > > +(defvar auth-source-pass--match-regexp nil) > + > +(defun auth-source-pass--match-regexp (s) > + (rx-to-string ; autoloaded > + `(: (or bot "/") > + (or (: (? (group-n 20 (+ (not (in ?\ ?/ ?@ ,s)))) "@") > + (group-n 10 (+ (not (in ?\ ?/ ?@ ,s)))) > + (? ,s (group-n 30 (+ (not (in ?\ ?/ ,s)))))) > + (: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s)))) > + (? ,s (group-n 31 (+ (not (in ?\ ?/ ,s))))) > + (? "/" (group-n 21 (+ (not (in ?\ ?/ ,s))))))) > + eot) > + 'no-group)) LGTM. > + > +(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* ((auth-source-pass--match-regexp (auth-source-pass--match-regexp > + auth-source-pass-port-separator)) > + (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-extra-query-keywords 'test) > + (reverse rv) The value `test' is not documented. Is it used in tests? If it is, I think an internal variable would be better. > + (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)))))) > + LGTM. > ;;;###autoload > (defun auth-source-pass-enable () > "Enable auth-source-password-store." > @@ -206,6 +257,62 @@ auth-source-pass--find-match > hosts > (list hosts)))) > > +(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))) LGTM. > + > +(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))))) LGTM. > + > +;; For now, this ignores the contents of files and only considers path > +;; components when matching. The file name contains host, user and port, so parsing contents is not needed at all. > +(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)) Can "auth-source-pass--disambiguate" return host with the protocol part? > + (setq p nil)) > + (dolist (user (or users (list u))) > + (dolist (port (or ports (list p))) > + (setq port-number-p (equal 'integer (type-of port))) Just saw the first use of "type-of". Doesn't "(integerp port)" work? > + (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) LGTM. > + (when (or (zerop (cl-decf max)) > + (null (setq entries (delete e entries)))) Can the delete call conflict with the dolist loop? > + (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 I don't have much idea about these tests, but... > index f5147a7ce0..718c7cf4ba 100644 > --- a/test/lisp/auth-source-pass-tests.el > +++ b/test/lisp/auth-source-pass-tests.el > @@ -488,6 +488,150 @@ 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-extra-query-keywords--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"))))))) How this is testing auth-source-pass? > + > +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss () > + (let ((auth-source-pass-extra-query-keywords '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-extra-query-keywords--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-extra-query-keywords--wild-port-hit () > + (let ((auth-source-pass-extra-query-keywords '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-extra-query-keywords--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-extra-query-keywords--wild-port-req-miss () > + (let ((auth-source-pass-extra-query-keywords '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))))) > + > +;; Specifying a :host without a :user finds a lone entry and does not > +;; include extra fields (i.e., :port nil) in the result > +;; https://lists.gnu.org/archive/html/emacs-devel/2022-11/msg00130.html > + > +(ert-deftest auth-source-pass-extra-query-keywords--netrc-akib () > + (ert-with-temp-file netrc-file > + :text "\ > +machine x.com password a > +machine disroot.org user akib password b > +machine z.com password c > +" > + (let* ((auth-sources (list netrc-file)) > + (auth-source-do-cache nil) > + (results (auth-source-search :host "disroot.org" :max 2))) > + (dolist (result results) > + (setf result (plist-put result :secret (auth-info-password result)))) > + (should (equal results > + '((:host "disroot.org" :user "akib" :secret "b"))))))) > + > +(ert-deftest auth-source-pass-extra-query-keywords--akib () > + (let ((auth-source-pass-extra-query-keywords 'test)) > + (auth-source-pass--with-store '(("x.com" (secret . "a")) > + ("akib@disroot.org" (secret . "b")) > + ("z.com" (secret . "c"))) > + (auth-source-pass-enable) > + (should (equal (auth-source-search :host "disroot.org" :max 2) > + '((:host "disroot.org" :user "akib" :secret "b"))))))) > + > +;; A retrieved store entry mustn't be nil regardless of whether its > +;; path contains port or user components > + > +(ert-deftest auth-source-pass-extra-query-keywords--baseline () > + (let ((auth-source-pass-extra-query-keywords '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-extra-query-keywords--port-type () > + (let ((auth-source-pass-extra-query-keywords '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-extra-query-keywords--hosts-first () > + (let ((auth-source-pass-extra-query-keywords '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 -- Akib Azmain Turja --- https://akib.codeberg.page/ GPG key: 70018CE5819F17A3BBA666AFE74F0EFA922AE7F5 Fediverse: akib@hostux.social, Codeberg: akib emailselfdefense.fsf.org | "Nothing can be secure without encryption." [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 832 bytes --] ^ permalink raw reply [flat|nested] 39+ messages in thread
[parent not found: <878rkjl1vd.fsf@disroot.org>]
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [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> 2 siblings, 0 replies; 39+ messages in thread From: J.P. @ 2022-11-10 14:38 UTC (permalink / raw) To: Akib Azmain Turja Cc: Damien Cassou, Björn Bidar, emacs-erc, Michael Albinus, 58985 [-- Attachment #1: Type: text/plain, Size: 5143 bytes --] Akib Azmain Turja <akib@disroot.org> writes: >> +(defcustom auth-source-pass-extra-query-keywords nil > [...] > > This should be non-nil by default, since it fixes a number of bugs. We > don't want to deprive users from these fixes, do we? If that's what everyone here agrees to, then fine by me. Hopefully end users and dependent packages will agree. >> +(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* ((auth-source-pass--match-regexp (auth-source-pass--match-regexp >> + auth-source-pass-port-separator)) >> + (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-extra-query-keywords 'test) >> + (reverse rv) > > The value `test' is not documented. Is it used in tests? If it is, I > think an internal variable would be better. We could certainly do that. I left it as something uglier and more sentinel-like for now. >> + >> +;; For now, this ignores the contents of files and only considers path >> +;; components when matching. > > The file name contains host, user and port, so parsing contents is not > needed at all. Right, but since `auth-source-pass--parse-data' impacts the code path whenever a multiline file is encountered, I thought the reader should know that we're consciously disregarding its findings. Anyway, I've moved the comment somewhere more relevant and reworded it for clarity. >> +(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)) > > Can "auth-source-pass--disambiguate" return host with the protocol part? No, but it downcases the host, so "Libera.Chat" becomes "libera.chat", which may be desirable for some use cases but not for ERC's (and I suspect those of other dependent libraries as well). If I call `auth-source-search' with :host Libera.Chat or "ircs://irc.libera.chat", and I get a match, I want the result to contain a host `equal' to the one I passed in (as is the case with other back ends) and not some normalized version, like "{,irc.}libera.chat". Likewise, for ports and users. >> + (setq p nil)) >> + (dolist (user (or users (list u))) >> + (dolist (port (or ports (list p))) >> + (setq port-number-p (equal 'integer (type-of port))) > > Just saw the first use of "type-of". Doesn't "(integerp port)" work? Thanks. >> + (when (or (zerop (cl-decf max)) >> + (null (setq entries (delete e entries)))) > > Can the delete call conflict with the dolist loop? In this particular case, I don't believe so, although things get confusing when you have duplicates (which we don't). When expanded, we basically have (let ((tail entries)) (while tail (let ((e (car tail))) (cl-assert (eq (member e entries) tail)) ; invariant (when ... (setq entries (delete e entries))) (setq tail (cdr tail))))) where the CDR of the current tail may become the CDR of the previous tail on a match, but that doesn't mutate the former. Regardless, I suppose it's bad practice to depend on internal implementations, which could always change, so I've swapped this out for `remove' instead. Good question. >> +(ert-deftest auth-source-pass-extra-query-keywords--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"))))))) > > How this is testing auth-source-pass? It's there for comparison and to cement the behavior of the reference implementation, netrc, as canon. Notice that those `auth-source-search' calls for every pair of cases are identical despite having different back ends (that's the whole point). Happy to move all the netrc variants to test/lisp/auth-source-tests.el, but locality for juxtaposition's sake can often be a mercy on tired eyes. Thanks for the notes. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-v3-v4.diff --] [-- Type: text/x-patch, Size: 10074 bytes --] From e5fe85b89746fdc90ba68f3648482e15019720fd Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Thu, 10 Nov 2022 05:38:48 -0800 Subject: [PATCH 0/2] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (2): [POC] Make auth-source-pass behave more like other backends [POC] Support auth-source-pass in ERC doc/misc/auth.texi | 11 ++ doc/misc/erc.texi | 3 +- etc/NEWS | 8 ++ lisp/auth-source-pass.el | 107 +++++++++++++++++- lisp/erc/erc-compat.el | 99 ++++++++++++++++ lisp/erc/erc.el | 7 +- test/lisp/auth-source-pass-tests.el | 169 ++++++++++++++++++++++++++++ test/lisp/erc/erc-services-tests.el | 3 - 8 files changed, 401 insertions(+), 6 deletions(-) Interdiff: diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index d9129667e1..8d7241eb1a 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -130,7 +130,7 @@ auth-source-pass--build-result-many require (or max 1)))) (when auth-source-debug (auth-source-pass--do-debug "final result: %S" rv)) - (if (eq auth-source-pass-extra-query-keywords 'test) + (if (eq auth-source-pass-extra-query-keywords '--test--) (reverse rv) (let (out) (dolist (e rv out) @@ -276,14 +276,11 @@ auth-source-pass--match-parts (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) @@ -292,15 +289,16 @@ auth-source-pass--find-match-many (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))) + seen e (integerp port)))) ((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)) + ;; For now, ignore body-content pairs, if any, + ;; from `auth-source-pass--parse-data'. (secret (or (auth-source-pass--get-attr 'secret parsed) (not (memq :secret require))))) (push @@ -310,7 +308,7 @@ auth-source-pass--find-match-many ,@(and secret (not (eq secret t)) (list :secret secret))) out) (when (or (zerop (cl-decf max)) - (null (setq entries (delete e entries)))) + (null (setq entries (remove e entries)))) (throw 'done out))))))))))) (defun auth-source-pass--disambiguate (host &optional user port) diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 747a1152ff..739f502764 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -221,7 +221,6 @@ erc-compat--auth-source-pass--build-result-many (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) @@ -230,12 +229,11 @@ erc-compat--auth-source-pass--build-result-many (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))) + seen e (integerp port)))) ((equal host (plist-get m :host))) ((funcall check m :port port)) ((funcall check m :user user)) @@ -249,7 +247,7 @@ erc-compat--auth-source-pass--build-result-many ,@(and secret (not (eq secret t)) (list :secret secret))) out) (when (or (zerop (cl-decf max)) - (null (setq entries (delete e entries)))) + (null (setq entries (remove e entries)))) (throw 'done nil))))))))) (reverse out))) diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 718c7cf4ba..1839801546 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -508,7 +508,7 @@ auth-source-pass-extra-query-keywords--wild-port-miss-netrc (should (equal results '((:host "x.com" :secret "a"))))))) (ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss () - (let ((auth-source-pass-extra-query-keywords 'test)) + (let ((auth-source-pass-extra-query-keywords '--test--)) (auth-source-pass--with-store '(("x.com" (secret . "a")) ("x.com:42" (secret . "b"))) (auth-source-pass-enable) @@ -532,7 +532,7 @@ auth-source-pass-extra-query-keywords--wild-port-hit-netrc (:host "x.com" :port "42" :secret "b"))))))) (ert-deftest auth-source-pass-extra-query-keywords--wild-port-hit () - (let ((auth-source-pass-extra-query-keywords 'test)) + (let ((auth-source-pass-extra-query-keywords '--test--)) (auth-source-pass--with-store '(("x.com" (secret . "a")) ("x.com:42" (secret . "b"))) (auth-source-pass-enable) @@ -555,7 +555,7 @@ auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc (should-not results)))) (ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss () - (let ((auth-source-pass-extra-query-keywords 'test)) + (let ((auth-source-pass-extra-query-keywords '--test--)) (auth-source-pass--with-store '(("x.com" (secret . "a")) ("x.com:42" (secret . "b"))) (auth-source-pass-enable) @@ -582,7 +582,7 @@ auth-source-pass-extra-query-keywords--netrc-akib '((:host "disroot.org" :user "akib" :secret "b"))))))) (ert-deftest auth-source-pass-extra-query-keywords--akib () - (let ((auth-source-pass-extra-query-keywords 'test)) + (let ((auth-source-pass-extra-query-keywords '--test--)) (auth-source-pass--with-store '(("x.com" (secret . "a")) ("akib@disroot.org" (secret . "b")) ("z.com" (secret . "c"))) @@ -590,11 +590,36 @@ auth-source-pass-extra-query-keywords--akib (should (equal (auth-source-search :host "disroot.org" :max 2) '((:host "disroot.org" :user "akib" :secret "b"))))))) +;; Searches for :host are case-sensitive, and a returned host isn't +;; normalized. + +(ert-deftest auth-source-pass-extra-query-keywords--netrc-host () + (ert-with-temp-file netrc-file + :text "\ +machine libera.chat password a +machine Libera.Chat password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "Libera.Chat" :max 2))) + (dolist (result results) + (setf result (plist-put result :secret (auth-info-password result)))) + (should (equal results '((:host "Libera.Chat" :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--host () + (let ((auth-source-pass-extra-query-keywords '--test--)) + (auth-source-pass--with-store '(("libera.chat" (secret . "a")) + ("Libera.Chat" (secret . "b"))) + (auth-source-pass-enable) + (should (equal (auth-source-search :host "Libera.Chat" :max 2) + '((:host "Libera.Chat" :secret "b"))))))) + + ;; A retrieved store entry mustn't be nil regardless of whether its ;; path contains port or user components (ert-deftest auth-source-pass-extra-query-keywords--baseline () - (let ((auth-source-pass-extra-query-keywords 'test)) + (let ((auth-source-pass-extra-query-keywords '--test--)) (auth-source-pass--with-store '(("x.com")) (auth-source-pass-enable) (should-not (auth-source-search :host "x.com"))))) @@ -602,7 +627,7 @@ auth-source-pass-extra-query-keywords--baseline ;; Output port type (int or string) matches that of input parameter (ert-deftest auth-source-pass-extra-query-keywords--port-type () - (let ((auth-source-pass-extra-query-keywords 'test)) + (let ((auth-source-pass-extra-query-keywords '--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) @@ -618,7 +643,7 @@ auth-source-pass-extra-query-keywords--port-type ;; returned in the order encountered (ert-deftest auth-source-pass-extra-query-keywords--hosts-first () - (let ((auth-source-pass-extra-query-keywords 'test)) + (let ((auth-source-pass-extra-query-keywords '--test--)) (auth-source-pass--with-store '(("x.com:42/bar" (secret . "a")) ("gnu.org" (secret . "b")) ("x.com" (secret . "c")) -- 2.38.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0001-POC-Make-auth-source-pass-behave-more-like-other-bac.patch --] [-- Type: text/x-patch, Size: 18772 bytes --] From 94741d20ac4e9c2b76ef1634aa910fb7e06b6c3e 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-extra-query-keywords): 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-extra-query-keywords' 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-extra-query-keywords--wild-port-miss-netrc, auth-source-pass-extra-query-keywords--wild-port-miss, auth-source-pass-extra-query-keywords--wild-port-hit-netrc, auth-source-pass-extra-query-keywords--wild-port-hit, auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc, auth-source-pass-extra-query-keywords--wild-port-req-miss, auth-source-pass-extra-query-keywords--netrc-akib, auth-source-pass-extra-query-keywords--akib, auth-source-pass-extra-query-keywords--netrc-host, auth-source-pass-extra-query-keywords--host, auth-source-pass-extra-query-keywords--baseline, auth-source-pass-extra-query-keywords--port-type, auth-source-pass-extra-query-keywords--hosts-first): Add juxtaposed netrc and extra-query-keywords pairs to demo optional extra-compliant behavior. * doc/misc/auth.texi: Add option `auth-source-pass-extra-query-keywords' to auth-source-pass section. * etc/NEWS: Mention `auth-source-pass-extra-query-keywords' in Emacs 29.1 package changes section. Bug#58985. --- doc/misc/auth.texi | 11 ++ etc/NEWS | 8 ++ lisp/auth-source-pass.el | 107 +++++++++++++++++- test/lisp/auth-source-pass-tests.el | 169 ++++++++++++++++++++++++++++ 4 files changed, 294 insertions(+), 1 deletion(-) diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 9dc63af6bc..222fce2058 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -526,6 +526,8 @@ The Unix password store while searching for an entry matching the @code{rms} user on host @code{gnu.org} and port @code{22}, then the entry @file{gnu.org:22/rms.gpg} is preferred over @file{gnu.org.gpg}. +However, such filtering is not applied when the option +@code{auth-source-pass-extra-parameters} is set to @code{t}. Users of @code{pass} may also be interested in functionality provided by other Emacs packages: @@ -549,6 +551,15 @@ The Unix password store port in an entry. Defaults to @samp{:}. @end defvar +@defvar auth-source-pass-extra-query-keywords +Set this to @code{t} if you encounter problems predicting the outcome +of searches relative to other auth-source backends or if you have code +that expects to query multiple backends uniformly. This tells +auth-source-pass to consider the @code{:max} and @code{:require} +keywords as well as lists containing multiple query params (for +applicable keywords). +@end defvar + @node Help for developers @chapter Help for developers diff --git a/etc/NEWS b/etc/NEWS index ab64eff74e..2c61732f8d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1385,6 +1385,14 @@ If non-nil and there's only one matching option, auto-select that. If non-nil, this user option describes what entries not to add to the database stored on disk. +** Auth-Source + ++++ +*** New user option 'auth-source-pass-extra-query-keywords'. +Whether to recognize additional keyword params, like ':max' and +':require', as well as accept lists of query terms paired with +applicable keywords. + ** Dired +++ diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 0955e2ed07..8d7241eb1a 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -55,13 +55,27 @@ auth-source-pass-port-separator :type 'string :version "27.1") +(defcustom auth-source-pass-extra-query-keywords nil + "Whether to consider additional keywords when performing a query. +Specifically, when the value is t, recognize the `:max' and +`:require' keywords and accept lists of query parameters for +certain keywords, such as `:host' and `:user'. Also, wrap all +returned secrets in a function and forgo any further results +filtering unless given an applicable `:require' argument. When +this option is nil, do none of that, and enact the narrowing +behavior described toward the bottom of the Info node `(auth) The +Unix password store'." + :type 'boolean + :version "29.1") + (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 +84,8 @@ auth-source-pass-search ((null host) ;; Do not build a result, as none will match when HOST is nil nil) + (auth-source-pass-extra-query-keywords + (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 +105,41 @@ auth-source-pass--build-result (seq-subseq retval 0 -2)) ;; remove password retval)))) +(defvar auth-source-pass--match-regexp nil) + +(defun auth-source-pass--match-regexp (s) + (rx-to-string ; autoloaded + `(: (or bot "/") + (or (: (? (group-n 20 (+ (not (in ?\ ?/ ?@ ,s)))) "@") + (group-n 10 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 30 (+ (not (in ?\ ?/ ,s)))))) + (: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 31 (+ (not (in ?\ ?/ ,s))))) + (? "/" (group-n 21 (+ (not (in ?\ ?/ ,s))))))) + eot) + 'no-group)) + +(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* ((auth-source-pass--match-regexp (auth-source-pass--match-regexp + auth-source-pass-port-separator)) + (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-extra-query-keywords '--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 +257,60 @@ auth-source-pass--find-match hosts (list hosts)))) +(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))))) + +(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)) + 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))) + (dolist (e entries) + (when-let* + ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed + seen e (integerp port)))) + ((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)) + ;; For now, ignore body-content pairs, if any, + ;; from `auth-source-pass--parse-data'. + (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 (remove 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..1839801546 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -488,6 +488,175 @@ 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-extra-query-keywords--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-extra-query-keywords--wild-port-miss () + (let ((auth-source-pass-extra-query-keywords '--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-extra-query-keywords--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-extra-query-keywords--wild-port-hit () + (let ((auth-source-pass-extra-query-keywords '--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-extra-query-keywords--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-extra-query-keywords--wild-port-req-miss () + (let ((auth-source-pass-extra-query-keywords '--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))))) + +;; Specifying a :host without a :user finds a lone entry and does not +;; include extra fields (i.e., :port nil) in the result +;; https://lists.gnu.org/archive/html/emacs-devel/2022-11/msg00130.html + +(ert-deftest auth-source-pass-extra-query-keywords--netrc-akib () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine disroot.org user akib password b +machine z.com password c +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "disroot.org" :max 2))) + (dolist (result results) + (setf result (plist-put result :secret (auth-info-password result)))) + (should (equal results + '((:host "disroot.org" :user "akib" :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--akib () + (let ((auth-source-pass-extra-query-keywords '--test--)) + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("akib@disroot.org" (secret . "b")) + ("z.com" (secret . "c"))) + (auth-source-pass-enable) + (should (equal (auth-source-search :host "disroot.org" :max 2) + '((:host "disroot.org" :user "akib" :secret "b"))))))) + +;; Searches for :host are case-sensitive, and a returned host isn't +;; normalized. + +(ert-deftest auth-source-pass-extra-query-keywords--netrc-host () + (ert-with-temp-file netrc-file + :text "\ +machine libera.chat password a +machine Libera.Chat password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "Libera.Chat" :max 2))) + (dolist (result results) + (setf result (plist-put result :secret (auth-info-password result)))) + (should (equal results '((:host "Libera.Chat" :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--host () + (let ((auth-source-pass-extra-query-keywords '--test--)) + (auth-source-pass--with-store '(("libera.chat" (secret . "a")) + ("Libera.Chat" (secret . "b"))) + (auth-source-pass-enable) + (should (equal (auth-source-search :host "Libera.Chat" :max 2) + '((:host "Libera.Chat" :secret "b"))))))) + + +;; A retrieved store entry mustn't be nil regardless of whether its +;; path contains port or user components + +(ert-deftest auth-source-pass-extra-query-keywords--baseline () + (let ((auth-source-pass-extra-query-keywords '--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-extra-query-keywords--port-type () + (let ((auth-source-pass-extra-query-keywords '--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-extra-query-keywords--hosts-first () + (let ((auth-source-pass-extra-query-keywords '--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 #4: 0002-POC-Support-auth-source-pass-in-ERC.patch --] [-- Type: text/x-patch, Size: 9182 bytes --] From e5fe85b89746fdc90ba68f3648482e15019720fd 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. Bug#58985. --- doc/misc/erc.texi | 3 +- lisp/erc/erc-compat.el | 99 +++++++++++++++++++++++++++++ lisp/erc/erc.el | 7 +- test/lisp/erc/erc-services-tests.el | 3 - 4 files changed, 107 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 @@ 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 03bd8f1352..739f502764 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 @@ -168,6 +170,103 @@ erc-compat--with-memoization `(cl--generic-with-memoization ,table ,@forms)) (t `(progn ,@forms)))) +;;;; 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)) + +;; This basically hard codes `auth-source-pass-port-separator' to ":" +(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)))))) + 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))) + (dolist (e entries) + (when-let* + ((m (or (gethash e seen) + (erc-compat--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))) + out) + (when (or (zerop (cl-decf max)) + (null (setq entries (remove 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 6b14cf87e2..3769e73041 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3225,7 +3225,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 c22d4cf75e..7ff2e36e77 100644 --- a/test/lisp/erc/erc-services-tests.el +++ b/test/lisp/erc/erc-services-tests.el @@ -474,7 +474,6 @@ erc-join-tests--auth-source-pass-entries ("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--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)) @@ -500,7 +498,6 @@ 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" (secret . "spam")) -- 2.38.1 ^ permalink raw reply related [flat|nested] 39+ messages in thread
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [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> 2 siblings, 0 replies; 39+ messages in thread From: J.P. @ 2022-11-11 3:17 UTC (permalink / raw) To: Akib Azmain Turja Cc: Damien Cassou, Björn Bidar, emacs-erc, Michael Albinus, 58985 [-- Attachment #1: Type: text/plain, Size: 1044 bytes --] Akib Azmain Turja <akib@disroot.org> writes: >> +(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* ((auth-source-pass--match-regexp (auth-source-pass--match-regexp >> + auth-source-pass-port-separator)) >> + (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-extra-query-keywords 'test) >> + (reverse rv) > > The value `test' is not documented. Is it used in tests? If it is, I > think an internal variable would be better. I got rid of the `test' stuff completely, so this function now always wraps secrets. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-v4-v5.diff --] [-- Type: text/x-patch, Size: 11241 bytes --] From ff9878576a6826e13567049629451d494afd8c9c Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Thu, 10 Nov 2022 19:09:38 -0800 Subject: [PATCH 0/2] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (2): [POC] Make auth-source-pass behave more like other backends [POC] Support auth-source-pass in ERC doc/misc/auth.texi | 11 ++ doc/misc/erc.texi | 3 +- etc/NEWS | 8 ++ lisp/auth-source-pass.el | 105 +++++++++++++++- lisp/erc/erc-compat.el | 99 +++++++++++++++ lisp/erc/erc.el | 7 +- test/lisp/auth-source-pass-tests.el | 184 ++++++++++++++++++++++++++++ test/lisp/erc/erc-services-tests.el | 3 - 8 files changed, 414 insertions(+), 6 deletions(-) Interdiff: diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 8d7241eb1a..54070e03eb 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -130,15 +130,13 @@ auth-source-pass--build-result-many require (or max 1)))) (when auth-source-debug (auth-source-pass--do-debug "final result: %S" rv)) - (if (eq auth-source-pass-extra-query-keywords '--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)))))) + (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 () diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 1839801546..60903808e0 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -504,16 +504,18 @@ auth-source-pass-extra-query-keywords--wild-port-miss-netrc (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)))) + (setf (plist-get result :secret) (auth-info-password result))) (should (equal results '((:host "x.com" :secret "a"))))))) (ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss () - (let ((auth-source-pass-extra-query-keywords '--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"))))))) + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("x.com:42" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "x.com" :port 22 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "x.com" :secret "a"))))))) ;; One of two entries has the requested port, both returned @@ -527,16 +529,19 @@ auth-source-pass-extra-query-keywords--wild-port-hit-netrc (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)))) + (setf (plist-get 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-extra-query-keywords--wild-port-hit () - (let ((auth-source-pass-extra-query-keywords '--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) + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("x.com:42" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "x.com" :port 42 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "x.com" :secret "a") (:host "x.com" :port 42 :secret "b"))))))) @@ -555,7 +560,7 @@ auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc (should-not results)))) (ert-deftest auth-source-pass-extra-query-keywords--wild-port-req-miss () - (let ((auth-source-pass-extra-query-keywords '--test--)) + (let ((auth-source-pass-extra-query-keywords t)) (auth-source-pass--with-store '(("x.com" (secret . "a")) ("x.com:42" (secret . "b"))) (auth-source-pass-enable) @@ -577,17 +582,20 @@ auth-source-pass-extra-query-keywords--netrc-akib (auth-source-do-cache nil) (results (auth-source-search :host "disroot.org" :max 2))) (dolist (result results) - (setf result (plist-put result :secret (auth-info-password result)))) + (setf (plist-get result :secret) (auth-info-password result))) (should (equal results '((:host "disroot.org" :user "akib" :secret "b"))))))) (ert-deftest auth-source-pass-extra-query-keywords--akib () - (let ((auth-source-pass-extra-query-keywords '--test--)) - (auth-source-pass--with-store '(("x.com" (secret . "a")) - ("akib@disroot.org" (secret . "b")) - ("z.com" (secret . "c"))) - (auth-source-pass-enable) - (should (equal (auth-source-search :host "disroot.org" :max 2) + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("akib@disroot.org" (secret . "b")) + ("z.com" (secret . "c"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "disroot.org" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "disroot.org" :user "akib" :secret "b"))))))) ;; Searches for :host are case-sensitive, and a returned host isn't @@ -603,15 +611,18 @@ auth-source-pass-extra-query-keywords--netrc-host (auth-source-do-cache nil) (results (auth-source-search :host "Libera.Chat" :max 2))) (dolist (result results) - (setf result (plist-put result :secret (auth-info-password result)))) + (setf (plist-get result :secret) (auth-info-password result))) (should (equal results '((:host "Libera.Chat" :secret "b"))))))) (ert-deftest auth-source-pass-extra-query-keywords--host () - (let ((auth-source-pass-extra-query-keywords '--test--)) - (auth-source-pass--with-store '(("libera.chat" (secret . "a")) - ("Libera.Chat" (secret . "b"))) - (auth-source-pass-enable) - (should (equal (auth-source-search :host "Libera.Chat" :max 2) + (auth-source-pass--with-store '(("libera.chat" (secret . "a")) + ("Libera.Chat" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "Libera.Chat" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "Libera.Chat" :secret "b"))))))) @@ -619,7 +630,7 @@ auth-source-pass-extra-query-keywords--host ;; path contains port or user components (ert-deftest auth-source-pass-extra-query-keywords--baseline () - (let ((auth-source-pass-extra-query-keywords '--test--)) + (let ((auth-source-pass-extra-query-keywords t)) (auth-source-pass--with-store '(("x.com")) (auth-source-pass-enable) (should-not (auth-source-search :host "x.com"))))) @@ -627,14 +638,15 @@ auth-source-pass-extra-query-keywords--baseline ;; Output port type (int or string) matches that of input parameter (ert-deftest auth-source-pass-extra-query-keywords--port-type () - (let ((auth-source-pass-extra-query-keywords '--test--)) + (let ((auth-source-pass-extra-query-keywords t) + (f (lambda (r) (setf (plist-get r :secret) (auth-info-password r)) r))) (auth-source-pass--with-store '(("x.com:42" (secret . "a"))) (auth-source-pass-enable) - (should (equal (auth-source-search :host "x.com" :port 42) + (should (equal (mapcar f (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") + (should (equal (mapcar f (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 @@ -643,14 +655,17 @@ auth-source-pass-extra-query-keywords--port-type ;; returned in the order encountered (ert-deftest auth-source-pass-extra-query-keywords--hosts-first () - (let ((auth-source-pass-extra-query-keywords '--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) + (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) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host '("x.com" "gnu.org") :max 3))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results ;; Notice gnu.org is never considered ^ '((:host "x.com" :user "bar" :port "42" :secret "a") (:host "x.com" :secret "c") -- 2.38.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0001-POC-Make-auth-source-pass-behave-more-like-other-bac.patch --] [-- Type: text/x-patch, Size: 19306 bytes --] From 8870cb62be1ad3ac5b9e5553e52a7f6ed7533c2f 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-extra-query-keywords): 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-extra-query-keywords' 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-extra-query-keywords--wild-port-miss-netrc, auth-source-pass-extra-query-keywords--wild-port-miss, auth-source-pass-extra-query-keywords--wild-port-hit-netrc, auth-source-pass-extra-query-keywords--wild-port-hit, auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc, auth-source-pass-extra-query-keywords--wild-port-req-miss, auth-source-pass-extra-query-keywords--netrc-akib, auth-source-pass-extra-query-keywords--akib, auth-source-pass-extra-query-keywords--netrc-host, auth-source-pass-extra-query-keywords--host, auth-source-pass-extra-query-keywords--baseline, auth-source-pass-extra-query-keywords--port-type, auth-source-pass-extra-query-keywords--hosts-first): Add juxtaposed netrc and extra-query-keywords pairs to demo optional extra-compliant behavior. * doc/misc/auth.texi: Add option `auth-source-pass-extra-query-keywords' to auth-source-pass section. * etc/NEWS: Mention `auth-source-pass-extra-query-keywords' in Emacs 29.1 package changes section. Bug#58985. --- doc/misc/auth.texi | 11 ++ etc/NEWS | 8 ++ lisp/auth-source-pass.el | 105 +++++++++++++++- test/lisp/auth-source-pass-tests.el | 184 ++++++++++++++++++++++++++++ 4 files changed, 307 insertions(+), 1 deletion(-) diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 9dc63af6bc..222fce2058 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -526,6 +526,8 @@ The Unix password store while searching for an entry matching the @code{rms} user on host @code{gnu.org} and port @code{22}, then the entry @file{gnu.org:22/rms.gpg} is preferred over @file{gnu.org.gpg}. +However, such filtering is not applied when the option +@code{auth-source-pass-extra-parameters} is set to @code{t}. Users of @code{pass} may also be interested in functionality provided by other Emacs packages: @@ -549,6 +551,15 @@ The Unix password store port in an entry. Defaults to @samp{:}. @end defvar +@defvar auth-source-pass-extra-query-keywords +Set this to @code{t} if you encounter problems predicting the outcome +of searches relative to other auth-source backends or if you have code +that expects to query multiple backends uniformly. This tells +auth-source-pass to consider the @code{:max} and @code{:require} +keywords as well as lists containing multiple query params (for +applicable keywords). +@end defvar + @node Help for developers @chapter Help for developers diff --git a/etc/NEWS b/etc/NEWS index ab64eff74e..2c61732f8d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1385,6 +1385,14 @@ If non-nil and there's only one matching option, auto-select that. If non-nil, this user option describes what entries not to add to the database stored on disk. +** Auth-Source + ++++ +*** New user option 'auth-source-pass-extra-query-keywords'. +Whether to recognize additional keyword params, like ':max' and +':require', as well as accept lists of query terms paired with +applicable keywords. + ** Dired +++ diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 0955e2ed07..54070e03eb 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -55,13 +55,27 @@ auth-source-pass-port-separator :type 'string :version "27.1") +(defcustom auth-source-pass-extra-query-keywords nil + "Whether to consider additional keywords when performing a query. +Specifically, when the value is t, recognize the `:max' and +`:require' keywords and accept lists of query parameters for +certain keywords, such as `:host' and `:user'. Also, wrap all +returned secrets in a function and forgo any further results +filtering unless given an applicable `:require' argument. When +this option is nil, do none of that, and enact the narrowing +behavior described toward the bottom of the Info node `(auth) The +Unix password store'." + :type 'boolean + :version "29.1") + (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 +84,8 @@ auth-source-pass-search ((null host) ;; Do not build a result, as none will match when HOST is nil nil) + (auth-source-pass-extra-query-keywords + (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 +105,39 @@ auth-source-pass--build-result (seq-subseq retval 0 -2)) ;; remove password retval)))) +(defvar auth-source-pass--match-regexp nil) + +(defun auth-source-pass--match-regexp (s) + (rx-to-string ; autoloaded + `(: (or bot "/") + (or (: (? (group-n 20 (+ (not (in ?\ ?/ ?@ ,s)))) "@") + (group-n 10 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 30 (+ (not (in ?\ ?/ ,s)))))) + (: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 31 (+ (not (in ?\ ?/ ,s))))) + (? "/" (group-n 21 (+ (not (in ?\ ?/ ,s))))))) + eot) + 'no-group)) + +(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* ((auth-source-pass--match-regexp (auth-source-pass--match-regexp + auth-source-pass-port-separator)) + (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)) + (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 +255,60 @@ auth-source-pass--find-match hosts (list hosts)))) +(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))))) + +(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)) + 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))) + (dolist (e entries) + (when-let* + ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed + seen e (integerp port)))) + ((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)) + ;; For now, ignore body-content pairs, if any, + ;; from `auth-source-pass--parse-data'. + (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 (remove 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..60903808e0 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -488,6 +488,190 @@ 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-extra-query-keywords--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 (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "x.com" :secret "a"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("x.com:42" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "x.com" :port 22 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "x.com" :secret "a"))))))) + +;; One of two entries has the requested port, both returned + +(ert-deftest auth-source-pass-extra-query-keywords--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 (plist-get 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-extra-query-keywords--wild-port-hit () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("x.com:42" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "x.com" :port 42 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((: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-extra-query-keywords--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-extra-query-keywords--wild-port-req-miss () + (let ((auth-source-pass-extra-query-keywords t)) + (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))))) + +;; Specifying a :host without a :user finds a lone entry and does not +;; include extra fields (i.e., :port nil) in the result +;; https://lists.gnu.org/archive/html/emacs-devel/2022-11/msg00130.html + +(ert-deftest auth-source-pass-extra-query-keywords--netrc-akib () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine disroot.org user akib password b +machine z.com password c +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "disroot.org" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "disroot.org" :user "akib" :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--akib () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("akib@disroot.org" (secret . "b")) + ("z.com" (secret . "c"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "disroot.org" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "disroot.org" :user "akib" :secret "b"))))))) + +;; Searches for :host are case-sensitive, and a returned host isn't +;; normalized. + +(ert-deftest auth-source-pass-extra-query-keywords--netrc-host () + (ert-with-temp-file netrc-file + :text "\ +machine libera.chat password a +machine Libera.Chat password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "Libera.Chat" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "Libera.Chat" :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--host () + (auth-source-pass--with-store '(("libera.chat" (secret . "a")) + ("Libera.Chat" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "Libera.Chat" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "Libera.Chat" :secret "b"))))))) + + +;; A retrieved store entry mustn't be nil regardless of whether its +;; path contains port or user components + +(ert-deftest auth-source-pass-extra-query-keywords--baseline () + (let ((auth-source-pass-extra-query-keywords t)) + (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-extra-query-keywords--port-type () + (let ((auth-source-pass-extra-query-keywords t) + (f (lambda (r) (setf (plist-get r :secret) (auth-info-password r)) r))) + (auth-source-pass--with-store '(("x.com:42" (secret . "a"))) + (auth-source-pass-enable) + (should (equal (mapcar f (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 (mapcar f (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-extra-query-keywords--hosts-first () + (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) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host '("x.com" "gnu.org") :max 3))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + ;; 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 #4: 0002-POC-Support-auth-source-pass-in-ERC.patch --] [-- Type: text/x-patch, Size: 9182 bytes --] From ff9878576a6826e13567049629451d494afd8c9c 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. Bug#58985. --- doc/misc/erc.texi | 3 +- lisp/erc/erc-compat.el | 99 +++++++++++++++++++++++++++++ lisp/erc/erc.el | 7 +- test/lisp/erc/erc-services-tests.el | 3 - 4 files changed, 107 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 @@ 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 03bd8f1352..739f502764 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 @@ -168,6 +170,103 @@ erc-compat--with-memoization `(cl--generic-with-memoization ,table ,@forms)) (t `(progn ,@forms)))) +;;;; 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)) + +;; This basically hard codes `auth-source-pass-port-separator' to ":" +(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)))))) + 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))) + (dolist (e entries) + (when-let* + ((m (or (gethash e seen) + (erc-compat--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))) + out) + (when (or (zerop (cl-decf max)) + (null (setq entries (remove 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 6b14cf87e2..3769e73041 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3225,7 +3225,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 c22d4cf75e..7ff2e36e77 100644 --- a/test/lisp/erc/erc-services-tests.el +++ b/test/lisp/erc/erc-services-tests.el @@ -474,7 +474,6 @@ erc-join-tests--auth-source-pass-entries ("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--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)) @@ -500,7 +498,6 @@ 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" (secret . "spam")) -- 2.38.1 ^ permalink raw reply related [flat|nested] 39+ messages in thread
[parent not found: <877d026uym.fsf@neverwas.me>]
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [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> 1 sibling, 0 replies; 39+ messages in thread From: Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2022-11-11 14:45 UTC (permalink / raw) To: J.P.; +Cc: Damien Cassou, Björn Bidar, emacs-erc, Michael Albinus, 58985 [-- Attachment #1: Type: text/plain, Size: 7794 bytes --] "J.P." <jp@neverwas.me> writes: >>> + (if (eq auth-source-pass-extra-query-keywords 'test) >>> + (reverse rv) >> >> The value `test' is not documented. Is it used in tests? If it is, I >> think an internal variable would be better. > > I got rid of the `test' stuff completely, so this function now always > wraps secrets. That looks good. > > > From 8870cb62be1ad3ac5b9e5553e52a7f6ed7533c2f 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-extra-query-keywords): 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-extra-query-keywords' 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-extra-query-keywords--wild-port-miss-netrc, > auth-source-pass-extra-query-keywords--wild-port-miss, > auth-source-pass-extra-query-keywords--wild-port-hit-netrc, > auth-source-pass-extra-query-keywords--wild-port-hit, > auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc, > auth-source-pass-extra-query-keywords--wild-port-req-miss, > auth-source-pass-extra-query-keywords--netrc-akib, > auth-source-pass-extra-query-keywords--akib, > auth-source-pass-extra-query-keywords--netrc-host, > auth-source-pass-extra-query-keywords--host, > auth-source-pass-extra-query-keywords--baseline, > auth-source-pass-extra-query-keywords--port-type, > auth-source-pass-extra-query-keywords--hosts-first): Add juxtaposed > netrc and extra-query-keywords pairs to demo optional extra-compliant > behavior. > * doc/misc/auth.texi: Add option > `auth-source-pass-extra-query-keywords' to auth-source-pass section. > * etc/NEWS: Mention `auth-source-pass-extra-query-keywords' in Emacs > 29.1 package changes section. Bug#58985. > --- > doc/misc/auth.texi | 11 ++ > etc/NEWS | 8 ++ > lisp/auth-source-pass.el | 105 +++++++++++++++- > test/lisp/auth-source-pass-tests.el | 184 ++++++++++++++++++++++++++++ > 4 files changed, 307 insertions(+), 1 deletion(-) > [...] > +(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* ((auth-source-pass--match-regexp (auth-source-pass--match-regexp > + auth-source-pass-port-separator)) > + (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)) > + (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)))) Why the closure doesn't capture "s"? For me, the following code captures "s" (obviously with lexical binding): (just let-wrapped version of your code) --8<---------------cut here---------------start------------->8--- (let ((e '(:secret "topsecret"))) (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)))) e) ;; => (:secret ;; (closure ;; ((p #1) ;; (v . "XIcHKKIKtavKgK8J6zXP1w==-N/XAaAOqAtGcCzKGKX71og==") ;; (s . "topsecret") ;; LEAKED!!! ;; (e :secret #1) ;; t) ;; nil ;; (auth-source--deobfuscate v))) --8<---------------cut here---------------end--------------->8--- > + (push e out))))) [...] > +(defun auth-source-pass--retrieve-parsed (seen path port-number-p) > + (when-let ((m (string-match auth-source-pass--match-regexp path))) Why do you let-bound "m"? I can't find any use of it in the body. > + (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--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)) > + 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))) > + (dolist (e entries) > + (when-let* > + ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed > + seen e (integerp port)))) > + ((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)) > + ;; For now, ignore body-content pairs, if any, > + ;; from `auth-source-pass--parse-data'. > + (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 (remove e entries)))) Remove will create a lot of garbage, e.g. (let ((x '(1 2 3 4 5))) (eq (remove 6 x) x)) and (let ((x '(1 2 3 4 5))) (eq (remove 1 x) (cdr x))) both returns nil. If you think delete is OK, go ahead and use it. If you think remove is better, keep it. Do whatever you think right. > + (throw 'done out))))))))))) > + [...] -- Akib Azmain Turja, GPG key: 70018CE5819F17A3BBA666AFE74F0EFA922AE7F5 Fediverse: akib@hostux.social Codeberg: akib emailselfdefense.fsf.org | "Nothing can be secure without encryption." [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 832 bytes --] ^ permalink raw reply [flat|nested] 39+ messages in thread
[parent not found: <87tu35eehq.fsf@disroot.org>]
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [not found] ` <87tu35eehq.fsf@disroot.org> @ 2022-11-12 4:30 ` J.P. [not found] ` <87bkpcu74w.fsf@neverwas.me> 1 sibling, 0 replies; 39+ messages in thread From: J.P. @ 2022-11-12 4:30 UTC (permalink / raw) To: Akib Azmain Turja Cc: Damien Cassou, Björn Bidar, emacs-erc, Michael Albinus, 58985 [-- Attachment #1: Type: text/plain, Size: 5166 bytes --] Akib Azmain Turja <akib@disroot.org> writes: > Why the closure doesn't capture "s"? For me, the following code > captures "s" (obviously with lexical binding): (just let-wrapped version > of your code) > > (let ((e '(:secret "topsecret"))) > (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)))) > e) > ;; => (:secret > ;; (closure > ;; ((p #1) > ;; (v . "XIcHKKIKtavKgK8J6zXP1w==-N/XAaAOqAtGcCzKGKX71og==") > ;; (s . "topsecret") ;; LEAKED!!! > ;; (e :secret #1) > ;; t) > ;; nil > ;; (auth-source--deobfuscate v))) > Looks like you don't have: commit 1b1ffe07897ebe06cf96ab423fad3cde9fd6c981 Author: Stefan Monnier <monnier@iro.umontreal.ca> Date: Mon Oct 17 17:11:40 2022 -0400 (Ffunction): Make interpreted closures safe for space It's easiest to just make a habit of applying patches on the latest HEAD. Once you do, you'll find that the output of your example changes. If ELPA's Compat ever takes an interest, I suppose a backported version could just `byte-compile' the lambda. >> + (push e out))))) > > [...] > >> +(defun auth-source-pass--retrieve-parsed (seen path port-number-p) >> + (when-let ((m (string-match auth-source-pass--match-regexp path))) > > Why do you let-bound "m"? Because I am slow and blind, I guess. > I can't find any use of it in the body. Go figure. (Thanks.) >> +(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)) >> + 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))) >> + (dolist (e entries) >> + (when-let* >> + ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed >> + seen e (integerp port)))) >> + ((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)) >> + ;; For now, ignore body-content pairs, if any, >> + ;; from `auth-source-pass--parse-data'. >> + (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 (remove e entries)))) > > Remove will create a lot of garbage, e.g. (let ((x '(1 2 3 4 5))) > (eq (remove 6 x) x)) and (let ((x '(1 2 3 4 5))) (eq (remove 1 x) > (cdr x))) both returns nil. Since you're clearly aware that, for lists, `remove' just calls `delete' on a shallow copy, how could (remove thing x) ever be eq to some nthcdr of x so long as both are non-nil? > If you think delete is OK, go ahead and use it. If you think remove is > better, keep it. Do whatever you think right. As I tried to explain in https://debbugs.gnu.org/cgi/bugreport.cgi?bug=58985#64 I think `delete' is safe in this situation, assuming of course that, for ancient, core functions, the implementation can be construed as the de facto interface. Based on your comments, you seem to agree with this assumption, which seems only sane. I have thus reverted the change. > >> + (throw 'done out))))))))))) >> + > > [...] While I certainly welcome the assiduous scrutinizing of Emacs lisp mechanics and technique (truly), I was mainly hoping that, as an avid pass user, you would also help flesh out the precise effects of the behavior introduced by these changes and hopefully share some insights into how they might impact day-to-day usage for the typical pass user. Granted, that necessarily involves applying these patches atop your daily driver and living with them for a spell and, ideally, investing some thought into imagining common usage patterns beyond your own (plus any potentially problematic edge cases). If you have the energy to devote to (perhaps just some of) these areas, it would really help move this bug report forward. Thanks. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-v5-v6.diff --] [-- Type: text/x-patch, Size: 4398 bytes --] From 1859ab24a1fee10d78aa2a3907e48786c2f1d7f6 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Fri, 11 Nov 2022 19:55:11 -0800 Subject: [PATCH 0/2] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (2): [POC] Make auth-source-pass behave more like other backends [POC] Support auth-source-pass in ERC doc/misc/auth.texi | 11 ++ doc/misc/erc.texi | 3 +- etc/NEWS | 8 ++ lisp/auth-source-pass.el | 105 +++++++++++++++- lisp/erc/erc-compat.el | 99 +++++++++++++++ lisp/erc/erc.el | 7 +- test/lisp/auth-source-pass-tests.el | 184 ++++++++++++++++++++++++++++ test/lisp/erc/erc-services-tests.el | 3 - 8 files changed, 414 insertions(+), 6 deletions(-) Interdiff: diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 54070e03eb..34edd4fa31 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -132,7 +132,7 @@ auth-source-pass--build-result-many (auth-source-pass--do-debug "final result: %S" rv)) (let (out) (dolist (e rv out) - (when-let* ((s (plist-get e :secret)) ; s not captured by closure + (when-let* ((s (plist-get e :secret)) ; not captured by closure in 29.1 (v (auth-source--obfuscate s))) (setf (plist-get e :secret) (lambda () (auth-source--deobfuscate v)))) @@ -256,7 +256,7 @@ auth-source-pass--find-match (list hosts)))) (defun auth-source-pass--retrieve-parsed (seen path port-number-p) - (when-let ((m (string-match auth-source-pass--match-regexp path))) + (when (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)) @@ -306,7 +306,7 @@ auth-source-pass--find-match-many ,@(and secret (not (eq secret t)) (list :secret secret))) out) (when (or (zerop (cl-decf max)) - (null (setq entries (remove e entries)))) + (null (setq entries (delete e entries)))) (throw 'done out))))))))))) (defun auth-source-pass--disambiguate (host &optional user port) diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 739f502764..47d5258f92 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -184,15 +184,15 @@ erc-compat--with-memoization ;; This basically hard codes `auth-source-pass-port-separator' to ":" (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))) + (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 (list :host (or (match-string 10 e) (match-string 11 e)) :user (or (match-string 20 e) @@ -247,7 +247,7 @@ erc-compat--auth-source-pass--build-result-many ,@(and secret (not (eq secret t)) (list :secret secret))) out) (when (or (zerop (cl-decf max)) - (null (setq entries (remove e entries)))) + (null (setq entries (delete e entries)))) (throw 'done nil))))))))) (reverse out))) -- 2.38.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0001-POC-Make-auth-source-pass-behave-more-like-other-bac.patch --] [-- Type: text/x-patch, Size: 19302 bytes --] From 0ab6214112f9fead4173981286d5491cc70b502c 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-extra-query-keywords): 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-extra-query-keywords' 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-extra-query-keywords--wild-port-miss-netrc, auth-source-pass-extra-query-keywords--wild-port-miss, auth-source-pass-extra-query-keywords--wild-port-hit-netrc, auth-source-pass-extra-query-keywords--wild-port-hit, auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc, auth-source-pass-extra-query-keywords--wild-port-req-miss, auth-source-pass-extra-query-keywords--netrc-akib, auth-source-pass-extra-query-keywords--akib, auth-source-pass-extra-query-keywords--netrc-host, auth-source-pass-extra-query-keywords--host, auth-source-pass-extra-query-keywords--baseline, auth-source-pass-extra-query-keywords--port-type, auth-source-pass-extra-query-keywords--hosts-first): Add juxtaposed netrc and extra-query-keywords pairs to demo optional extra-compliant behavior. * doc/misc/auth.texi: Add option `auth-source-pass-extra-query-keywords' to auth-source-pass section. * etc/NEWS: Mention `auth-source-pass-extra-query-keywords' in Emacs 29.1 package changes section. Bug#58985. --- doc/misc/auth.texi | 11 ++ etc/NEWS | 8 ++ lisp/auth-source-pass.el | 105 +++++++++++++++- test/lisp/auth-source-pass-tests.el | 184 ++++++++++++++++++++++++++++ 4 files changed, 307 insertions(+), 1 deletion(-) diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 9dc63af6bc..222fce2058 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -526,6 +526,8 @@ The Unix password store while searching for an entry matching the @code{rms} user on host @code{gnu.org} and port @code{22}, then the entry @file{gnu.org:22/rms.gpg} is preferred over @file{gnu.org.gpg}. +However, such filtering is not applied when the option +@code{auth-source-pass-extra-parameters} is set to @code{t}. Users of @code{pass} may also be interested in functionality provided by other Emacs packages: @@ -549,6 +551,15 @@ The Unix password store port in an entry. Defaults to @samp{:}. @end defvar +@defvar auth-source-pass-extra-query-keywords +Set this to @code{t} if you encounter problems predicting the outcome +of searches relative to other auth-source backends or if you have code +that expects to query multiple backends uniformly. This tells +auth-source-pass to consider the @code{:max} and @code{:require} +keywords as well as lists containing multiple query params (for +applicable keywords). +@end defvar + @node Help for developers @chapter Help for developers diff --git a/etc/NEWS b/etc/NEWS index ab64eff74e..2c61732f8d 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1385,6 +1385,14 @@ If non-nil and there's only one matching option, auto-select that. If non-nil, this user option describes what entries not to add to the database stored on disk. +** Auth-Source + ++++ +*** New user option 'auth-source-pass-extra-query-keywords'. +Whether to recognize additional keyword params, like ':max' and +':require', as well as accept lists of query terms paired with +applicable keywords. + ** Dired +++ diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 0955e2ed07..34edd4fa31 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -55,13 +55,27 @@ auth-source-pass-port-separator :type 'string :version "27.1") +(defcustom auth-source-pass-extra-query-keywords nil + "Whether to consider additional keywords when performing a query. +Specifically, when the value is t, recognize the `:max' and +`:require' keywords and accept lists of query parameters for +certain keywords, such as `:host' and `:user'. Also, wrap all +returned secrets in a function and forgo any further results +filtering unless given an applicable `:require' argument. When +this option is nil, do none of that, and enact the narrowing +behavior described toward the bottom of the Info node `(auth) The +Unix password store'." + :type 'boolean + :version "29.1") + (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 +84,8 @@ auth-source-pass-search ((null host) ;; Do not build a result, as none will match when HOST is nil nil) + (auth-source-pass-extra-query-keywords + (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 +105,39 @@ auth-source-pass--build-result (seq-subseq retval 0 -2)) ;; remove password retval)))) +(defvar auth-source-pass--match-regexp nil) + +(defun auth-source-pass--match-regexp (s) + (rx-to-string ; autoloaded + `(: (or bot "/") + (or (: (? (group-n 20 (+ (not (in ?\ ?/ ?@ ,s)))) "@") + (group-n 10 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 30 (+ (not (in ?\ ?/ ,s)))))) + (: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 31 (+ (not (in ?\ ?/ ,s))))) + (? "/" (group-n 21 (+ (not (in ?\ ?/ ,s))))))) + eot) + 'no-group)) + +(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* ((auth-source-pass--match-regexp (auth-source-pass--match-regexp + auth-source-pass-port-separator)) + (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)) + (let (out) + (dolist (e rv out) + (when-let* ((s (plist-get e :secret)) ; not captured by closure in 29.1 + (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 +255,60 @@ auth-source-pass--find-match hosts (list hosts)))) +(defun auth-source-pass--retrieve-parsed (seen path port-number-p) + (when (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))))) + +(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)) + 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))) + (dolist (e entries) + (when-let* + ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed + seen e (integerp port)))) + ((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)) + ;; For now, ignore body-content pairs, if any, + ;; from `auth-source-pass--parse-data'. + (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..60903808e0 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -488,6 +488,190 @@ 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-extra-query-keywords--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 (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "x.com" :secret "a"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("x.com:42" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "x.com" :port 22 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "x.com" :secret "a"))))))) + +;; One of two entries has the requested port, both returned + +(ert-deftest auth-source-pass-extra-query-keywords--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 (plist-get 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-extra-query-keywords--wild-port-hit () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("x.com:42" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "x.com" :port 42 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((: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-extra-query-keywords--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-extra-query-keywords--wild-port-req-miss () + (let ((auth-source-pass-extra-query-keywords t)) + (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))))) + +;; Specifying a :host without a :user finds a lone entry and does not +;; include extra fields (i.e., :port nil) in the result +;; https://lists.gnu.org/archive/html/emacs-devel/2022-11/msg00130.html + +(ert-deftest auth-source-pass-extra-query-keywords--netrc-akib () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine disroot.org user akib password b +machine z.com password c +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "disroot.org" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "disroot.org" :user "akib" :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--akib () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("akib@disroot.org" (secret . "b")) + ("z.com" (secret . "c"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "disroot.org" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "disroot.org" :user "akib" :secret "b"))))))) + +;; Searches for :host are case-sensitive, and a returned host isn't +;; normalized. + +(ert-deftest auth-source-pass-extra-query-keywords--netrc-host () + (ert-with-temp-file netrc-file + :text "\ +machine libera.chat password a +machine Libera.Chat password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "Libera.Chat" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "Libera.Chat" :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--host () + (auth-source-pass--with-store '(("libera.chat" (secret . "a")) + ("Libera.Chat" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "Libera.Chat" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "Libera.Chat" :secret "b"))))))) + + +;; A retrieved store entry mustn't be nil regardless of whether its +;; path contains port or user components + +(ert-deftest auth-source-pass-extra-query-keywords--baseline () + (let ((auth-source-pass-extra-query-keywords t)) + (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-extra-query-keywords--port-type () + (let ((auth-source-pass-extra-query-keywords t) + (f (lambda (r) (setf (plist-get r :secret) (auth-info-password r)) r))) + (auth-source-pass--with-store '(("x.com:42" (secret . "a"))) + (auth-source-pass-enable) + (should (equal (mapcar f (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 (mapcar f (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-extra-query-keywords--hosts-first () + (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) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host '("x.com" "gnu.org") :max 3))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + ;; 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 #4: 0002-POC-Support-auth-source-pass-in-ERC.patch --] [-- Type: text/x-patch, Size: 9199 bytes --] From 1859ab24a1fee10d78aa2a3907e48786c2f1d7f6 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. Bug#58985. --- doc/misc/erc.texi | 3 +- lisp/erc/erc-compat.el | 99 +++++++++++++++++++++++++++++ lisp/erc/erc.el | 7 +- test/lisp/erc/erc-services-tests.el | 3 - 4 files changed, 107 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 @@ 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 03bd8f1352..47d5258f92 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 @@ -168,6 +170,103 @@ erc-compat--with-memoization `(cl--generic-with-memoization ,table ,@forms)) (t `(progn ,@forms)))) +;;;; 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)) + +;; This basically hard codes `auth-source-pass-port-separator' to ":" +(defun erc-compat--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 (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)))))) + 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))) + (dolist (e entries) + (when-let* + ((m (or (gethash e seen) + (erc-compat--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))) + 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 6b14cf87e2..3769e73041 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3225,7 +3225,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 c22d4cf75e..7ff2e36e77 100644 --- a/test/lisp/erc/erc-services-tests.el +++ b/test/lisp/erc/erc-services-tests.el @@ -474,7 +474,6 @@ erc-join-tests--auth-source-pass-entries ("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--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)) @@ -500,7 +498,6 @@ 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" (secret . "spam")) -- 2.38.1 ^ permalink raw reply related [flat|nested] 39+ messages in thread
[parent not found: <87bkpcu74w.fsf@neverwas.me>]
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [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> 1 sibling, 0 replies; 39+ messages in thread From: Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2022-11-12 15:24 UTC (permalink / raw) To: J.P.; +Cc: Damien Cassou, Björn Bidar, emacs-erc, Michael Albinus, 58985 [-- Attachment #1: Type: text/plain, Size: 6301 bytes --] "J.P." <jp@neverwas.me> writes: > Akib Azmain Turja <akib@disroot.org> writes: > >> Why the closure doesn't capture "s"? For me, the following code >> captures "s" (obviously with lexical binding): (just let-wrapped version >> of your code) >> >> (let ((e '(:secret "topsecret"))) >> (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)))) >> e) >> ;; => (:secret >> ;; (closure >> ;; ((p #1) >> ;; (v . "XIcHKKIKtavKgK8J6zXP1w==-N/XAaAOqAtGcCzKGKX71og==") >> ;; (s . "topsecret") ;; LEAKED!!! >> ;; (e :secret #1) >> ;; t) >> ;; nil >> ;; (auth-source--deobfuscate v))) >> > > Looks like you don't have: > > commit 1b1ffe07897ebe06cf96ab423fad3cde9fd6c981 > Author: Stefan Monnier <monnier@iro.umontreal.ca> > Date: Mon Oct 17 17:11:40 2022 -0400 > > (Ffunction): Make interpreted closures safe for space > > It's easiest to just make a habit of applying patches on the latest > HEAD. Once you do, you'll find that the output of your example changes. > If ELPA's Compat ever takes an interest, I suppose a backported version > could just `byte-compile' the lambda. That's a recent commit, I'm using Emacs from a commit over two months ago (I tried to upgrade just a few days before Eglot merged, but was forced to revert due to native compilation errors). > >>> + (push e out))))) >> >> [...] >> >>> +(defun auth-source-pass--retrieve-parsed (seen path port-number-p) >>> + (when-let ((m (string-match auth-source-pass--match-regexp path))) >> >> Why do you let-bound "m"? > > Because I am slow and blind, I guess. > >> I can't find any use of it in the body. > > Go figure. (Thanks.) I can't find any existence of "m". > >>> +(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)) >>> + 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))) >>> + (dolist (e entries) >>> + (when-let* >>> + ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed >>> + seen e (integerp port)))) >>> + ((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)) >>> + ;; For now, ignore body-content pairs, if any, >>> + ;; from `auth-source-pass--parse-data'. >>> + (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 (remove e entries)))) >> >> Remove will create a lot of garbage, e.g. (let ((x '(1 2 3 4 5))) >> (eq (remove 6 x) x)) and (let ((x '(1 2 3 4 5))) (eq (remove 1 x) >> (cdr x))) both returns nil. > > Since you're clearly aware that, for lists, `remove' just calls `delete' > on a shallow copy, how could (remove thing x) ever be eq to some nthcdr > of x so long as both are non-nil? > >> If you think delete is OK, go ahead and use it. If you think remove is >> better, keep it. Do whatever you think right. > > As I tried to explain in > > https://debbugs.gnu.org/cgi/bugreport.cgi?bug=58985#64 > > I think `delete' is safe in this situation, assuming of course that, for > ancient, core functions, the implementation can be construed as the de > facto interface. Based on your comments, you seem to agree with this > assumption, which seems only sane. I have thus reverted the change. > Any one contributing to core Emacs is almost certain more experienced that me, so they should ignore me if they wish. >> >>> + (throw 'done out))))))))))) >>> + >> >> [...] > > While I certainly welcome the assiduous scrutinizing of Emacs lisp > mechanics and technique (truly), I was mainly hoping that, as an avid > pass user, you would also help flesh out the precise effects of the > behavior introduced by these changes and hopefully share some insights > into how they might impact day-to-day usage for the typical pass user. > Granted, that necessarily involves applying these patches atop your > daily driver and living with them for a spell and, ideally, investing > some thought into imagining common usage patterns beyond your own (plus > any potentially problematic edge cases). If you have the energy to > devote to (perhaps just some of) these areas, it would really help move > this bug report forward. Thanks. > > > > Actually, I'm not very brave, and any damage to my password-store would be an absolute disaster. However, I have made a backup and add the encrypted passwords to a Git repository, and since the patch looks safe, I'm going to apply and test it. -- Akib Azmain Turja, GPG key: 70018CE5819F17A3BBA666AFE74F0EFA922AE7F5 Fediverse: akib@hostux.social Codeberg: akib emailselfdefense.fsf.org | "Nothing can be secure without encryption." [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 832 bytes --] ^ permalink raw reply [flat|nested] 39+ messages in thread
[parent not found: <875yfkdwlm.fsf@disroot.org>]
* Re: bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [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> 0 siblings, 2 replies; 39+ messages in thread From: Akib Azmain Turja @ 2022-11-13 7:26 UTC (permalink / raw) To: Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors Cc: J.P., Damien Cassou, Björn Bidar, emacs-erc, Michael Albinus, 58985 [-- Attachment #1: Type: text/plain, Size: 2148 bytes --] Akib Azmain Turja via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org> writes: > "J.P." <jp@neverwas.me> writes: > >> While I certainly welcome the assiduous scrutinizing of Emacs lisp >> mechanics and technique (truly), I was mainly hoping that, as an avid >> pass user, you would also help flesh out the precise effects of the >> behavior introduced by these changes and hopefully share some insights >> into how they might impact day-to-day usage for the typical pass user. >> Granted, that necessarily involves applying these patches atop your >> daily driver and living with them for a spell and, ideally, investing >> some thought into imagining common usage patterns beyond your own (plus >> any potentially problematic edge cases). If you have the energy to >> devote to (perhaps just some of) these areas, it would really help move >> this bug report forward. Thanks. > > Actually, I'm not very brave, and any damage to my password-store would > be an absolute disaster. > > However, I have made a backup and add the encrypted passwords to a Git > repository, and since the patch looks safe, I'm going to apply and test > it. I have applied the patch the on top commit f8c11b5a, and it works fine. I did some basic testing (manually) of auth-source-pass and the dependent packages I use, password-store and pass, and they all seem to be unaffected when the new option enabled. So I guess we can enable it by default. I didn't felt the need of test with the new feature disabled, since the patch doesn't touch any old code. And I also found that, auth-source finds the entry "akib@disroot.org" correctly with (auth-source-search :host "disroot.org") when the new user option is set to t. However, I haven't still installed the Emacs build with the patch applied as my daily driver, I'm working on that. The tests were performed on Emacs build without GUI. -- Akib Azmain Turja, GPG key: 70018CE5819F17A3BBA666AFE74F0EFA922AE7F5 Fediverse: akib@hostux.social Codeberg: akib emailselfdefense.fsf.org | "Nothing can be secure without encryption." [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 832 bytes --] ^ permalink raw reply [flat|nested] 39+ messages in thread
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends 2022-11-13 7:26 ` Akib Azmain Turja @ 2022-11-13 15:29 ` J.P. [not found] ` <875yfiq3d8.fsf@neverwas.me> 1 sibling, 0 replies; 39+ messages in thread From: J.P. @ 2022-11-13 15:29 UTC (permalink / raw) To: Akib Azmain Turja Cc: Damien Cassou, Björn Bidar, emacs-erc, Michael Albinus, 58985 Akib Azmain Turja <akib@disroot.org> writes: > Akib Azmain Turja via "Bug reports for GNU Emacs, the Swiss army knife > of text editors" <bug-gnu-emacs@gnu.org> writes: > >> "J.P." <jp@neverwas.me> writes: >> >>> While I certainly welcome the assiduous scrutinizing of Emacs lisp >>> mechanics and technique (truly), I was mainly hoping that, as an avid >>> pass user, you would also help flesh out the precise effects of the >>> behavior introduced by these changes and hopefully share some insights >>> into how they might impact day-to-day usage for the typical pass user. >>> Granted, that necessarily involves applying these patches atop your >>> daily driver and living with them for a spell and, ideally, investing >>> some thought into imagining common usage patterns beyond your own (plus >>> any potentially problematic edge cases). If you have the energy to >>> devote to (perhaps just some of) these areas, it would really help move >>> this bug report forward. Thanks. >> >> Actually, I'm not very brave, and any damage to my password-store would >> be an absolute disaster. >> >> However, I have made a backup and add the encrypted passwords to a Git >> repository, and since the patch looks safe, I'm going to apply and test >> it. > > I have applied the patch the on top commit f8c11b5a, and it works fine. > > I did some basic testing (manually) of auth-source-pass and the > dependent packages I use, password-store and pass, and they all seem to > be unaffected when the new option enabled. So I guess we can enable it > by default. I didn't felt the need of test with the new feature > disabled, since the patch doesn't touch any old code. Awesome. Thanks for all the work. I know it's kind of a hassle. > And I also found that, auth-source finds the entry "akib@disroot.org" > correctly with (auth-source-search :host "disroot.org") when the new > user option is set to t. Yeah, it's sometimes tricky to tell if the new code is even running, so it's great that you checked that. > However, I haven't still installed the Emacs build with the patch > applied as my daily driver, I'm working on that. The tests were > performed on Emacs build without GUI. OK, nice. You mentioned previously some potentially surprising ambiguities surrounding the trailing /user syntax. If any realistic scenarios present themselves, perhaps we can try to improve the situation if it's not too far out of scope (or just document the behavior, maybe in a unit test). Thanks again. ^ permalink raw reply [flat|nested] 39+ messages in thread
[parent not found: <875yfiq3d8.fsf@neverwas.me>]
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [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> 1 sibling, 0 replies; 39+ messages in thread From: Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2022-11-14 6:50 UTC (permalink / raw) To: J.P.; +Cc: Damien Cassou, Björn Bidar, emacs-erc, Michael Albinus, 58985 [-- Attachment #1: Type: text/plain, Size: 3793 bytes --] "J.P." <jp@neverwas.me> writes: > Akib Azmain Turja <akib@disroot.org> writes: > >> Akib Azmain Turja via "Bug reports for GNU Emacs, the Swiss army knife >> of text editors" <bug-gnu-emacs@gnu.org> writes: >> >>> "J.P." <jp@neverwas.me> writes: >>> >>>> While I certainly welcome the assiduous scrutinizing of Emacs lisp >>>> mechanics and technique (truly), I was mainly hoping that, as an avid >>>> pass user, you would also help flesh out the precise effects of the >>>> behavior introduced by these changes and hopefully share some insights >>>> into how they might impact day-to-day usage for the typical pass user. >>>> Granted, that necessarily involves applying these patches atop your >>>> daily driver and living with them for a spell and, ideally, investing >>>> some thought into imagining common usage patterns beyond your own (plus >>>> any potentially problematic edge cases). If you have the energy to >>>> devote to (perhaps just some of) these areas, it would really help move >>>> this bug report forward. Thanks. >>> >>> Actually, I'm not very brave, and any damage to my password-store would >>> be an absolute disaster. >>> >>> However, I have made a backup and add the encrypted passwords to a Git >>> repository, and since the patch looks safe, I'm going to apply and test >>> it. >> >> I have applied the patch the on top commit f8c11b5a, and it works fine. >> >> I did some basic testing (manually) of auth-source-pass and the >> dependent packages I use, password-store and pass, and they all seem to >> be unaffected when the new option enabled. So I guess we can enable it >> by default. I didn't felt the need of test with the new feature >> disabled, since the patch doesn't touch any old code. > > Awesome. Thanks for all the work. I know it's kind of a hassle. > >> And I also found that, auth-source finds the entry "akib@disroot.org" >> correctly with (auth-source-search :host "disroot.org") when the new >> user option is set to t. > > Yeah, it's sometimes tricky to tell if the new code is even running, so > it's great that you checked that. I'm pretty sure the new code was running, since I set auth-source-do-cache to nil to disable cache prior doing the tests. > >> However, I haven't still installed the Emacs build with the patch >> applied as my daily driver, I'm working on that. The tests were >> performed on Emacs build without GUI. > > OK, nice. > > You mentioned previously some potentially surprising ambiguities > surrounding the trailing /user syntax. If any realistic scenarios > present themselves, perhaps we can try to improve the situation if it's > not too far out of scope (or just document the behavior, maybe in a unit > test). Thanks again. I think it's good enough to install on master. Then more people can test and report about it. However, observed some behavior of the new code, here are my findings: The new searching code seems to prefer "HOST/USER" over "USER@HOST". I created the password store entry "foo.com/bar.org". Then I evaluated: (warning: manually typed with hands) (auth-source-search :host "bar.org") ;; => nil (auth-source-search :host "foo.com") ;; => ((:host "foo.com" :user "bar.org" :secret ...)) I created another entry "bar.org@foo.com". But it returns the password in "foo.com/bar.org". I deleted "foo.com/bar.org", now it return the password of "bar.org@foo.com". I created "foo.com/bar.org" again, and "foo.com/bar.org" is preferred again. I suggest to prefer the "@" syntax over "/user" syntax. -- Akib Azmain Turja, GPG key: 70018CE5819F17A3BBA666AFE74F0EFA922AE7F5 Fediverse: akib@hostux.social Codeberg: akib emailselfdefense.fsf.org | "Nothing can be secure without encryption." [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 832 bytes --] ^ permalink raw reply [flat|nested] 39+ messages in thread
[parent not found: <87mt8uvxkp.fsf@disroot.org>]
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [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 0 siblings, 1 reply; 39+ messages in thread From: J.P. @ 2022-11-14 15:12 UTC (permalink / raw) To: Akib Azmain Turja Cc: Damien Cassou, Björn Bidar, emacs-erc, Michael Albinus, 58985 [-- Attachment #1: Type: text/plain, Size: 1729 bytes --] Akib Azmain Turja <akib@disroot.org> writes: > "J.P." <jp@neverwas.me> writes: > >> You mentioned previously some potentially surprising ambiguities >> surrounding the trailing /user syntax. If any realistic scenarios >> present themselves, perhaps we can try to improve the situation if it's >> not too far out of scope (or just document the behavior, maybe in a unit >> test). Thanks again. > > I think it's good enough to install on master. Then more people can > test and report about it. > > However, observed some behavior of the new code, here are my findings: > > The new searching code seems to prefer "HOST/USER" over "USER@HOST". That's the effect, right. I think `directory-files-recursively' basically determines the ordering in which the entries are considered. > I created the password store entry "foo.com/bar.org". Then I evaluated: > (warning: manually typed with hands) > > (auth-source-search :host "bar.org") > ;; => nil > > (auth-source-search :host "foo.com") > ;; => ((:host "foo.com" :user "bar.org" :secret ...)) > > I created another entry "bar.org@foo.com". But it returns the password > in "foo.com/bar.org". > > I deleted "foo.com/bar.org", now it return the password of > "bar.org@foo.com". > > I created "foo.com/bar.org" again, and "foo.com/bar.org" is preferred > again. > > I suggest to prefer the "@" syntax over "/user" syntax. I have tried tweaking things in that direction. But as far as deprecating the /user form officially: that seems more like a group decision. And then there's the question of how to express such a policy. Should we emit a warning? At the very least, it would need to be documented somewhere. Anyway, this is useful analysis. Thanks again for all your help. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-v6-v7.diff --] [-- Type: text/x-patch, Size: 10404 bytes --] From 7a6ee6960ded65dfdec768b094eca8d1883a8f4d Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Mon, 14 Nov 2022 06:51:56 -0800 Subject: [PATCH 0/2] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (2): [POC] Make auth-source-pass behave more like other backends [POC] Support auth-source-pass in ERC doc/misc/auth.texi | 11 ++ doc/misc/erc.texi | 3 +- etc/NEWS | 8 + lisp/auth-source-pass.el | 113 +++++++++++++- lisp/erc/erc-compat.el | 104 +++++++++++++ lisp/erc/erc.el | 7 +- test/lisp/auth-source-pass-tests.el | 223 ++++++++++++++++++++++++++++ test/lisp/erc/erc-services-tests.el | 3 - 8 files changed, 466 insertions(+), 6 deletions(-) Interdiff: diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 34edd4fa31..aa39df014c 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -258,14 +258,16 @@ auth-source-pass--find-match (defun auth-source-pass--retrieve-parsed (seen path port-number-p) (when (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))) + `( :host ,(or (match-string 10 path) (match-string 11 path)) + ,@(if-let* ((tr (match-string 21 path))) + (list :user tr :suffix t) + (list :user (match-string 20 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) @@ -279,7 +281,7 @@ auth-source-pass--find-match-many Each plist contains, at the very least, a host and a secret." (let ((seen (make-hash-table :test #'equal)) (entries (auth-source-pass-entries)) - out) + out suffixed suffixedp) (catch 'done (dolist (host hosts out) (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host))) @@ -304,10 +306,16 @@ auth-source-pass--find-match-many ,@(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))))))))))) + (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)))))))))) (defun auth-source-pass--disambiguate (host &optional user port) "Return (HOST USER PORT) after disambiguation. diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index 47d5258f92..51bf251026 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -193,17 +193,16 @@ erc-compat--auth-source-pass--retrieve-parsed (? "/" (group-n 21 (+ (not (in " /:"))))))) eot) 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))) + (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'. @@ -221,7 +220,7 @@ erc-compat--auth-source-pass--build-result-many (if (memq k require) (and v (equal mv v)) (or (not v) (not mv) (equal mv v)))))) - out) + out suffixed suffixedp) (catch 'done (dolist (host hosts) (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host))) @@ -245,10 +244,16 @@ erc-compat--auth-source-pass--build-result-many ,@(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))))))))) + (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--auth-source-pass-search diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 60903808e0..a92653b5ac 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -654,6 +654,11 @@ auth-source-pass-extra-query-keywords--port-type ;; matches are not given precedence, i.e., matching store items are ;; returned in the order encountered +;; Note that all trailing /user forms are demoted for the sake of +;; predictability, and so are quasi-deprecated. This means that, in +;; the following test, /bar is shunted off to limbo, followed by /foo, +;; but they both retain priority over "gnu.org", as noted above. + (ert-deftest auth-source-pass-extra-query-keywords--hosts-first () (auth-source-pass--with-store '(("x.com:42/bar" (secret . "a")) ("gnu.org" (secret . "b")) @@ -667,10 +672,44 @@ auth-source-pass-extra-query-keywords--hosts-first (setf (plist-get result :secret) (auth-info-password result))) (should (equal results ;; Notice gnu.org is never considered ^ - '((:host "x.com" :user "bar" :port "42" :secret "a") - (:host "x.com" :secret "c") + '((:host "x.com" :secret "c") + (:host "x.com" :user "bar" :port "42" :secret "a") (:host "x.com" :user "foo" :secret "e"))))))) +(ert-deftest auth-source-pass-extra-query-keywords--ambiguous-user-host () + (auth-source-pass--with-store '(("foo.com/bar.org" (secret . "a")) + ("foo.com" (secret . "b")) + ("bar.org" (secret . "c")) + ("fake.com" (secret . "d"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "bar.org" :max 3))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "bar.org" :secret "c"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--suffixed-user () + (auth-source-pass--with-store '(("x.com:42/bar" (secret . "a")) + ("bar@x.com" (secret . "b")) + ("x.com" (secret . "?")) + ("bar@y.org" (secret . "c")) + ("fake.com" (secret . "?")) + ("fake.com/bar" (secret . "d")) + ("y.org/bar" (secret . "?")) + ("bar@fake.com" (secret . "e"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host '("x.com" "fake.com" "y.org") + :user "bar" + :require '(:user) :max 5))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "x.com" :user "bar" :secret "b") + (:host "x.com" :user "bar" :port "42" :secret "a") + (:host "fake.com" :user "bar" :secret "e") + (:host "fake.com" :user "bar" :secret "d") + (:host "y.org" :user "bar" :secret "c"))))))) (provide 'auth-source-pass-tests) -- 2.38.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0001-POC-Make-auth-source-pass-behave-more-like-other-bac.patch --] [-- Type: text/x-patch, Size: 22097 bytes --] From aef40854691b4c6e9c97ffdedefb342ae3fcc669 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-extra-query-keywords): 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-extra-query-keywords' 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-extra-query-keywords--wild-port-miss-netrc, auth-source-pass-extra-query-keywords--wild-port-miss, auth-source-pass-extra-query-keywords--wild-port-hit-netrc, auth-source-pass-extra-query-keywords--wild-port-hit, auth-source-pass-extra-query-keywords--wild-port-req-miss-netrc, auth-source-pass-extra-query-keywords--wild-port-req-miss, auth-source-pass-extra-query-keywords--netrc-akib, auth-source-pass-extra-query-keywords--akib, auth-source-pass-extra-query-keywords--netrc-host, auth-source-pass-extra-query-keywords--host, auth-source-pass-extra-query-keywords--baseline, auth-source-pass-extra-query-keywords--port-type, auth-source-pass-extra-query-keywords--hosts-first, auth-source-pass-extra-query-keywords--ambiguous-user-host, auth-source-pass-extra-query-keywords--suffixed-user): Add juxtaposed netrc and extra-query-keywords pairs to demo optional extra-compliant behavior. * doc/misc/auth.texi: Add option `auth-source-pass-extra-query-keywords' to auth-source-pass section. * etc/NEWS: Mention `auth-source-pass-extra-query-keywords' in Emacs 29.1 package changes section. Bug#58985. --- doc/misc/auth.texi | 11 ++ etc/NEWS | 8 + lisp/auth-source-pass.el | 113 +++++++++++++- test/lisp/auth-source-pass-tests.el | 223 ++++++++++++++++++++++++++++ 4 files changed, 354 insertions(+), 1 deletion(-) diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 9dc63af6bc..222fce2058 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -526,6 +526,8 @@ The Unix password store while searching for an entry matching the @code{rms} user on host @code{gnu.org} and port @code{22}, then the entry @file{gnu.org:22/rms.gpg} is preferred over @file{gnu.org.gpg}. +However, such filtering is not applied when the option +@code{auth-source-pass-extra-parameters} is set to @code{t}. Users of @code{pass} may also be interested in functionality provided by other Emacs packages: @@ -549,6 +551,15 @@ The Unix password store port in an entry. Defaults to @samp{:}. @end defvar +@defvar auth-source-pass-extra-query-keywords +Set this to @code{t} if you encounter problems predicting the outcome +of searches relative to other auth-source backends or if you have code +that expects to query multiple backends uniformly. This tells +auth-source-pass to consider the @code{:max} and @code{:require} +keywords as well as lists containing multiple query params (for +applicable keywords). +@end defvar + @node Help for developers @chapter Help for developers diff --git a/etc/NEWS b/etc/NEWS index 7cd192b9d3..465ab4ad68 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1395,6 +1395,14 @@ If non-nil and there's only one matching option, auto-select that. If non-nil, this user option describes what entries not to add to the database stored on disk. +** Auth-Source + ++++ +*** New user option 'auth-source-pass-extra-query-keywords'. +Whether to recognize additional keyword params, like ':max' and +':require', as well as accept lists of query terms paired with +applicable keywords. + ** Dired +++ diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 0955e2ed07..aa39df014c 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -55,13 +55,27 @@ auth-source-pass-port-separator :type 'string :version "27.1") +(defcustom auth-source-pass-extra-query-keywords nil + "Whether to consider additional keywords when performing a query. +Specifically, when the value is t, recognize the `:max' and +`:require' keywords and accept lists of query parameters for +certain keywords, such as `:host' and `:user'. Also, wrap all +returned secrets in a function and forgo any further results +filtering unless given an applicable `:require' argument. When +this option is nil, do none of that, and enact the narrowing +behavior described toward the bottom of the Info node `(auth) The +Unix password store'." + :type 'boolean + :version "29.1") + (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 +84,8 @@ auth-source-pass-search ((null host) ;; Do not build a result, as none will match when HOST is nil nil) + (auth-source-pass-extra-query-keywords + (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 +105,39 @@ auth-source-pass--build-result (seq-subseq retval 0 -2)) ;; remove password retval)))) +(defvar auth-source-pass--match-regexp nil) + +(defun auth-source-pass--match-regexp (s) + (rx-to-string ; autoloaded + `(: (or bot "/") + (or (: (? (group-n 20 (+ (not (in ?\ ?/ ?@ ,s)))) "@") + (group-n 10 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 30 (+ (not (in ?\ ?/ ,s)))))) + (: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s)))) + (? ,s (group-n 31 (+ (not (in ?\ ?/ ,s))))) + (? "/" (group-n 21 (+ (not (in ?\ ?/ ,s))))))) + eot) + 'no-group)) + +(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* ((auth-source-pass--match-regexp (auth-source-pass--match-regexp + auth-source-pass-port-separator)) + (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)) + (let (out) + (dolist (e rv out) + (when-let* ((s (plist-get e :secret)) ; not captured by closure in 29.1 + (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 +255,68 @@ auth-source-pass--find-match hosts (list hosts)))) +(defun auth-source-pass--retrieve-parsed (seen path port-number-p) + (when (string-match auth-source-pass--match-regexp path) + (puthash path + `( :host ,(or (match-string 10 path) (match-string 11 path)) + ,@(if-let* ((tr (match-string 21 path))) + (list :user tr :suffix t) + (list :user (match-string 20 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))))) + +(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)) + out suffixed suffixedp) + (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))) + (dolist (e entries) + (when-let* + ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed + seen e (integerp port)))) + ((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)) + ;; For now, ignore body-content pairs, if any, + ;; from `auth-source-pass--parse-data'. + (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)))))))))) + (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..a92653b5ac 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -488,6 +488,229 @@ 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-extra-query-keywords--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 (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "x.com" :secret "a"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--wild-port-miss () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("x.com:42" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "x.com" :port 22 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "x.com" :secret "a"))))))) + +;; One of two entries has the requested port, both returned + +(ert-deftest auth-source-pass-extra-query-keywords--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 (plist-get 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-extra-query-keywords--wild-port-hit () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("x.com:42" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "x.com" :port 42 :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((: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-extra-query-keywords--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-extra-query-keywords--wild-port-req-miss () + (let ((auth-source-pass-extra-query-keywords t)) + (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))))) + +;; Specifying a :host without a :user finds a lone entry and does not +;; include extra fields (i.e., :port nil) in the result +;; https://lists.gnu.org/archive/html/emacs-devel/2022-11/msg00130.html + +(ert-deftest auth-source-pass-extra-query-keywords--netrc-akib () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine disroot.org user akib password b +machine z.com password c +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "disroot.org" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "disroot.org" :user "akib" :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--akib () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("akib@disroot.org" (secret . "b")) + ("z.com" (secret . "c"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "disroot.org" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "disroot.org" :user "akib" :secret "b"))))))) + +;; Searches for :host are case-sensitive, and a returned host isn't +;; normalized. + +(ert-deftest auth-source-pass-extra-query-keywords--netrc-host () + (ert-with-temp-file netrc-file + :text "\ +machine libera.chat password a +machine Libera.Chat password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "Libera.Chat" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "Libera.Chat" :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--host () + (auth-source-pass--with-store '(("libera.chat" (secret . "a")) + ("Libera.Chat" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "Libera.Chat" :max 2))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "Libera.Chat" :secret "b"))))))) + + +;; A retrieved store entry mustn't be nil regardless of whether its +;; path contains port or user components + +(ert-deftest auth-source-pass-extra-query-keywords--baseline () + (let ((auth-source-pass-extra-query-keywords t)) + (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-extra-query-keywords--port-type () + (let ((auth-source-pass-extra-query-keywords t) + (f (lambda (r) (setf (plist-get r :secret) (auth-info-password r)) r))) + (auth-source-pass--with-store '(("x.com:42" (secret . "a"))) + (auth-source-pass-enable) + (should (equal (mapcar f (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 (mapcar f (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 + +;; Note that all trailing /user forms are demoted for the sake of +;; predictability, and so are quasi-deprecated. This means that, in +;; the following test, /bar is shunted off to limbo, followed by /foo, +;; but they both retain priority over "gnu.org", as noted above. + +(ert-deftest auth-source-pass-extra-query-keywords--hosts-first () + (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) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host '("x.com" "gnu.org") :max 3))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + ;; Notice gnu.org is never considered ^ + '((:host "x.com" :secret "c") + (:host "x.com" :user "bar" :port "42" :secret "a") + (:host "x.com" :user "foo" :secret "e"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--ambiguous-user-host () + (auth-source-pass--with-store '(("foo.com/bar.org" (secret . "a")) + ("foo.com" (secret . "b")) + ("bar.org" (secret . "c")) + ("fake.com" (secret . "d"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "bar.org" :max 3))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "bar.org" :secret "c"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--suffixed-user () + (auth-source-pass--with-store '(("x.com:42/bar" (secret . "a")) + ("bar@x.com" (secret . "b")) + ("x.com" (secret . "?")) + ("bar@y.org" (secret . "c")) + ("fake.com" (secret . "?")) + ("fake.com/bar" (secret . "d")) + ("y.org/bar" (secret . "?")) + ("bar@fake.com" (secret . "e"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host '("x.com" "fake.com" "y.org") + :user "bar" + :require '(:user) :max 5))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "x.com" :user "bar" :secret "b") + (:host "x.com" :user "bar" :port "42" :secret "a") + (:host "fake.com" :user "bar" :secret "e") + (:host "fake.com" :user "bar" :secret "d") + (:host "y.org" :user "bar" :secret "c"))))))) + (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 #4: 0002-POC-Support-auth-source-pass-in-ERC.patch --] [-- Type: text/x-patch, Size: 9503 bytes --] From 7a6ee6960ded65dfdec768b094eca8d1883a8f4d 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. Bug#58985. --- doc/misc/erc.texi | 3 +- lisp/erc/erc-compat.el | 104 ++++++++++++++++++++++++++++ lisp/erc/erc.el | 7 +- test/lisp/erc/erc-services-tests.el | 3 - 4 files changed, 112 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 @@ 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 03bd8f1352..51bf251026 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 @@ -168,6 +170,108 @@ erc-compat--with-memoization `(cl--generic-with-memoization ,table ,@forms)) (t `(progn ,@forms)))) +;;;; 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)) + +;; This basically hard codes `auth-source-pass-port-separator' to ":" +(defun erc-compat--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--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--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--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 6b14cf87e2..3769e73041 100644 --- a/lisp/erc/erc.el +++ b/lisp/erc/erc.el @@ -3225,7 +3225,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 c22d4cf75e..7ff2e36e77 100644 --- a/test/lisp/erc/erc-services-tests.el +++ b/test/lisp/erc/erc-services-tests.el @@ -474,7 +474,6 @@ erc-join-tests--auth-source-pass-entries ("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--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)) @@ -500,7 +498,6 @@ 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" (secret . "spam")) -- 2.38.1 ^ permalink raw reply related [flat|nested] 39+ messages in thread
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends 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> 0 siblings, 2 replies; 39+ messages in thread From: Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2022-11-14 17:49 UTC (permalink / raw) To: J.P.; +Cc: Damien Cassou, Björn Bidar, emacs-erc, Michael Albinus, 58985 [-- Attachment #1: Type: text/plain, Size: 2516 bytes --] "J.P." <jp@neverwas.me> writes: > Akib Azmain Turja <akib@disroot.org> writes: > >> "J.P." <jp@neverwas.me> writes: >> >>> You mentioned previously some potentially surprising ambiguities >>> surrounding the trailing /user syntax. If any realistic scenarios >>> present themselves, perhaps we can try to improve the situation if it's >>> not too far out of scope (or just document the behavior, maybe in a unit >>> test). Thanks again. >> >> I think it's good enough to install on master. Then more people can >> test and report about it. >> >> However, observed some behavior of the new code, here are my findings: >> >> The new searching code seems to prefer "HOST/USER" over "USER@HOST". > > That's the effect, right. I think `directory-files-recursively' > basically determines the ordering in which the entries are considered. > >> I created the password store entry "foo.com/bar.org". Then I evaluated: >> (warning: manually typed with hands) >> >> (auth-source-search :host "bar.org") >> ;; => nil >> >> (auth-source-search :host "foo.com") >> ;; => ((:host "foo.com" :user "bar.org" :secret ...)) >> >> I created another entry "bar.org@foo.com". But it returns the password >> in "foo.com/bar.org". >> >> I deleted "foo.com/bar.org", now it return the password of >> "bar.org@foo.com". >> >> I created "foo.com/bar.org" again, and "foo.com/bar.org" is preferred >> again. >> >> I suggest to prefer the "@" syntax over "/user" syntax. > > I have tried tweaking things in that direction. But as far as > deprecating the /user form officially: that seems more like a group > decision. And then there's the question of how to express such a policy. > Should we emit a warning? At the very least, it would need to be > documented somewhere. No, I didn't say to deprecate that syntax, the syntax makes much sense. I'm suggesting to return "USER@HOST" if both "USER@HOST" and "HOST/USER" are present, because the former makes more sense. > > Anyway, this is useful analysis. Thanks again for all your help. > > > > When are you going to install this? It's definitely an improvement over the one in master, and doesn't have any problems to block it. Installing it will also expose it to more users to the change, so this will get even more testing. -- Akib Azmain Turja, GPG key: 70018CE5819F17A3BBA666AFE74F0EFA922AE7F5 Fediverse: akib@hostux.social Codeberg: akib emailselfdefense.fsf.org | "Nothing can be secure without encryption." [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 832 bytes --] ^ permalink raw reply [flat|nested] 39+ messages in thread
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends 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> 1 sibling, 0 replies; 39+ messages in thread From: J.P. @ 2022-11-15 3:32 UTC (permalink / raw) To: Akib Azmain Turja Cc: Damien Cassou, Björn Bidar, emacs-erc, Michael Albinus, 58985 Akib Azmain Turja <akib@disroot.org> writes: >>> I suggest to prefer the "@" syntax over "/user" syntax. >> >> I have tried tweaking things in that direction. But as far as >> deprecating the /user form officially: that seems more like a group >> decision. And then there's the question of how to express such a policy. >> Should we emit a warning? At the very least, it would need to be >> documented somewhere. > > No, I didn't say to deprecate that syntax, the syntax makes much sense. Oh, well then pardon my inferring that. But without deprecation, we'd need to somehow "encode" the @-wins behavior into the interface with documentation and tests, which is usually more complex than it first appears. Otherwise, we can just treat @ favoritism as an implementation detail not subject to preservation come some future rewrite or major overhaul. As things stand, this patch mostly takes the latter approach (tests aside). > I'm suggesting to return "USER@HOST" if both "USER@HOST" and "HOST/USER" > are present, because the former makes more sense. Right, I guess you didn't bother trying out the latest changes attached to my previous email, which is fine. The thing I'd like to stress here (mainly for posterity) is that the degree to which we demote/defer candidates of the / form is deliberate. The way I have things now gives search order primacy over @-vs-/ contention, meaning a search tree like h g / @ / @ 1 2 1 2 1 2 1 2 and params like :host '("h" "g") :port 2 :max 5 gives @h:2, h:2/, @g:2, g:2/ whereas full demotion (not implemented) would yield @h:2, @g:2, h:2/, g:2/ IOW, if you omit the :port 2 part, you currently get @h:1, @h:2, h:1/, h:2/, @g:1 which is likewise expected. Basically, the current search strategy adheres more closely to how the other back ends operate and is thus preferred. >> Anyway, this is useful analysis. Thanks again for all your help. > > When are you going to install this? It's definitely an improvement over > the one in master, and doesn't have any problems to block it. > Installing it will also expose it to more users to the change, so this > will get even more testing. I am willing to install this but am not really comfortable enabling it by default unless the maintainers of the downstream packages (Cc. Björn) can promise to report any problems while Emacs 29.1 is still unreleased. Without such a pledge, I'm inclined to just leave it disabled. Thanks. ^ permalink raw reply [flat|nested] 39+ messages in thread
[parent not found: <87a64s99ka.fsf@neverwas.me>]
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [not found] ` <87a64s99ka.fsf@neverwas.me> @ 2022-11-18 14:14 ` J.P. 2022-11-18 23:25 ` Kai Tetzlaff [not found] ` <87bkp4z6xg.fsf@neverwas.me> 1 sibling, 1 reply; 39+ messages in thread From: J.P. @ 2022-11-18 14:14 UTC (permalink / raw) To: 58985-done Cc: Damien Cassou, Björn Bidar, emacs-erc, Michael Albinus, Akib Azmain Turja "J.P." <jp@neverwas.me> writes: >> When are you going to install this? It's definitely an improvement over >> the one in master, and doesn't have any problems to block it. >> Installing it will also expose it to more users to the change, so this >> will get even more testing. > > I am willing to install this but am not really comfortable enabling it > by default unless the maintainers of the downstream packages (Cc. Björn) > can promise to report any problems while Emacs 29.1 is still unreleased. > Without such a pledge, I'm inclined to just leave it disabled. Thanks. Because I am easily swayed (or maybe just a liar), I've gone ahead and enabled it by default [1]. I've also informed Nicolas Petton of the change. I guess Björn was too busy or annoyed by my pestering to keep up, which is understandable. Thanks, everyone, for your help with this (especially Akib, who I pray will consider contributing to ERC in the future). And please remember to complain if you encounter any related ugliness. In the meantime, I am closing this bug. [1] https://git.savannah.gnu.org/cgit/emacs.git/commit/?id=2cf9e699 ^ permalink raw reply [flat|nested] 39+ messages in thread
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends 2022-11-18 14:14 ` J.P. @ 2022-11-18 23:25 ` Kai Tetzlaff 2022-11-19 0:35 ` J.P. 0 siblings, 1 reply; 39+ messages in thread From: Kai Tetzlaff @ 2022-11-18 23:25 UTC (permalink / raw) To: 58985; +Cc: jp This change breaks my use of `auth-source-pass' in gnus. I haven't had time to investigate the issue but what I can already say is that the problem occurs independent of the value of `auth-source-pass-extra-query-keywords' (`t' or `nil'). So the change is not backward compatible. It would (at least) be nice to mention this in the NEWS entry. ^ permalink raw reply [flat|nested] 39+ messages in thread
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends 2022-11-18 23:25 ` Kai Tetzlaff @ 2022-11-19 0:35 ` J.P. 2022-11-19 1:02 ` Kai Tetzlaff 0 siblings, 1 reply; 39+ messages in thread From: J.P. @ 2022-11-19 0:35 UTC (permalink / raw) To: Kai Tetzlaff; +Cc: 58985 Hi Kai, Kai Tetzlaff <emacs+bug@tetzco.de> writes: > This change breaks my use of `auth-source-pass' in gnus. Thanks a lot for reporting this. And sorry about the breakage. > I haven't had time to investigate the issue but what I can already say > is that the problem occurs independent of the value of > `auth-source-pass-extra-query-keywords' (`t' or `nil'). So the > change is not backward compatible. It would (at least) be nice to > mention this in the NEWS entry. I'd rather not settle for "at least" if we can help it. If the user option doesn't preserve existing behavior, that's a bug that needs fixing. The traditional and new code paths diverge in `auth-source-pass-search', so without a backtrace, we should start there. (Obviously, a full backtrace would be ideal, but I understand completely if you're not willing to surrender one.) First off, can you try reverting the changes to that function alone? Just eval'ing a modified version in place, without the extra `cond' clause and the two keywords, :max and :require, should do it. If that doesn't tell us anything (and only if you're up for it) you could trace the function and tell me what the inputs were (obviously after swapping out any sensitive info). A mini example of your ~/.password-store layout might also be helpful. According to etc/AUTHORS, you're likely much better acquainted with Emacs than I (2009!). So, please adjust the above recommendations accordingly and, if possible, apply some of that experience to helping fix this bug. And apologies again for the disruption. Thanks, J.P. ^ permalink raw reply [flat|nested] 39+ messages in thread
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends 2022-11-19 0:35 ` J.P. @ 2022-11-19 1:02 ` Kai Tetzlaff 2022-11-19 3:39 ` J.P. 2022-11-19 14:59 ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors 0 siblings, 2 replies; 39+ messages in thread From: Kai Tetzlaff @ 2022-11-19 1:02 UTC (permalink / raw) To: J.P.; +Cc: 58985 "J.P." <jp@neverwas.me> writes: Thanks for the quick reply. >> I haven't had time to investigate the issue but what I can already say >> is that the problem occurs independent of the value of >> `auth-source-pass-extra-query-keywords' (`t' or `nil'). So the >> change is not backward compatible. It would (at least) be nice to >> mention this in the NEWS entry. > > I'd rather not settle for "at least" if we can help it. If the user > option doesn't preserve existing behavior, that's a bug that needs > fixing. I've done some further checks and now it seems that setting `auth-source-pass-extra-query-keywords' to `nil' in a new emacs session does indeed fix the issue (maybe `auth-source' caching of the negative lookup caused my initial breakage to persist even after changing `auth-source-pass-extra-query-keywords'). The lookup which fails with the new code is for the following parameters: auth-source-search: found 0 results (max 1) matching (:max 1 :host ("news6.open-news-network.org" "onn6") :port ("119" "nntp" "nntp" "563" "nntps" "snews")) My password store contains an entry for 'nntp/open-news-network.org'. I don't use the full hostname since the open news network has multiple servers (news1/2/3/4...) with the same domain name. Right now I don't have time for a more detailed analysis. But I will (hopefully) get back to it during the weekend. ^ permalink raw reply [flat|nested] 39+ messages in thread
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends 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 1 sibling, 1 reply; 39+ messages in thread From: J.P. @ 2022-11-19 3:39 UTC (permalink / raw) To: Kai Tetzlaff; +Cc: 58985 [-- Attachment #1: Type: text/plain, Size: 1678 bytes --] Kai Tetzlaff <emacs+bug@tetzco.de> writes: > I've done some further checks and now it seems that setting > `auth-source-pass-extra-query-keywords' to `nil' in a new emacs session > does indeed fix the issue (maybe `auth-source' caching of the negative > lookup caused my initial breakage to persist even after changing > `auth-source-pass-extra-query-keywords'). Ah, right, the cache (gets me every time). BTW, it's probably still worth mentioning the incompatibility in NEWS and the docs. > The lookup which fails with the new code is for the following > parameters: > > auth-source-search: found 0 results (max 1) matching > (:max 1 > :host ("news6.open-news-network.org" "onn6") > :port ("119" "nntp" "nntp" "563" "nntps" "snews")) > > My password store contains an entry for 'nntp/open-news-network.org'. I > don't use the full hostname since the open news network has multiple > servers (news1/2/3/4...) with the same domain name. > > Right now I don't have time for a more detailed analysis. But I will > (hopefully) get back to it during the weekend. Wow, thanks, this is really helpful. Based on that, I'm pretty sure what's going on. Basically, the new behavior is geared toward blindly replicating that of the other back ends, warts and all. But that means some handy pass-specific features, like subdomain matching, are notably absent. I've attached a demo patch that better illustrates this. My main question for you is: do you think we ought to change the default for `auth-source-pass-extra-query-keywords' to nil? What about additionally demoting it from an option to a public variable intended solely for use by dependent libraries instead of end users? [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-POC-Allow-subdomain-matching-in-auth-source-pass-fin.patch --] [-- Type: text/x-patch, Size: 8695 bytes --] From 22f0e5001fe42d095285c27ec903bd074fdb0d57 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Fri, 18 Nov 2022 19:14:30 -0800 Subject: [PATCH] [POC] Allow subdomain matching in auth-source-pass--find-match-many * doc/misc/auth.texi: Mention incompatible domain-matching behavior in `auth-source-pass-extra-query-keywords' section. * etc/NEWS: Mention incompatible behavior in `auth-source-pass-extra-query-keywords' section. * lisp/auth-source-pass.el (auth-source-pass-extra-query-keywords): Mention lack of subdomain matching in doc string. (auth-source-pass--match-host, auth-source-pass--match-host-function): Add alternate subdomain matching function and internal variable to demo backwards compatibility. The latter could be made non-internal and offered as an opt-in for third-party libraries. (auth-source-pass--find-match-many): Call `auth-source-pass--match-host-function' to handle host matching. * test/lisp/auth-source-pass-tests.el: FIXME Add ephemeral tests. --- doc/misc/auth.texi | 11 ++--- etc/NEWS | 3 +- lisp/auth-source-pass.el | 17 ++++++-- test/lisp/auth-source-pass-tests.el | 68 +++++++++++++++++++++++++++++ 4 files changed, 90 insertions(+), 9 deletions(-) diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 872e5f88f5..cd8efd8607 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -560,11 +560,12 @@ The Unix password store param was provided. In general, if you prefer idiosyncrasies traditionally exhibited by -this backend, such as prioritizing field count in a filename, try -setting this option to @code{nil}. But, if you experience problems -predicting the outcome of searches relative to other auth-source -backends or encounter code expecting to query multiple backends -uniformly, try flipping it back to @code{t} (the default). +this backend, such as prioritizing field count in a filename or +matching against subdomain labels, try setting this option to +@code{nil}. But, if you experience problems predicting the outcome of +searches relative to other auth-source backends or encounter code +expecting to query multiple backends uniformly, try flipping it back +to @code{t} (the default). @end defvar @node Help for developers diff --git a/etc/NEWS b/etc/NEWS index 8a34afe8d2..73c848c033 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1407,7 +1407,8 @@ database stored on disk. *** New user option 'auth-source-pass-extra-query-keywords'. Whether to recognize additional keyword params, like ':max' and ':require', as well as accept lists of query terms paired with -applicable keywords. +applicable keywords. This disables most known search behavior unique +to auth-source-pass, such as wildcard subdomain matching. ** Dired diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index dc274843e1..d0b7acb931 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -59,8 +59,9 @@ auth-source-pass-extra-query-keywords "Whether to consider additional keywords when performing a query. Specifically, when the value is t, recognize the `:max' and `:require' keywords and accept lists of query parameters for -certain keywords, such as `:host' and `:user'. Also, wrap all -returned secrets in a function and forgo any further results +certain keywords, such as `:host' and `:user'. Beyond that, wrap +all returned secrets in a function and don't bother considering +subdomains when matching hosts. Also, forgo any further results filtering unless given an applicable `:require' argument. When this option is nil, do none of that, and enact the narrowing behavior described toward the bottom of the Info node `(auth) The @@ -276,6 +277,15 @@ auth-source-pass--match-parts (and value (equal mv value)) (or (not value) (not mv) (equal mv value))))) +(defun auth-source-pass--match-host (search-param matched-path) + (pcase search-param + ((rx "." (+ (not ".")) "." (>= 2 alpha) eot) + (string-suffix-p matched-path search-param)) + (_ (equal matched-path search-param)))) + +(defvar auth-source-pass--match-host-function #'equal + "An escape hatch for alternate host-matching behavior.") + (defun auth-source-pass--find-match-many (hosts users ports require max) "Return plists for valid combinations of HOSTS, USERS, PORTS." (let ((seen (make-hash-table :test #'equal)) @@ -292,7 +302,8 @@ auth-source-pass--find-match-many (when-let* ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed seen e (integerp port)))) - ((equal host (plist-get m :host))) + ((funcall auth-source-pass--match-host-function + 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)) diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 8bcb2739bb..dd694c72f6 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -751,6 +751,74 @@ auth-source-pass-extra-query-keywords--user-priorities (:host "g" :user "u" :port 2 :secret "@") ; ** (:host "g" :user "u" :port 2 :secret "/")))))))) +;; Kai demo (delete) + +;; The netrc backend is does not consider subdomains + +(ert-deftest auth-source-pass-extra-query-keywords--subdomain-miss-netrc () + (ert-with-temp-file netrc-file + :text "\ +machine open-news-network.org password a +machine onn6 port nope password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search + :max 1 + :host '("news6.open-news-network.org" "onn6") + :port '("119" "nntp" "nntp" "563" "nntps" "snews")))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should-not results)))) + +;; And neither do we, when `auth-source-pass-extra-query-keywords' is t + +(ert-deftest auth-source-pass-extra-query-keywords--subdomain-miss () + (auth-source-pass--with-store '(("open-news-network.org" (secret . "a")) + ("onn6:nope" (secret . "b"))) + (auth-source-pass-enable) + (let ((auth-source-pass-extra-query-keywords t)) + (should-not (auth-source-search + :max 1 + :host '("news6.open-news-network.org" "onn6") + :port '("119" "nntp" "nntp" "563" "nntps" "snews")))))) + +;; But we could offer optional legacy matching behavior + +(ert-deftest auth-source-pass-extra-query-keywords--subdomain-compat-hit () + (auth-source-pass--with-store '(("open-news-network.org" (secret . "a")) + ("onn6:nope" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (auth-source-pass--match-host-function #'auth-source-pass--match-host) + (results (auth-source-search + :max 1 + :host '("news6.open-news-network.org" "onn6") + :port '("119" "nntp" "nntp" "563" "nntps" "snews")))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "news6.open-news-network.org" :secret "a"))))))) + +;; Traditional behavior when `auth-source-pass-extra-query-keywords' is nil + +(ert-deftest auth-source-pass-extra-query-keywords--nil--subdomain-hit () + (auth-source-pass--with-store '(("open-news-network.org" (secret . "a")) + ("onn6:nope" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords nil) + (results (auth-source-search + :max 1 + :host '("news6.open-news-network.org" "onn6") + :port '("119" "nntp" "nntp" "563" "nntps" "snews")))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '(( :host "news6.open-news-network.org" + :port ("119" "nntp" "nntp" "563" "nntps" "snews") + :user nil + :secret "a"))))))) + (provide 'auth-source-pass-tests) ;;; auth-source-pass-tests.el ends here -- 2.38.1 ^ permalink raw reply related [flat|nested] 39+ messages in thread
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends 2022-11-19 3:39 ` J.P. @ 2022-11-19 4:08 ` J.P. 0 siblings, 0 replies; 39+ messages in thread From: J.P. @ 2022-11-19 4:08 UTC (permalink / raw) To: Kai Tetzlaff; +Cc: 58985 [-- Attachment #1: Type: text/plain, Size: 231 bytes --] This is probably a(nother) bad idea, but what about making `auth-source-pass-extra-query-keywords' a "tristate" option with a third, hybrid value, like `match-domains', that acts like `t' except with subdomain matching turned on? [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0000-v1-v2.diff --] [-- Type: text/x-patch, Size: 3874 bytes --] From 89ec2fd5ba7d3d276cb18d1d256080aff9f2ab77 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Fri, 18 Nov 2022 19:59:11 -0800 Subject: [PATCH 0/1] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (1): [POC] Allow subdomain matching in auth-source-pass--find-match-many doc/misc/auth.texi | 11 ++--- etc/NEWS | 3 +- lisp/auth-source-pass.el | 20 ++++++--- test/lisp/auth-source-pass-tests.el | 67 +++++++++++++++++++++++++++++ 4 files changed, 90 insertions(+), 11 deletions(-) Interdiff: diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index d0b7acb931..2501a1ca85 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -65,8 +65,10 @@ auth-source-pass-extra-query-keywords filtering unless given an applicable `:require' argument. When this option is nil, do none of that, and enact the narrowing behavior described toward the bottom of the Info node `(auth) The -Unix password store'." - :type 'boolean +Unix password store'. With a value of `match-domains', this +option behaves as it does when set to t except that subdomain +matching is enabled." + :type '(choice (const nil) (const t) (const match-domains)) :version "29.1") (cl-defun auth-source-pass-search (&rest spec @@ -278,13 +280,11 @@ auth-source-pass--match-parts (or (not value) (not mv) (equal mv value))))) (defun auth-source-pass--match-host (search-param matched-path) - (pcase search-param - ((rx "." (+ (not ".")) "." (>= 2 alpha) eot) - (string-suffix-p matched-path search-param)) - (_ (equal matched-path search-param)))) - -(defvar auth-source-pass--match-host-function #'equal - "An escape hatch for alternate host-matching behavior.") + (if (and (eq auth-source-pass-extra-query-keywords 'match-domains) + (string-match (rx "." (+ (not ".")) "." (>= 2 alpha) eot) + search-param)) + (string-suffix-p matched-path search-param) + (equal matched-path search-param))) (defun auth-source-pass--find-match-many (hosts users ports require max) "Return plists for valid combinations of HOSTS, USERS, PORTS." @@ -302,8 +302,7 @@ auth-source-pass--find-match-many (when-let* ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed seen e (integerp port)))) - ((funcall auth-source-pass--match-host-function - host (plist-get m :host))) + ((auth-source-pass--match-host 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)) diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index dd694c72f6..cca203d790 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -785,12 +785,11 @@ auth-source-pass-extra-query-keywords--subdomain-miss ;; But we could offer optional legacy matching behavior -(ert-deftest auth-source-pass-extra-query-keywords--subdomain-compat-hit () +(ert-deftest auth-source-pass-extra-query-keywords--match-domains () (auth-source-pass--with-store '(("open-news-network.org" (secret . "a")) ("onn6:nope" (secret . "b"))) (auth-source-pass-enable) - (let* ((auth-source-pass-extra-query-keywords t) - (auth-source-pass--match-host-function #'auth-source-pass--match-host) + (let* ((auth-source-pass-extra-query-keywords 'match-domains) (results (auth-source-search :max 1 :host '("news6.open-news-network.org" "onn6") -- 2.38.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0001-POC-Allow-subdomain-matching-in-auth-source-pass-fin.patch --] [-- Type: text/x-patch, Size: 8725 bytes --] From 89ec2fd5ba7d3d276cb18d1d256080aff9f2ab77 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Fri, 18 Nov 2022 19:14:30 -0800 Subject: [PATCH 1/1] [POC] Allow subdomain matching in auth-source-pass--find-match-many * doc/misc/auth.texi: Mention incompatible domain-matching behavior in `auth-source-pass-extra-query-keywords' section. * etc/NEWS: Mention incompatible behavior in `auth-source-pass-extra-query-keywords' section. * lisp/auth-source-pass.el (auth-source-pass-extra-query-keywords): Mention lack of subdomain matching in doc string. (auth-source-pass--match-host): Add function to optionally regain traditional subdomain matching behavior. (auth-source-pass--find-match-many): Call `auth-source-pass--match-host' to handle host matching. * test/lisp/auth-source-pass-tests.el: FIXME Add ephemeral tests. --- doc/misc/auth.texi | 11 ++--- etc/NEWS | 3 +- lisp/auth-source-pass.el | 20 ++++++--- test/lisp/auth-source-pass-tests.el | 67 +++++++++++++++++++++++++++++ 4 files changed, 90 insertions(+), 11 deletions(-) diff --git a/doc/misc/auth.texi b/doc/misc/auth.texi index 872e5f88f5..cd8efd8607 100644 --- a/doc/misc/auth.texi +++ b/doc/misc/auth.texi @@ -560,11 +560,12 @@ The Unix password store param was provided. In general, if you prefer idiosyncrasies traditionally exhibited by -this backend, such as prioritizing field count in a filename, try -setting this option to @code{nil}. But, if you experience problems -predicting the outcome of searches relative to other auth-source -backends or encounter code expecting to query multiple backends -uniformly, try flipping it back to @code{t} (the default). +this backend, such as prioritizing field count in a filename or +matching against subdomain labels, try setting this option to +@code{nil}. But, if you experience problems predicting the outcome of +searches relative to other auth-source backends or encounter code +expecting to query multiple backends uniformly, try flipping it back +to @code{t} (the default). @end defvar @node Help for developers diff --git a/etc/NEWS b/etc/NEWS index 8a34afe8d2..73c848c033 100644 --- a/etc/NEWS +++ b/etc/NEWS @@ -1407,7 +1407,8 @@ database stored on disk. *** New user option 'auth-source-pass-extra-query-keywords'. Whether to recognize additional keyword params, like ':max' and ':require', as well as accept lists of query terms paired with -applicable keywords. +applicable keywords. This disables most known search behavior unique +to auth-source-pass, such as wildcard subdomain matching. ** Dired diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index dc274843e1..2501a1ca85 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -59,13 +59,16 @@ auth-source-pass-extra-query-keywords "Whether to consider additional keywords when performing a query. Specifically, when the value is t, recognize the `:max' and `:require' keywords and accept lists of query parameters for -certain keywords, such as `:host' and `:user'. Also, wrap all -returned secrets in a function and forgo any further results +certain keywords, such as `:host' and `:user'. Beyond that, wrap +all returned secrets in a function and don't bother considering +subdomains when matching hosts. Also, forgo any further results filtering unless given an applicable `:require' argument. When this option is nil, do none of that, and enact the narrowing behavior described toward the bottom of the Info node `(auth) The -Unix password store'." - :type 'boolean +Unix password store'. With a value of `match-domains', this +option behaves as it does when set to t except that subdomain +matching is enabled." + :type '(choice (const nil) (const t) (const match-domains)) :version "29.1") (cl-defun auth-source-pass-search (&rest spec @@ -276,6 +279,13 @@ auth-source-pass--match-parts (and value (equal mv value)) (or (not value) (not mv) (equal mv value))))) +(defun auth-source-pass--match-host (search-param matched-path) + (if (and (eq auth-source-pass-extra-query-keywords 'match-domains) + (string-match (rx "." (+ (not ".")) "." (>= 2 alpha) eot) + search-param)) + (string-suffix-p matched-path search-param) + (equal matched-path search-param))) + (defun auth-source-pass--find-match-many (hosts users ports require max) "Return plists for valid combinations of HOSTS, USERS, PORTS." (let ((seen (make-hash-table :test #'equal)) @@ -292,7 +302,7 @@ auth-source-pass--find-match-many (when-let* ((m (or (gethash e seen) (auth-source-pass--retrieve-parsed seen e (integerp port)))) - ((equal host (plist-get m :host))) + ((auth-source-pass--match-host 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)) diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 8bcb2739bb..cca203d790 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -751,6 +751,73 @@ auth-source-pass-extra-query-keywords--user-priorities (:host "g" :user "u" :port 2 :secret "@") ; ** (:host "g" :user "u" :port 2 :secret "/")))))))) +;; Kai demo (delete) + +;; The netrc backend is does not consider subdomains + +(ert-deftest auth-source-pass-extra-query-keywords--subdomain-miss-netrc () + (ert-with-temp-file netrc-file + :text "\ +machine open-news-network.org password a +machine onn6 port nope password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search + :max 1 + :host '("news6.open-news-network.org" "onn6") + :port '("119" "nntp" "nntp" "563" "nntps" "snews")))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should-not results)))) + +;; And neither do we, when `auth-source-pass-extra-query-keywords' is t + +(ert-deftest auth-source-pass-extra-query-keywords--subdomain-miss () + (auth-source-pass--with-store '(("open-news-network.org" (secret . "a")) + ("onn6:nope" (secret . "b"))) + (auth-source-pass-enable) + (let ((auth-source-pass-extra-query-keywords t)) + (should-not (auth-source-search + :max 1 + :host '("news6.open-news-network.org" "onn6") + :port '("119" "nntp" "nntp" "563" "nntps" "snews")))))) + +;; But we could offer optional legacy matching behavior + +(ert-deftest auth-source-pass-extra-query-keywords--match-domains () + (auth-source-pass--with-store '(("open-news-network.org" (secret . "a")) + ("onn6:nope" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords 'match-domains) + (results (auth-source-search + :max 1 + :host '("news6.open-news-network.org" "onn6") + :port '("119" "nntp" "nntp" "563" "nntps" "snews")))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '((:host "news6.open-news-network.org" :secret "a"))))))) + +;; Traditional behavior when `auth-source-pass-extra-query-keywords' is nil + +(ert-deftest auth-source-pass-extra-query-keywords--nil--subdomain-hit () + (auth-source-pass--with-store '(("open-news-network.org" (secret . "a")) + ("onn6:nope" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords nil) + (results (auth-source-search + :max 1 + :host '("news6.open-news-network.org" "onn6") + :port '("119" "nntp" "nntp" "563" "nntps" "snews")))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '(( :host "news6.open-news-network.org" + :port ("119" "nntp" "nntp" "563" "nntps" "snews") + :user nil + :secret "a"))))))) + (provide 'auth-source-pass-tests) ;;; auth-source-pass-tests.el ends here -- 2.38.1 ^ permalink raw reply related [flat|nested] 39+ messages in thread
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends 2022-11-19 1:02 ` Kai Tetzlaff 2022-11-19 3:39 ` J.P. @ 2022-11-19 14:59 ` Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors 1 sibling, 0 replies; 39+ messages in thread From: Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2022-11-19 14:59 UTC (permalink / raw) To: Kai Tetzlaff; +Cc: 58985, J.P. [-- Attachment #1: Type: text/plain, Size: 1866 bytes --] Kai Tetzlaff <emacs+bug@tetzco.de> writes: > "J.P." <jp@neverwas.me> writes: > > Thanks for the quick reply. > >>> I haven't had time to investigate the issue but what I can already say >>> is that the problem occurs independent of the value of >>> `auth-source-pass-extra-query-keywords' (`t' or `nil'). So the >>> change is not backward compatible. It would (at least) be nice to >>> mention this in the NEWS entry. >> >> I'd rather not settle for "at least" if we can help it. If the user >> option doesn't preserve existing behavior, that's a bug that needs >> fixing. > > I've done some further checks and now it seems that setting > `auth-source-pass-extra-query-keywords' to `nil' in a new emacs session > does indeed fix the issue (maybe `auth-source' caching of the negative > lookup caused my initial breakage to persist even after changing > `auth-source-pass-extra-query-keywords'). Probably because auth-source was caching the result. Either set auth-source-do-cache to nil, or do M-x auth-source-forget-all-cached to clear cache. > > The lookup which fails with the new code is for the following > parameters: > > auth-source-search: found 0 results (max 1) matching > (:max 1 > :host ("news6.open-news-network.org" "onn6") > :port ("119" "nntp" "nntp" "563" "nntps" "snews")) > > My password store contains an entry for 'nntp/open-news-network.org'. I > don't use the full hostname since the open news network has multiple > servers (news1/2/3/4...) with the same domain name. > > Right now I don't have time for a more detailed analysis. But I will > (hopefully) get back to it during the weekend. > > > -- Akib Azmain Turja, GPG key: 70018CE5819F17A3BBA666AFE74F0EFA922AE7F5 Fediverse: akib@hostux.social Codeberg: akib emailselfdefense.fsf.org | "Nothing can be secure without encryption." [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 832 bytes --] ^ permalink raw reply [flat|nested] 39+ messages in thread
[parent not found: <87bkp4z6xg.fsf@neverwas.me>]
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [not found] ` <87bkp4z6xg.fsf@neverwas.me> @ 2022-12-07 14:30 ` J.P. 0 siblings, 0 replies; 39+ messages in thread From: J.P. @ 2022-12-07 14:30 UTC (permalink / raw) To: 58985-done Cc: Damien Cassou, Björn Bidar, emacs-erc, Michael Albinus, Akib Azmain Turja [-- Attachment #1: Type: text/plain, Size: 1211 bytes --] "J.P." <jp@neverwas.me> writes: > Because I am easily swayed (or maybe just a liar), I've gone ahead and > enabled it by default [1]. I've also informed Nicolas Petton of the > change. I guess Björn was too busy or annoyed by my pestering to keep > up, which is understandable. > > Thanks, everyone, for your help with this (especially Akib, who I pray > will consider contributing to ERC in the future). And please remember to > complain if you encounter any related ugliness. In the meantime, I am > closing this bug. A couple updates for anyone who cares: 1. As you may have noticed, due to various complaints here on the tracker, the new option `auth-source-pass-extra-query-keywords' is now disabled by default. 2. The changes currently installed contain a bug involving spaces in file names. Basically, all other back ends allow spaces in an entry's user and host fields. The second (throwaway) patch below demonstrates this, and the first attempts to make things right. In my mind, item #2 is a bug that needs fixing on the release branch, and I plan on doing so in the coming days. If there are questions or concerns, please let them be known. Thanks. [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #2: 0001-Allow-spaces-in-auth-source-pass-match-regexp.patch --] [-- Type: text/x-patch, Size: 6905 bytes --] From 85f00ef178b59573f91f0389f67c69585742a6e2 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Thu, 24 Nov 2022 21:03:03 -0800 Subject: [PATCH 1/2] Allow spaces in auth-source-pass--match-regexp * lisp/auth-source-pass.el (auth-source-pass--match-regexp): Allow spaces in host and user components because all other backends do. * lisp/erc/erc-compat.el (erc-compat--29-auth-source-pass--retrieve-parsed): Allow spaces in host and user components in auth-source-pass regexp. * test/lisp/auth-source-pass-tests.el (auth-source-pass-any-host): Silence warning message re wildcards from `auth-source-pass-search'. (auth-source-pass-extra-query-keywords--suffixed-user): Add spaces to users and hosts of some entries. (Bug#58985.) --- lisp/auth-source-pass.el | 12 +++++------ lisp/erc/erc-compat.el | 8 ++++---- test/lisp/auth-source-pass-tests.el | 31 +++++++++++++++-------------- 3 files changed, 26 insertions(+), 25 deletions(-) diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 74d3808448..3262880c47 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -111,12 +111,12 @@ auth-source-pass--match-regexp (defun auth-source-pass--match-regexp (s) (rx-to-string ; autoloaded `(: (or bot "/") - (or (: (? (group-n 20 (+ (not (in ?\ ?/ ,s)))) "@") - (group-n 10 (+ (not (in ?\ ?/ ?@ ,s)))) - (? ,s (group-n 30 (+ (not (in ?\ ?/ ,s)))))) - (: (group-n 11 (+ (not (in ?\ ?/ ?@ ,s)))) - (? ,s (group-n 31 (+ (not (in ?\ ?/ ,s))))) - (? "/" (group-n 21 (+ (not (in ?\ ?/ ,s))))))) + (or (: (? (group-n 20 (+ (not (in ?/ ,s)))) "@") ; user pfx + (group-n 10 (+ (not (in ?/ ?@ ,s)))) ; host + (? ,s (group-n 30 (+ (not (in ?\s ?/ ,s)))))) ; port + (: (group-n 11 (+ (not (in ?/ ?@ ,s)))) ; host + (? ,s (group-n 31 (+ (not (in ?\s ?/ ,s))))) ; port + (? "/" (group-n 21 (+ (not (in ?/ ,s))))))) ; user sfx eot) 'no-group)) diff --git a/lisp/erc/erc-compat.el b/lisp/erc/erc-compat.el index abbaafcd93..bd93254758 100644 --- a/lisp/erc/erc-compat.el +++ b/lisp/erc/erc-compat.el @@ -176,12 +176,12 @@ 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 " /:@")))) + (or (: (? (group-n 20 (+ (not (in "/:")))) "@") + (group-n 10 (+ (not (in "/:@")))) (? ":" (group-n 30 (+ (not (in " /:")))))) - (: (group-n 11 (+ (not (in " /:@")))) + (: (group-n 11 (+ (not (in "/:@")))) (? ":" (group-n 31 (+ (not (in " /:"))))) - (? "/" (group-n 21 (+ (not (in " /:"))))))) + (? "/" (group-n 21 (+ (not (in "/:"))))))) eot) e) (puthash e `( :host ,(or (match-string 10 e) (match-string 11 e)) diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 1107e09b51..d6d42ce942 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -175,7 +175,8 @@ auth-source-pass-match-any-entry-p (ert-deftest auth-source-pass-any-host () (auth-source-pass--with-store '(("foo" ("port" . "foo-port") ("host" . "foo-user")) ("bar")) - (should-not (auth-source-pass-search :host t)))) + (let ((inhibit-message t)) ; silence "... does not handle host wildcards." + (should-not (auth-source-pass-search :host t))))) (ert-deftest auth-source-pass-undefined-host () (auth-source-pass--with-store '(("foo" ("port" . "foo-port") ("host" . "foo-user")) @@ -697,29 +698,29 @@ auth-source-pass-extra-query-keywords--ambiguous-user-host ;; with slightly more realistic and less legible values. (ert-deftest auth-source-pass-extra-query-keywords--suffixed-user () - (let ((store (sort (copy-sequence '(("x.com:42/b@r" (secret . "a")) - ("b@r@x.com" (secret . "b")) + (let ((store (sort (copy-sequence '(("x.com:42/s p@m" (secret . "a")) + ("s p@m@x.com" (secret . "b")) ("x.com" (secret . "?")) - ("b@r@y.org" (secret . "c")) - ("fake.com" (secret . "?")) - ("fake.com/b@r" (secret . "d")) - ("y.org/b@r" (secret . "?")) - ("b@r@fake.com" (secret . "e")))) + ("s p@m@y.org" (secret . "c")) + ("fa ke" (secret . "?")) + ("fa ke/s p@m" (secret . "d")) + ("y.org/s p@m" (secret . "?")) + ("s p@m@fa ke" (secret . "e")))) (lambda (&rest _) (zerop (random 2)))))) (auth-source-pass--with-store store (auth-source-pass-enable) (let* ((auth-source-pass-extra-query-keywords t) - (results (auth-source-search :host '("x.com" "fake.com" "y.org") - :user "b@r" + (results (auth-source-search :host '("x.com" "fa ke" "y.org") + :user "s p@m" :require '(:user) :max 5))) (dolist (result results) (setf (plist-get result :secret) (auth-info-password result))) (should (equal results - '((:host "x.com" :user "b@r" :secret "b") - (:host "x.com" :user "b@r" :port "42" :secret "a") - (:host "fake.com" :user "b@r" :secret "e") - (:host "fake.com" :user "b@r" :secret "d") - (:host "y.org" :user "b@r" :secret "c")))))))) + '((:host "x.com" :user "s p@m" :secret "b") + (:host "x.com" :user "s p@m" :port "42" :secret "a") + (:host "fa ke" :user "s p@m" :secret "e") + (:host "fa ke" :user "s p@m" :secret "d") + (:host "y.org" :user "s p@m" :secret "c")))))))) ;; This is a more distilled version of `suffixed-user', above. It ;; better illustrates that search order takes precedence over "/user" -- 2.38.1 [-- Warning: decoded text below may be mangled, UTF-8 assumed --] [-- Attachment #3: 0002-POC-Demo-spaces-in-hosts-users-among-auth-source-bac.patch --] [-- Type: text/x-patch, Size: 11651 bytes --] From c379523c177ea0188f8c270585efc6077901479a Mon Sep 17 00:00:00 2001 From: "F. Jason Park" <jp@neverwas.me> Date: Thu, 24 Nov 2022 21:03:03 -0800 Subject: [PATCH 2/2] [POC] Demo spaces in hosts/users among auth-source backends --- test/lisp/auth-source-pass-tests.el | 255 ++++++++++++++++++++++++++++ 1 file changed, 255 insertions(+) diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index d6d42ce942..59a0c1252f 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -752,6 +752,261 @@ auth-source-pass-extra-query-keywords--user-priorities (:host "g" :user "u" :port 2 :secret "@") ; ** (:host "g" :user "u" :port 2 :secret "/")))))))) +;;;; Whitespace demo + +;; These demonstrate that all back ends support spaces in host and +;; user fields. + +;; netrc + +(ert-deftest auth-source-pass-extra-query-keywords--ws-host-netrc () + (ert-with-temp-file netrc-file + :text "\ +machine \"hello world\" password a +machine localhost password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "hello world"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "hello world" :secret "a"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--ws-user-netrc () + (ert-with-temp-file netrc-file + :text "\ +machine localhost login onetwo password a +machine localhost login \"one two\" password b +" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :user "one two"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '(( :host "localhost" + :user "one two" + :secret "b"))))))) + +;; plstore + +(require 'epg) + +(ert-deftest auth-source-pass-extra-query-keywords--ws-host-plstore () + (ert-with-temp-file plstore-file + :suffix ".plist" + :text "\ +;;; public entries -*- mode: plstore -*- +((\"8faf07aac16e46c49857598b6cd6dd809762c5cb\" + :secret-secret t :host \"hello world\") + (\"12d4700ff04a5dbadec60b55319ff3f473d026fa\" + :secret-secret t :host \"localhost\")) +;;; secret entries +((\"8faf07aac16e46c49857598b6cd6dd809762c5cb\" :secret \"a\") + (\"12d4700ff04a5dbadec60b55319ff3f473d026fa\" :secret \"b\")) +" + (cl-letf (((symbol-function 'epg-decrypt-string) + (lambda (&rest r) (prin1-to-string (cadr r)))) + ((symbol-function 'epg-find-configuration) + (lambda (&rest _) '((program . "/bin/true"))))) + (let* ((auth-sources (list plstore-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "hello world"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '(( :login nil + :port nil + :secret "a" + :host "hello world")))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--ws-user-plstore () + (ert-with-temp-file plstore-file + :suffix ".plist" + :text "\ +;;; public entries -*- mode: plstore -*- +((\"8b23ccce4b95bee4b9a8676409a7f196f1adc59e\" + :secret-secret t + :host \"localhost\" + :user \"onetwo\") + (\"e4c4fcb6c505d389ff72a58314571f37fb936365\" + :secret-secret t + :host \"localhost\" + :user \"one two\")) +;;; secret entries +((\"8b23ccce4b95bee4b9a8676409a7f196f1adc59e\" :secret \"a\") + (\"e4c4fcb6c505d389ff72a58314571f37fb936365\" :secret \"b\")) +" + (cl-letf (((symbol-function 'epg-decrypt-string) + (lambda (&rest r) (prin1-to-string (cadr r)))) + ((symbol-function 'epg-find-configuration) + (lambda (&rest _) '((program . "/bin/true"))))) + (let* ((auth-sources (list plstore-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "localhost" + :user "one two"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '(( :login nil + :port nil + :secret "b" + :host "localhost" + :user "one two")))))))) + +;; json + +(ert-deftest auth-source-pass-extra-query-keywords--ws-host-json () + (ert-with-temp-file json-store + :suffix ".json" + :text "\ +[{\"host\":\"hello world\",\"secret\":\"a\"}, + {\"host\":\"localhost\",\"secret\":\"b\"}] +" + (let* ((auth-sources (list json-store)) + (auth-source-do-cache nil) + (results (auth-source-search :host "hello world"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '(( :host "hello world" + :secret "a"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--ws-user-json () + (ert-with-temp-file json-store + :suffix ".json" + :text "\ +[{\"host\":\"localhost\", + \"user\":\"onetwo\", + \"secret\":\"a\"}, + {\"host\":\"localhost\", + \"user\":\"one two\", + \"secret\":\"b\"}] +" + (let* ((auth-sources (list json-store)) + (auth-source-do-cache nil) + (results (auth-source-search :host "localhost" :user "one two"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '(( :host "localhost" + :user "one two" + :secret "b"))))))) + +;; secrets + +(require 'secrets) + +(ert-deftest auth-source-pass-extra-query-keywords--ws-host-secrets () + (let ((auth-sources '("secrets:Test")) + (auth-source-do-cache nil) + (entries '(("nil@hello world:nil" + (:host . "hello world") + (:xdg:schema . "org.freedesktop.Secret.Generic")) + ("nil@localhost:nil" + (:host . "localhost") + (:xdg:schema . "org.freedesktop.Secret.Generic")))) + (secrets '(("nil@hello world:nil" . "a") + ("nil@localhost:nil" . "b")))) + + (cl-letf (((symbol-function 'secrets-search-items) + (lambda (_ &rest r) + (mapcan (lambda (s) + (and (seq-every-p (pcase-lambda (`(,k . ,v)) + (equal v (alist-get k (cdr s)))) + (map-pairs r)) + (list (car s)))) + entries))) + ((symbol-function 'secrets-get-secret) + (lambda (_ label) (assoc-default label secrets))) + ((symbol-function 'secrets-get-attributes) + (lambda (_ label) (assoc-default label entries)))) + + (let ((results (auth-source-search :host "hello world"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '(( :login nil + :port nil + :secret "a" + :host "hello world" + :xdg:schema "org.freedesktop.Secret.Generic")))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--secrets-joao-user () + (let ((auth-sources '("secrets:Test")) + (auth-source-do-cache nil) + (entries '(("onetwo@localhost:nil" + (:host . "localhost") + (:user . "onetwo") + (:xdg:schema . "org.freedesktop.Secret.Generic")) + ("one two@localhost:nil" + (:host . "localhost") + (:user . "one two") + (:xdg:schema . "org.freedesktop.Secret.Generic")))) + (secrets '(("onetwo@localhost:nil" . "a") + ("one two@localhost:nil" . "b")))) + + (cl-letf (((symbol-function 'secrets-search-items) + (lambda (_ &rest r) + (mapcan (lambda (s) + (and (seq-every-p (pcase-lambda (`(,k . ,v)) + (equal v (alist-get k (cdr s)))) + (map-pairs r)) + (list (car s)))) + entries))) + ((symbol-function 'secrets-get-secret) + (lambda (_ label) (assoc-default label secrets))) + ((symbol-function 'secrets-get-attributes) + (lambda (_ label) (assoc-default label entries)))) + + (let ((results (auth-source-search :host "localhost" :user "one two"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '(( :login nil + :port nil + :secret "b" + :host "localhost" + :user "one two" + :xdg:schema "org.freedesktop.Secret.Generic")))))))) + +;; Pass + +(ert-deftest auth-source-pass-extra-query-keywords--ws-host-pass () + (auth-source-pass--with-store '(("hello world:80" (secret . "a")) + ("localhost:80" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "hello world"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '(( :host "hello world" + :port "80" + :secret "a"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--ws-user-pass () + ;; "suffix" syntax + (auth-source-pass--with-store '(("localhost:80/onetwo" (secret . "a")) + ("localhost:80/one two" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "localhost" :user "one two"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '(( :host "localhost" + :user "one two" + :port "80" + :secret "b")))))) + ;; "prefix" syntax + (auth-source-pass--with-store '(("onetwo@localhost:80" (secret . "a")) + ("one two@localhost:80" (secret . "b"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "localhost" :user "one two"))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '(( :host "localhost" + :user "one two" + :port "80" + :secret "b"))))))) + (provide 'auth-source-pass-tests) ;;; auth-source-pass-tests.el ends here -- 2.38.1 ^ permalink raw reply related [flat|nested] 39+ messages in thread
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [not found] ` <87pme09vis.fsf@gmx.de> 2022-11-07 5:00 ` J.P. [not found] ` <87a653z7dl.fsf@neverwas.me> @ 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> 3 siblings, 0 replies; 39+ messages in thread From: Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2022-11-09 18:21 UTC (permalink / raw) To: Michael Albinus; +Cc: Damien Cassou, emacs-erc, 58985, J.P. [-- Attachment #1: Type: text/plain, Size: 2258 bytes --] Michael Albinus <michael.albinus@gmx.de> writes: > "J.P." <jp@neverwas.me> writes: > > Hi, > >> v2. Respect existing user option. > > I'm not familiar with the auth-source-pass.el implementation, so I > cannot speak too much about your patch. Reading it roughly, I haven't > found serious flaws, 'tho. It has a serious flaw AFAIK. I have a password entry "akib@disroot.org", and this legitimate search query doesn't find it: (auth-source-search :host "disroot.org") But if specify the user, it finds the entry: (auth-source-search :host "disroot.org" :user "akib") And the entries can also be ambiguous. For example, the entry at path "foo.org/bar.net" might be interpreted as the password of bar.net, or as the password of the user "bar.net" on "foo.org". The current implementation seems to interpret such entries unpredictably. > > However :-) > > +(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) > > - The name of this user option as well as its docstring are focussed on > the current behavior. People won't know what "mimic other auth-source > backends" would mean. Please describe the effect w/o that comparison, > and pls give it a name based on its effect, and not "...-standard-search". I agree. This variable should be something like "auth-source-pass-old-search" (or even "...-obsolete-search"). And the default should be nil, because it fixes many bugs, and it's pointless to disable the fixes by the default. > > - I'm missing the documentation in doc/misc/auth.texi and etc/NEWS. What documentation? Of this change or anything else? I think we should focus on the implement before writing documentation. > > Best regards, Michael. > > > -- Akib Azmain Turja, GPG key: 70018CE5819F17A3BBA666AFE74F0EFA922AE7F5 Fediverse: akib@hostux.social Codeberg: akib emailselfdefense.fsf.org | "Nothing can be secure without encryption." [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 832 bytes --] ^ permalink raw reply [flat|nested] 39+ messages in thread
[parent not found: <878rkkoup4.fsf@disroot.org>]
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [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> 2 siblings, 0 replies; 39+ messages in thread From: J.P. @ 2022-11-10 5:23 UTC (permalink / raw) To: Akib Azmain Turja Cc: Damien Cassou, Björn Bidar, emacs-erc, Michael Albinus, 58985 Hi Akib, Akib Azmain Turja <akib@disroot.org> writes: > Michael Albinus <michael.albinus@gmx.de> writes: > >> "J.P." <jp@neverwas.me> writes: >> >> Hi, >> >>> v2. Respect existing user option. >> >> I'm not familiar with the auth-source-pass.el implementation, so I >> cannot speak too much about your patch. Reading it roughly, I haven't >> found serious flaws, 'tho. > > It has a serious flaw AFAIK. I have a password entry > "akib@disroot.org", and this legitimate search query doesn't find it: > > (auth-source-search :host "disroot.org") > > But if specify the user, it finds the entry: > > (auth-source-search :host "disroot.org" :user "akib") Hm, that's unfortunate. I specifically added a pair of tests just for this, namely auth-source-pass-extra-query-keywords--netrc-akib auth-source-pass-extra-query-keywords--akib Are you able to pinpoint why they're reporting a false positive by any chance (or give a minimal repro recipe with an FS tree layout of some ~/.password-store)? Also, and I'm not trying to be insulting here, but did you remember to rerun Make after applying the patch(es)? > And the entries can also be ambiguous. For example, the entry at path > "foo.org/bar.net" might be interpreted as the password of bar.net, or > as the password of the user "bar.net" on "foo.org". The current > implementation seems to interpret such entries unpredictably. Sounds convincing. What do you think about deprecating the /user form? (This may have to be spun off into a separate bug report.) At the end of the day, I'm more concerned about consistency (and thus predictability) than anything. IOW, I'd be okay with "foo.org/bar.net" being parsed either way, as long as it's the *same* way every time, which we could then document. If you're indeed finding otherwise, please provide an MRE for this as well (with patches applied, of course). >> - The name of this user option as well as its docstring are focussed on >> the current behavior. People won't know what "mimic other auth-source >> backends" would mean. Please describe the effect w/o that comparison, >> and pls give it a name based on its effect, and not "...-standard-search". > > I agree. This variable should be something like > "auth-source-pass-old-search" (or even "...-obsolete-search"). Wait, but `auth-source-pass-old-search' sounds like we're regressing to describing a comparison rather than an effect. The name in the second (v2) iteration, `auth-source-pass-extra-query-keywords', was an attempt to rein in the scope of the option and convey no more than what it's claiming to offer. > And the default should be nil, because it fixes many bugs, and it's > pointless to disable the fixes by the default. Not sure I agree here, even though Damien seems to be in accord. In the interest of minimizing churn for Melpa's pass and password-store packages, I'd rather make this an opt-in for Emacs 29 if we end up including it at all. >> - I'm missing the documentation in doc/misc/auth.texi and etc/NEWS. > > What documentation? Of this change or anything else? I think we should > focus on the implement before writing documentation. Hm, (again, not trying to insult here, but) did you somehow miss the patches attached to the email you replied to? It kind of looks that way based on your comments. If I'm wrong, though, please forgive; I appreciate your input regardless. Thanks, J.P. ^ permalink raw reply [flat|nested] 39+ messages in thread
* Re: bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [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> 2 siblings, 0 replies; 39+ messages in thread From: Akib Azmain Turja @ 2022-11-10 7:12 UTC (permalink / raw) To: Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors Cc: Michael Albinus, Damien Cassou, emacs-erc, 58985, J.P. [-- Attachment #1: Type: text/plain, Size: 1309 bytes --] Akib Azmain Turja via "Bug reports for GNU Emacs, the Swiss army knife of text editors" <bug-gnu-emacs@gnu.org> writes: > Michael Albinus <michael.albinus@gmx.de> writes: > >> "J.P." <jp@neverwas.me> writes: >> >> Hi, >> >>> v2. Respect existing user option. >> >> I'm not familiar with the auth-source-pass.el implementation, so I >> cannot speak too much about your patch. Reading it roughly, I haven't >> found serious flaws, 'tho. > > It has a serious flaw AFAIK. I have a password entry > "akib@disroot.org", and this legitimate search query doesn't find it: > > (auth-source-search :host "disroot.org") > > But if specify the user, it finds the entry: > > (auth-source-search :host "disroot.org" :user "akib") > > And the entries can also be ambiguous. For example, the entry at path > "foo.org/bar.net" might be interpreted as the password of bar.net, or > as the password of the user "bar.net" on "foo.org". The current > implementation seems to interpret such entries unpredictably. > I mean, the current implementation, not the patch. -- Akib Azmain Turja --- https://akib.codeberg.page/ GPG key: 70018CE5819F17A3BBA666AFE74F0EFA922AE7F5 Fediverse: akib@hostux.social, Codeberg: akib emailselfdefense.fsf.org | "Nothing can be secure without encryption." [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 832 bytes --] ^ permalink raw reply [flat|nested] 39+ messages in thread
[parent not found: <87a64zo01q.fsf@neverwas.me>]
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [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 0 siblings, 0 replies; 39+ messages in thread From: Akib Azmain Turja via Bug reports for GNU Emacs, the Swiss army knife of text editors @ 2022-11-10 8:11 UTC (permalink / raw) To: J.P.; +Cc: Damien Cassou, Björn Bidar, emacs-erc, Michael Albinus, 58985 [-- Attachment #1: Type: text/plain, Size: 4395 bytes --] "J.P." <jp@neverwas.me> writes: > Hi Akib, > > Akib Azmain Turja <akib@disroot.org> writes: > >> Michael Albinus <michael.albinus@gmx.de> writes: >> >>> "J.P." <jp@neverwas.me> writes: >>> >>> Hi, >>> >>>> v2. Respect existing user option. >>> >>> I'm not familiar with the auth-source-pass.el implementation, so I >>> cannot speak too much about your patch. Reading it roughly, I haven't >>> found serious flaws, 'tho. >> >> It has a serious flaw AFAIK. I have a password entry >> "akib@disroot.org", and this legitimate search query doesn't find it: >> >> (auth-source-search :host "disroot.org") >> >> But if specify the user, it finds the entry: >> >> (auth-source-search :host "disroot.org" :user "akib") > > Hm, that's unfortunate. I specifically added a pair of tests just for > this, namely > > auth-source-pass-extra-query-keywords--netrc-akib > auth-source-pass-extra-query-keywords--akib > > Are you able to pinpoint why they're reporting a false positive by any > chance (or give a minimal repro recipe with an FS tree layout of some > ~/.password-store)? Also, and I'm not trying to be insulting here, but > did you remember to rerun Make after applying the patch(es)? > Actually, I didn't review the patches in this email, I just commented on the auth-source-pass in the master *right now*, not the patch. Sorry for the trouble. >> And the entries can also be ambiguous. For example, the entry at path >> "foo.org/bar.net" might be interpreted as the password of bar.net, or >> as the password of the user "bar.net" on "foo.org". The current >> implementation seems to interpret such entries unpredictably. > > Sounds convincing. What do you think about deprecating the /user form? > (This may have to be spun off into a separate bug report.) > > At the end of the day, I'm more concerned about consistency (and thus > predictability) than anything. IOW, I'd be okay with "foo.org/bar.net" > being parsed either way, as long as it's the *same* way every time, > which we could then document. If you're indeed finding otherwise, please > provide an MRE for this as well (with patches applied, of course). > >>> - The name of this user option as well as its docstring are focussed on >>> the current behavior. People won't know what "mimic other auth-source >>> backends" would mean. Please describe the effect w/o that comparison, >>> and pls give it a name based on its effect, and not "...-standard-search". >> >> I agree. This variable should be something like >> "auth-source-pass-old-search" (or even "...-obsolete-search"). > > Wait, but `auth-source-pass-old-search' sounds like we're regressing to > describing a comparison rather than an effect. The name in the second > (v2) iteration, `auth-source-pass-extra-query-keywords', was an attempt > to rein in the scope of the option and convey no more than what it's > claiming to offer. Thanks for clarification. I have written the same thing in my another (actual) patch review email, feel free to ignore those parts. > >> And the default should be nil, because it fixes many bugs, and it's >> pointless to disable the fixes by the default. > > Not sure I agree here, even though Damien seems to be in accord. In the > interest of minimizing churn for Melpa's pass and password-store > packages, I'd rather make this an opt-in for Emacs 29 if we end up > including it at all. > How about communicating with them? >>> - I'm missing the documentation in doc/misc/auth.texi and etc/NEWS. >> >> What documentation? Of this change or anything else? I think we should >> focus on the implement before writing documentation. > > Hm, (again, not trying to insult here, but) did you somehow miss the > patches attached to the email you replied to? It kind of looks that way > based on your comments. If I'm wrong, though, please forgive; I > appreciate your input regardless. Yeah, you are right, I didn't notice those patches and just commented on the auth-source-pass in the master *right now*, not the patch. Please forgive for the trouble. > > Thanks, > J.P. > > > -- Akib Azmain Turja --- https://akib.codeberg.page/ GPG key: 70018CE5819F17A3BBA666AFE74F0EFA922AE7F5 Fediverse: akib@hostux.social, Codeberg: akib emailselfdefense.fsf.org | "Nothing can be secure without encryption." [-- Attachment #2: signature.asc --] [-- Type: application/pgp-signature, Size: 832 bytes --] ^ permalink raw reply [flat|nested] 39+ messages in thread
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends [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 14:39 ` Damien Cassou 2022-11-07 4:59 ` J.P. 1 sibling, 1 reply; 39+ messages in thread From: Damien Cassou @ 2022-11-06 14:39 UTC (permalink / raw) To: jp, 58985 Hi J.P., thank you very much for working on auth-source-pass. I think it's fine to break backward compatibility if it makes auth-source-pass closer to what auth-source requires. I don't have time to review the code though, I'm sorry. Best -- Damien Cassou "Success is the ability to go from one failure to another without losing enthusiasm." --Winston Churchill ^ permalink raw reply [flat|nested] 39+ messages in thread
* bug#58985: 29.0.50; Have auth-source-pass behave more like other back ends 2022-11-06 14:39 ` Damien Cassou @ 2022-11-07 4:59 ` J.P. 0 siblings, 0 replies; 39+ messages in thread From: J.P. @ 2022-11-07 4:59 UTC (permalink / raw) To: Damien Cassou; +Cc: emacs-erc, akib, 58985, tino.calancha Hi Damien, Damien Cassou <damien@cassou.me> writes: > I think it's fine to break backward compatibility if it makes > auth-source-pass closer to what auth-source requires. There's some nice behavior that you introduced initially regarding the narrowing of results, namely (from the info manual): If several entries match, the one matching the most items (where an "item" is one of username, port or host) is preferred. For example ... It'd be a shame to lose that, since folks may have come to rely on it. Perhaps it would be prudent to offer an escape hatch of some sort to restore the existing behavior? > I don't have time to review the code though, I'm sorry. No worries at all. Unfortunately, I don't use pass myself and am mostly concerned with ERC's integration. The good news is an actual pass user, Akib (Cc'd), has expressed some interest regarding this topic on emacs-devel, so I'm hoping they'll step in and take over or collaborate in some fashion. Also, I noticed that the password-store.el in zx2c4's contrib/emacs subdir actually requires auth-source as a dependency, so I've Cc'd the maintainer for that package as well. Thanks, J.P. ^ permalink raw reply [flat|nested] 39+ messages in thread
* 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. [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-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 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 external index https://git.savannah.gnu.org/cgit/emacs.git https://git.savannah.gnu.org/cgit/emacs/org-mode.git This is an external index of several public inboxes, see mirroring instructions on how to clone and mirror all data and code used by this external index.