-(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))
- ;; the code below is almost same as `netrc-store-data' except
- ;; the `epa-file-encrypt-to' hack (see bug#7487).
- (with-temp-buffer
- (when (file-exists-p source)
- (insert-file-contents source))
- (when auth-source-gpg-encrypt-to
- ;; making `epa-file-encrypt-to' local to this buffer lets
- ;; epa-file skip the key selection query (see the
- ;; `local-variable-p' check in `epa-file-write-region').
- (unless (local-variable-p 'epa-file-encrypt-to (current-buffer))
- (make-local-variable 'epa-file-encrypt-to))
- (if (listp auth-source-gpg-encrypt-to)
- (setq epa-file-encrypt-to auth-source-gpg-encrypt-to)))
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- (insert (format "machine %s login %s password %s port %s\n"
- host
- (or user (cdr (assoc "login" result)))
- (cdr (assoc "password" result))
- prot))
- (write-region (point-min) (point-max) source nil 'silent)))))
- (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)))