procyberian/emacs
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

auth-source.el (auth-source-token-passphrase-callback-function): Simplify and remove EPA dependency.

Browse source
This commit is contained in:
Daiki Ueno 2011-07-01 14:05:59 +00:00 • committed by Katsumi Yamaoka
parent 26bde865f6
commit e9cb4479f5
2 changed files with 130 additions and 133 deletions
Download patch file Download diff file Expand all files Collapse all files

5
lisp/gnus/ChangeLog
View file

@ -1,3 +1,8 @@
2011-07-01 Daiki Ueno <ueno@unixuser.org>
* auth-source.el (auth-source-token-passphrase-callback-function):
Simplify and remove EPA dependency.
2011-07-01 Andrew Cohen <cohen@andy.bu.edu> 2011-07-01 Andrew Cohen <cohen@andy.bu.edu>
* nnir.el (nnir-request-article): Fix error message text. * nnir.el (nnir-request-article): Fix error message text.

258
lisp/gnus/auth-source.el
View file

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