>From dda2ccaed516afcea5f685f3b3f51849c58b197c Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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