+;; (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"))
+(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))))
+
+;; (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)))
+
+;; (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-get-source (entry)
+ "Return the source string of ENTRY, which is one entry in `auth-sources'.
+If it is a Secret Service API, return the collection name, otherwise
+the file name."
+ (let ((source (plist-get entry :source)))
+ (if (stringp source)
+ source
+ ;; Secret Service API.
+ (setq source (plist-get source :secrets))
+ (when (eq source 'default)
+ (setq source (or (secrets-get-alias "default") "login")))
+ (or source "session"))))
+
+(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."
+ (let ((keys (loop for i below (length spec) by 2 collect (nth i spec)))
+ choices)
+ (dolist (choice (copy-tree auth-sources) choices)
+ (let ((source (plist-get choice :source))
+ (match t))
+ (when
+ (and
+ ;; Check existence of source.
+ (if (consp source)
+ ;; Secret Service API.
+ (member (auth-get-source choice) (secrets-list-collections))
+ ;; authinfo file.
+ (file-exists-p source))
+
+ ;; Check keywords.
+ (dolist (k keys match)
+ (let* ((v (plist-get spec k))
+ (choicev (if (plist-member choice k)
+ (plist-get choice k) t)))
+ (setq match
+ (and match
+ (or
+ ;; source always matches spec key
+ (eq t choicev)
+ ;; 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))))))))
+
+ (add-to-list 'choices choice 'append))))))
+
+(defun auth-source-retrieve (mode entry &rest spec)
+ "Retrieve MODE credentials according to SPEC from ENTRY."
+ (catch 'no-password
+ (let ((host (plist-get spec :host))
+ (user (plist-get spec :user))
+ (prot (plist-get spec :protocol))
+ (source (plist-get entry :source))
+ result)
+ (cond
+ ;; Secret Service API.
+ ((consp source)
+ (let ((coll (auth-get-source entry))
+ item)
+ ;; Loop over candidates with a matching host attribute.
+ (dolist (elt (secrets-search-items coll :host host) item)
+ (when (and (or (not user)
+ (string-equal
+ user (secrets-get-attribute coll elt :user)))
+ (or (not prot)
+ (string-equal
+ prot (secrets-get-attribute coll elt :protocol))))
+ (setq item elt)
+ (return elt)))
+ ;; Compose result.
+ (when item
+ (setq result
+ (mapcar (lambda (m)
+ (if (string-equal "password" m)
+ (or (secrets-get-secret coll item)
+ ;; When we do not find a password,
+ ;; we return nil anyway.
+ (throw 'no-password nil))
+ (or (secrets-get-attribute coll item :user)
+ user)))
+ (if (consp mode) mode (list mode)))))
+ (if (consp mode) result (car result))))
+ ;; Anything else is netrc.
+ (t
+ (let ((search (list source (list host) (list (format "%s" prot))
+ (auth-source-protocol-defaults prot))))
+ (setq result
+ (mapcar (lambda (m)
+ (if (string-equal "password" m)
+ (or (apply
+ 'netrc-machine-user-or-password m search)
+ ;; When we do not find a password, we
+ ;; return nil anyway.
+ (throw 'no-password nil))
+ (or (apply
+ 'netrc-machine-user-or-password m search)
+ user)))
+ (if (consp mode) mode (list mode)))))
+ (if (consp mode) result (car result)))))))
+
+(defun auth-source-create (mode entry &rest spec)
+ "Create interactively credentials according to SPEC in ENTRY.
+Return structure as specified by MODE."
+ (let* ((host (plist-get spec :host))
+ (user (plist-get spec :user))
+ (prot (plist-get spec :protocol))
+ (source (plist-get entry :source))
+ (name (concat (if user (format "%s@" user))
+ host
+ (if prot (format ":%s" prot))))
+ result)
+ (setq result
+ (mapcar
+ (lambda (m)
+ (cons
+ m
+ (cond
+ ((equal "password" m)
+ (let ((passwd (read-passwd
+ (format "Password for %s on %s: " prot host))))
+ (cond
+ ;; Secret Service API.
+ ((consp source)
+ (apply
+ 'secrets-create-item
+ (auth-get-source entry) name passwd spec))
+ (t)) ;; netrc not implemented yes.
+ passwd))
+ ((equal "login" m)
+ (or user
+ (read-string
+ (format "User name for %s on %s (default %s): " prot host
+ (user-login-name))
+ nil nil (user-login-name))))
+ (t
+ "unknownuser"))))
+ (if (consp mode) mode (list mode))))
+ ;; Allow the source to save the data.
+ (cond
+ ((consp source)
+ ;; Secret Service API -- not implemented.
+ )
+ (t
+ ;; netrc interface.
+ (when (y-or-n-p (format "Do you want to save this password in %s? "
+ source))
+ (netrc-store-data source host prot
+ (or user (cdr (assoc "login" result)))
+ (cdr (assoc "password" result))))))
+ (if (consp mode)
+ (mapcar #'cdr result)
+ (cdar result))))
+
+(defun auth-source-delete (entry &rest spec)
+ "Delete credentials according to SPEC in ENTRY."
+ (let ((host (plist-get spec :host))
+ (user (plist-get spec :user))
+ (prot (plist-get spec :protocol))
+ (source (plist-get entry :source)))
+ (cond
+ ;; Secret Service API.
+ ((consp source)
+ (let ((coll (auth-get-source entry)))
+ ;; Loop over candidates with a matching host attribute.
+ (dolist (elt (secrets-search-items coll :host host))
+ (when (and (or (not user)
+ (string-equal
+ user (secrets-get-attribute coll elt :user)))
+ (or (not prot)
+ (string-equal
+ prot (secrets-get-attribute coll elt :protocol))))
+ (secrets-delete-item coll elt)))))
+ (t)))) ;; netrc not implemented yes.
+
+(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")))
+
+(defun auth-source-user-or-password
+ (mode host protocol &optional username create-missing delete-existing)
+ "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.
+
+A non nil DELETE-EXISTING means deleting any matching password
+entry in the respective sources. This is useful only when
+CREATE-MISSING is non nil as well; the intended use case is to
+remove wrong password entries.
+
+If no matching entry is found, and CREATE-MISSING is non nil,
+the password will be retrieved interactively, and it will be
+stored in the password database which matches best (see
+`auth-sources').
+
+MODE can be \"login\" or \"password\"."
+ (auth-source-do-debug
+ "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 (if username
+ (format "%s %s:%s %s" mode host protocol username)
+ (format "%s %s:%s" mode host protocol)))
+ (search (list :host host :protocol protocol))
+ (search (if username (append search (list :user username)) search))
+ (found (if (not delete-existing)
+ (gethash cname auth-source-cache)
+ (remhash cname auth-source-cache)
+ nil)))
+ (if found
+ (progn
+ (auth-source-do-debug
+ "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 username)
+ found) ; return the found data
+ ;; else, if not found
+ (let ((choices (apply 'auth-source-pick search)))
+ (dolist (choice choices)
+ (if delete-existing
+ (apply 'auth-source-delete choice search)
+ (setq found (apply 'auth-source-retrieve mode choice search)))
+ (and found (return found)))
+
+ ;; We haven't found something, so we will create it interactively.
+ (when (and (not found) create-missing)
+ (setq found (apply 'auth-source-create
+ mode (if choices
+ (car choices)
+ (car auth-sources))
+ search)))
+
+ ;; Cache the result.
+ (when found
+ (auth-source-do-debug
+ "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 username)
+ (setq found (if listy found (car-safe found)))
+ (when auth-source-do-cache
+ (puthash cname found auth-source-cache)))
+
+ found))))