From: LdBeth <andpuke@foxmail.com>
To: Michael Albinus <michael.albinus@gmx.de>
Cc: LdBeth <andpuke@foxmail.com>,
64977@debbugs.gnu.org, Eli Zaretskii <eliz@gnu.org>
Subject: bug#64977: 29.1; `auth-source-macos-keychain-search' handles :user key incorrectly
Date: Sat, 12 Aug 2023 14:02:33 -0500 [thread overview]
Message-ID: <tencent_B61D562B8B3F18B7BD6E39C7EF1E050C7307@qq.com> (raw)
In-Reply-To: <87r0o8z1sc.fsf@gmx.de>
[-- Attachment #1: Type: text/plain, Size: 191 bytes --]
Sure. I have made the test. I also found a issue not covered in my
previous patch, that if the protocol is longer than 4 characters it
should be truncated. Please have a look at them.
ldb
[-- Attachment #2: patch1 --]
[-- Type: text/plain, Size: 6439 bytes --]
--- auth-source.el.old 2023-08-08 16:37:41.000000000 -0500
+++ auth-source.el 2023-08-08 17:08:23.000000000 -0500
@@ -1958,20 +1958,23 @@
(hosts (if (and hosts (listp hosts)) hosts `(,hosts)))
(ports (plist-get spec :port))
(ports (if (and ports (listp ports)) ports `(,ports)))
+ (users (plist-get spec :user))
+ (users (if (and users (listp users)) users `(,users)))
;; Loop through all combinations of host/port and pass each of these to
;; auth-source-macos-keychain-search-items
(items (catch 'match
(dolist (host hosts)
(dolist (port ports)
- (let* ((port (if port (format "%S" port)))
- (items (apply #'auth-source-macos-keychain-search-items
- coll
- type
- max
- host port
- search-spec)))
- (when items
- (throw 'match items)))))))
+ (dolist (user users)
+ (let ((items (apply
+ #'auth-source-macos-keychain-search-items
+ coll
+ type
+ max
+ host port user
+ search-spec)))
+ (when items
+ (throw 'match items))))))))
;; ensure each item has each key in `returned-keys'
(items (mapcar (lambda (plist)
@@ -2003,8 +2006,9 @@
collect var))
'utf-8)))
-(cl-defun auth-source-macos-keychain-search-items (coll _type _max host port
- &key label type user
+(cl-defun auth-source-macos-keychain-search-items (coll _type _max
+ host port user
+ &key label type
&allow-other-keys)
(let* ((keychain-generic (eq type 'macos-keychain-generic))
(args `(,(if keychain-generic
@@ -2022,47 +2026,49 @@
(when port
(if keychain-generic
(setq args (append args (list "-s" port)))
- (setq args (append args (list
- (if (string-match "[0-9]+" port) "-P" "-r")
- port)))))
-
- (unless (equal coll "default")
- (setq args (append args (list coll))))
-
- (with-temp-buffer
- (apply #'call-process "/usr/bin/security" nil t nil args)
- (goto-char (point-min))
- (while (not (eobp))
- (cond
- ((looking-at "^password: \\(?:0x[0-9A-F]+\\)? *\"\\(.+\\)\"")
- (setq ret (auth-source-macos-keychain-result-append
- ret
- keychain-generic
- "secret"
- (let ((v (auth-source--decode-octal-string
- (match-string 1))))
- (lambda () v)))))
- ;; TODO: check if this is really the label
- ;; match 0x00000007 <blob>="AppleID"
- ((looking-at
- "^[ ]+0x00000007 <blob>=\\(?:0x[0-9A-F]+\\)? *\"\\(.+\\)\"")
- (setq ret (auth-source-macos-keychain-result-append
- ret
- keychain-generic
- "label"
- (auth-source--decode-octal-string (match-string 1)))))
- ;; match "crtr"<uint32>="aapl"
- ;; match "svce"<blob>="AppleID"
- ((looking-at
- "^[ ]+\"\\([a-z]+\\)\"[^=]+=\\(?:0x[0-9A-F]+\\)? *\"\\(.+\\)\"")
- (setq ret (auth-source-macos-keychain-result-append
- ret
- keychain-generic
- (auth-source--decode-octal-string (match-string 1))
- (auth-source--decode-octal-string (match-string 2))))))
- (forward-line)))
- ;; return `ret' iff it has the :secret key
- (and (plist-get ret :secret) (list ret))))
+ (setq args (append args (if (string-match "[0-9]+" port)
+ (list "-P" port)
+ (list "-r" (substring
+ (format "%-4s" port)
+ 0 4)))))))
+
+ (unless (equal coll "default")
+ (setq args (append args (list coll))))
+
+ (with-temp-buffer
+ (apply #'call-process "/usr/bin/security" nil t nil args)
+ (goto-char (point-min))
+ (while (not (eobp))
+ (cond
+ ((looking-at "^password: \\(?:0x[0-9A-F]+\\)? *\"\\(.+\\)\"")
+ (setq ret (auth-source-macos-keychain-result-append
+ ret
+ keychain-generic
+ "secret"
+ (let ((v (auth-source--decode-octal-string
+ (match-string 1))))
+ (lambda () v)))))
+ ;; TODO: check if this is really the label
+ ;; match 0x00000007 <blob>="AppleID"
+ ((looking-at
+ "^[ ]+0x00000007 <blob>=\\(?:0x[0-9A-F]+\\)? *\"\\(.+\\)\"")
+ (setq ret (auth-source-macos-keychain-result-append
+ ret
+ keychain-generic
+ "label"
+ (auth-source--decode-octal-string (match-string 1)))))
+ ;; match "crtr"<uint32>="aapl"
+ ;; match "svce"<blob>="AppleID"
+ ((looking-at
+ "^[ ]+\"\\([a-z]+\\)\"[^=]+=\\(?:0x[0-9A-F]+\\)? *\"\\(.+\\)\"")
+ (setq ret (auth-source-macos-keychain-result-append
+ ret
+ keychain-generic
+ (auth-source--decode-octal-string (match-string 1))
+ (auth-source--decode-octal-string (match-string 2))))))
+ (forward-line)))
+ ;; return `ret' iff it has the :secret key
+ (and (plist-get ret :secret) (list ret))))
(defun auth-source-macos-keychain-result-append (result generic k v)
(push v result)
[-- Attachment #3: Type: text/plain, Size: 1 bytes --]
[-- Attachment #4: patch2 --]
[-- Type: text/plain, Size: 1527 bytes --]
--- auth-source-tests.el.old 2023-08-12 12:55:52.000000000 -0500
+++ auth-source-tests.el 2023-08-12 13:58:28.000000000 -0500
@@ -435,5 +435,25 @@
'((("machine" . "XM") ("login" . "XL") ("password" . "XP"))
(("machine" . "YM") ("login" . "YL") ("password" . "YP")))))))
+(ert-deftest test-macos-keychain-search ()
+ "Test if the constructed command line arglist is correct."
+ (let ((auth-sources '(macos-keychain-internet macos-keychain-generic)))
+ ;; Redefine `call-process' to check command line arguments.
+ (cl-letf (((symbol-function 'call-process)
+ (lambda (_program _infile _destination _display
+ &rest args)
+ ;; Arguments must be all strings
+ (should (cl-every #'stringp args))
+ ;; Argument number should be even
+ (should (cl-evenp (length args)))
+ (should (cond ((string= (car args) "find-internet-password")
+ (let ((protocol (cl-member "-r" args :test #'string=)))
+ (if protocol
+ (= 4 (length (cadr protocol)))
+ t)))
+ ((string= (car args) "find-generic-password")
+ t))))))
+ (auth-source-search :user '("a" "b") :host '("example.org") :port '("irc" "ftp" "https")))))
+
(provide 'auth-source-tests)
;;; auth-source-tests.el ends here
[-- Attachment #5: Type: text/plain, Size: 1090 bytes --]
>>>>> In <87r0o8z1sc.fsf@gmx.de>
>>>>> Michael Albinus <michael.albinus@gmx.de> wrote:
> LdBeth <andpuke@foxmail.com> writes:
> Hi,
>> I think it is possible to use cl-left to redefine
>> `auth-source-macos-keychain-search-items' to avoid calling external
>> security command and just check the argument passed to
>> `call-process'.
>>
>> Something like:
>>
>> (cl-letf (((symbol-function 'call-process) (lambda (&rest r) (print r))))
>> (auth-source-search :user "ldb" :port "irc"))
>>
>> ("/usr/bin/security" nil t nil "find-internet-password" "-g" "-a" "ldb" "-r" "irc ")
>>
>> ("/usr/bin/security" nil t nil "find-generic-password" "-g" "-a" "ldb" "-s" "irc")
> Yes, like this. And in the lambda function, you could check the expected
> arguments of the "/usr/bin/security" call by `should' and friends.
> Would you like to add such test(s)? This would give us more confidence
> that nothing is or will be broken, because people using macOS would test
> this by default when running "make check", even if they don't care the
> macOS keychain.
>> ldb
> Best regards, Michael.
next prev parent reply other threads:[~2023-08-12 19:02 UTC|newest]
Thread overview: 11+ messages / expand[flat|nested] mbox.gz Atom feed top
2023-07-31 15:46 bug#64977: 29.1; `auth-source-macos-keychain-search' handles :user key incorrectly LdBeth
2023-08-02 13:22 ` J.P.
2023-08-08 22:20 ` LdBeth
2023-08-12 6:55 ` Eli Zaretskii
2023-08-12 11:39 ` Michael Albinus
2023-08-12 12:55 ` LdBeth
2023-08-12 13:14 ` Michael Albinus
2023-08-12 15:40 ` LdBeth
2023-08-12 16:02 ` Michael Albinus
2023-08-12 19:02 ` LdBeth [this message]
2023-08-13 16:34 ` Michael Albinus
Reply instructions:
You may reply publicly to this message via plain-text email
using any one of the following methods:
* Save the following mbox file, import it into your mail client,
and reply-to-all from there: mbox
Avoid top-posting and favor interleaved quoting:
https://en.wikipedia.org/wiki/Posting_style#Interleaved_style
List information: https://www.gnu.org/software/emacs/
* Reply using the --to, --cc, and --in-reply-to
switches of git-send-email(1):
git send-email \
--in-reply-to=tencent_B61D562B8B3F18B7BD6E39C7EF1E050C7307@qq.com \
--to=andpuke@foxmail.com \
--cc=64977@debbugs.gnu.org \
--cc=eliz@gnu.org \
--cc=michael.albinus@gmx.de \
/path/to/YOUR_REPLY
https://kernel.org/pub/software/scm/git/docs/git-send-email.html
* If your mail client supports setting the In-Reply-To header
via mailto: links, try the mailto: link
Be sure your reply has a Subject: header at the top and a blank line
before the message body.
Code repositories for project(s) associated with this public inbox
https://git.savannah.gnu.org/cgit/emacs.git
This is a public inbox, see mirroring instructions
for how to clone and mirror all data and code used for this inbox;
as well as URLs for read-only IMAP folder(s) and NNTP newsgroup(s).