- (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)
- (if (equal "password" m)
- (let ((passwd (read-passwd "Password: ")))
- (cond
- ;; Secret Service API.
- ((consp source)
- (apply
- 'secrets-create-item
- (auth-get-source entry) name passwd spec))
- (t)) ;; netrc not implemented yes.
- passwd)
- (or
- ;; the originally requested :user
- user
- "unknown-user")))
- (if (consp mode) mode (list mode))))
- (if (consp mode) result (car 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))
+ (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" :port 'imap :user "joe")
+;; (auth-source-pick t :host "any" :port 'imap :user "joe")
+;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
+;; (:source (:secrets "session") :host t :port t :user "joe")
+;; (:source (:secrets "Login") :host t :port t)
+;; (:source "~/.authinfo.gpg" :host t :port t)))
+
+;; (setq auth-sources '((:source (:secrets default) :host t :port t :user "joe")
+;; (:source (:secrets "session") :host t :port t :user "joe")
+;; (:source (:secrets "Login") :host t :port t)
+;; ))
+
+;; (setq auth-sources '((:source "~/.authinfo.gpg" :host t :port t)))
+
+;; (auth-source-backend-parse "myfile.gpg")
+;; (auth-source-backend-parse 'default)
+;; (auth-source-backend-parse "secrets:Login")
+
+(defun auth-source-backend-parse (entry)
+ "Creates an auth-source-backend from an ENTRY in `auth-sources'."
+ (auth-source-backend-parse-parameters
+ entry
+ (cond
+ ;; take 'default and recurse to get it as a Secrets API default collection
+ ;; matching any user, host, and protocol
+ ((eq entry 'default)
+ (auth-source-backend-parse '(:source (:secrets default))))
+ ;; take secrets:XYZ and recurse to get it as Secrets API collection "XYZ"
+ ;; matching any user, host, and protocol
+ ((and (stringp entry) (string-match "^secrets:\\(.+\\)" entry))
+ (auth-source-backend-parse `(:source (:secrets ,(match-string 1 entry)))))
+ ;; take just a file name and recurse to get it as a netrc file
+ ;; matching any user, host, and protocol
+ ((stringp entry)
+ (auth-source-backend-parse `(:source ,entry)))
+
+ ;; a file name with parameters
+ ((stringp (plist-get entry :source))
+ (auth-source-backend
+ (plist-get entry :source)
+ :source (plist-get entry :source)
+ :type 'netrc
+ :search-function 'auth-source-netrc-search
+ :create-function 'auth-source-netrc-create))
+
+ ;; the Secrets API. We require the package, in order to have a
+ ;; defined value for `secrets-enabled'.
+ ((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
+
+ ;; the source is either the :secrets key in ENTRY or
+ ;; if that's missing or nil, it's "session"
+ (let ((source (or (plist-get (plist-get entry :source) :secrets)
+ "session")))
+
+ ;; if the source is a symbol, we look for the alias named so,
+ ;; and if that alias is missing, we use "Login"
+ (when (symbolp source)
+ (setq source (or (secrets-get-alias (symbol-name source))
+ "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-warn
+ "auth-source-backend-parse: invalid backend spec: %S" entry)
+ (auth-source-backend
+ "Empty"
+ :source ""
+ :type 'ignore)))))
+
+(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, :port, and :user search
+parameters."
+ (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))
+ (oset backend user val))
+ (when (setq val (plist-get entry :port))
+ (oset backend port val)))
+ backend)
+
+;; (mapcar 'auth-source-backend-parse auth-sources)
+
+(defun* auth-source-search (&rest spec
+ &key type max host user port secret
+ create delete
+ &allow-other-keys)
+ "Search or modify authentication backends according to SPEC.
+
+This function parses `auth-sources' for matches of the SPEC
+plist. It can optionally create or update an authentication
+token if requested. A token is just a standard Emacs property
+list with a :secret property that can be a function; all the
+other properties will always hold scalar values.
+
+Typically the :secret property, if present, contains a password.
+
+Common search keys are :max, :host, :port, and :user. In
+addition, :create specifies how tokens will be or created.
+Finally, :type can specify which backend types you want to check.
+
+A string value is always matched literally. A symbol is matched
+as its string value, literally. All the SPEC values can be
+single values (symbol or string) or lists thereof (in which case
+any of the search terms matches).
+
+:create t means to create a token if possible.
+
+A new token will be created if no matching tokens were found.
+The new token will have only the keys the backend requires. For
+the netrc backend, for instance, that's the user, host, and
+port keys.
+
+Here's an example:
+
+\(let ((auth-source-creation-defaults '((user . \"defaultUser\")
+ (A . \"default A\"))))
+ (auth-source-search :host \"mine\" :type 'netrc :max 1
+ :P \"pppp\" :Q \"qqqq\"
+ :create t))
+
+which says:
+
+\"Search for any entry matching host 'mine' in backends of type
+ 'netrc', maximum one result.
+
+ Create a new entry if you found none. The netrc backend will
+ automatically require host, user, and port. The host will be
+ 'mine'. We prompt for the user with default 'defaultUser' and
+ for the port without a default. We will not prompt for A, Q,
+ or P. The resulting token will only have keys user, host, and
+ port.\"
+
+:create '(A B C) also means to create a token if possible.
+
+The behavior is like :create t but if the list contains any
+parameter, that parameter will be required in the resulting
+token. The value for that parameter will be obtained from the
+search parameters or from user input. If any queries are needed,
+the alist `auth-source-creation-defaults' will be checked for the
+default prompt.
+
+Here's an example:
+
+\(let ((auth-source-creation-defaults '((user . \"defaultUser\")
+ (A . \"default A\"))))
+ (auth-source-search :host '(\"nonesuch\" \"twosuch\") :type 'netrc :max 1
+ :P \"pppp\" :Q \"qqqq\"
+ :create '(A B Q)))
+
+which says:
+
+\"Search for any entry matching host 'nonesuch'
+ or 'twosuch' in backends of type 'netrc', maximum one result.
+
+ Create a new entry if you found none. The netrc backend will
+ automatically require host, user, and port. The host will be
+ 'nonesuch' and Q will be 'qqqq'. We prompt for A with default
+ 'default A', for B and port with default nil, and for the
+ user with default 'defaultUser'. We will not prompt for Q. The
+ resulting token will have keys user, host, port, A, B, and Q.
+ It will not have P with any value, even though P is used in the
+ search to find only entries that have P set to 'pppp'.\"
+
+When multiple values are specified in the search parameter, the
+user is prompted for which one. So :host (X Y Z) would ask the
+user to choose between X, Y, and Z.
+
+This creation can fail if the search was not specific enough to
+create a new token (it's up to the backend to decide that). You
+should `catch' the backend-specific error as usual. Some
+backends (netrc, at least) will prompt the user rather than throw
+an error.
+
+:delete t means to delete any found entries. nil by default.
+Use `auth-source-delete' in ELisp code instead of calling
+`auth-source-search' directly with this parameter.
+
+:type (X Y Z) will check only those backend types. 'netrc and
+'secrets are the only ones supported right now.
+
+:max N means to try to return at most N items (defaults to 1).
+When 0 the function will return just t or nil to indicate if any
+matches were found. More than N items may be returned, depending
+on the search and the backend.
+
+:host (X Y Z) means to match only hosts X, Y, or Z according to
+the match rules above. Defaults to t.
+
+:user (X Y Z) means to match only users X, Y, or Z according to
+the match rules above. Defaults to t.
+
+:port (P Q R) means to match only protocols P, Q, or R.
+Defaults to t.
+
+:K (V1 V2 V3) for any other key K will match values V1, V2, or
+V3 (note the match rules above).
+
+The return value is a list with at most :max tokens. Each token
+is a plist with keys :backend :host :port :user, plus any other
+keys provided by the backend (notably :secret). But note the
+exception for :max 0, which see above.
+
+The token's :secret key can hold a function. In that case you
+must call it to obtain the actual value."
+ (let* ((backends (mapcar 'auth-source-backend-parse auth-sources))
+ (max (or max 1))
+ (ignored-keys '(:create :delete :max))
+ (keys (loop for i below (length spec) by 2
+ unless (memq (nth i spec) ignored-keys)
+ collect (nth i spec)))
+ (found (auth-source-recall spec))
+ filtered-backends accessor-key found-here goal matches)
+
+ (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 backends matching %S"
+ (length filtered-backends) spec)
+
+ ;; (debug spec "filtered" filtered-backends)
+ (setq goal max)
+ ;; First go through all the backends without :create, so we can
+ ;; query them all.
+ (let ((uspec (copy-sequence spec)))
+ (plist-put uspec :create nil)
+ (dolist (backend filtered-backends)
+ (let ((match (apply
+ (slot-value backend 'search-function)
+ :backend backend
+ uspec)))
+ (when match
+ (push (list backend match) matches)))))
+ ;; If we didn't find anything, then we allow the backend(s) to
+ ;; create the entries.
+ (when (and create
+ (not matches))
+ (dolist (backend filtered-backends)
+ (unless matches
+ (let ((match (apply
+ (slot-value backend 'search-function)
+ :backend backend
+ :create create
+ :delete delete
+ spec)))
+ (when match
+ (push (list backend match) matches))))))
+
+ (setq backend (caar matches)
+ found-here (cadar matches))
+
+ (block nil
+ ;; 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))
+
+ ;; 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)
+
+(defun* auth-source-delete (&rest spec
+ &key delete
+ &allow-other-keys)
+ "Delete entries from the authentication backends according to SPEC.
+Calls `auth-source-search' with the :delete property in SPEC set to t.
+The backend may not actually delete the entries.
+
+Returns the deleted entries."
+ (auth-source-search (plist-put spec :delete t)))
+
+(defun auth-source-search-collection (collection value)
+ "Returns t is VALUE is t or COLLECTION is t or contains VALUE."
+ (when (and (atom collection) (not (eq t collection)))
+ (setq collection (list collection)))
+
+ ;; (debug :collection collection :value value)
+ (or (eq collection t)
+ (eq value t)
+ (equal collection value)
+ (member value collection)))