From 2728b5773c7b09dded332cca1dc53e131420767b Mon Sep 17 00:00:00 2001 From: yoichi Date: Tue, 12 Nov 2002 06:59:56 +0000 Subject: [PATCH] * wl-mime.el (wl-message-decrypt-pgp-nonmime): New function. (wl-message-verify-pgp-nonmime): Ditto. * wl-e21.el, wl-mule.el, wl-xmas.el (wl-message-define-keymap): Bind them to C-c:d and C-c:v respectively. Merge following code by Teranishi-san from [wl-en:00167]. * wl-mime.el (wl-mime-preview-application/pgp): New function. (wl-mime-preview-application/pgp-encrypted): Ditto. (wl-mime-setup): Add entry. --- wl/ChangeLog | 12 ++++++ wl/wl-e21.el | 2 + wl/wl-mime.el | 117 +++++++++++++++++++++++++++++++++++++++++++++++++++++++++ wl/wl-mule.el | 2 + wl/wl-xmas.el | 2 + 5 files changed, 135 insertions(+) diff --git a/wl/ChangeLog b/wl/ChangeLog index 8d52d42..1552334 100644 --- a/wl/ChangeLog +++ b/wl/ChangeLog @@ -1,3 +1,15 @@ +2002-11-12 Yoichi NAKAYAMA + + * wl-mime.el (wl-message-decrypt-pgp-nonmime): New function. + (wl-message-verify-pgp-nonmime): Ditto. + * wl-e21.el, wl-mule.el, wl-xmas.el (wl-message-define-keymap): + Bind them to C-c:d and C-c:v respectively. + + Merge following code by Teranishi-san from [wl-en:00167]. + * wl-mime.el (wl-mime-preview-application/pgp): New function. + (wl-mime-preview-application/pgp-encrypted): Ditto. + (wl-mime-setup): Add entry. + 2002-11-10 Yoichi NAKAYAMA * wl-summary.el (wl-summary-target-mark-erase): New function. diff --git a/wl/wl-e21.el b/wl/wl-e21.el index 49110ef..9fae1d9 100644 --- a/wl/wl-e21.el +++ b/wl/wl-e21.el @@ -530,6 +530,8 @@ (let ((keymap (make-sparse-keymap))) (define-key keymap "D" 'wl-message-delete-current-part) (define-key keymap "l" 'wl-message-toggle-disp-summary) + (define-key keymap "\C-c:d" 'wl-message-decrypt-pgp-nonmime) + (define-key keymap "\C-c:v" 'wl-message-verify-pgp-nonmime) (define-key keymap [mouse-4] 'wl-message-wheel-down) (define-key keymap [mouse-5] 'wl-message-wheel-up) (define-key keymap [S-mouse-4] 'wl-message-wheel-down) diff --git a/wl/wl-mime.el b/wl/wl-mime.el index 19e2fc0..933ac6b 100644 --- a/wl/wl-mime.el +++ b/wl/wl-mime.el @@ -34,6 +34,11 @@ (require 'mime-play) (require 'elmo) +(eval-when-compile + (defalias-maybe 'pgg-decrypt-region 'ignore) + (defalias-maybe 'pgg-display-output-buffer 'ignore) + (defalias-maybe 'pgg-verify-region 'ignore)) + ;;; Draft (defalias 'wl-draft-editor-mode 'mime-edit-mode) @@ -288,6 +293,110 @@ It calls following-method selected from variable (wl-summary-toggle-disp-msg 'off) (wl-summary-sync nil "update"))))) +(defun wl-message-decrypt-pgp-nonmime () + "Decrypt PGP encrypted region" + (interactive) + (require 'pgg) + (save-excursion + (beginning-of-line) + (if (or (re-search-forward "^-+END PGP MESSAGE-+$" nil t) + (re-search-backward "^-+END PGP MESSAGE-+$" nil t)) + (let (beg end status) + (setq end (match-end 0)) + (if (setq beg (re-search-backward "^-+BEGIN PGP MESSAGE-+$" nil t)) + (let ((inhibit-read-only t)) + (setq status (pgg-decrypt-region beg end)) + (pgg-display-output-buffer beg end status)) + (message "Cannot find pgp encrypted region"))) + (message "Cannot find pgp encrypted region")))) + +(defun wl-message-verify-pgp-nonmime () + "Verify PGP signed region" + (interactive) + (require 'pgg) + (save-excursion + (beginning-of-line) + (if (or (re-search-forward "^-+END PGP SIGNATURE-+$" nil t) + (re-search-backward "^-+END PGP SIGNATURE-+$" nil t)) + (let (beg end status) + (setq end (match-end 0)) + (if (setq beg (re-search-backward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t)) + (progn + (save-excursion + (mime-show-echo-buffer) + (set-buffer mime-echo-buffer-name) + (set-window-start + (get-buffer-window mime-echo-buffer-name) + (point-max))) + (setq status (pgg-verify-region beg end nil 'fetch)) + (set-buffer mime-echo-buffer-name) + (insert-buffer-substring + (if status pgg-output-buffer pgg-errors-buffer))) + (message "Cannot find pgp signed region"))) + (message "Cannot find pgp signed region")))) + +;; XXX: encrypted multipart isn't represented as multipart +(defun wl-mime-preview-application/pgp (parent-entity entity situation) + (require 'pgg) + (goto-char (point-max)) + (let ((p (point)) + raw-buf to-buf representation-type child-entity) + (goto-char p) + (save-restriction + (narrow-to-region p p) + (setq to-buf (current-buffer)) + (with-temp-buffer + (setq raw-buf (current-buffer)) + (mime-insert-entity entity) + (cond ((progn + (goto-char (point-min)) + (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t)) + (pgg-verify-region (match-beginning 0)(point-max) nil 'fetch) + (goto-char (point-min)) + (delete-region + (point-min) + (and + (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+\n\n") + (match-end 0))) + (delete-region + (and (re-search-forward "^-+BEGIN PGP SIGNATURE-+") + (match-beginning 0)) + (point-max)) + (goto-char (point-min)) + (while (re-search-forward "^- -" nil t) + (replace-match "-")) + (setq representation-type (if (mime-entity-cooked-p entity) + 'cooked))) + ((progn + (goto-char (point-min)) + (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t)) + (pgg-decrypt-region (point-min)(point-max)) + (delete-region (point-min) (point-max)) + (insert-buffer pgg-output-buffer) + (setq representation-type 'elmo-buffer))) + (setq child-entity (mime-parse-message + (mm-expand-class-name representation-type) + nil + parent-entity + (mime-entity-node-id-internal parent-entity))) + (mime-display-entity + child-entity + nil + `((header . visible) + (body . visible) + (entity-button . invisible)) + to-buf))))) + +(defun wl-mime-preview-application/pgp-encrypted (entity situation) + (let* ((entity-node-id (mime-entity-node-id entity)) + (mother (mime-entity-parent entity)) + (knum (car entity-node-id)) + (onum (if (> knum 0) + (1- knum) + (1+ knum))) + (orig-entity (nth onum (mime-entity-children mother)))) + (wl-mime-preview-application/pgp entity orig-entity situation))) + ;;; Summary (defun wl-summary-burst-subr (message-entity target number) ;; returns new number. @@ -463,6 +572,14 @@ With ARG, ask destination folder." (major-mode . wl-original-message-mode))) (ctree-set-calist-strictly + 'mime-preview-condition + '((type . application)(subtype . pgp-encrypted) + (encoding . t) + (body . invisible) + (body-presentation-method . wl-mime-preview-application/pgp-encrypted) + (major-mode . wl-original-message-mode))) + + (ctree-set-calist-strictly 'mime-acting-condition '((type . message) (subtype . partial) (method . wl-mime-combine-message/partial-pieces) diff --git a/wl/wl-mule.el b/wl/wl-mule.el index 985768d..75038c0 100644 --- a/wl/wl-mule.el +++ b/wl/wl-mule.el @@ -102,6 +102,8 @@ Special commands: (let ((keymap (make-sparse-keymap))) (define-key keymap "D" 'wl-message-delete-current-part) (define-key keymap "l" 'wl-message-toggle-disp-summary) + (define-key keymap "\C-c:d" 'wl-message-decrypt-pgp-nonmime) + (define-key keymap "\C-c:v" 'wl-message-verify-pgp-nonmime) (define-key keymap [mouse-4] 'wl-message-wheel-down) (define-key keymap [mouse-5] 'wl-message-wheel-up) (define-key keymap [S-mouse-4] 'wl-message-wheel-down) diff --git a/wl/wl-xmas.el b/wl/wl-xmas.el index 93da3a2..6667d89 100644 --- a/wl/wl-xmas.el +++ b/wl/wl-xmas.el @@ -448,6 +448,8 @@ (let ((keymap (make-sparse-keymap))) (define-key keymap "D" 'wl-message-delete-current-part) (define-key keymap "l" 'wl-message-toggle-disp-summary) + (define-key keymap "\C-c:d" 'wl-message-decrypt-pgp-nonmime) + (define-key keymap "\C-c:v" 'wl-message-verify-pgp-nonmime) (define-key keymap 'button4 'wl-message-wheel-down) (define-key keymap 'button5 'wl-message-wheel-up) (define-key keymap [(shift button4)] 'wl-message-wheel-down) -- 1.7.10.4