;; See the auth.info Info documentation for details.
+;; TODO:
+
+;; - never decode the backend file unless it's necessary
+;; - a more generic way to match backends and search backend contents
+;; - absorb netrc.el and simplify it
+;; - protect passwords better
+;; - allow creating and changing netrc lines (not files) e.g. change a password
+
;;; Code:
(require 'gnus-util)
:group 'gnus)
(defcustom auth-source-protocols '((imap "imap" "imaps" "143" "993")
- (pop3 "pop3" "pop" "pop3s" "110" "995")
- (ssh "ssh" "22")
- (sftp "sftp" "115")
- (smtp "smtp" "25"))
+ (pop3 "pop3" "pop" "pop3s" "110" "995")
+ (ssh "ssh" "22")
+ (sftp "sftp" "115")
+ (smtp "smtp" "25"))
"List of authentication protocols and their names"
:group 'auth-source
:version "23.2" ;; No Gnus
:type '(repeat :tag "Authentication Protocols"
- (cons :tag "Protocol Entry"
- (symbol :tag "Protocol")
- (repeat :tag "Names"
- (string :tag "Name")))))
+ (cons :tag "Protocol Entry"
+ (symbol :tag "Protocol")
+ (repeat :tag "Names"
+ (string :tag "Name")))))
;;; generate all the protocols in a format Customize can use
;;; TODO: generate on the fly from auth-source-protocols
(defconst auth-source-protocols-customize
(mapcar (lambda (a)
- (let ((p (car-safe a)))
- (list 'const
- :tag (upcase (symbol-name p))
- p)))
- auth-source-protocols))
+ (let ((p (car-safe a)))
+ (list 'const
+ :tag (upcase (symbol-name p))
+ p)))
+ auth-source-protocols))
(defvar auth-source-cache (make-hash-table :test 'equal)
"Cache for auth-source data")
that function using the same arguments as `message'."
:group 'auth-source
:version "23.2" ;; No Gnus
- :type `(choice
- :tag "auth-source debugging mode"
- (const :tag "Log using `message' to the *Messages* buffer" t)
- (function :tag "Function that takes arguments like `message'")
- (const :tag "Don't log anything" nil)))
+ :type `(choice
+ :tag "auth-source debugging mode"
+ (const :tag "Log using `message' to the *Messages* buffer" t)
+ (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.
:type `boolean)
(defcustom auth-sources '((:source "~/.authinfo.gpg")
- (:source "~/.authinfo"))
+ (:source "~/.authinfo"))
"List of authentication sources.
The default will get login and password information from a .gpg
:group 'auth-source
:version "23.2" ;; No Gnus
:type `(repeat :tag "Authentication Sources"
- (list :tag "Source definition"
- (const :format "" :value :source)
- (choice :tag "Authentication backend choice"
- (string :tag "Authentication Source (file)")
- (list :tag "secrets.el (Secret Service API/KWallet/GNOME Keyring)"
+ (list :tag "Source definition"
+ (const :format "" :value :source)
+ (choice :tag "Authentication backend choice"
+ (string :tag "Authentication Source (file)")
+ (list :tag "secrets.el (Secret Service API/KWallet/GNOME Keyring)"
(const :format "" :value :secrets)
(choice :tag "Collection to use"
(string :tag "Collection name")
(const :tag "Default" 'default)
(const :tag "Login" "login")
(const :tag "Temporary" "session"))))
- (repeat :tag "Extra Parameters" :inline t
- (choice :tag "Extra parameter"
- (list :tag "Host (omit to match as a fallback)"
- (const :format "" :value :host)
- (choice :tag "Host (machine) choice"
- (const :tag "Any" t)
- (regexp :tag "Host (machine) regular expression")))
- (list :tag "Protocol (omit to match as a fallback)"
- (const :format "" :value :protocol)
- (choice :tag "Protocol"
- (const :tag "Any" t)
- ,@auth-source-protocols-customize))
- (list :tag "User (omit to match as a fallback)" :inline t
- (const :format "" :value :user)
- (choice :tag "Personality or username"
- (const :tag "Any" t)
- (string :tag "Specific user name"))))))))
+ (repeat :tag "Extra Parameters" :inline t
+ (choice :tag "Extra parameter"
+ (list :tag "Host (omit to match as a fallback)"
+ (const :format "" :value :host)
+ (choice :tag "Host (machine) choice"
+ (const :tag "Any" t)
+ (regexp :tag "Host (machine) regular expression")))
+ (list :tag "Protocol (omit to match as a fallback)"
+ (const :format "" :value :protocol)
+ (choice :tag "Protocol"
+ (const :tag "Any" t)
+ ,@auth-source-protocols-customize))
+ (list :tag "User (omit to match as a fallback)" :inline t
+ (const :format "" :value :user)
+ (choice :tag "Personality or username"
+ (const :tag "Any" t)
+ (string :tag "Specific user name"))))))))
;; temp for debugging
;; (unintern 'auth-source-protocols)
;; we also check the value
(when auth-source-debug
(let ((logger (if (functionp auth-source-debug)
- auth-source-debug
- 'message)))
+ 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)))
+;; (: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)
-;; ))
+;; (: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)))
the file name."
(let ((source (plist-get entry :source)))
(if (stringp source)
- source
+ source
;; Secret Service API.
(setq source (plist-get source :secrets))
(when (eq source 'default)
- (setq source (or (secrets-get-alias "default") "login")))
+ (setq source (or (secrets-get-alias "default") "login")))
(or source "session"))))
(defun auth-source-pick (&rest spec)
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)
+ 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))))))
+ (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)
+ (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))))
+ (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)))))))
+ (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)
+ (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))))
+ (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)
(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))))))
+ source))
+ (netrc-store-data source host prot
+ (or user (cdr (assoc "login" result)))
+ (cdr (assoc "password" result))))))
(if (consp mode)
- (mapcar #'cdr result)
+ (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)))
+ (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)))))
+ ;; 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
"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)))
+ (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
+ (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))))
+ (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))))
(defun auth-source-protocol-defaults (protocol)
"Return a list of default ports and names for PROTOCOL."
projects / emacs.git / commitdiff