diff options
| author | Richard M. Stallman | 2014-11-08 10:48:13 -0500 |
|---|---|---|
| committer | Richard M. Stallman | 2014-11-08 10:48:13 -0500 |
| commit | c6bd7594658dcad56bdd6507088c43b792db83a1 (patch) | |
| tree | 8722c783c0aaa76b8de60f6358b8b1c7c6a9fb8a | |
| parent | 31a57f2215330a772b8d7f1fa444ce14aa107582 (diff) | |
| download | emacs-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/ChangeLog | 7 | ||||
| -rw-r--r-- | lisp/mail/rmail.el | 56 |
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 @@ | |||
| 1 | 2014-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 | |||
| 1 | 2014-11-08 Martin Rudalics <rudalics@gmx.at> | 8 | 2014-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)) |