+;; (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: " prot host))))
+ (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."