Commit 936d08bb authored by Gnus developers's avatar Gnus developers Committed by Katsumi Yamaoka
Browse files

Merge changes made in Gnus trunk.

gnus-art.el (gnus-request-article-this-buffer): Use existing function `gnus-refer-article-methods'.
auth-source.el: Require EPA and EPG.
 (auth-source-passphrase-alist): New variable.
 (auth-source-passphrase-callback-function, auth-source-token-passphrase-callback-function): Callbacks for the netrc field encryption (GPG tokens).
 (auth-source-epa-extract-gpg-token, auth-source-epa-make-gpg-token): Symmetric encryption and decryption of the netrc GPG tokens.
 (auth-source-netrc-normalize): Use them, simplifying the closure.
parent 9851bfc5
2011-06-30 Andrew Cohen <cohen@andy.bu.edu>
* gnus-art.el (gnus-request-article-this-buffer): Use existing function
`gnus-refer-article-methods'.
2011-06-30 Teodor Zlatanov <tzz@lifelogs.com>
* auth-source.el: Require EPA and EPG.
(auth-source-passphrase-alist): New variable.
(auth-source-passphrase-callback-function)
(auth-source-token-passphrase-callback-function): Callbacks for the
netrc field encryption (GPG tokens).
(auth-source-epa-extract-gpg-token, auth-source-epa-make-gpg-token):
Symmetric encryption and decryption of the netrc GPG tokens.
(auth-source-netrc-normalize): Use them, simplifying the closure.
2011-06-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
 
