;;; Code:
+(require 'password-cache)
(require 'gnus-util)
(require 'netrc)
(require 'assoc)
(eval-when-compile (require 'cl))
-(require 'eieio)
+(eval-and-compile
+ (or (require 'eieio nil t)
+ ;; gnus-fallback-lib/ from gnus/lisp/gnus-fallback-lib
+ (load "gnus-fallback-lib/eieio/eieio"))
+ (unless (featurep 'eieio)
+ (error "eieio not found in `load-path' or gnus-fallback-lib/ directory.")))
(autoload 'secrets-create-item "secrets")
(autoload 'secrets-delete-item "secrets")
:version "23.1" ;; No Gnus
:group 'gnus)
+;;;###autoload
+(defcustom auth-source-cache-expiry 7200
+ "How many seconds passwords are cached, or nil to disable
+expiring. Overrides `password-cache-expiry' through a
+let-binding."
+ :group 'auth-source
+ :type '(choice (const :tag "Never" nil)
+ (const :tag "All Day" 86400)
+ (const :tag "2 Hours" 7200)
+ (const :tag "30 Minutes" 1800)
+ (integer :tag "Seconds")))
+
(defclass auth-source-backend ()
((type :initarg :type
:initform 'netrc
(defvar auth-source-creation-defaults nil
"Defaults for creating token values. Usually let-bound.")
-(defvar auth-source-cache (make-hash-table :test 'equal)
- "Cache for auth-source data")
+(make-obsolete 'auth-source-hide-passwords nil "Emacs 24.1")
+
+(defvar auth-source-magic "auth-source-magic ")
(defcustom auth-source-do-cache t
- "Whether auth-source should cache information."
+ "Whether auth-source should cache information with `password-cache'."
:group 'auth-source
:version "23.2" ;; No Gnus
:type `boolean)
-(defcustom auth-source-debug nil
+(defcustom auth-source-debug t
"Whether auth-source should log debug messages.
-Also see `auth-source-hide-passwords'.
If the value is nil, debug messages are not logged.
-If the value is t, debug messages are logged with `message'.
- In that case, your authentication data will be in the
- clear (except for passwords, which are always stripped out).
+
+If the value is t, debug messages are logged with `message'. In
+that case, your authentication data will be in the clear (except
+for passwords).
+
If the value is a function, debug messages are logged by calling
that function using the same arguments as `message'."
:group 'auth-source
(function :tag "Function that takes arguments like `message'")
(const :tag "Don't log anything" nil)))
-(defcustom auth-source-hide-passwords t
- "Whether auth-source should hide passwords in log messages.
-Only relevant if `auth-source-debug' is not nil."
- :group 'auth-source
- :version "23.2" ;; No Gnus
- :type `boolean)
-
(defcustom auth-sources '("~/.authinfo.gpg" "~/.authinfo")
"List of authentication sources.
(choice
(string :tag "Just a file")
(const :tag "Default Secrets API Collection" 'default)
- (const :tag "Login Secrets API Collection" "secrets:login")
+ (const :tag "Login Secrets API Collection" "secrets:Login")
(const :tag "Temp Secrets API Collection" "secrets:session")
(list :tag "Source definition"
(const :format "" :value :source)
(choice :tag "Collection to use"
(string :tag "Collection name")
(const :tag "Default" 'default)
- (const :tag "Login" "login")
+ (const :tag "Login" "Login")
(const
:tag "Temporary" "session"))))
(repeat :tag "Extra Parameters" :inline t
;; (auth-source-user-or-password-imap "password" "imap.myhost.com")
;; (auth-source-protocol-defaults 'imap)
-;; (let ((auth-source-debug 'debug)) (auth-source-debug "hello"))
-;; (let ((auth-source-debug t)) (auth-source-debug "hello"))
-;; (let ((auth-source-debug nil)) (auth-source-debug "hello"))
+;; (let ((auth-source-debug 'debug)) (auth-source-do-debug "hello"))
+;; (let ((auth-source-debug t)) (auth-source-do-debug "hello"))
+;; (let ((auth-source-debug nil)) (auth-source-do-debug "hello"))
(defun auth-source-do-debug (&rest msg)
- ;; set logger to either the function in auth-source-debug or 'message
- ;; note that it will be 'message if auth-source-debug is nil, so
- ;; we also check the value
(when auth-source-debug
- (let ((logger (if (functionp auth-source-debug)
- auth-source-debug
- 'message)))
- (apply logger msg))))
+ (apply 'auth-source-do-warn msg)))
+
+(defun auth-source-do-warn (&rest msg)
+ (apply
+ ;; set logger to either the function in auth-source-debug or 'message
+ ;; note that it will be 'message if auth-source-debug is nil
+ (if (functionp auth-source-debug)
+ auth-source-debug
+ 'message)
+ msg))
+
;; (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 (:secrets "Login") :host t :protocol t)
;; (:source "~/.authinfo.gpg" :host t :protocol t)))
;; (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 (:secrets "Login") :host t :protocol t)
;; ))
;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :protocol t)))
;; (auth-source-backend-parse "myfile.gpg")
;; (auth-source-backend-parse 'default)
-;; (auth-source-backend-parse "secrets:login")
+;; (auth-source-backend-parse "secrets:Login")
(defun auth-source-backend-parse (entry)
"Creates an auth-source-backend from an ENTRY in `auth-sources'."
"session")))
;; if the source is a symbol, we look for the alias named so,
- ;; and if that alias is missing, we use "login"
+ ;; and if that alias is missing, we use "Login"
(when (symbolp source)
(setq source (or (secrets-get-alias (symbol-name source))
- "login")))
-
- (auth-source-backend
- (format "Secrets API (%s)" source)
- :source source
- :type 'secrets
- :search-function 'auth-source-secrets-search
- :create-function 'auth-source-secrets-create)))
+ "Login")))
+
+ (if (featurep 'secrets)
+ (auth-source-backend
+ (format "Secrets API (%s)" source)
+ :source source
+ :type 'secrets
+ :search-function 'auth-source-secrets-search
+ :create-function 'auth-source-secrets-create)
+ (auth-source-do-warn
+ "auth-source-backend-parse: no Secrets API, ignoring spec: %S" entry)
+ (auth-source-backend
+ (format "Ignored Secrets API (%s)" source)
+ :source ""
+ :type 'ignore))))
;; none of them
(t
- (auth-source-do-debug
+ (auth-source-do-warn
"auth-source-backend-parse: invalid backend spec: %S" entry)
(auth-source-backend
"Empty"
(defun auth-source-backend-parse-parameters (entry backend)
"Fills in the extra auth-source-backend parameters of ENTRY.
Using the plist ENTRY, get the :host, :protocol, and :user search
-parameters. Accepts :port as an alias to :protocol. Sets all
-the parameters to t if they are missing."
- (let (val)
+parameters. Accepts :port as an alias to :protocol."
+ (let ((entry (if (stringp entry)
+ nil
+ entry))
+ val)
(when (setq val (plist-get entry :host))
(oset backend host val))
(when (setq val (plist-get entry :user))
(keys (loop for i below (length spec) by 2
unless (memq (nth i spec) ignored-keys)
collect (nth i spec)))
- filtered-backends accessor-key found-here found goal)
- (assert (or (eq t create) (listp create)) t
- "Invalid auth-source :create parameter (must be nil, t, or a list)")
-
- (setq filtered-backends (copy-list backends))
- (dolist (backend backends)
- (dolist (key keys)
- ;; ignore invalid slots
- (condition-case signal
- (unless (eval `(auth-source-search-collection
- (plist-get spec key)
- (oref backend ,key)))
- (setq filtered-backends (delq backend filtered-backends))
- (return))
- (invalid-slot-name))))
-
- (auth-source-do-debug
- "auth-source-search: found %d backends matching %S"
- (length filtered-backends) spec)
-
- ;; (debug spec "filtered" filtered-backends)
- (setq goal max)
- (dolist (backend filtered-backends)
- (setq found-here (apply
- (slot-value backend 'search-function)
- :backend backend
- :create create
- :delete delete
- spec))
-
- ;; if max is 0, as soon as we find something, return it
- (when (and (zerop max) (> 0 (length found-here)))
- (return t))
-
- ;; decrement the goal by the number of new results
- (decf goal (length found-here))
- ;; and append the new results to the full list
- (setq found (append found found-here))
+ (found (auth-source-recall spec))
+ filtered-backends accessor-key found-here goal)
+
+ (if (and found auth-source-do-cache)
+ (auth-source-do-debug
+ "auth-source-search: found %d CACHED results matching %S"
+ (length found) spec)
+
+ (assert
+ (or (eq t create) (listp create)) t
+ "Invalid auth-source :create parameter (must be nil, t, or a list): %s %s")
+
+ (setq filtered-backends (copy-sequence backends))
+ (dolist (backend backends)
+ (dolist (key keys)
+ ;; ignore invalid slots
+ (condition-case signal
+ (unless (eval `(auth-source-search-collection
+ (plist-get spec key)
+ (oref backend ,key)))
+ (setq filtered-backends (delq backend filtered-backends))
+ (return))
+ (invalid-slot-name))))
(auth-source-do-debug
- "auth-source-search: found %d results (max %d/%d) in %S matching %S"
- (length found-here) max goal backend spec)
+ "auth-source-search: found %d backends matching %S"
+ (length filtered-backends) spec)
+
+ ;; (debug spec "filtered" filtered-backends)
+ (setq goal max)
+ (dolist (backend filtered-backends)
+ (setq found-here (apply
+ (slot-value backend 'search-function)
+ :backend backend
+ :create create
+ :delete delete
+ spec))
+
+ ;; if max is 0, as soon as we find something, return it
+ (when (and (zerop max) (> 0 (length found-here)))
+ (return t))
+
+ ;; decrement the goal by the number of new results
+ (decf goal (length found-here))
+ ;; and append the new results to the full list
+ (setq found (append found found-here))
- ;; return full list if the goal is 0 or negative
- (when (zerop (max 0 goal))
- (return found))
+ (auth-source-do-debug
+ "auth-source-search: found %d results (max %d/%d) in %S matching %S"
+ (length found-here) max goal backend spec)
- ;; change the :max parameter in the spec to the goal
- (setq spec (plist-put spec :max goal)))
- found))
+ ;; return full list if the goal is 0 or negative
+ (when (zerop (max 0 goal))
+ (return found))
+ ;; change the :max parameter in the spec to the goal
+ (setq spec (plist-put spec :max goal)))
+
+ (when (and found auth-source-do-cache)
+ (auth-source-remember spec found)))
+
+ found))
+
+;;; (auth-source-search :max 1)
+;;; (funcall (plist-get (nth 0 (auth-source-search :max 1)) :secret))
;;; (auth-source-search :host "nonesuch" :type 'netrc :K 1)
;;; (auth-source-search :host "nonesuch" :type 'secrets)
(equal collection value)
(member value collection)))
+(defun auth-source-forget-all-cached ()
+ "Forget all cached auth-source data."
+ (interactive)
+ (loop for sym being the symbols of password-data
+ ;; when the symbol name starts with auth-source-magic
+ when (string-match (concat "^" auth-source-magic)
+ (symbol-name sym))
+ ;; remove that key
+ do (password-cache-remove (symbol-name sym))))
+
+(defun auth-source-remember (spec found)
+ "Remember FOUND search results for SPEC."
+ (let ((password-cache-expiry auth-source-cache-expiry))
+ (password-cache-add
+ (concat auth-source-magic (format "%S" spec)) found)))
+
+(defun auth-source-recall (spec)
+ "Recall FOUND search results for SPEC."
+ (password-read-from-cache
+ (concat auth-source-magic (format "%S" spec))))
+
+(defun auth-source-forget (spec)
+ "Forget any cached data matching SPEC exactly.
+
+This is the same SPEC you passed to `auth-source-search'.
+Returns t or nil for forgotten or not found."
+ (password-cache-remove (concat auth-source-magic (format "%S" spec))))
+
+;;; (loop for sym being the symbols of password-data when (string-match (concat "^" auth-source-magic) (symbol-name sym)) collect (symbol-name sym))
+
+;;; (auth-source-remember '(:host "wedd") '(4 5 6))
+;;; (auth-source-remember '(:host "xedd") '(1 2 3))
+;;; (auth-source-recall '(:host "xedd"))
+;;; (auth-source-recall '(:host t))
+;;; (auth-source-forget+ :host t)
+
+(defun* auth-source-forget+ (&rest spec &allow-other-keys)
+ "Forget any cached data matching SPEC. Returns forgotten count.
+
+This is not a full `auth-source-search' spec but works similarly.
+For instance, \(:host \"myhost\" \"yourhost\") would find all the
+cached data that was found with a search for those two hosts,
+while \(:host t) would find all host entries."
+ (let ((count 0)
+ sname)
+ (loop for sym being the symbols of password-data
+ ;; when the symbol name matches with auth-source-magic
+ when (and (setq sname (symbol-name sym))
+ (string-match (concat "^" auth-source-magic "\\(.+\\)")
+ sname)
+ ;; and the spec matches what was stored in the cache
+ (auth-source-specmatchp spec (read (match-string 1 sname))))
+ ;; remove that key
+ do (progn
+ (password-cache-remove sname)
+ (incf count)))
+ count))
+
+(defun auth-source-specmatchp (spec stored)
+ (let ((keys (loop for i below (length spec) by 2
+ collect (nth i spec))))
+ (not (eq
+ (dolist (key keys)
+ (unless (auth-source-search-collection (plist-get stored key)
+ (plist-get spec key))
+ (return 'no)))
+ 'no))))
+
;;; Backend specific parsing: netrc/authinfo backend
;;; (auth-source-netrc-parse "~/.authinfo.gpg")
See `auth-source-search' for details on SPEC."
;; just in case, check that the type is correct (null or same as the backend)
(assert (or (null type) (eq type (oref backend type)))
- t "Invalid netrc search")
+ t "Invalid netrc search: %s %s")
(let ((results (auth-source-netrc-normalize
(auth-source-netrc-parse
(when (and create
(= 0 (length results)))
- ;; create based on the spec
- (apply (slot-value backend 'create-function) spec)
- ;; turn off the :create key
- (setq spec (plist-put spec :create nil))
- ;; run the search again to get the updated data
- ;; the result will be returned, even if the search fails
- (setq results (apply 'auth-source-netrc-search spec)))
-
+ ;; create based on the spec and record the value
+ (setq results (or
+ ;; if the user did not want to create the entry
+ ;; in the file, it will be returned
+ (apply (slot-value backend 'create-function) spec)
+ ;; if not, we do the search again without :create
+ ;; to get the updated data.
+
+ ;; the result will be returned, even if the search fails
+ (apply 'auth-source-netrc-search
+ (plist-put spec :create nil)))))
results))
;;; (auth-source-search :host "nonesuch" :type 'netrc :max 1 :create t)
(file (oref backend source))
(add "")
;; `valist' is an alist
- valist)
+ valist
+ ;; `artificial' will be returned if no creation is needed
+ artificial)
;; only for base required elements (defined as function parameters):
;; fill in the valist with whatever data we may have from the search
nil nil default))
(t data))))
+ (when data
+ (setq artificial (plist-put artificial
+ (intern (concat ":" (symbol-name r)))
+ (if (eq r 'secret)
+ (lexical-let ((data data))
+ (lambda () data))
+ data))))
+
;; when r is not an empty string...
(when (and (stringp data)
(< 0 (length data)))
(goto-char (point-max))
;; ask AFTER we've successfully opened the file
- (when (y-or-n-p (format "Add to file %s: line [%s]" file add))
- (unless (bolp)
- (insert "\n"))
- (insert add "\n")
- (write-region (point-min) (point-max) file nil 'silent)
- (auth-source-do-debug
- "auth-source-netrc-create: wrote 1 new line to %s"
- file)))))
+ (if (y-or-n-p (format "Add to file %s: line [%s]" file add))
+ (progn
+ (unless (bolp)
+ (insert "\n"))
+ (insert add "\n")
+ (write-region (point-min) (point-max) file nil 'silent)
+ (auth-source-do-debug
+ "auth-source-netrc-create: wrote 1 new line to %s"
+ file)
+ nil)
+ (list artificial)))))
;;; Backend specific parsing: Secrets API backend
;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :delete t))
;;; (let ((auth-sources '(default))) (auth-source-search :max 1))
;;; (let ((auth-sources '(default))) (auth-source-search))
-;;; (let ((auth-sources '("secrets:login"))) (auth-source-search :max 1))
-;;; (let ((auth-sources '("secrets:login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git"))
+;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1))
+;;; (let ((auth-sources '("secrets:Login"))) (auth-source-search :max 1 :signon_realm "https://git.gnus.org/Git"))
(defun* auth-source-secrets-search (&rest
spec
You'll get back all the properties of the token as a plist.
-Here's an example that looks for the first item in the 'login'
+Here's an example that looks for the first item in the 'Login'
Secrets collection:
- \(let ((auth-sources '(\"secrets:login\")))
+ \(let ((auth-sources '(\"secrets:Login\")))
(auth-source-search :max 1)
-Here's another that looks for the first item in the 'login'
+Here's another that looks for the first item in the 'Login'
Secrets collection whose label contains 'gnus':
- \(let ((auth-sources '(\"secrets:login\")))
+ \(let ((auth-sources '(\"secrets:Login\")))
(auth-source-search :max 1 :label \"gnus\")
-And this one looks for the first item in the 'login' Secrets
+And this one looks for the first item in the 'Login' Secrets
collection that's a Google Chrome entry for the git.gnus.org site
-login:
+authentication tokens:
- \(let ((auth-sources '(\"secrets:login\")))
+ \(let ((auth-sources '(\"secrets:Login\")))
(auth-source-search :max 1 :signon_realm \"https://git.gnus.org/Git\"))
"
collect (nth i spec)))
;; build a search spec without the ignored keys
;; if a search key is nil or t (match anything), we skip it
- (search-spec (mapcan (lambda (k) (if (or (null (plist-get spec k))
- (eq t (plist-get spec k)))
- nil
- (list k (plist-get spec k))))
- search-keys))
+ (search-spec (apply 'append (mapcar
+ (lambda (k)
+ (if (or (null (plist-get spec k))
+ (eq t (plist-get spec k)))
+ nil
+ (list k (plist-get spec k))))
+ search-keys)))
;; needed keys (always including host, login, protocol, and secret)
- (returned-keys (remove-duplicates (append
- '(:host :login :protocol :secret)
- search-keys)))
+ (returned-keys (delete-dups (append
+ '(:host :login :protocol :secret)
+ search-keys)))
(items (loop for item in (apply 'secrets-search-items coll search-spec)
unless (and (stringp label)
(not (string-match label item)))
collect item))
;; TODO: respect max in `secrets-search-items', not after the fact
- (items (subseq items 0 (min (length items) max)))
+ (items (butlast items (- (length items) max)))
;; convert the item name to a full plist
(items (mapcar (lambda (item)
(append
(lexical-let ((v (secrets-get-secret coll item)))
(lambda () v)))
;; rewrite the entry from ((k1 v1) (k2 v2)) to plist
- (mapcan (lambda (entry)
- (list (car entry) (cdr entry)))
- (secrets-get-attributes coll item))))
+ (apply 'append
+ (mapcar (lambda (entry)
+ (list (car entry) (cdr entry)))
+ (secrets-get-attributes coll item)))))
items))
;; ensure each item has each key in `returned-keys'
(items (mapcar (lambda (plist)
(append
- (mapcan (lambda (req)
- (if (plist-get plist req)
- nil
- (list req nil)))
- returned-keys)
+ (apply 'append
+ (mapcar (lambda (req)
+ (if (plist-get plist req)
+ nil
+ (list req nil)))
+ returned-keys))
plist))
items)))
items))
;;; older API
-(defun auth-source-forget-user-or-password
- (mode host protocol &optional username)
- "Remove cached authentication token."
- (interactive "slogin/password: \nsHost: \nsProtocol: \n") ;for testing
- (remhash
- (if username
- (format "%s %s:%s %s" mode host protocol username)
- (format "%s %s:%s" mode host protocol))
- auth-source-cache))
-
-(defun auth-source-forget-all-cached ()
- "Forget all cached auth-source authentication tokens."
- (interactive)
- (setq auth-source-cache (make-hash-table :test 'equal)))
-
-;; (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")))
-
;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")
-;; deprecate this interface
-(make-obsolete 'auth-source-user-or-password 'auth-source-search "Emacs 24.1")
+;; deprecate the old interface
+(make-obsolete 'auth-source-user-or-password
+ 'auth-source-search "Emacs 24.1")
+(make-obsolete 'auth-source-forget-user-or-password
+ 'auth-source-forget "Emacs 24.1")
(defun auth-source-user-or-password
(mode host protocol &optional username create-missing delete-existing)
(search (if delete-existing
(append search (list :delete t))
search))
- (found (if (not delete-existing)
- (gethash cname auth-source-cache)
- (remhash cname auth-source-cache)
- nil)))
+ ;; (found (if (not delete-existing)
+ ;; (gethash cname auth-source-cache)
+ ;; (remhash cname auth-source-cache)
+ ;; nil)))
+ (found nil))
(if found
(progn
(auth-source-do-debug
"auth-source-user-or-password: DEPRECATED cached %s=%s for %s (%s) + %s"
mode
;; don't show the password
- (if (and (member "password" mode) auth-source-hide-passwords)
+ (if (and (member "password" mode) t)
"SECRET"
found)
host protocol username)
projects / gnus / blobdiff