mirror/emacs
1
0
Fork 0
mirror of https://git.savannah.gnu.org/git/emacs.git synced 2024-11-23 07:19:15 +00:00
Code Issues Releases Activity

auth-source: support JSON backend with .json extension

Browse Source 
* lisp/auth-source.el (auth-source-backends-parser-file): Look
for .gpg extension and make backend decision without it. Add
JSON case to backends.

(auth-source-json-check): Parse JSON data.
This commit is contained in:
Ted Zlatanov 2017-12-19 11:36:43 -05:00
parent 56274bc0bb
commit 1d0a37f845
No known key found for this signature in database
GPG Key ID: 11F23D0A4E4B9DEE
1 changed files with 99 additions and 14 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

113
lisp/auth-source.el
View File

@ -379,24 +379,38 @@ soon as a function returns non-nil.")
;; take just a file name use it as a netrc/plist file
;; matching any user, host, and protocol
(when (stringp entry)
(setq entry `(:source ,entry)))
(cond
;; a file name with parameters
((stringp (plist-get entry :source))
(if (equal (file-name-extension (plist-get entry :source)) "plist")
(setq entry (list :source entry)))
(let* ((source (plist-get entry :source))
(source-without-gpg
(if (and (stringp source)
(equal (file-name-extension source) "gpg"))
(file-name-sans-extension source)
(or source "")))
(extension (or (file-name-extension source-without-gpg)
"")))
(when (stringp source)
(cond
((equal extension "plist")
(auth-source-backend
(plist-get entry :source)
:source (plist-get entry :source)
source
:source source
:type 'plstore
:search-function #'auth-source-plstore-search
:create-function #'auth-source-plstore-create
:data (plstore-open (plist-get entry :source)))
(auth-source-backend
(plist-get entry :source)
:source (plist-get entry :source)
:type 'netrc
:search-function #'auth-source-netrc-search
:create-function #'auth-source-netrc-create)))))
:data (plstore-open source)))
((member-ignore-case extension '("json"))
(auth-source-backend
source
:source source
:type 'json
:search-function #'auth-source-json-search))
(t
(auth-source-backend
source
:source source
:type 'netrc
:search-function #'auth-source-netrc-search
:create-function #'auth-source-netrc-create))))))
;; Note this function should be last in the parser functions, so we add it first
(add-hook 'auth-source-backend-parser-functions 'auth-source-backends-parser-file)
@ -1967,6 +1981,77 @@ entries for git.gnus.org:
(plstore-get-file (oref backend data))))
(plstore-save (oref backend data)))))
;;; Backend specific parsing: JSON backend
;;; (auth-source-search :max 1 :machine "imap.gmail.com")
;;; (auth-source-search :max 1 :host '("my-gmail" "imap.gmail.com") :port '(993 "imaps" "imap" "993" "143") :user nil :require '(:user :secret))
(defun auth-source-json-check (host user port require item)
(and item
(auth-source-search-collection
(or host t)
(or
(plist-get item :machine)
(plist-get item :host)
t))
(auth-source-search-collection
(or user t)
(or
(plist-get item :login)
(plist-get item :account)
(plist-get item :user)
t))
(auth-source-search-collection
(or port t)
(or
(plist-get item :port)
(plist-get item :protocol)
t))
(or
;; the required list of keys is nil, or
(null require)
;; every element of require is in
(cl-loop for req in require
always (plist-get item req)))))
(cl-defun auth-source-json-search (&rest spec
&key backend require create
type max host user port
&allow-other-keys)
"Given a property list SPEC, return search matches from the :backend.
See `auth-source-search' for details on SPEC."
;; just in case, check that the type is correct (null or same as the backend)
(cl-assert (or (null type) (eq type (oref backend type)))
t "Invalid JSON search: %s %s")
;; Hide the secrets early to avoid accidental exposure.
(let* ((jdata
(mapcar (lambda (entry)
(let (ret)
(while entry
(let* ((item (pop entry))
(k (auth-source--symbol-keyword (car item)))
(v (cdr item)))
(setq k (cond ((memq k '(:machine)) :host)
((memq k '(:login :account)) :user)
((memq k '(:protocol)) :port)
((memq k '(:password)) :secret)
(t k)))
;; send back the secret in a function (lexical binding)
(when (eq k :secret)
(setq v (let ((lexv v))
(lambda () lexv))))
(setq ret (plist-put ret k v))))
ret))
(json-read-file (oref backend source))))
(max (or max 5000)) ; sanity check: default to stop at 5K
all)
(dolist (item jdata)
(when (and item
(> max (length all))
(auth-source-json-check host user port require item))
(push item all)))
(nreverse all)))
;;; older API
;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")