* nnimap.el (nnimap-split-incoming-mail): If `nnimap-split-fancy' is
......
......@@ -43,6 +43,9 @@
(require 'mm-util)
(require 'gnus-util)
(require 'assoc)
(require 'epa)
(require 'epg)
(eval-when-compile (require 'cl))
(require 'eieio)
......@@ -979,56 +982,78 @@ Note that the MAX parameter is used so we can exit the parse early."
(nreverse result))))))
(defmacro with-auth-source-epa-overrides (&rest body)
`(let ((file-name-handler-alist
',(if (boundp 'epa-file-handler)
(remove (symbol-value 'epa-file-handler)
file-name-handler-alist)
file-name-handler-alist))
(,(if (boundp 'find-file-hook) 'find-file-hook 'find-file-hooks)
',(remove
'epa-file-find-file-hook
(if (boundp 'find-file-hook)
(symbol-value 'find-file-hook)
(symbol-value 'find-file-hooks))))
(auto-mode-alist
',(if (boundp 'epa-file-auto-mode-alist-entry)
(remove (symbol-value 'epa-file-auto-mode-alist-entry)
auto-mode-alist)
auto-mode-alist)))
,@body))
(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)
;; return the saved passphrase, calling a function if needed
(or (copy-sequence (if (functionp (cdr entry))
(funcall (cdr entry))
(cdr entry)))
(progn
(unless entry
(setq entry (list file))
(push entry auth-source-passphrase-alist))
(setq passphrase (auth-source-passphrase-callback-function context
key-id
file
" tokens"))
(setcdr entry (lexical-let ((p (copy-sequence passphrase)))
(lambda () p)))
passphrase)))
(epa-passphrase-callback-function context key-id file)))
;; (auth-source-epa-extract-gpg-token "gpg:LS0tLS1CRUdJTiBQR1AgTUVTU0FHRS0tLS0tClZlcnNpb246IEdudVBHIHYxLjQuMTEgKEdOVS9MaW51eCkKCmpBMEVBd01DT25qMjB1ak9rZnRneVI3K21iNm9aZWhuLzRad3cySkdlbnVaKzRpeEswWDY5di9icDI1U1dsQT0KPS9yc2wKLS0tLS1FTkQgUEdQIE1FU1NBR0UtLS0tLQo=" "~/.netrc")
(defun auth-source-epa-extract-gpg-token (secret file)
"Pass either the decoded SECRET or the gpg:BASE64DATA version.
FILE is the file from which we obtained this token."
(when (string-match "^gpg:\\(.+\\)" secret)
(setq secret (base64-decode-string (match-string 1 secret))))
(let ((context (epg-make-context 'OpenPGP))
plain)
(epg-context-set-passphrase-callback
context
(cons #'auth-source-token-passphrase-callback-function
file))
(epg-decrypt-string context secret)))
;; (insert (auth-source-epa-make-gpg-token "mysecret" "~/.netrc"))
(defun auth-source-epa-make-gpg-token (secret file)
(require 'epa nil t)
(unless (featurep 'epa)
(error "EPA could not be loaded."))
(let* ((base (file-name-sans-extension file))
(passkey (format "gpg:-%s" base))
(stash (concat base ".gpg"))
;; temporarily disable EPA
(stashfile
(with-auth-source-epa-overrides
(make-temp-file "gpg-token" nil
stash)))
(epa-file-passphrase-alist
`((,stashfile
. ,(password-read
(format
"token pass for %s? "
file)
passkey)))))
(write-region secret nil stashfile)
;; temporarily disable EPA
(unwind-protect
(with-auth-source-epa-overrides
(with-temp-buffer
(insert-file-contents stashfile)
(base64-encode-region (point-min) (point-max) t)
(concat "gpg:"
(buffer-substring-no-properties
(point-min)
(point-max)))))
(delete-file stashfile))))
(let ((context (epg-make-context 'OpenPGP))
(pp-escape-newlines nil)
cipher)
(epg-context-set-armor context t)
(epg-context-set-passphrase-callback
context
(cons #'auth-source-token-passphrase-callback-function
file))
(setq cipher (epg-encrypt-string context secret nil))
(with-temp-buffer
(insert cipher)
(base64-encode-region (point-min) (point-max) t)
(concat "gpg:" (buffer-substring-no-properties
(point-min)
(point-max))))))
(defun auth-source-netrc-normalize (alist filename)
(mapcar (lambda (entry)
......@@ -1046,60 +1071,22 @@ Note that the MAX parameter is used so we can exit the parse early."
;; send back the secret in a function (lexical binding)
(when (equal k "secret")
(setq v (lexical-let ((v v)
(filename filename)
(base (file-name-nondirectory
filename))
(token-decoder nil)
(gpgdata nil)
(stash nil))
(setq stash (concat base ".gpg"))
(when (string-match "gpg:\\(.+\\)" v)
(require 'epa nil t)
(unless (featurep 'epa)
(error "EPA could not be loaded."))
(setq gpgdata (base64-decode-string
(match-string 1 v)))
;; it's a GPG token
(setq
token-decoder
(lambda (gpgdata)
;;; FIXME: this relies on .gpg files being handled by EPA/EPG
(let* ((passkey (format "gpg:-%s" base))
;; temporarily disable EPA
(stashfile
(with-auth-source-epa-overrides
(make-temp-file "gpg-token" nil
stash)))
(epa-file-passphrase-alist
`((,stashfile
. ,(password-read
(format
"token pass for %s? "
filename)
passkey)))))
(unwind-protect
(progn
;; temporarily disable EPA
(with-auth-source-epa-overrides
(write-region gpgdata
nil
stashfile))
(setq
v
(with-temp-buffer
(insert-file-contents stashfile)
(buffer-substring-no-properties
(point-min)
(point-max)))))
(delete-file stashfile)))
;; clear out the decoder at end
(setq token-decoder nil
gpgdata nil))))
(lambda ()
(when token-decoder
(funcall token-decoder gpgdata))
v))))
(setq v (lexical-let ((lexv v)
(token-decoder nil))
(when (string-match "^gpg:" lexv)
;; it's a GPG token: create a token decoder
;; which unsets itself once
(setq token-decoder
(lambda (val)
(prog1
(auth-source-epa-extract-gpg-token
val
filename)
(setq token-decoder nil)))))
(lambda ()
(when token-decoder
(setq lexv (funcall token-decoder lexv)))
lexv))))
(setq ret (plist-put ret
(intern (concat ":" k))
v))))
......
......@@ -6832,23 +6832,16 @@ If given a prefix, show the hidden text instead."
(numberp article))
(let ((gnus-override-method gnus-override-method)
(methods (and (stringp article)
gnus-refer-article-method))
(with-current-buffer gnus-summary-buffer
(gnus-refer-article-methods))))
(backend (car (gnus-find-method-for-group
gnus-newsgroup-name)))
result
(inhibit-read-only t))
(if (or (not (listp methods))
(and (symbolp (car methods))
(assq (car methods) nnoo-definition-alist)))
(setq methods (list methods)))
(when (and (null gnus-override-method)
methods)
(setq gnus-override-method (pop methods)))
(while (not result)
(when (eq gnus-override-method 'current)
(setq gnus-override-method
(with-current-buffer gnus-summary-buffer
gnus-current-select-method)))
(erase-buffer)
(gnus-kill-all-overlays)
(let ((gnus-newsgroup-name group))
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment