mirrors/emacs
1
Fork 0
mirror of git://git.sv.gnu.org/emacs.git synced 2026-01-30 12:21:25 -08:00
Code Issues Projects Releases Wiki Activity

2010-03-27 Teodor Zlatanov <tzz@lifelogs.com>

Browse source 
* auth-source.el (auth-sources): Change default to be simpler.  Explain
 about Secret Service API sources.  Improve Customize options.
 (auth-source-pick): Change to accept any number of search parameters.
 Implement fallbacks iteratively, not recursively.  Add scoring on the
 second pass and sort by score.  Call Secret Service API when needed.
 (auth-source-user-or-password): Use it.  Call Secret Service API
 directly when needed to get the user name and the password.
This commit is contained in:
Katsumi Yamaoka 2010-03-28 23:52:01 +00:00
parent 40f0529d4e
commit fb178e4c72
2 changed files with 200 additions and 56 deletions
Download patch file Download diff file Expand all files Collapse all files

10
lisp/gnus/ChangeLog
View file

@ -1,3 +1,13 @@
2010-03-27 Teodor Zlatanov <tzz@lifelogs.com>
* auth-source.el (auth-sources): Change default to be simpler. Explain
about Secret Service API sources. Improve Customize options.
(auth-source-pick): Change to accept any number of search parameters.
Implement fallbacks iteratively, not recursively. Add scoring on the
second pass and sort by score. Call Secret Service API when needed.
(auth-source-user-or-password): Use it. Call Secret Service API
directly when needed to get the user name and the password.
2010-03-24 Juanma Barranquero <lekktu@gmail.com>
* message.el (message-interactive): Doc fix.

246
lisp/gnus/auth-source.el
View file

