From 287283f6c78cf9a1a862d7d552d29836281fd4ae Mon Sep 17 00:00:00 2001 From: ueno Date: Tue, 2 Nov 1999 17:48:04 +0000 Subject: [PATCH] Add comment that this module is based on draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME) and RFC 2440(OpenPGP Message Format) as well. (mime-verify-application/pgp-signature): Use `pgg-verify-region' instead of `mime-pgp-check-signature'. (mime-display-application/pgp-signature): New function. (mime-display-application/pgp-encrypted): New function. (mime-display-application/pgp-keys): New function. --- mime-pgp.el | 182 ++++++++++++++++++++++++++++++++++++++++++++--------------- 1 file changed, 136 insertions(+), 46 deletions(-) diff --git a/mime-pgp.el b/mime-pgp.el index fb76f45..42cd715 100644 --- a/mime-pgp.el +++ b/mime-pgp.el @@ -3,6 +3,7 @@ ;; Copyright (C) 1995,1996,1997,1998,1999 MORIOKA Tomohiko ;; Author: MORIOKA Tomohiko +;; Daiki Ueno ;; Created: 1995/12/7 ;; Renamed: 1997/2/27 from tm-pgp.el ;; Keywords: PGP, security, MIME, multimedia, mail, news @@ -44,6 +45,8 @@ ;;; Code: (require 'mime-play) +(require 'pgg-def) +(require 'pgg-parse) ;;; @ Internal method for multipart/signed @@ -68,6 +71,7 @@ (new-name (format "%s-%s" (buffer-name) (mime-entity-number entity))) (mother (current-buffer)) + (preview-buffer (concat "*Preview-" (buffer-name) "*")) representation-type) (set-buffer (get-buffer-create new-name)) (erase-buffer) @@ -75,7 +79,8 @@ (cond ((progn (goto-char (point-min)) (re-search-forward "^-+BEGIN PGP SIGNED MESSAGE-+$" nil t)) - (funcall (pgp-function 'verify)) + (funcall (pgp-function 'verify) + (point-min)(point-max)) (goto-char (point-min)) (delete-region (point-min) @@ -96,18 +101,16 @@ ((progn (goto-char (point-min)) (re-search-forward "^-+BEGIN PGP MESSAGE-+$" nil t)) - (as-binary-process (funcall (pgp-function 'decrypt))) - (goto-char (point-min)) - (delete-region (point-min) - (and - (search-forward "\n\n") - (match-end 0))) + (funcall (pgp-function 'decrypt) + (point-min)(point-max)) + (delete-region (point-min)(point-max)) + (insert-buffer pgg-output-buffer) (setq representation-type 'binary) )) (setq major-mode 'mime-show-message-mode) - (save-window-excursion (mime-view-buffer nil nil mother + (save-window-excursion (mime-view-buffer nil preview-buffer mother nil representation-type)) - (set-window-buffer p-win mime-preview-buffer) + (set-window-buffer p-win preview-buffer) )) @@ -162,45 +165,89 @@ It should be ISO 639 2 letter language code such as en, ja, ...") (1+ knum))) (orig-entity (nth onum (mime-entity-children mother))) (basename (expand-file-name "tm" temporary-file-directory)) - (orig-file (make-temp-name basename)) - (sig-file (concat orig-file ".sig")) + (sig-file (concat (make-temp-name basename) ".asc")) ) - (mime-write-entity orig-entity orig-file) (save-excursion (mime-show-echo-buffer)) (mime-write-entity-content entity sig-file) - (or (mime-pgp-check-signature mime-echo-buffer-name sig-file orig-file) - (let (pgp-id) - (save-excursion - (set-buffer mime-echo-buffer-name) - (goto-char (point-min)) - (let ((regexp (cdr (assq (or mime-pgp-default-language 'en) - mime-pgp-key-expected-regexp-alist)))) - (cond ((not (stringp regexp)) - (message - "Please specify right regexp for specified language") - ) - ((re-search-forward regexp nil t) - (setq pgp-id - (concat "0x" (buffer-substring-no-properties - (match-beginning 1) - (match-end 1)))) - )))) - (if (and pgp-id - (y-or-n-p - (format "Key %s not found; attempt to fetch? " pgp-id)) - ) - (progn - (funcall (pgp-function 'fetch-key) (cons nil pgp-id)) - (mime-pgp-check-signature mime-echo-buffer-name orig-file) - )) - )) - (let ((other-window-scroll-buffer mime-echo-buffer-name)) - (scroll-other-window 8) - ) - (delete-file orig-file) + (with-temp-buffer + (mime-insert-entity orig-entity) + (goto-char (point-min)) + (while (progn (end-of-line) (not (eobp))) + (insert "\r") + (forward-line 1)) + (let ((pgg-output-buffer mime-echo-buffer-name)) + (funcall (pgp-function 'verify) + (point-min)(point-max) sig-file))) (delete-file sig-file) )) +(defun mime-display-application/pgp-signature (entity situation) + (let ((packet + (cdr (assq 2 (pgg-parse-armor (mime-entity-content entity))))) + field) + (insert + "version: " + (int-to-string (cdr (assq 'version packet))) + "\n" + "signature type: " + (cdr (assq 'signature-type packet)) + "\n" + (if (setq field (cdr (assq 'hash-algorithm packet))) + (concat "hash algorithm: " (symbol-name field) "\n") + "") + (if (setq field (cdr (assq 'public-key-algorithm packet))) + (concat "public key algorithm: " (symbol-name field) "\n") + "") + (if (setq field (cdr (assq 'key-identifier packet))) + (concat "key identifier: " field "\n") + "") + (if (setq field (cdr (assq 'creation-time packet))) + (concat "creation time: " (current-time-string field) "\n") + "") + (if (setq field (cdr (assq 'signature-expiry packet))) + (concat "signature exipiration time: " + (current-time-string field) "\n") + "") + (if (setq field (cdr (assq 'key-expiry packet))) + (concat "key exipiration time: " (current-time-string field) "\n") + "") + (if (setq field (cdr (assq 'trust-level packet))) + (concat "trust level: " (int-to-string field) "\n") + "") + (if (setq field (cdr (assq 'preferred-symmetric-key-algorithm packet))) + (concat "preferred symmetric algorithm: " + (symbol-name field) "\n") + "") + (if (setq field (cdr (assq 'preferred-hash-algorithm packet))) + (concat "preferred hash algorithm: " + (symbol-name field) "\n") + "") + (if (setq field (cdr (assq 'exportability packet))) + (concat "signature exportable: " + (if (< 0 field) "yes" "no") "\n") + "") + (if (setq field (cdr (assq 'revocability packet))) + (concat "signature revocable: " + (if (< 0 field) "yes" "no") "\n") + "") + (if (setq field (cdr (assq 'policy-url packet))) + (concat "policy URL: " field "\n") + "") + (if (setq field + (delq nil (mapcar + (function (lambda (nn) + (and (eq (car nn) 'notation) nn))) + packet))) + (concat "notations:\n" + (mapconcat (lambda (nn) + (concat " " (cadr nn) ": " (cddr nn))) + field "\n") + "\n") + "")) + (mime-add-url-buttons) + (run-hooks 'mime-display-application/pgp-signature-hook) + )) + ;;; @ Internal method for application/pgp-encrypted ;;; @@ -217,14 +264,36 @@ It should be ISO 639 2 letter language code such as en, ja, ...") (mime-view-application/pgp orig-entity situation) )) +(defun mime-display-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))) + (packet (cdr (assq 1 (pgg-parse-armor + (mime-entity-content orig-entity)))))) + (insert + "version: " + (int-to-string (cdr (assq 'version packet))) + "\n" + "public key identifier: " + (cdr (assq 'public-key-identifier packet)) + "\n" + "public key algorithm: " + (symbol-name (cdr (assq 'public-key-algorithm packet))) + "\n\n") + (run-hooks 'mime-display-application/pgp-encrypted-hook) + )) ;;; @ Internal method for application/pgp-keys ;;; ;;; It is based on RFC 2015 (PGP/MIME). (defun mime-add-application/pgp-keys (entity situation) - (let* ((start (mime-entity-point-min entity)) - (end (mime-entity-point-max entity)) + (let* ((start (mime-entity-header-start-point entity)) + (end (mime-entity-body-end-point entity)) (entity-number (mime-entity-number entity)) (new-name (format "%s-%s" (buffer-name) entity-number)) (encoding (cdr (assq 'encoding situation))) @@ -239,11 +308,32 @@ It should be ISO 639 2 letter language code such as en, ja, ...") (delete-region (point-min) (match-end 0)) ) (mime-decode-region (point-min)(point-max) encoding) - (funcall (pgp-function 'snarf-keys)) + (funcall (pgp-function 'snarf-keys) + (point-min)(point-max)) (kill-buffer (current-buffer)) )) - +(defun mime-display-application/pgp-keys (entity situation) + (let ((packet + (cdr (assq 6 (pgg-parse-armor (mime-entity-content entity))))) + field) + (insert + "version: " + (int-to-string (cdr (assq 'version packet))) + "\n" + "creation time: " + (current-time-string (cdr (assq 'creation-time packet))) + "\n" + "public key algorithm: " + (symbol-name (cdr (assq 'public-key-algorithm packet))) + "\n" + (if (setq field (cdr (assq 'key-expiry packet))) + (concat "key exipiration time: " (current-time-string field) "\n") + "")) + (run-hooks 'mime-display-application/pgp-keys-hook) + )) + + ;;; @ end ;;; -- 1.7.10.4