diff options
| author | Martin Jesper Low Madsen | 2016-02-06 17:17:27 +1100 |
|---|---|---|
| committer | Lars Ingebrigtsen | 2016-02-06 17:17:27 +1100 |
| commit | 20087772d63192a2ef443cc2ea6ac48423db5ed6 (patch) | |
| tree | e29e621dee8d47166078f342f1da2579346d8ccd | |
| parent | c796361d79f2ec856847ed38c45f83c4d7247aab (diff) | |
| download | emacs-20087772d63192a2ef443cc2ea6ac48423db5ed6.tar.gz emacs-20087772d63192a2ef443cc2ea6ac48423db5ed6.zip | |
Search for host/port combinations in auth-source on OS X
* lisp/gnus/auth-source.el (auth-source-macos-keychain-search):
Search for all host/port (or protocol) combinations for a match in
the OS X keychain.
| -rw-r--r-- | lisp/gnus/auth-source.el | 34 |
1 files changed, 25 insertions, 9 deletions
diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index 52765ce6b31..da3d670b4cd 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el | |||
| @@ -1715,12 +1715,13 @@ entries for git.gnus.org: | |||
| 1715 | 1715 | ||
| 1716 | (let* ((coll (oref backend source)) | 1716 | (let* ((coll (oref backend source)) |
| 1717 | (max (or max 5000)) ; sanity check: default to stop at 5K | 1717 | (max (or max 5000)) ; sanity check: default to stop at 5K |
| 1718 | (ignored-keys '(:create :delete :max :backend :label)) | 1718 | ;; Filter out ignored keys from the spec |
| 1719 | (ignored-keys '(:create :delete :max :backend :label :host :port)) | ||
| 1720 | ;; Build a search spec without the ignored keys | ||
| 1719 | (search-keys (loop for i below (length spec) by 2 | 1721 | (search-keys (loop for i below (length spec) by 2 |
| 1720 | unless (memq (nth i spec) ignored-keys) | 1722 | unless (memq (nth i spec) ignored-keys) |
| 1721 | collect (nth i spec))) | 1723 | collect (nth i spec))) |
| 1722 | ;; build a search spec without the ignored keys | 1724 | ;; If a search key value is nil or t (match anything), we skip it |
| 1723 | ;; if a search key is nil or t (match anything), we skip it | ||
| 1724 | (search-spec (apply #'append (mapcar | 1725 | (search-spec (apply #'append (mapcar |
| 1725 | (lambda (k) | 1726 | (lambda (k) |
| 1726 | (if (or (null (plist-get spec k)) | 1727 | (if (or (null (plist-get spec k)) |
| @@ -1732,11 +1733,25 @@ entries for git.gnus.org: | |||
| 1732 | (returned-keys (mm-delete-duplicates (append | 1733 | (returned-keys (mm-delete-duplicates (append |
| 1733 | '(:host :login :port :secret) | 1734 | '(:host :login :port :secret) |
| 1734 | search-keys))) | 1735 | search-keys))) |
| 1735 | (items (apply #'auth-source-macos-keychain-search-items | 1736 | ;; Extract host and port from spec |
| 1736 | coll | 1737 | (hosts (plist-get spec :host)) |
| 1737 | type | 1738 | (hosts (if (and hosts (listp hosts)) hosts `(,hosts))) |
| 1738 | max | 1739 | (ports (plist-get spec :port)) |
| 1739 | search-spec)) | 1740 | (ports (if (and ports (listp ports)) ports `(,ports))) |
| 1741 | ;; Loop through all combinations of host/port and pass each of these to | ||
| 1742 | ;; auth-source-macos-keychain-search-items | ||
| 1743 | (items (catch 'match | ||
| 1744 | (dolist (host hosts) | ||
| 1745 | (dolist (port ports) | ||
| 1746 | (let* ((port (format "%S" port)) | ||
| 1747 | (items (apply #'auth-source-macos-keychain-search-items | ||
| 1748 | coll | ||
| 1749 | type | ||
| 1750 | max | ||
| 1751 | host port | ||
| 1752 | search-spec))) | ||
| 1753 | (when items | ||
| 1754 | (throw 'match items))))))) | ||
| 1740 | 1755 | ||
| 1741 | ;; ensure each item has each key in `returned-keys' | 1756 | ;; ensure each item has each key in `returned-keys' |
| 1742 | (items (mapcar (lambda (plist) | 1757 | (items (mapcar (lambda (plist) |
| @@ -1752,8 +1767,9 @@ entries for git.gnus.org: | |||
| 1752 | items)) | 1767 | items)) |
| 1753 | 1768 | ||
| 1754 | (defun* auth-source-macos-keychain-search-items (coll _type _max | 1769 | (defun* auth-source-macos-keychain-search-items (coll _type _max |
| 1770 | host port | ||
| 1755 | &key label type | 1771 | &key label type |
| 1756 | host user port | 1772 | user |
| 1757 | &allow-other-keys) | 1773 | &allow-other-keys) |
| 1758 | 1774 | ||
| 1759 | (let* ((keychain-generic (eq type 'macos-keychain-generic)) | 1775 | (let* ((keychain-generic (eq type 'macos-keychain-generic)) |