auth-source.el (auth-source-token-passphrase-callback-function): Simplify and remove EPA dependency.
This commit is contained in:
Daiki Ueno
Katsumi Yamaoka
parent
26bde865f6
commit
e9cb4479f5
2 changed files with 130 additions and 133 deletions
|
|
@ -45,7 +45,17 @@
|
|||
(require 'assoc)
|
||||
|
||||
(eval-when-compile (require 'cl))
|
||||
(require 'eieio)
|
||||
(eval-and-compile
|
||||
(or (ignore-errors (require 'eieio))
|
||||
;; gnus-fallback-lib/ from gnus/lisp/gnus-fallback-lib
|
||||
(ignore-errors
|
||||
(let ((load-path (cons (expand-file-name
|
||||
"gnus-fallback-lib/eieio"
|
||||
(file-name-directory (locate-library "gnus")))
|
||||
load-path)))
|
||||
(require 'eieio)))
|
||||
(error
|
||||
"eieio not found in `load-path' or gnus-fallback-lib/ directory.")))
|
||||
|
||||
(autoload 'secrets-create-item "secrets")
|
||||
(autoload 'secrets-delete-item "secrets")
|
||||
|
|
@ -64,8 +74,6 @@
|
|||
(autoload 'plstore-save "plstore")
|
||||
(autoload 'plstore-get-file "plstore")
|
||||
|
||||
(autoload 'epa-passphrase-callback-function "epa")
|
||||
|
||||
(autoload 'epg-context-operation "epg")
|
||||
(autoload 'epg-make-context "epg")
|
||||
(autoload 'epg-context-set-passphrase-callback "epg")
|
||||
|
|
@ -92,6 +100,9 @@ let-binding."
|
|||
(const :tag "30 Minutes" 1800)
|
||||
(integer :tag "Seconds")))
|
||||
|
||||
;;; The slots below correspond with the `auth-source-search' spec,
|
||||
;;; so a backend with :host set, for instance, would match only
|
||||
;;; searches for that host. Normally they are nil.
|
||||
(defclass auth-source-backend ()
|
||||
((type :initarg :type
|
||||
:initform 'netrc
|
||||
|
|
@ -285,9 +296,9 @@ can get pretty complex."
|
|||
(const :format "" :value :user)
|
||||
(choice
|
||||
:tag "Personality/Username"
|
||||
(const :tag "Any" t)
|
||||
(string
|
||||
:tag "Name")))))))))
|
||||
(const :tag "Any" t)
|
||||
(string
|
||||
:tag "Name")))))))))
|
||||
|
||||
(defcustom auth-source-gpg-encrypt-to t
|
||||
"List of recipient keys that `authinfo.gpg' encrypted to.
|
||||
|
|
@ -328,8 +339,8 @@ If the value is not a list, symmetric encryption will be used."
|
|||
|
||||
(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
|
||||
;; 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)
|
||||
|
|
@ -397,19 +408,19 @@ with \"[a/b/c] \" if CHOICES is '\(?a ?b ?c\)."
|
|||
;; a file name with parameters
|
||||
((stringp (plist-get entry :source))
|
||||
(if (equal (file-name-extension (plist-get entry :source)) "plist")
|
||||
(auth-source-backend
|
||||
(plist-get entry :source)
|
||||
:source (plist-get entry :source)
|
||||
:type 'plstore
|
||||
:search-function 'auth-source-plstore-search
|
||||
:create-function 'auth-source-plstore-create
|
||||
:data (plstore-open (plist-get entry :source)))
|
||||
(auth-source-backend
|
||||
(plist-get entry :source)
|
||||
:source (plist-get entry :source)
|
||||
:type 'plstore
|
||||
:search-function 'auth-source-plstore-search
|
||||
:create-function 'auth-source-plstore-create
|
||||
:data (plstore-open (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)))
|
||||
(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'.
|
||||
|
|
@ -683,7 +694,7 @@ must call it to obtain the actual value."
|
|||
(when auth-source-do-cache
|
||||
(auth-source-remember spec found)))
|
||||
|
||||
found))
|
||||
found))
|
||||
|
||||
(defun auth-source-search-backends (backends spec max create delete require)
|
||||
(let (matches)
|
||||
|
|
@ -805,7 +816,7 @@ while \(:host t) would find all host entries."
|
|||
|
||||
(defun auth-source-specmatchp (spec stored)
|
||||
(let ((keys (loop for i below (length spec) by 2
|
||||
collect (nth i spec))))
|
||||
collect (nth i spec))))
|
||||
(not (eq
|
||||
(dolist (key keys)
|
||||
(unless (auth-source-search-collection (plist-get stored key)
|
||||
|
|
@ -840,10 +851,10 @@ while \(:host t) would find all host entries."
|
|||
(unless (listp values)
|
||||
(setq values (list values)))
|
||||
(mapcar (lambda (value)
|
||||
(if (numberp value)
|
||||
(format "%s" value)
|
||||
value))
|
||||
values))
|
||||
(if (numberp value)
|
||||
(format "%s" value)
|
||||
value))
|
||||
values))
|
||||
|
||||
;;; Backend specific parsing: netrc/authinfo backend
|
||||
|
||||
|
|
@ -888,7 +899,7 @@ Note that the MAX parameter is used so we can exit the parse early."
|
|||
(base64-encode-string
|
||||
(buffer-string)))))
|
||||
(lambda () (base64-decode-string
|
||||
(rot13-string v)))))))
|
||||
(rot13-string v)))))))
|
||||
(goto-char (point-min))
|
||||
;; Go through the file, line by line.
|
||||
(while (and (not (eobp))
|
||||
|
|
@ -955,7 +966,7 @@ Note that the MAX parameter is used so we can exit the parse early."
|
|||
(null require)
|
||||
;; every element of require is in the normalized list
|
||||
(let ((normalized (nth 0 (auth-source-netrc-normalize
|
||||
(list alist) file))))
|
||||
(list alist) file))))
|
||||
(loop for req in require
|
||||
always (plist-get normalized req)))))
|
||||
(decf max)
|
||||
|
|
@ -993,25 +1004,7 @@ Note that the MAX parameter is used so we can exit the parse early."
|
|||
|
||||
(defvar auth-source-passphrase-alist nil)
|
||||
|
||||
(defun auth-source-passphrase-callback-function (context key-id handback
|
||||
&optional sym-detail)
|
||||
"Exactly like `epa-passphrase-callback-function' but takes an
|
||||
extra SYM-DETAIL parameter which will be printed at the end of
|
||||
the symmetric passphrase prompt, and assumes symmetric
|
||||
encryption."
|
||||
(read-passwd
|
||||
(format "Passphrase for symmetric encryption%s%s: "
|
||||
;; Add the file name to the prompt, if any.
|
||||
(if (stringp handback)
|
||||
(format " for %s" handback)
|
||||
"")
|
||||
(if (stringp sym-detail)
|
||||
sym-detail
|
||||
""))
|
||||
(eq (epg-context-operation context) 'encrypt)))
|
||||
|
||||
(defun auth-source-token-passphrase-callback-function (context key-id file)
|
||||
(if (eq key-id 'SYM)
|
||||
(let* ((file (file-truename file))
|
||||
(entry (assoc file auth-source-passphrase-alist))
|
||||
passphrase)
|
||||
|
|
@ -1023,14 +1016,13 @@ encryption."
|
|||
(unless entry
|
||||
(setq entry (list file))
|
||||
(push entry auth-source-passphrase-alist))
|
||||
(setq passphrase (auth-source-passphrase-callback-function context
|
||||
key-id
|
||||
file
|
||||
" tokens"))
|
||||
(setq passphrase
|
||||
(read-passwd
|
||||
(format "Passphrase for %s tokens: " file)
|
||||
t))
|
||||
(setcdr entry (lexical-let ((p (copy-sequence passphrase)))
|
||||
(lambda () p)))
|
||||
passphrase)))
|
||||
(epa-passphrase-callback-function context key-id file)))
|
||||
passphrase))))
|
||||
|
||||
;; (auth-source-epa-extract-gpg-token "gpg:LS0tLS1CRUdJTiBQR1AgTUVTU0FHRS0tLS0tClZlcnNpb246IEdudVBHIHYxLjQuMTEgKEdOVS9MaW51eCkKCmpBMEVBd01DT25qMjB1ak9rZnRneVI3K21iNm9aZWhuLzRad3cySkdlbnVaKzRpeEswWDY5di9icDI1U1dsQT0KPS9yc2wKLS0tLS1FTkQgUEdQIE1FU1NBR0UtLS0tLQo=" "~/.netrc")
|
||||
(defun auth-source-epa-extract-gpg-token (secret file)
|
||||
|
|
@ -1096,11 +1088,11 @@ FILE is the file from which we obtained this token."
|
|||
(when token-decoder
|
||||
(setq lexv (funcall token-decoder lexv)))
|
||||
lexv))))
|
||||
(setq ret (plist-put ret
|
||||
(intern (concat ":" k))
|
||||
v))))
|
||||
ret))
|
||||
alist))
|
||||
(setq ret (plist-put ret
|
||||
(intern (concat ":" k))
|
||||
v))))
|
||||
ret))
|
||||
alist))
|
||||
|
||||
;;; (setq secret (plist-get (nth 0 (auth-source-search :host t :type 'netrc :K 1 :max 1)) :secret))
|
||||
;;; (funcall secret)
|
||||
|
|
@ -1110,7 +1102,7 @@ FILE is the file from which we obtained this token."
|
|||
&key backend require create delete
|
||||
type max host user port
|
||||
&allow-other-keys)
|
||||
"Given a property list SPEC, return search matches from the :backend.
|
||||
"Given a property list SPEC, return search matches from the :backend.
|
||||
See `auth-source-search' for details on SPEC."
|
||||
;; just in case, check that the type is correct (null or same as the backend)
|
||||
(assert (or (null type) (eq type (oref backend type)))
|
||||
|
|
@ -1160,9 +1152,9 @@ See `auth-source-search' for details on SPEC."
|
|||
;; we know (because of an assertion in auth-source-search) that the
|
||||
;; :create parameter is either t or a list (which includes nil)
|
||||
(create-extra (if (eq t create) nil create))
|
||||
(current-data (car (auth-source-search :max 1
|
||||
:host host
|
||||
:port port)))
|
||||
(current-data (car (auth-source-search :max 1
|
||||
:host host
|
||||
:port port)))
|
||||
(required (append base-required create-extra))
|
||||
(file (oref backend source))
|
||||
(add "")
|
||||
|
|
@ -1198,8 +1190,8 @@ See `auth-source-search' for details on SPEC."
|
|||
(let* ((data (aget valist r))
|
||||
;; take the first element if the data is a list
|
||||
(data (or (auth-source-netrc-element-or-first data)
|
||||
(plist-get current-data
|
||||
(intern (format ":%s" r) obarray))))
|
||||
(plist-get current-data
|
||||
(intern (format ":%s" r) obarray))))
|
||||
;; this is the default to be offered
|
||||
(given-default (aget auth-source-creation-defaults r))
|
||||
;; the default supplementals are simple:
|
||||
|
|
@ -1246,8 +1238,8 @@ See `auth-source-search' for details on SPEC."
|
|||
(cond
|
||||
((and (null data) (eq r 'secret))
|
||||
;; Special case prompt for passwords.
|
||||
;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") nil) (t gpg)))
|
||||
;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
|
||||
;; TODO: make the default (setq auth-source-netrc-use-gpg-tokens `((,(if (boundp 'epa-file-auto-mode-alist-entry) (car (symbol-value 'epa-file-auto-mode-alist-entry)) "\\.gpg\\'") nil) (t gpg)))
|
||||
;; TODO: or maybe leave as (setq auth-source-netrc-use-gpg-tokens 'never)
|
||||
(let* ((ep (format "Use GPG password tokens in %s?" file))
|
||||
(gpg-encrypt
|
||||
(cond
|
||||
|
|
@ -1264,7 +1256,7 @@ See `auth-source-search' for details on SPEC."
|
|||
(setq ret (cdr item))
|
||||
(setq check nil)))))
|
||||
(t 'never)))
|
||||
(plain (read-passwd prompt)))
|
||||
(plain (read-passwd prompt)))
|
||||
;; ask if we don't know what to do (in which case
|
||||
;; auth-source-netrc-use-gpg-tokens must be a list)
|
||||
(unless gpg-encrypt
|
||||
|
|
@ -1312,9 +1304,9 @@ See `auth-source-search' for details on SPEC."
|
|||
(secret "password")
|
||||
(port "port") ; redundant but clearer
|
||||
(t (symbol-name r)))
|
||||
(if (string-match "[\" ]" data)
|
||||
(format "%S" data)
|
||||
data)))))
|
||||
(if (string-match "[\" ]" data)
|
||||
(format "%S" data)
|
||||
data)))))
|
||||
(setq add (concat add (funcall printer)))))))
|
||||
|
||||
(plist-put
|
||||
|
|
@ -1377,9 +1369,9 @@ Respects `auth-source-save-behavior'. Uses
|
|||
(?n (setq add ""
|
||||
done t))
|
||||
(?N
|
||||
(setq add ""
|
||||
done t)
|
||||
(customize-save-variable 'auth-source-save-behavior nil))
|
||||
(setq add ""
|
||||
done t)
|
||||
(customize-save-variable 'auth-source-save-behavior nil))
|
||||
(?e (setq add (read-string "Line to add: " add)))
|
||||
(t nil)))
|
||||
|
||||
|
|
@ -1470,11 +1462,11 @@ authentication tokens:
|
|||
(eq t (plist-get spec k)))
|
||||
nil
|
||||
(list k (plist-get spec k))))
|
||||
search-keys)))
|
||||
search-keys)))
|
||||
;; needed keys (always including host, login, port, and secret)
|
||||
(returned-keys (mm-delete-duplicates (append
|
||||
'(:host :login :port :secret)
|
||||
search-keys)))
|
||||
'(:host :login :port :secret)
|
||||
search-keys)))
|
||||
(items (loop for item in (apply 'secrets-search-items coll search-spec)
|
||||
unless (and (stringp label)
|
||||
(not (string-match label item)))
|
||||
|
|
@ -1534,31 +1526,31 @@ authentication tokens:
|
|||
;; if a search key is nil or t (match anything), we skip it
|
||||
(search-spec (apply 'append (mapcar
|
||||
(lambda (k)
|
||||
(let ((v (plist-get spec k)))
|
||||
(if (or (null v)
|
||||
(eq t v))
|
||||
nil
|
||||
(if (stringp v)
|
||||
(setq v (list v)))
|
||||
(list k v))))
|
||||
search-keys)))
|
||||
(let ((v (plist-get spec k)))
|
||||
(if (or (null v)
|
||||
(eq t v))
|
||||
nil
|
||||
(if (stringp v)
|
||||
(setq v (list v)))
|
||||
(list k v))))
|
||||
search-keys)))
|
||||
;; needed keys (always including host, login, port, and secret)
|
||||
(returned-keys (mm-delete-duplicates (append
|
||||
'(:host :login :port :secret)
|
||||
search-keys)))
|
||||
'(:host :login :port :secret)
|
||||
search-keys)))
|
||||
(items (plstore-find store search-spec))
|
||||
(item-names (mapcar #'car items))
|
||||
(item-names (mapcar #'car items))
|
||||
(items (butlast items (- (length items) max)))
|
||||
;; convert the item to a full plist
|
||||
(items (mapcar (lambda (item)
|
||||
(let* ((plist (copy-tree (cdr item)))
|
||||
(secret (plist-member plist :secret)))
|
||||
(if secret
|
||||
(setcar
|
||||
(cdr secret)
|
||||
(lexical-let ((v (car (cdr secret))))
|
||||
(lambda () v))))
|
||||
plist))
|
||||
(let* ((plist (copy-tree (cdr item)))
|
||||
(secret (plist-member plist :secret)))
|
||||
(if secret
|
||||
(setcar
|
||||
(cdr secret)
|
||||
(lexical-let ((v (car (cdr secret))))
|
||||
(lambda () v))))
|
||||
plist))
|
||||
items))
|
||||
;; ensure each item has each key in `returned-keys'
|
||||
(items (mapcar (lambda (plist)
|
||||
|
|
@ -1574,38 +1566,38 @@ authentication tokens:
|
|||
(cond
|
||||
;; if we need to create an entry AND none were found to match
|
||||
((and create
|
||||
(not items))
|
||||
(not items))
|
||||
|
||||
;; create based on the spec and record the value
|
||||
(setq items (or
|
||||
;; if the user did not want to create the entry
|
||||
;; in the file, it will be returned
|
||||
(apply (slot-value backend 'create-function) spec)
|
||||
;; if not, we do the search again without :create
|
||||
;; to get the updated data.
|
||||
;; if the user did not want to create the entry
|
||||
;; in the file, it will be returned
|
||||
(apply (slot-value backend 'create-function) spec)
|
||||
;; if not, we do the search again without :create
|
||||
;; to get the updated data.
|
||||
|
||||
;; the result will be returned, even if the search fails
|
||||
(apply 'auth-source-plstore-search
|
||||
(plist-put spec :create nil)))))
|
||||
;; the result will be returned, even if the search fails
|
||||
(apply 'auth-source-plstore-search
|
||||
(plist-put spec :create nil)))))
|
||||
((and delete
|
||||
item-names)
|
||||
item-names)
|
||||
(dolist (item-name item-names)
|
||||
(plstore-delete store item-name))
|
||||
(plstore-delete store item-name))
|
||||
(plstore-save store)))
|
||||
items))
|
||||
|
||||
(defun* auth-source-plstore-create (&rest spec
|
||||
&key backend
|
||||
secret host user port create
|
||||
&allow-other-keys)
|
||||
&key backend
|
||||
secret host user port create
|
||||
&allow-other-keys)
|
||||
(let* ((base-required '(host user port secret))
|
||||
(base-secret '(secret))
|
||||
(base-secret '(secret))
|
||||
;; we know (because of an assertion in auth-source-search) that the
|
||||
;; :create parameter is either t or a list (which includes nil)
|
||||
(create-extra (if (eq t create) nil create))
|
||||
(current-data (car (auth-source-search :max 1
|
||||
:host host
|
||||
:port port)))
|
||||
(current-data (car (auth-source-search :max 1
|
||||
:host host
|
||||
:port port)))
|
||||
(required (append base-required create-extra))
|
||||
(file (oref backend source))
|
||||
(add "")
|
||||
|
|
@ -1613,7 +1605,7 @@ authentication tokens:
|
|||
valist
|
||||
;; `artificial' will be returned if no creation is needed
|
||||
artificial
|
||||
secret-artificial)
|
||||
secret-artificial)
|
||||
|
||||
;; only for base required elements (defined as function parameters):
|
||||
;; fill in the valist with whatever data we may have from the search
|
||||
|
|
@ -1642,8 +1634,8 @@ authentication tokens:
|
|||
(let* ((data (aget valist r))
|
||||
;; take the first element if the data is a list
|
||||
(data (or (auth-source-netrc-element-or-first data)
|
||||
(plist-get current-data
|
||||
(intern (format ":%s" r) obarray))))
|
||||
(plist-get current-data
|
||||
(intern (format ":%s" r) obarray))))
|
||||
;; this is the default to be offered
|
||||
(given-default (aget auth-source-creation-defaults r))
|
||||
;; the default supplementals are simple:
|
||||
|
|
@ -1702,23 +1694,23 @@ authentication tokens:
|
|||
(t (or data default))))
|
||||
|
||||
(when data
|
||||
(if (member r base-secret)
|
||||
(setq secret-artificial
|
||||
(plist-put secret-artificial
|
||||
(intern (concat ":" (symbol-name r)))
|
||||
data))
|
||||
(setq artificial (plist-put artificial
|
||||
(intern (concat ":" (symbol-name r)))
|
||||
data))))))
|
||||
(if (member r base-secret)
|
||||
(setq secret-artificial
|
||||
(plist-put secret-artificial
|
||||
(intern (concat ":" (symbol-name r)))
|
||||
data))
|
||||
(setq artificial (plist-put artificial
|
||||
(intern (concat ":" (symbol-name r)))
|
||||
data))))))
|
||||
(plstore-put (oref backend data)
|
||||
(sha1 (format "%s@%s:%s"
|
||||
(plist-get artificial :user)
|
||||
(plist-get artificial :host)
|
||||
(plist-get artificial :port)))
|
||||
artificial secret-artificial)
|
||||
(sha1 (format "%s@%s:%s"
|
||||
(plist-get artificial :user)
|
||||
(plist-get artificial :host)
|
||||
(plist-get artificial :port)))
|
||||
artificial secret-artificial)
|
||||
(if (y-or-n-p (format "Save auth info to file %s? "
|
||||
(plstore-get-file (oref backend data))))
|
||||
(plstore-save (oref backend data)))))
|
||||
(plstore-get-file (oref backend data))))
|
||||
(plstore-save (oref backend data)))))
|
||||
|
||||
;;; older API
|
||||
|
||||
|
|
@ -1794,14 +1786,14 @@ MODE can be \"login\" or \"password\"."
|
|||
(cond
|
||||
((equal "password" m)
|
||||
(push (if (plist-get choice :secret)
|
||||
(funcall (plist-get choice :secret))
|
||||
nil) found))
|
||||
(funcall (plist-get choice :secret))
|
||||
nil) found))
|
||||
((equal "login" m)
|
||||
(push (plist-get choice :user) found)))))
|
||||
(setq found (nreverse found))
|
||||
(setq found (if listy found (car-safe found)))))
|
||||
|
||||
found))
|
||||
found))
|
||||
|
||||
(provide 'auth-source)
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Add a link
Reference in a new issue