From 936d08bba7cdc8c3a28d7ad716e82a00555fccef Mon Sep 17 00:00:00 2001 From: Gnus developers Date: Thu, 30 Jun 2011 14:25:27 +0000 Subject: [PATCH] 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. --- lisp/gnus/ChangeLog | 16 ++++ lisp/gnus/auth-source.el | 193 ++++++++++++++++++--------------------- lisp/gnus/gnus-art.el | 11 +-- 3 files changed, 108 insertions(+), 112 deletions(-) diff --git a/lisp/gnus/ChangeLog b/lisp/gnus/ChangeLog index ea7aedc3e6a..8133964dd41 100644 --- a/lisp/gnus/ChangeLog +++ b/lisp/gnus/ChangeLog @@ -1,3 +1,19 @@ +2011-06-30 Andrew Cohen + + * gnus-art.el (gnus-request-article-this-buffer): Use existing function + `gnus-refer-article-methods'. + +2011-06-30 Teodor Zlatanov + + * 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 * nnimap.el (nnimap-split-incoming-mail): If `nnimap-split-fancy' is diff --git a/lisp/gnus/auth-source.el b/lisp/gnus/auth-source.el index d62b79b6484..25c6b924305 100644 --- a/lisp/gnus/auth-source.el +++ b/lisp/gnus/auth-source.el @@ -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)))) diff --git a/lisp/gnus/gnus-art.el b/lisp/gnus/gnus-art.el index 6c3ad01eabf..7e2d213d20c 100644 --- a/lisp/gnus/gnus-art.el +++ b/lisp/gnus/gnus-art.el @@ -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)) -- 2.39.2