aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authorRichard Stallman2015-08-12 11:21:49 -0400
committerRichard Stallman2015-08-12 11:21:49 -0400
commit503058a1d6df415331167ec6ada3559da431bdf8 (patch)
tree954e596b69e2b740228805a63ca3959d4902907d
parent472addd6f2b693e171fc5096d78dbca1536bfb8e (diff)
downloademacs-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.el170
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.
4513The starting string of the encrypted text should have just been regexp-matched.
4514Argument 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