@ -38,6 +38,7 @@
(autoload 'secrets-search-items "secrets")
(autoload 'secrets-get-alias "secrets")
(autoload 'secrets-get-attribute "secrets")
(autoload 'secrets-get-secret "secrets")
(defgroup auth-source nil
"Authentication sources."
@ -60,6 +61,7 @@
(string :tag "Name")))))
;;; generate all the protocols in a format Customize can use
;;; TODO: generate on the fly from auth-source-protocols
(defconst auth-source-protocols-customize
(mapcar (lambda (a)
(let ((p (car-safe a)))
@ -102,9 +104,13 @@ Only relevant if `auth-source-debug' is not nil."
:version "23.2" ;; No Gnus
:type `boolean)
(defcustom auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t))
(defcustom auth-sources '((:source "~/.authinfo.gpg"))
"List of authentication sources.
The default will get login and password information from a .gpg
file, which you should set up with the EPA/EPG packages to be
encrypted. See the auth.info manual for details.
Each entry is the authentication type with optional properties.
It's best to customize this with `M-x customize-variable' because the choices
@ -121,27 +127,24 @@ can get pretty complex."
(choice :tag "Collection to use"
(string :tag "Collection name")
(const :tag "Default" 'default)
(const :tag "Any" t)
(const :tag "Temporary" "session")
(string :tag "Specific session name")
(const :tag "Fallback" nil))))
(const :format "" :value :host)
(choice :tag "Host (machine) choice"
(const :tag "Any" t)
(regexp :tag "Host (machine) regular expression (TODO)")
(const :tag "Fallback" nil))
(const :format "" :value :protocol)
(choice :tag "Protocol"
(const :tag "Any" t)
(const :tag "Fallback" nil)
,@auth-source-protocols-customize)
(const :tag "Login" "login")
(const :tag "Temporary" "session"))))
(repeat :tag "Extra Parameters" :inline t
(choice :tag "Extra parameter"
(list :tag "Preferred username" :inline t
(const :format "" :value :preferred-username)
(list :tag "Host (omit to match as a fallback)"
(const :format "" :value :host)
(choice :tag "Host (machine) choice"
(const :tag "Any" t)
(regexp :tag "Host (machine) regular expression")))
(list :tag "Protocol (omit to match as a fallback)"
(const :format "" :value :protocol)
(choice :tag "Protocol"
(const :tag "Any" t)
,@auth-source-protocols-customize))
(list :tag "User (omit to match as a fallback)" :inline t
(const :format "" :value :user)
(choice :tag "Personality or username"
(const :tag "Any" t)
(const :tag "Fallback" nil)
(string :tag "Specific user name"))))))))
;; temp for debugging
@ -153,7 +156,7 @@ can get pretty complex."
;; (customize-variable 'auth-source-protocols)
;; (setq auth-source-protocols nil)
;; (format "%S" auth-source-protocols)
;; (auth-source-pick "a" 'imap)
;; (auth-source-pick nil :host "a" :port 'imap)
;; (auth-source-user-or-password "login" "imap.myhost.com" 'imap)
;; (auth-source-user-or-password "password" "imap.myhost.com" 'imap)
;; (auth-source-user-or-password-imap "login" "imap.myhost.com")
@ -173,27 +176,121 @@ can get pretty complex."
'message)))
(apply logger msg))))
(defun auth-source-pick (host protocol &optional fallback)
"Parse `auth-sources' for HOST, and PROTOCOL matches.
;; (auth-source-pick nil :host "any" :protocol 'imap :user "joe")
;; (auth-source-pick t :host "any" :protocol 'imap :user "joe")
;; (setq auth-sources '((:source (:secrets default) :host t :protocol t :user "joe")
;; (:source (:secrets "session") :host t :protocol t :user "joe")
;; (:source (:secrets "login") :host t :protocol t)
;; (:source "~/.authinfo.gpg" :host t :protocol t)))
Returns fallback choices (where PROTOCOL or HOST are nil) with FALLBACK t."
(interactive "sHost: \nsProtocol: \n") ;for testing
;; (setq auth-sources '((:source (:secrets default) :host t :protocol t :user "joe")
;; (:source (:secrets "session") :host t :protocol t :user "joe")
;; (:source (:secrets "login") :host t :protocol t)
;; ))
;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t)))
(defun auth-source-pick (&rest spec)
"Parse `auth-sources' for matches of the SPEC plist.
Common keys are :host, :protocol, and :user. A value of t in
SPEC means to always succeed in the match. A string value is
matched as a regex.
The first pass skips fallback choices. If no choices are found
on the first pass, a second pass is made including the fallback
choices.
For string (filename) sources, fallback choices are those where
PROTOCOL or HOST are nil.
For secrets.el collections, the :host and :protocol keys are not
checked for fallback choices."
(let (choices)
(dolist (choice auth-sources)
(let ((h (plist-get choice :host))
(p (plist-get choice :protocol)))
(when (and
(or (equal t h)
(and (stringp h) (string-match h host))
(and fallback (equal h nil)))
(or (equal t p)
(and (symbolp p) (equal p protocol))
(and fallback (equal p nil))))
(push choice choices))))
(if choices
choices
(unless fallback
(auth-source-pick host protocol t)))))
(dolist (fallback '(nil t))
(let ((keys (loop for i below (length spec) by 2
collect (nth i spec)))
(default-session-fallback "login"))
(dolist (choice auth-sources)
(let* ((s (plist-get choice :source))
;; this is only set for Secret Service API specs (see secrets.el)
(coll (plist-get s :secrets))
(score 0))
(cond
(coll ; use secrets.el here
(when (eq coll 'default)
(setq coll (secrets-get-alias "default"))
(unless coll
(auth-source-do-debug
"No 'default' alias. Trying collection '%s'."
default-session-fallback)
(setq coll default-session-fallback)))
(let* ((coll-search (cond
((stringp coll) coll)
;; when the collection is nil:
;; in fallback mode, accept it as any
;; otherwise, hope to fail
((null coll) (if fallback
nil
" *fallback-fail*"))))
;; assemble a search query for secrets-search-items
;; in fallback mode, host and protocol are not checked
(other-search (loop for k
in (if fallback
(remove :host
(remove :protocol keys))
keys)
append (list
k
;; convert symbols to a string
(let ((v (plist-get spec k)))
(if (stringp v)
v
(prin1-to-string v))))))
;; the score is based on how exact the search was,
;; plus base score = 1 for any match
(score (1+ (length other-search)))
(results (apply 'secrets-search-items
coll-search
other-search)))
(auth-source-do-debug
"auth-source-pick: got items %s in collection '%s' + %s"
results coll-search other-search)
;; put the results in the choices variable
(dolist (result results)
(setq choices (cons (list score
`(:source secrets
:item ,result
:collection ,coll
:search ,coll-search
,@other-search))
choices)))))
;; this is any non-secrets spec (currently means a string filename)
(t
(let ((match t))
(dolist (k keys)
(let* ((v (plist-get spec k))
(choicev (plist-get choice k)))
(setq match
(and match
(or (eq t choicev) ; source always matches spec key
;; source key gives regex to match against spec
(and (stringp choicev) (string-match choicev v))
;; source key gives symbol to match against spec
(and (symbolp choicev) (eq choicev v))
;; in fallback mode, missing source key is OK
fallback)))
(when match (incf score)))) ; increment the score for each match
;; now if the whole iteration resulted in a match:
(when match
(setq choices (cons (list score choice) choices))))))))
;; when there were matches, skip the second pass
(when choices (return choices))))
;; return the results sorted by score
(mapcar 'cadr (sort choices (lambda (x y) (> (car x) (car y)))))))
(defun auth-source-forget-user-or-password (mode host protocol)
(interactive "slogin/password: \nsHost: \nsProtocol: \n") ;for testing
@ -204,44 +301,81 @@ Returns fallback choices (where PROTOCOL or HOST are nil) with FALLBACK t."
(interactive)
(setq auth-source-cache (make-hash-table :test 'equal)))
(defun auth-source-user-or-password (mode host protocol)
;; (progn
;; (auth-source-forget-all-cached)
;; (list
;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other")
;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other" "tzz")
;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" "other" "joe")))
(defun auth-source-user-or-password (mode host protocol &optional username)
"Find MODE (string or list of strings) matching HOST and PROTOCOL.
USERNAME is optional and will be used as \"login\" in a search
across the Secret Service API (see secrets.el) if the resulting
items don't have a username. This means that if you search for
username \"joe\" and it matches an item but the item doesn't have
a :user attribute, the username \"joe\" will be returned.
MODE can be \"login\" or \"password\" for example."
(auth-source-do-debug
"auth-source-user-or-password: get %s for %s (%s)"
mode host protocol)
"auth-source-user-or-password: get %s for %s (%s) + user=%s"
mode host protocol username)
(let* ((listy (listp mode))
(mode (if listy mode (list mode)))
(cname (format "%s %s:%s" mode host protocol))
(extras (when username `(:user ,username)))
(cname (format "%s %s:%s %s" mode host protocol extras))
(search (list :host host :protocol protocol))
(search (if username (append search (list :user username)) search))
(found (gethash cname auth-source-cache)))
(if found
(progn
(auth-source-do-debug
"auth-source-user-or-password: cached %s=%s for %s (%s)"
"auth-source-user-or-password: cached %s=%s for %s (%s) + %s"
mode
;; don't show the password
(if (and (member "password" mode) auth-source-hide-passwords) "SECRET" found)
host protocol)
found)
(dolist (choice (auth-source-pick host protocol))
(setq found (netrc-machine-user-or-password
mode
(plist-get choice :source)
(list host)
(list (format "%s" protocol))
(auth-source-protocol-defaults protocol)))
(if (and (member "password" mode) auth-source-hide-passwords)
"SECRET"
found)
host protocol extras)
found) ; return the found data
;; else, if not found
(dolist (choice (apply 'auth-source-pick search))
(setq found (cond
;; the secrets.el spec
((eq (plist-get choice :source) 'secrets)
(let ((coll (plist-get choice :search))
(item (plist-get choice :item)))
(mapcar (lambda (m)
(if (equal "password" m)
(secrets-get-secret coll item)
;; the user name is either
(or
;; the secret's attribute :user, or
(secrets-get-attribute coll item :user)
;; the originally requested :user
username
"unknown-user")))
mode)))
(t ; anything else is netrc
(netrc-machine-user-or-password
mode
(plist-get choice :source)
(list host)
(list (format "%s" protocol))
(auth-source-protocol-defaults protocol)))))
(when found
(auth-source-do-debug
"auth-source-user-or-password: found %s=%s for %s (%s)"
"auth-source-user-or-password: found %s=%s for %s (%s) + %s"
mode
;; don't show the password
(if (and (member "password" mode) auth-source-hide-passwords) "SECRET" found)
host protocol)
host protocol extras)
(setq found (if listy found (car-safe found)))
(when auth-source-do-cache
(puthash cname found auth-source-cache)))
(return found)))))
(defun auth-source-protocol-defaults (protocol)
"Return a list of default ports and names for PROTOCOL."
(cdr-safe (assoc protocol auth-source-protocols)))