diff options
| author | Richard Stallman | 2015-08-12 11:21:49 -0400 |
|---|---|---|
| committer | Richard Stallman | 2015-08-12 11:21:49 -0400 |
| commit | 503058a1d6df415331167ec6ada3559da431bdf8 (patch) | |
| tree | 954e596b69e2b740228805a63ca3959d4902907d | |
| parent | 472addd6f2b693e171fc5096d78dbca1536bfb8e (diff) | |
| download | emacs-503058a1d6df415331167ec6ada3559da431bdf8.tar.gz emacs-503058a1d6df415331167ec6ada3559da431bdf8.zip | |
Re-enable mime processing after decryption. Add 'decrypt' keyword.
* rmail.el (rmail-epa-decrypt-1): New subroutine.
(rmail-epa-decrypt): rmail-epa-decrypt-1 broken out.
In a mime message, reenable Mime and show the parts that
were shown before.
Add keyword "decrypt" if anything decrypted.
| -rw-r--r-- | lisp/mail/rmail.el | 170 |
1 files changed, 101 insertions, 69 deletions
diff --git a/lisp/mail/rmail.el b/lisp/mail/rmail.el index 26c91bb26fa..1ccf5e2aea6 100644 --- a/lisp/mail/rmail.el +++ b/lisp/mail/rmail.el | |||
| @@ -4508,9 +4508,78 @@ encoded string (and the same mask) will decode the string." | |||
| 4508 | (setq i (1+ i))) | 4508 | (setq i (1+ i))) |
| 4509 | (concat string-vector))) | 4509 | (concat string-vector))) |
| 4510 | 4510 | ||
| 4511 | (defun rmail-epa-decrypt-1 (mime) | ||
| 4512 | "Decrypt a single GnuPG encrypted text in a message. | ||
| 4513 | The starting string of the encrypted text should have just been regexp-matched. | ||
| 4514 | Argument MIME is non-nil if this is a mime message." | ||
| 4515 | (let* ((armor-start (match-beginning 0)) | ||
| 4516 | (armor-prefix (buffer-substring | ||
| 4517 | (line-beginning-position) | ||
| 4518 | armor-start)) | ||
| 4519 | (armor-end-regexp) | ||
| 4520 | armor-end after-end | ||
| 4521 | unquote) | ||
| 4522 | (if (string-match "<pre>\\'" armor-prefix) | ||
| 4523 | (setq armor-prefix "")) | ||
| 4524 | |||
| 4525 | (setq armor-end-regexp | ||
| 4526 | (concat "^" | ||
| 4527 | armor-prefix | ||
| 4528 | "-----END PGP MESSAGE-----$")) | ||
| 4529 | (setq armor-end (re-search-forward armor-end-regexp | ||
| 4530 | nil t)) | ||
| 4531 | |||
| 4532 | (unless armor-end | ||
| 4533 | (error "Encryption armor beginning has no matching end")) | ||
| 4534 | (goto-char armor-start) | ||
| 4535 | |||
| 4536 | ;; Because epa--find-coding-system-for-mime-charset not autoloaded. | ||
| 4537 | (require 'epa) | ||
| 4538 | |||
| 4539 | ;; Advance over this armor. | ||
| 4540 | (goto-char armor-end) | ||
| 4541 | (setq after-end (- (point-max) armor-end)) | ||
| 4542 | |||
| 4543 | (when mime | ||
| 4544 | (save-excursion | ||
| 4545 | (goto-char armor-start) | ||
| 4546 | (re-search-backward "^--" nil t) | ||
| 4547 | (save-restriction | ||
| 4548 | (narrow-to-region (point) armor-start) | ||
| 4549 | |||
| 4550 | ;; Use the charset specified in the armor. | ||
| 4551 | (unless coding-system-for-read | ||
| 4552 | (if (re-search-forward "^[ \t]*Charset[ \t\n]*:[ \t\n]*\\(.*\\)" nil t) | ||
| 4553 | (setq coding-system-for-read | ||
| 4554 | (epa--find-coding-system-for-mime-charset | ||
| 4555 | (intern (downcase (match-string 1))))))) | ||
| 4556 | |||
| 4557 | (goto-char (point-min)) | ||
| 4558 | (if (re-search-forward "^[ \t]*Content-transfer-encoding[ \t\n]*:[ \t\n]*quoted-printable[ \t]*$" nil t) | ||
| 4559 | (setq unquote t))))) | ||
| 4560 | |||
| 4561 | (when unquote | ||
| 4562 | (let ((inhibit-read-only t)) | ||
| 4563 | (mail-unquote-printable-region armor-start | ||
| 4564 | (- (point-max) after-end)))) | ||
| 4565 | |||
| 4566 | ;; Decrypt it, maybe in place, maybe making new buffer. | ||
| 4567 | (epa-decrypt-region | ||
| 4568 | armor-start (- (point-max) after-end) | ||
| 4569 | ;; Call back this function to prepare the output. | ||
| 4570 | (lambda () | ||
| 4571 | (let ((inhibit-read-only t)) | ||
| 4572 | (delete-region armor-start (- (point-max) after-end)) | ||
| 4573 | (goto-char armor-start) | ||
| 4574 | (current-buffer)))) | ||
| 4575 | |||
| 4576 | (list armor-start (- (point-max) after-end) mime | ||
| 4577 | armor-end-regexp))) | ||
| 4578 | |||
| 4511 | ;; Should this have a key-binding, or be in a menu? | 4579 | ;; Should this have a key-binding, or be in a menu? |
| 4512 | ;; There doesn't really seem to be an appropriate menu. | 4580 | ;; There doesn't really seem to be an appropriate menu. |
| 4513 | ;; Eg the edit command is not in a menu either. | 4581 | ;; Eg the edit command is not in a menu either. |
| 4582 | |||
| 4514 | (defun rmail-epa-decrypt () | 4583 | (defun rmail-epa-decrypt () |
| 4515 | "Decrypt GnuPG or OpenPGP armors in current message." | 4584 | "Decrypt GnuPG or OpenPGP armors in current message." |
| 4516 | (interactive) | 4585 | (interactive) |
| @@ -4519,12 +4588,14 @@ encoded string (and the same mask) will decode the string." | |||
| 4519 | ;; change it in one of the calls to `epa-decrypt-region'. | 4588 | ;; change it in one of the calls to `epa-decrypt-region'. |
| 4520 | 4589 | ||
| 4521 | (save-excursion | 4590 | (save-excursion |
| 4522 | (let (decrypts (mime (rmail-mime-message-p))) | 4591 | (let (decrypts (mime (rmail-mime-message-p)) |
| 4592 | mime-disabled) | ||
| 4523 | (goto-char (point-min)) | 4593 | (goto-char (point-min)) |
| 4524 | 4594 | ||
| 4525 | ;; Turn off mime processing. | 4595 | ;; Turn off mime processing. |
| 4526 | (when (and mime | 4596 | (when (and mime |
| 4527 | (not (get-text-property (point-min) 'rmail-mime-hidden))) | 4597 | (not (get-text-property (point-min) 'rmail-mime-hidden))) |
| 4598 | (setq mime-disabled t) | ||
| 4528 | (rmail-mime)) | 4599 | (rmail-mime)) |
| 4529 | 4600 | ||
| 4530 | ;; Now find all armored messages in the buffer | 4601 | ;; Now find all armored messages in the buffer |
| @@ -4532,74 +4603,12 @@ encoded string (and the same mask) will decode the string." | |||
| 4532 | (goto-char (point-min)) | 4603 | (goto-char (point-min)) |
| 4533 | (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t) | 4604 | (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t) |
| 4534 | (let ((coding-system-for-read coding-system-for-read) | 4605 | (let ((coding-system-for-read coding-system-for-read) |
| 4535 | (case-fold-search t) | 4606 | (case-fold-search t)) |
| 4536 | unquote | ||
| 4537 | armor-start armor-prefix armor-end-regexp armor-end after-end) | ||
| 4538 | |||
| 4539 | (setq armor-start (match-beginning 0) | ||
| 4540 | armor-prefix (buffer-substring | ||
| 4541 | (line-beginning-position) | ||
| 4542 | armor-start)) | ||
| 4543 | (if (string-match "<pre>\\'" armor-prefix) | ||
| 4544 | (setq armor-prefix "")) | ||
| 4545 | |||
| 4546 | (setq armor-end-regexp | ||
| 4547 | (concat "^" | ||
| 4548 | armor-prefix | ||
| 4549 | "-----END PGP MESSAGE-----$")) | ||
| 4550 | (setq armor-end (re-search-forward armor-end-regexp | ||
| 4551 | nil t)) | ||
| 4552 | |||
| 4553 | (unless armor-end | ||
| 4554 | (error "Encryption armor beginning has no matching end")) | ||
| 4555 | (goto-char armor-start) | ||
| 4556 | |||
| 4557 | ;; Because epa--find-coding-system-for-mime-charset not autoloaded. | ||
| 4558 | (require 'epa) | ||
| 4559 | |||
| 4560 | ;; Advance over this armor. | ||
| 4561 | (goto-char armor-end) | ||
| 4562 | (setq after-end (- (point-max) armor-end)) | ||
| 4563 | |||
| 4564 | (when mime | ||
| 4565 | (save-excursion | ||
| 4566 | (goto-char armor-start) | ||
| 4567 | (re-search-backward "^--" nil t) | ||
| 4568 | (save-restriction | ||
| 4569 | (narrow-to-region (point) armor-start) | ||
| 4570 | |||
| 4571 | ;; Use the charset specified in the armor. | ||
| 4572 | (unless coding-system-for-read | ||
| 4573 | (if (re-search-forward "^[ \t]*Charset[ \t\n]*:[ \t\n]*\\(.*\\)" nil t) | ||
| 4574 | (setq coding-system-for-read | ||
| 4575 | (epa--find-coding-system-for-mime-charset | ||
| 4576 | (intern (downcase (match-string 1))))))) | ||
| 4577 | |||
| 4578 | (goto-char (point-min)) | ||
| 4579 | (if (re-search-forward "^[ \t]*Content-transfer-encoding[ \t\n]*:[ \t\n]*quoted-printable[ \t]*$" nil t) | ||
| 4580 | (setq unquote t))))) | ||
| 4581 | |||
| 4582 | (when unquote | ||
| 4583 | (let ((inhibit-read-only t)) | ||
| 4584 | (mail-unquote-printable-region armor-start | ||
| 4585 | (- (point-max) after-end)))) | ||
| 4586 | |||
| 4587 | ;; Decrypt it, maybe in place, maybe making new buffer. | ||
| 4588 | (epa-decrypt-region | ||
| 4589 | armor-start (- (point-max) after-end) | ||
| 4590 | ;; Call back this function to prepare the output. | ||
| 4591 | (lambda () | ||
| 4592 | (let ((inhibit-read-only t)) | ||
| 4593 | (delete-region armor-start (- (point-max) after-end)) | ||
| 4594 | (goto-char armor-start) | ||
| 4595 | (current-buffer)))) | ||
| 4596 | |||
| 4597 | (push (list armor-start (- (point-max) after-end) mime | ||
| 4598 | armor-end-regexp) | ||
| 4599 | decrypts))) | ||
| 4600 | 4607 | ||
| 4601 | (unless decrypts | 4608 | (push (rmail-epa-decrypt-1 mime) decrypts))) |
| 4602 | (error "Nothing to decrypt")) | 4609 | |
| 4610 | (when (and decrypts (eq major-mode 'rmail-mode)) | ||
| 4611 | (rmail-add-label "decrypt")) | ||
| 4603 | 4612 | ||
| 4604 | (when (and decrypts (rmail-buffers-swapped-p)) | 4613 | (when (and decrypts (rmail-buffers-swapped-p)) |
| 4605 | (when (y-or-n-p "Replace the original message? ") | 4614 | (when (y-or-n-p "Replace the original message? ") |
| @@ -4639,7 +4648,30 @@ encoded string (and the same mask) will decode the string." | |||
| 4639 | (let ((value (match-string 0))) | 4648 | (let ((value (match-string 0))) |
| 4640 | (unless (member value '("text/plain" "text/html")) | 4649 | (unless (member value '("text/plain" "text/html")) |
| 4641 | (replace-match "text/plain")))))))) | 4650 | (replace-match "text/plain")))))))) |
| 4642 | )))))))))) | 4651 | ))))))) |
| 4652 | |||
| 4653 | (when (and (null decrypts) | ||
| 4654 | mime mime-disabled) | ||
| 4655 | ;; Re-enable mime processinjg | ||
| 4656 | (rmail-mime) | ||
| 4657 | ;; Find each Show button and show that part. | ||
| 4658 | (while (search-forward " Show " nil t) | ||
| 4659 | (forward-char -2) | ||
| 4660 | (let ((rmail-mime-render-html-function nil) | ||
| 4661 | (entity (get-text-property (point) 'rmail-mime-entity))) | ||
| 4662 | (unless (and (not (stringp entity)) | ||
| 4663 | (rmail-mime-entity-truncated entity)) | ||
| 4664 | (push-button)))) | ||
| 4665 | (goto-char (point-min)) | ||
| 4666 | (while (re-search-forward "-----BEGIN PGP MESSAGE-----$" nil t) | ||
| 4667 | (let ((coding-system-for-read coding-system-for-read) | ||
| 4668 | (case-fold-search t)) | ||
| 4669 | (push (rmail-epa-decrypt-1 mime) decrypts))) | ||
| 4670 | |||
| 4671 | ) | ||
| 4672 | |||
| 4673 | (unless decrypts | ||
| 4674 | (error "Nothing to decrypt"))))) | ||
| 4643 | 4675 | ||
| 4644 | 4676 | ||
| 4645 | ;;;; Desktop support | 4677 | ;;;; Desktop support |