aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard M. Stallman2014-11-08 10:48:13 -0500
committerRichard M. Stallman2014-11-08 10:48:13 -0500
commitc6bd7594658dcad56bdd6507088c43b792db83a1 (patch)
tree8722c783c0aaa76b8de60f6358b8b1c7c6a9fb8a
parent31a57f2215330a772b8d7f1fa444ce14aa107582 (diff)
downloademacs-c6bd7594658dcad56bdd6507088c43b792db83a1.tar.gz
emacs-c6bd7594658dcad56bdd6507088c43b792db83a1.zip
Make rmail-epa-decrypt handle more ways of formatting the message.
* mail/rmail.el (rmail-epa-decrypt): Detect armor with line prefixes. Check more carefully for mime-part specified character set. Check for mime-part Content Transfer Encoding. Notify if no armor found.
-rw-r--r--lisp/ChangeLog7
-rw-r--r--lisp/mail/rmail.el56
2 files changed, 49 insertions, 14 deletions
diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index dae450a2776..aac6ba5d739 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
12014-11-08 Richard Stallman <rms@gnu.org>
2
3 * mail/rmail.el (rmail-epa-decrypt): Detect armor with line prefixes.
4 Check more carefully for mime-part specified character set.
5 Check for mime-part Content Transfer Encoding.
6 Notify if no armor found.
7
12014-11-08 Martin Rudalics <rudalics@gmx.at> 82014-11-08 Martin Rudalics <rudalics@gmx.at>
2 9
3 * faces.el (face-set-after-frame-default): Enable running 10 * faces.el (face-set-after-frame-default): Enable running
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el
index 5f3628b7131..8c43e090d63 100644
--- a/lisp/mail/rmail.el
+++ b/lisp/mail/rmail.el
@@ -4512,11 +4512,11 @@ encoded string (and the same mask) will decode the string."
4512 ;; change it in one of the calls to `epa-decrypt-region'. 4512 ;; change it in one of the calls to `epa-decrypt-region'.
4513 4513
4514 (save-excursion 4514 (save-excursion
4515 (let (decrypts) 4515 (let (decrypts (mime (rmail-mime-message-p)))
4516 (goto-char (point-min)) 4516 (goto-char (point-min))
4517 4517
4518 ;; Turn off mime processing. 4518 ;; Turn off mime processing.
4519 (when (and (rmail-mime-message-p) 4519 (when (and mime
4520 (not (get-text-property (point-min) 'rmail-mime-hidden))) 4520 (not (get-text-property (point-min) 'rmail-mime-hidden)))
4521 (rmail-mime)) 4521 (rmail-mime))
4522 4522
@@ -4525,10 +4525,19 @@ encoded string (and the same mask) will decode the string."
4525 (goto-char (point-min)) 4525 (goto-char (point-min))
4526 (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t) 4526 (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t)
4527 (let ((coding-system-for-read coding-system-for-read) 4527 (let ((coding-system-for-read coding-system-for-read)
4528 armor-start armor-end after-end) 4528 (case-fold-search t)
4529 unquote
4530 armor-start armor-prefix armor-end after-end)
4531
4529 (setq armor-start (match-beginning 0) 4532 (setq armor-start (match-beginning 0)
4530 armor-end (re-search-forward "^-----END PGP MESSAGE-----$" 4533 armor-prefix (buffer-substring
4531 nil t)) 4534 (line-beginning-position)
4535 armor-start)
4536 armor-end (re-search-forward
4537 (concat "^"
4538 armor-prefix
4539 "-----END PGP MESSAGE-----$")
4540 nil t))
4532 (unless armor-end 4541 (unless armor-end
4533 (error "Encryption armor beginning has no matching end")) 4542 (error "Encryption armor beginning has no matching end"))
4534 (goto-char armor-start) 4543 (goto-char armor-start)
@@ -4536,30 +4545,49 @@ encoded string (and the same mask) will decode the string."
4536 ;; Because epa--find-coding-system-for-mime-charset not autoloaded. 4545 ;; Because epa--find-coding-system-for-mime-charset not autoloaded.
4537 (require 'epa) 4546 (require 'epa)
4538 4547
4539 ;; Use the charset specified in the armor.
4540 (unless coding-system-for-read
4541 (if (re-search-forward "^Charset: \\(.*\\)" armor-end t)
4542 (setq coding-system-for-read
4543 (epa--find-coding-system-for-mime-charset
4544 (intern (downcase (match-string 1)))))))
4545
4546 ;; Advance over this armor. 4548 ;; Advance over this armor.
4547 (goto-char armor-end) 4549 (goto-char armor-end)
4548 (setq after-end (- (point-max) armor-end)) 4550 (setq after-end (- (point-max) armor-end))
4549 4551
4552 (when mime
4553 (save-excursion
4554 (goto-char armor-start)
4555 (re-search-backward "^--" nil t)
4556 (save-restriction
4557 (narrow-to-region (point) armor-start)
4558
4559 ;; Use the charset specified in the armor.
4560 (unless coding-system-for-read
4561 (if (re-search-forward "^Charset: \\(.*\\)" nil t)
4562 (setq coding-system-for-read
4563 (epa--find-coding-system-for-mime-charset
4564 (intern (downcase (match-string 1)))))))
4565
4566 (goto-char (point-min))
4567 (if (re-search-forward "^[ \t]*Content-transfer-encoding[ \t]*:[ \t]*quoted-printable[ \t]*$" nil t)
4568 (setq unquote t)))))
4569
4570 (when unquote
4571 (let ((inhibit-read-only t))
4572 (mail-unquote-printable-region armor-start
4573 (- (point-max) after-end))))
4574
4550 ;; Decrypt it, maybe in place, maybe making new buffer. 4575 ;; Decrypt it, maybe in place, maybe making new buffer.
4551 (epa-decrypt-region 4576 (epa-decrypt-region
4552 armor-start armor-end 4577 armor-start (- (point-max) after-end)
4553 ;; Call back this function to prepare the output. 4578 ;; Call back this function to prepare the output.
4554 (lambda () 4579 (lambda ()
4555 (let ((inhibit-read-only t)) 4580 (let ((inhibit-read-only t))
4556 (delete-region armor-start armor-end) 4581 (delete-region armor-start (- (point-max) after-end))
4557 (goto-char armor-start) 4582 (goto-char armor-start)
4558 (current-buffer)))) 4583 (current-buffer))))
4559 4584
4560 (push (list armor-start (- (point-max) after-end)) 4585 (push (list armor-start (- (point-max) after-end))
4561 decrypts))) 4586 decrypts)))
4562 4587
4588 (unless decrypts
4589 (error "Nothing to decrypt"))
4590
4563 (when (and decrypts (rmail-buffers-swapped-p)) 4591 (when (and decrypts (rmail-buffers-swapped-p))
4564 (when (y-or-n-p "Replace the original message? ") 4592 (when (y-or-n-p "Replace the original message? ")
4565 (setq decrypts (nreverse decrypts)) 4593 (setq decrypts (nreverse decrypts))