;;; Code:
+(require 'password-cache)
(require 'gnus-util)
(require 'netrc)
(require 'assoc)
(eval-when-compile (require 'cl))
-(eval-when-compile (require 'eieio))
+(require 'eieio)
(autoload 'secrets-create-item "secrets")
(autoload 'secrets-delete-item "secrets")
(autoload 'secrets-get-alias "secrets")
-(autoload 'secrets-get-attribute "secrets")
+(autoload 'secrets-get-attributes "secrets")
(autoload 'secrets-get-secret "secrets")
(autoload 'secrets-list-collections "secrets")
(autoload 'secrets-search-items "secrets")
:custom function
:documentation "The search function.")))
-;;(auth-source-backend "netrc" :type 'netrc)
-
(defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993")
(pop3 "pop3" "pop" "pop3s" "110" "995")
(ssh "ssh" "22")
(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)
(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.
((and
(not (null (plist-get entry :source))) ; the source must not be nil
(listp (plist-get entry :source)) ; and it must be a list
- (require 'secrets nil t) ; and we must load the Secrets API
- secrets-enabled) ; and that API must be enabled
+ (require 'secrets nil t) ; and we must load the Secrets API
+ secrets-enabled) ; and that API must be enabled
;; the source is either the :secrets key in ENTRY or
;; if that's missing or nil, it's "session"
(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)")
+
+ (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))
+
+ (auth-source-do-debug
+ "auth-source-search: found %d results (max %d/%d) in %S matching %S"
+ (length found-here) max goal backend spec)
- ;; return full list if the goal is 0 or negative
- (when (zerop (max 0 goal))
- (return 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)))
- 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."
+ (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")
;;; (let ((auth-sources '(default))) (auth-source-search :max 1 :create t))
;;; (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"))
(not (string-match label item)))
collect item))
;; TODO: respect max in `secrets-search-items', not after the fact
- (items (subseq items 0 max))
+ (items (subseq items 0 (min (length items) max)))
;; convert the item name to a full plist
(items (mapcar (lambda (item)
- (nconc
+ (append
;; make an entry for the secret (password) element
(list
:secret
items))
;; ensure each item has each key in `returned-keys'
(items (mapcar (lambda (plist)
- (nconc
+ (append
(mapcan (lambda (req)
(if (plist-get plist req)
nil
;;; 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))
+;;; (auth-source-user-or-password '("login" "password") "imap.myhost.com" t "tzz")
-(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")))
-
-;; 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)
(auth-source-do-debug
"auth-source-user-or-password: DEPRECATED get %s for %s (%s) + user=%s"
mode host protocol username)
+
(let* ((listy (listp mode))
(mode (if listy mode (list mode)))
(cname (if username
(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)
found) ; return the found data
;; else, if not found, search with a max of 1
(let ((choice (nth 0 (apply 'auth-source-search
- (nconc '(:max 1) search)))))
+ (append '(:max 1) search)))))
(when choice
- (when (member "password" mode)
- (push (funcall (plist-get :secret choice)) found))
- (when (member "login" mode)
- (push (funcall (plist-get :user choice)) found)))
- (setq found (if listy found (car-safe found)))))
+ (dolist (m mode)
+ (cond
+ ((equal "password" m)
+ (push (if (plist-get choice :secret)
+ (funcall (plist-get choice :secret))
+ nil) found))
+ ((equal "login" m)
+ (push (plist-get choice :user) found)))))
+ (setq found (nreverse found))
+ (setq found (if listy found (car-safe found)))))
found))
projects / gnus / blobdiff