From mboxrd@z Thu Jan 1 00:00:00 1970 Path: news.gmane.io!.POSTED.blaine.gmane.org!not-for-mail From: "J.P." Newsgroups: gmane.emacs.bugs Subject: bug#72441: 31.0.50; Auth-source-pass doesn't match password attributes or hosts without user when extra-query-keywords is true Date: Mon, 12 Aug 2024 12:33:48 -0700 Message-ID: <874j7pedsz.fsf@neverwas.me> References: <17083.4807607875$1722683645@news.gmane.org> <87frrdvaku.fsf@neverwas.me> <877ccoo4x8.fsf@neverwas.me> Mime-Version: 1.0 Content-Type: multipart/mixed; boundary="=-=-=" Injection-Info: ciao.gmane.io; posting-host="blaine.gmane.org:116.202.254.214"; logging-data="31079"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: =?UTF-8?Q?Bj=C3=B6rn?= Bidar To: 72441@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Mon Aug 12 21:34:59 2024 Return-path: Envelope-to: geb-bug-gnu-emacs@m.gmane-mx.org Original-Received: from lists.gnu.org ([209.51.188.17]) by ciao.gmane.io with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.92) (envelope-from ) id 1sdaok-0007vB-Lp for geb-bug-gnu-emacs@m.gmane-mx.org; Mon, 12 Aug 2024 21:34:59 +0200 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1sdaoL-0004Hm-9N; Mon, 12 Aug 2024 15:34:33 -0400 Original-Received: from eggs.gnu.org ([2001:470:142:3::10]) by lists.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_256_GCM_SHA384:256) (Exim 4.90_1) (envelope-from ) id 1sdaoI-0004HI-K5 for bug-gnu-emacs@gnu.org; Mon, 12 Aug 2024 15:34:30 -0400 Original-Received: from debbugs.gnu.org ([2001:470:142:5::43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1sdaoI-0007jD-AF for bug-gnu-emacs@gnu.org; Mon, 12 Aug 2024 15:34:30 -0400 DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=debbugs.gnu.org; s=debbugs-gnu-org; h=MIME-Version:Date:References:In-Reply-To:From:To:Subject; bh=Ed9Sry5fb7GnaO7k1sC52UBxaIDOMW4IyilFaEC0VgY=; b=H+iHlbJ4ofnUueJSn9syBSizovtFRdq1jZ1TMKqg5/1FnQGnC3cJ8N8F4gBOQxzjDkSAZ0NJiTloQ0mOa2UpSESF8xJ3wWZ57zPAWs2b+SzBBgbq5shTLDWUwXtaVYaE+A5ij+kZ0K50uKcE439v5I/IMl8T+lDVxwayIpOCSVvWPc86gz6ZCqmT9MIl8ri5Mllt80l/wCPJMjVRpdsv9cMIHlWvdCUhMzod0LTFQC8iwwpMlomd0SqZQIIkQza6tSmQkdmMPq/0qReXx2HmR4CCd5Nl631ihKPpNvXx9PYOwqkCZxCz/r1VXC33R8VSwK4KDYpKV9MO4Dw7T0xZ8A==; Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1sdaoo-0000l3-F4 for bug-gnu-emacs@gnu.org; Mon, 12 Aug 2024 15:35:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: bug-gnu-emacs@gnu.org Resent-Date: Mon, 12 Aug 2024 19:35:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: followup 72441 X-GNU-PR-Package: emacs Original-Received: via spool by 72441-submit@debbugs.gnu.org id=B72441.17234912732859 (code B ref 72441); Mon, 12 Aug 2024 19:35:02 +0000 Original-Received: (at 72441) by debbugs.gnu.org; 12 Aug 2024 19:34:33 +0000 Original-Received: from localhost ([127.0.0.1]:43848 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sdaoH-0000ju-NW for submit@debbugs.gnu.org; Mon, 12 Aug 2024 15:34:33 -0400 Original-Received: from mail-108-mta165.mxroute.com ([136.175.108.165]:44963) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1sdaoD-0000ji-C3 for 72441@debbugs.gnu.org; Mon, 12 Aug 2024 15:34:27 -0400 Original-Received: from filter006.mxroute.com ([136.175.111.3] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta165.mxroute.com (ZoneMTA) with ESMTPSA id 191481528200000a78.001 for <72441@debbugs.gnu.org> (version=TLSv1.3 cipher=TLS_AES_256_GCM_SHA384); Mon, 12 Aug 2024 19:33:51 +0000 X-Zone-Loop: 147a1a39328cccf6e60875e7f1d3b521c83eab0ba0f0 X-Originating-IP: [136.175.111.3] DKIM-Signature: v=1; a=rsa-sha256; q=dns/txt; c=relaxed/relaxed; d=neverwas.me ; s=x; h=Content-Type:MIME-Version:Message-ID:Date:References:In-Reply-To: Subject:Cc:To:From:Sender:Reply-To:Content-Transfer-Encoding:Content-ID: Content-Description:Resent-Date:Resent-From:Resent-Sender:Resent-To:Resent-Cc :Resent-Message-ID:List-Id:List-Help:List-Unsubscribe:List-Subscribe: List-Post:List-Owner:List-Archive; bh=Ed9Sry5fb7GnaO7k1sC52UBxaIDOMW4IyilFaEC0VgY=; b=EMTb1fNRx5+LP3JHTn0WkF4kFw g6Cx9xsKl01HLHH/jdm8WCpl9sxzkjRMXdDEdwNdZiogUqFccc/bWEZxnswFVe8OvfWam/swYpISO FeuUq7cph3hypT8Cd9KkhcHRo6p6ULhnPAG+OvWu2Q3hVTz0D7gbIu0l7K37Yw7zui1ofAgxm06j6 EA00KDfgw4UfliGTxcxT8YEov0DUkSUe6s29/ksjg/QiHv1Zz7EtJEoXPHwNivPn7Dek9r5Nkll39 4lQPXYQ29FyJFgJneaIz+HVDhq/NX1Q/PuGMFKr3cGrLiFkbf7TVb90t9mHusXuy2abUWnCZyYNeZ /VvbUhQw==; In-Reply-To: <877ccoo4x8.fsf@neverwas.me> (J. P.'s message of "Sat, 10 Aug 2024 06:58:43 -0700") X-Authenticated-Id: masked@neverwas.me X-BeenThere: debbugs-submit@debbugs.gnu.org X-Mailman-Version: 2.1.18 Precedence: list X-BeenThere: bug-gnu-emacs@gnu.org List-Id: "Bug reports for GNU Emacs, the Swiss army knife of text editors" List-Unsubscribe: , List-Archive: List-Post: List-Help: List-Subscribe: , Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Original-Sender: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:290058 Archived-At: --=-=-= Content-Type: text/plain While exploring ways to tackle this feature, I stumbled on a couple minor bugs related to `auth-source-pass-extra-query-keywords'. Because there's no telling when we'll end up with something installable for this feature, I've gone ahead and isolated the fixes into a separate patch (0001 in the attached). It's probably safe enough for Emacs 30, but since the option was introduced back in 29, I'll just install it on master (unless I hear otherwise in the coming days). Thanks. --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0000-v2-v3.diff >From d9bd10debf6c3930669aedb896026f9f19b54466 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Mon, 12 Aug 2024 07:00:23 -0700 Subject: [PATCH 0/2] *** NOT A PATCH *** *** BLURB HERE *** F. Jason Park (2): Fix deviations in auth-source-pass behavior WRT netrc [POC] Match attrs with auth-source-pass-extra-query-keywords lisp/auth-source-pass.el | 146 ++++++++++++++++++++-------- test/lisp/auth-source-pass-tests.el | 138 +++++++++++++++++++++++++- 2 files changed, 237 insertions(+), 47 deletions(-) Interdiff: diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 0df7817f501..a52dafc5ab2 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -266,9 +266,10 @@ auth-source-pass--cast-port (defun auth-source-pass--match-parts (cache key reference require) (let ((value (plist-get cache key))) - (if (memq key require) - (if reference (equal value reference) value) - (or (null reference) (null value) (equal value reference))))) + (cond ((memq key require) + (if reference (equal value reference) value)) + ((and value reference) (equal value reference)) + (t)))) (defvar auth-source-pass-check-attrs-with-extra-query-keywords t "When non-nil, decrypt files to find attributes matching parameters. diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index c6662cd8b42..695635299f9 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -548,6 +548,44 @@ auth-source-pass-extra-query-keywords--wild-port-hit '((:host "x.com" :secret "a") (:host "x.com" :port 42 :secret "b"))))))) +;; The query requires a user and doesn't specify a user to match against. +;; The only entry matching the host lacks a user, so the search fails. + +(ert-deftest auth-source-pass-extra-query-keywords--req-noparam-miss-netrc () + (ert-with-temp-file netrc-file + :text "machine foo password a\n" + (let ((auth-sources (list netrc-file)) + (auth-source-do-cache nil)) + (should-not (auth-source-search :host "foo" :require '(:user) :max 2))))) + +(ert-deftest auth-source-pass-extra-query-keywords--req-noparam-miss () + (let ((auth-source-pass-extra-query-keywords t)) + (auth-source-pass--with-store '(("foo" (secret . "a"))) + (auth-source-pass-enable) + (should-not (auth-source-search :host "foo" :require '(:user) :max 2))))) + +;; The query requires a user but does not provide a reference value to +;; match against. An entry matching the host that specifies a user is +;; selected because any user will do. +(ert-deftest auth-source-pass-extra-query-keywords--req-param-netrc () + (ert-with-temp-file netrc-file + :text "machine foo login bob password a\n" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "foo" :require '(:user)))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "foo" :user "bob" :secret "a"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--req-param () + (let ((auth-source-pass-extra-query-keywords t)) + (auth-source-pass--with-store '(("foo/bob" (secret . "a"))) + (auth-source-pass-enable) + (let ((results (auth-source-search :host "foo" :require '(:user)))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "foo" :user "bob" :secret "a")))))))) + ;; 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 () @@ -601,7 +639,7 @@ auth-source-pass-extra-query-keywords--akib (should (equal results '((:host "disroot.org" :user "akib" :secret "b"))))))) -(ert-deftest auth-source-pass-extra-query-keywords--akib/attr () +(ert-deftest auth-source-pass-extra-query-keywords--akib-attr () (auth-source-pass--with-store '(("x.com" (secret . "a")) ("disroot.org" (secret . "b") ("user" . "akib") ("port" . "42")) @@ -638,23 +676,7 @@ auth-source-pass-extra-query-keywords--akib/attr '(( :host "disroot.org" :user "akib" :port 42 :secret "b"))))))) -(ert-deftest auth-source-pass-extra-query-keywords--netrc-akib/require () - (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" - :require '(:user) :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/attr/require () +(ert-deftest auth-source-pass-extra-query-keywords--akib-attr-req () (auth-source-pass--with-store '(("x.com" (secret . "a")) ("disroot.org" (secret . "b") ("user" . "akib")) @@ -668,7 +690,23 @@ auth-source-pass-extra-query-keywords--akib/attr/require (should (equal results '((:host "disroot.org" :user "akib" :secret "b"))))))) -(ert-deftest auth-source-pass-extra-query-keywords--akib/attr/extras () +(ert-deftest auth-source-pass-extra-query-keywords--akib-attr-extras-netrc () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine disroot.org user akib port 42 password b foo 1 bar 2 +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" :port "42" + :secret "b" :foo "1" :bar "2"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--akib-attr-extras () (auth-source-pass--with-store '(("x.com" (secret . "a")) ("disroot.org" (secret . "b") ("user" . "akib") @@ -713,8 +751,8 @@ auth-source-pass-extra-query-keywords--host '((:host "Libera.Chat" :secret "b"))))))) -;; A retrieved store entry mustn't be nil regardless of whether its -;; path contains port or user components. +;; An effectively empty entry in the store returns nothing but the +;; :host field matching the given host parameter. (ert-deftest auth-source-pass-extra-query-keywords--netrc-baseline () (ert-with-temp-file netrc-file -- 2.46.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-Fix-deviations-in-auth-source-pass-behavior-WRT-netr.patch >From 1aa0f941d79b77de4a87a8043f13607c0719f5d0 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Sun, 11 Aug 2024 21:55:32 -0700 Subject: [PATCH 1/2] Fix deviations in auth-source-pass behavior WRT netrc The option `auth-source-pass-extra-query-keywords' aims to make this back end hew as close to the other built-in ones as possible, except WRT features not yet implemented, such as arbitrary "attribute" retrieval and new entry creation. This change only concerns behavior exhibited when the option is enabled. * lisp/auth-source-pass.el (auth-source-pass--match-parts): Account for the case in which a query lacks a reference parameter for a `:port' or `:user' but still requires one or both via the `:require' keyword. Previously, such a query would fail even when an entry met this requirement by simply specifying a field with any non-null value corresponding to the required parameter. (auth-source-pass--find-match-many): Account for the baseline case where a matching entry lacks a secret and the user doesn't require one. Although this function doesn't currently return so-called "attributes" from the contents of a matching decrypted file, were it to eventually, this case would no longer be academic. * test/lisp/auth-source-pass-tests.el (auth-source-pass-extra-query-keywords--req-noparam-miss-netrc) (auth-source-pass-extra-query-keywords--req-noparam-miss) (auth-source-pass-extra-query-keywords--req-param-netrc) (auth-source-pass-extra-query-keywords--req-param): New tests. (auth-source-pass-extra-query-keywords--netrc-baseline): New test asserting behavior of netrc backend when passed a lone `:host' as a query parameter. (auth-source-pass-extra-query-keywords--baseline): Reverse expected outcome to match that of the netrc reference implementation. (bug#72441) --- lisp/auth-source-pass.el | 19 +++++----- test/lisp/auth-source-pass-tests.el | 54 ++++++++++++++++++++++++++--- 2 files changed, 60 insertions(+), 13 deletions(-) diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index 03fd1f35811..dd93d414d5e 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -271,11 +271,12 @@ auth-source-pass--retrieve-parsed 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--match-parts (cache key reference require) + (let ((value (plist-get cache key))) + (cond ((memq key require) + (if reference (equal value reference) value)) + ((and value reference) (equal value reference)) + (t)))) (defun auth-source-pass--find-match-many (hosts users ports require max) "Return plists for valid combinations of HOSTS, USERS, PORTS." @@ -290,17 +291,17 @@ auth-source-pass--find-match-many (dolist (user (or users (list u))) (dolist (port (or ports (list p))) (dolist (e entries) - (when-let* + (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))))) + (secret (let ((parsed (auth-source-pass-parse-entry e))) + (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)) diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index 6455c3393d5..c54936c3f92 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -548,6 +548,44 @@ auth-source-pass-extra-query-keywords--wild-port-hit '((:host "x.com" :secret "a") (:host "x.com" :port 42 :secret "b"))))))) +;; The query requires a user and doesn't specify a user to match against. +;; The only entry matching the host lacks a user, so the search fails. + +(ert-deftest auth-source-pass-extra-query-keywords--req-noparam-miss-netrc () + (ert-with-temp-file netrc-file + :text "machine foo password a\n" + (let ((auth-sources (list netrc-file)) + (auth-source-do-cache nil)) + (should-not (auth-source-search :host "foo" :require '(:user) :max 2))))) + +(ert-deftest auth-source-pass-extra-query-keywords--req-noparam-miss () + (let ((auth-source-pass-extra-query-keywords t)) + (auth-source-pass--with-store '(("foo" (secret . "a"))) + (auth-source-pass-enable) + (should-not (auth-source-search :host "foo" :require '(:user) :max 2))))) + +;; The query requires a user but does not provide a reference value to +;; match against. An entry matching the host that specifies a user is +;; selected because any user will do. +(ert-deftest auth-source-pass-extra-query-keywords--req-param-netrc () + (ert-with-temp-file netrc-file + :text "machine foo login bob password a\n" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "foo" :require '(:user)))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "foo" :user "bob" :secret "a"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--req-param () + (let ((auth-source-pass-extra-query-keywords t)) + (auth-source-pass--with-store '(("foo/bob" (secret . "a"))) + (auth-source-pass-enable) + (let ((results (auth-source-search :host "foo" :require '(:user)))) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results '((:host "foo" :user "bob" :secret "a")))))))) + ;; 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 () @@ -629,14 +667,22 @@ auth-source-pass-extra-query-keywords--host '((:host "Libera.Chat" :secret "b"))))))) -;; A retrieved store entry mustn't be nil regardless of whether its -;; path contains port or user components. +;; An effectively empty entry in the store returns nothing but the +;; :host field matching the given host parameter. + +(ert-deftest auth-source-pass-extra-query-keywords--netrc-baseline () + (ert-with-temp-file netrc-file + :text "machine foo\n" + (let* ((auth-sources (list netrc-file)) + (auth-source-do-cache nil) + (results (auth-source-search :host "foo"))) + (should (equal results '((:host "foo"))))))) (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--with-store '(("foo")) (auth-source-pass-enable) - (should-not (auth-source-search :host "x.com"))))) + (should (equal (auth-source-search :host "foo") '((:host "foo"))))))) ;; Output port type (int or string) matches that of input parameter. -- 2.46.0 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-POC-Match-attrs-with-auth-source-pass-extra-query-ke.patch >From d9bd10debf6c3930669aedb896026f9f19b54466 Mon Sep 17 00:00:00 2001 From: "F. Jason Park" Date: Wed, 7 Aug 2024 22:23:09 -0700 Subject: [PATCH 2/2] [POC] Match attrs with auth-source-pass-extra-query-keywords * lisp/auth-source-pass.el (auth-source-pass--retrieve-parsed): Remove unused function. (auth-source-pass--cast-port): New function, a helper to match an entry's port to the given query param's type. (auth-source-pass--match-parts): Return non-nil when a key is required but the value is null. Not doing so produced behavior that deviated from the reference netrc implementation and was thus a bug. (auth-source-pass-check-attrs-with-extra-query-keywords): New variable, a flag to opt out of arguably expensive attribute lookups. (auth-source-pass--find-matched-entry): New function to isolate processing logic for a single entry. (auth-source-pass--find-match-many): Move single-entry processing logic to separate helper, mainly for readability. * test/lisp/auth-source-pass-tests.el (auth-source-pass-extra-query-keywords--akib-attr) (auth-source-pass-extra-query-keywords--akib-attr-req) (auth-source-pass-extra-query-keywords--akib-attr-netrc) (auth-source-pass-extra-query-keywords--akib-attr-extras) (auth-source-pass-extra-query-keywords--netrc-baseline): New tests. (auth-source-pass-extra-query-keywords--baseline): Reverse expected outcome to match reference implementation. That it didn't before was a bug. (Bug#72441) --- lisp/auth-source-pass.el | 133 ++++++++++++++++++++-------- test/lisp/auth-source-pass-tests.el | 84 ++++++++++++++++++ 2 files changed, 180 insertions(+), 37 deletions(-) diff --git a/lisp/auth-source-pass.el b/lisp/auth-source-pass.el index dd93d414d5e..a52dafc5ab2 100644 --- a/lisp/auth-source-pass.el +++ b/lisp/auth-source-pass.el @@ -256,20 +256,13 @@ 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--cast-port (val ref) + (cond ((integerp val) val) + ((and-let* (((integerp ref)) + (n (string-to-number val)) + ((not (zerop n)))) + n)) + (t (format "%s" val)))) (defun auth-source-pass--match-parts (cache key reference require) (let ((value (plist-get cache key))) @@ -278,11 +271,87 @@ auth-source-pass--match-parts ((and value reference) (equal value reference)) (t)))) +(defvar auth-source-pass-check-attrs-with-extra-query-keywords t + "When non-nil, decrypt files to find attributes matching parameters. +However, give precedence to fields encoded in file names. Only applies +when `auth-source-pass-extra-query-keywords' is non-nil.") + +;; This function tries to defer decryption as long as possible. For +;; that reason, an entry's file-path-derived :port or :user field +;; always takes precedence over their counterparts from a decrypted +;; file's attribute list. +(defun auth-source-pass--find-matched-entry (host user port require seen entry) + "Match ENTRY against query params HOST USER PORT REQUIRE with cache SEEN." + (when (string-match auth-source-pass--match-regexp entry) + (let* ((cached (gethash entry seen)) + (optp auth-source-pass-check-attrs-with-extra-query-keywords) + (suffixedp nil) + (h (or (and cached (plist-get cached :host)) + (match-string 10 entry) + (match-string 11 entry))) + (attrs (and cached (plist-get :attrs cached))) + (getat (lambda (k) + (save-match-data + (unless attrs + (setq attrs (auth-source-pass-parse-entry entry))) + (auth-source-pass--get-attr k attrs)))) + (u (cond (cached (plist-get cached :user)) + ((and-let* ((u (match-string 21 entry))) + (setq suffixedp t) + u)) + ((match-string 20 entry)) + ((and optp (or user (memq :user require))) + (funcall getat "user")))) + (p (cond (cached (plist-get cached :port)) + ((match-string 30 entry)) + ((match-string 31 entry)) + ((and optp (or port (memq :port require))) + (funcall getat "port")))) + ;; + s extras) + (when p + (setq p (auth-source-pass--cast-port p port))) + (unless cached + (setq cached `( :host ,h + ,@(and u (list :user u)) + ,@(and p (list :port p)) + ,@(and suffixedp (list :suffix t)) + ,@(and attrs (list :attrs attrs)))) + (puthash entry cached seen)) + (when (and (equal host h) + (auth-source-pass--match-parts cached :port port require) + (auth-source-pass--match-parts cached :user user require) + (setq s (or (funcall getat 'secret) + (not (memq :secret require))))) + (let (tmp) + (while-let ((v (pop attrs)) + (k (pop v))) + (pcase k + ((or "user" "username") + (unless (or user u) + (setq u v + cached (plist-put cached :user u)))) + ("port" + (unless (or port p) + (setq p (auth-source-pass--cast-port v port) + cached (plist-put cached :port p)))) + ((pred stringp) + (push (intern (concat ":" k)) extras) + (push v extras) + (push (cons k v) tmp)))) + (setq attrs (nreverse tmp))) + (puthash entry (plist-put cached :attrs attrs) seen) + `( :host ,host + ,@(and u (list :user u)) + ,@(and p (list :port p)) + ,@(and s (not (eq s t)) (list :secret s)) + ,@(nreverse extras)))))) + (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)) (entries (auth-source-pass-entries)) - out suffixed suffixedp) + out suffixed) (catch 'done (dolist (host hosts out) (pcase-let ((`(,_ ,u ,p) (auth-source-pass--disambiguate host))) @@ -290,28 +359,18 @@ auth-source-pass--find-match-many (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)) - ;; For now, ignore body-content pairs, if any, - ;; from `auth-source-pass--parse-data'. - (secret (let ((parsed (auth-source-pass-parse-entry e))) - (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))))) + (dolist (entry entries) + (let* ((result (auth-source-pass--find-matched-entry + host user port require seen entry)) + ;; + suffixedp) + (when result + (setq suffixedp (plist-get (gethash entry seen) :suffix)) + (push result (if suffixedp suffixed out)) + (unless suffixedp + (when (or (zerop (cl-decf max)) + (null (setq entries (delete entry entries)))) + (throw 'done out)))))) (setq suffixed (nreverse suffixed)) (while suffixed (push (pop suffixed) out) diff --git a/test/lisp/auth-source-pass-tests.el b/test/lisp/auth-source-pass-tests.el index c54936c3f92..695635299f9 100644 --- a/test/lisp/auth-source-pass-tests.el +++ b/test/lisp/auth-source-pass-tests.el @@ -639,6 +639,90 @@ auth-source-pass-extra-query-keywords--akib (should (equal results '((:host "disroot.org" :user "akib" :secret "b"))))))) +(ert-deftest auth-source-pass-extra-query-keywords--akib-attr () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("disroot.org" (secret . "b") + ("user" . "akib") ("port" . "42")) + ("z.com" (secret . "c"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + results) + + ;; Non-matching query param. + (setq results (auth-source-search :host "disroot.org" :user "?" :max 2)) + (should-not results) + + ;; No query params matching attrs. + (setq 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" + :port "42" :secret "b")))) + + ;; Matching user query param. + (setq results (auth-source-search :host "disroot.org" :user "akib")) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '(( :host "disroot.org" :user "akib" + :port "42" :secret "b")))) + + ;; Matching port typed query param. + (setq results (auth-source-search :host "disroot.org" :port 42)) + (dolist (result results) + (setf (plist-get result :secret) (auth-info-password result))) + (should (equal results + '(( :host "disroot.org" :user "akib" + :port 42 :secret "b"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--akib-attr-req () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("disroot.org" (secret . "b") + ("user" . "akib")) + ("z.com" (secret . "c"))) + (auth-source-pass-enable) + (let* ((auth-source-pass-extra-query-keywords t) + (results (auth-source-search :host "disroot.org" + :require '(:user) :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-attr-extras-netrc () + (ert-with-temp-file netrc-file + :text "\ +machine x.com password a +machine disroot.org user akib port 42 password b foo 1 bar 2 +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" :port "42" + :secret "b" :foo "1" :bar "2"))))))) + +(ert-deftest auth-source-pass-extra-query-keywords--akib-attr-extras () + (auth-source-pass--with-store '(("x.com" (secret . "a")) + ("disroot.org" (secret . "b") + ("user" . "akib") + ("port" . "42") + ("foo" . "1") + ("bar" . "2")) + ("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" :port "42" + :secret "b" :foo "1" :bar "2"))))))) + ;; Searches for :host are case-sensitive, and a returned host isn't ;; normalized. -- 2.46.0 --=-=-=--