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#58985: 29.0.50; Have auth-source-pass behave more like other back ends Date: Thu, 03 Nov 2022 06:51:29 -0700 Message-ID: <87wn8cb0ym.fsf__25270.8474568621$1667483568$gmane$org@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="34672"; mail-complaints-to="usenet@ciao.gmane.io" User-Agent: Gnus/5.13 (Gnus v5.13) Cc: Damien Cassou , emacs-erc@gnu.org To: 58985@debbugs.gnu.org Original-X-From: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Thu Nov 03 14:52:41 2022 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 1oqae7-0008m6-4U for geb-bug-gnu-emacs@m.gmane-mx.org; Thu, 03 Nov 2022 14:52:39 +0100 Original-Received: from localhost ([::1] helo=lists1p.gnu.org) by lists.gnu.org with esmtp (Exim 4.90_1) (envelope-from ) id 1oqada-0005sU-GI; Thu, 03 Nov 2022 09:52:06 -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 1oqadX-0005rB-5o; Thu, 03 Nov 2022 09:52:03 -0400 Original-Received: from debbugs.gnu.org ([209.51.188.43]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oqadW-0003e8-Tz; Thu, 03 Nov 2022 09:52:02 -0400 Original-Received: from Debian-debbugs by debbugs.gnu.org with local (Exim 4.84_2) (envelope-from ) id 1oqadW-0006aQ-El; Thu, 03 Nov 2022 09:52:02 -0400 X-Loop: help-debbugs@gnu.org Resent-From: "J.P." Original-Sender: "Debbugs-submit" Resent-CC: emacs-erc@gnu.org, bug-gnu-emacs@gnu.org Resent-Date: Thu, 03 Nov 2022 13:52:02 +0000 Resent-Message-ID: Resent-Sender: help-debbugs@gnu.org X-GNU-PR-Message: report 58985 X-GNU-PR-Package: emacs X-GNU-PR-Keywords: patch X-Debbugs-Original-To: bug-gnu-emacs@gnu.org X-Debbugs-Original-Xcc: emacs-erc@gnu.org Original-Received: via spool by submit@debbugs.gnu.org id=B.166748350925294 (code B ref -1); Thu, 03 Nov 2022 13:52:02 +0000 Original-Received: (at submit) by debbugs.gnu.org; 3 Nov 2022 13:51:49 +0000 Original-Received: from localhost ([127.0.0.1]:48397 helo=debbugs.gnu.org) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oqadH-0006Zt-RP for submit@debbugs.gnu.org; Thu, 03 Nov 2022 09:51:49 -0400 Original-Received: from lists.gnu.org ([209.51.188.17]:50498) by debbugs.gnu.org with esmtp (Exim 4.84_2) (envelope-from ) id 1oqadD-0006Zi-6X for submit@debbugs.gnu.org; Thu, 03 Nov 2022 09:51:46 -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 1oqadC-0005d2-I1 for bug-gnu-emacs@gnu.org; Thu, 03 Nov 2022 09:51:43 -0400 Original-Received: from mail-108-mta161.mxroute.com ([136.175.108.161]) by eggs.gnu.org with esmtps (TLS1.2:ECDHE_RSA_AES_128_GCM_SHA256:128) (Exim 4.90_1) (envelope-from ) id 1oqad7-0003cz-QJ for bug-gnu-emacs@gnu.org; Thu, 03 Nov 2022 09:51:42 -0400 Original-Received: from mail-111-mta2.mxroute.com ([136.175.111.2] filter006.mxroute.com) (Authenticated sender: mN4UYu2MZsgR) by mail-108-mta161.mxroute.com (ZoneMTA) with ESMTPSA id 1843dc2e2ff0006e99.002 for (version=TLSv1/SSLv3 cipher=ECDHE-RSA-AES128-GCM-SHA256); Thu, 03 Nov 2022 13:51:33 +0000 X-Zone-Loop: 24356a67364b47d3fdfea8c6183d495e122561d47164 X-Originating-IP: [136.175.111.2] 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: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:In-Reply-To: References:List-Id:List-Help:List-Unsubscribe:List-Subscribe:List-Post: List-Owner:List-Archive; bh=tkKuAdTPGNibcFjV3bKnu5Dz7jKIFmNo1KGvYADkHkQ=; b=c j+KdN2RFaPzT79l/xQtyy24uDdJbnhZOGvLtZj4FEXdzXIMz9VPyM8/0YbJ+G9aMNDl78290dtpZZ XfwJvhdl24sjMfcSat2TfISABAQdd1zn2iERcShkOVmZMiGFhh+yn7DawMdiq3gz/2p/JRzHGX29y KA8s8uhCahHk6Wl62OtVLrq8hvlopFc42uqdBBfNdJDiXSiQ5fjBg+0B4hTJmbxhtGlZOupDfVUwE ZYyasvVgYcSwKZGjsM2Uf/juLchUVAKBs2oLEagzYW8gP1u5PHW42dXXUW0m8JuKPDqurWF/vwmlE tWUf6/FwkVr6iihC3Qep3A0JBaSOmxumA==; X-Authenticated-Id: masked@neverwas.me Received-SPF: pass client-ip=136.175.108.161; envelope-from=jp@neverwas.me; helo=mail-108-mta161.mxroute.com X-Spam_score_int: -20 X-Spam_score: -2.1 X-Spam_bar: -- X-Spam_report: (-2.1 / 5.0 requ) BAYES_00=-1.9, DKIM_SIGNED=0.1, DKIM_VALID=-0.1, DKIM_VALID_AU=-0.1, DKIM_VALID_EF=-0.1, SPF_HELO_NONE=0.001, SPF_PASS=-0.001, WEIRD_PORT=0.001 autolearn=ham autolearn_force=no X-Spam_action: no action 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: , Original-Sender: "bug-gnu-emacs" Errors-To: bug-gnu-emacs-bounces+geb-bug-gnu-emacs=m.gmane-mx.org@gnu.org Xref: news.gmane.io gmane.emacs.bugs:246961 Archived-At: --=-=-= Content-Type: text/plain 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)) --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0001-POC-Make-auth-source-pass-behave-more-like-other-bac.patch >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 --=-=-= Content-Type: text/x-patch Content-Disposition: attachment; filename=0002-POC-Support-auth-source-pass-in-ERC.patch >From b78670992dd10c9566e620cd016767a4b36dd10f Mon Sep 17 00:00:00 2001 From: "F. Jason Park" 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 --=-=-=--