procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Fix auth-source-macos-keychain (bug#64977)

Browse source 
* lisp/auth-source.el (auth-source-macos-keychain-search)
(auth-source-macos-keychain-search-items): Fix handling of user
and port.

* test/lisp/auth-source-tests.el (test-macos-keychain-search): New test.
This commit is contained in:
LdBeth 2023-08-13 18:31:47 +02:00 • committed by Michael Albinus
parent ba914bd9c9
commit 14cd2a058e
2 changed files with 76 additions and 50 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

106
lisp/auth-source.el
View file

@ -1958,20 +1958,23 @@ entries for git.gnus.org:
(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 @@ entries for git.gnus.org:
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 @@ entries for git.gnus.org:
(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)))))
(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))))
(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))))
(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)

20
test/lisp/auth-source-tests.el
View file

@ -435,5 +435,25 @@ machine c1 port c2 user c3 password c4\n"
'((("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