-;;; mime-pgp.el --- mime-view internal methods foro PGP.
+;;; mime-pgp.el --- mime-view internal methods for PGP.
-;; Copyright (C) 1995,1996,1997,1998,1999 MORIOKA Tomohiko
+;; Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc.
-;; Author: MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; Author: MORIOKA Tomohiko <tomo@m17n.org>
+;; Daiki Ueno <ueno@unixuser.org>
;; Created: 1995/12/7
;; Renamed: 1997/2/27 from tm-pgp.el
;; Keywords: PGP, security, MIME, multimedia, mail, news
;; by Kazuhiko Yamamoto <kazu@is.aist-nara.ac.jp> (1995/10;
;; expired)
-;; [OpenPGP/MIME] draft-yamamoto-openpgp-mime-00.txt: "MIME
-;; Security with OpenPGP (OpenPGP/MIME)" by Kazuhiko YAMAMOTO
-;; <kazu@iijlab.net> (1998/1)
+;; [OpenPGP/MIME] draft-ietf-openpgp-mime-02.txt: "MIME
+;; Security with OpenPGP" by
+;; John W. Noerenberg II <jwn2@qualcomm.com>,
+;; Dave Del Torto <ddt@cryptorights.org> and
+;; Michael Elkins <michael_elkins@nai.com> (2000/8)
;;; Code:
"PGP verification of current region." t)
(autoload 'pgg-snarf-keys-region "pgg"
"Snarf PGP public keys in current region." t)
-(autoload 'smime-decrypt-region "smime"
+(autoload 'smime-decrypt-buffer "smime"
"S/MIME decryption of current region.")
-(autoload 'smime-verify-region "smime"
- "S/MIME verification of current region.")
-
+(autoload 'smime-verify-buffer "smime"
+ "Verify integrity of S/MIME message in BUFFER.")
+(autoload 'smime-noverify-buffer "smime"
+ "Verify integrity of S/MIME message in BUFFER.")
+(autoload 'smime-pkcs7-region "smime"
+ "Convert S/MIME message into a PKCS7 message.")
+(autoload 'smime-pkcs7-certificates-region "smime"
+ "Extract any certificates enclosed in PKCS7 message.")
+(autoload 'smime-pkcs7-email-region "smime"
+ "Get email addresses contained in certificate.")
+(defvar smime-details-buffer)
+(defvar smime-CA-file)
+(defvar smime-CA-directory)
;;; @ Internal method for multipart/signed
;;;
(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))
+ representation-type message-buf)
+ (set-buffer (setq message-buf (get-buffer-create new-name)))
(erase-buffer)
(mime-insert-entity entity)
(cond ((progn
(point-max))
(goto-char (point-min))
(while (re-search-forward "^- -" nil t)
- (replace-match "-")
- )
+ (replace-match "-"))
(setq representation-type (if (mime-entity-cooked-p entity)
- 'cooked))
- )
+ '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 'binary)
- ))
+ (setq representation-type 'binary)))
(setq major-mode 'mime-show-message-mode)
- (save-window-excursion (mime-view-buffer nil preview-buffer mother
- nil representation-type))
- (set-window-buffer p-win preview-buffer)
- ))
+ (save-window-excursion
+ (mime-view-buffer nil preview-buffer mother
+ nil representation-type)
+ (make-local-variable 'mime-view-temp-message-buffer)
+ (setq mime-view-temp-message-buffer message-buf))
+ (set-window-buffer p-win preview-buffer)))
;;; @ Internal method for application/pgp-signature
;;;
;;; It is based on RFC 2015 (PGP/MIME) and
-;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME).
+;;; draft-ietf-openpgp-mime-02.txt (OpenPGP/MIME).
(defun mime-verify-application/pgp-signature (entity situation)
"Internal method to check PGP/MIME signature."
(set-buffer mime-echo-buffer-name)
(set-window-start
(get-buffer-window mime-echo-buffer-name)
- (point-max))
- )
+ (point-max)))
(mime-write-entity-content entity sig-file)
(unwind-protect
(with-temp-buffer
(set-buffer mime-echo-buffer-name)
(insert-buffer-substring (if status pgg-output-buffer
pgg-errors-buffer))))
- (delete-file sig-file))
- ))
+ (delete-file sig-file))))
;;; @ Internal method for application/pgp-encrypted
;;;
;;; It is based on RFC 2015 (PGP/MIME) and
-;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME).
+;;; draft-ietf-openpgp-mime-02.txt (OpenPGP/MIME).
(defun mime-decrypt-application/pgp-encrypted (entity situation)
(let* ((entity-node-id (mime-entity-node-id entity))
(1- knum)
(1+ knum)))
(orig-entity (nth onum (mime-entity-children mother))))
- (mime-view-application/pgp orig-entity situation)
- ))
+ (mime-view-application/pgp orig-entity situation)))
;;; @ Internal method for application/pgp-keys
;;;
;;; It is based on RFC 2015 (PGP/MIME) and
-;;; draft-yamamoto-openpgp-mime-00.txt (OpenPGP/MIME).
+;;; draft-ietf-openpgp-mime-02.txt (OpenPGP/MIME).
(defun mime-add-application/pgp-keys (entity situation)
(save-excursion
(set-buffer mime-echo-buffer-name)
(set-window-start
(get-buffer-window mime-echo-buffer-name)
- (point-max))
- )
+ (point-max)))
(with-temp-buffer
(mime-insert-entity-content entity)
(mime-decode-region (point-min) (point-max)
(save-excursion
(set-buffer mime-echo-buffer-name)
(insert-buffer-substring (if status pgg-output-buffer
- pgg-errors-buffer)))
- )))
+ pgg-errors-buffer))))))
;;; @ Internal method for application/pkcs7-signature
;;;
-;;; It is based on RFC 2633 (S/MIME version 3).
+;;; It is based on the S/MIME user interface in Gnus.
(defun mime-verify-application/pkcs7-signature (entity situation)
"Internal method to check S/MIME signature."
- (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)))
- (basename (expand-file-name "tm" temporary-file-directory))
- (sig-file (concat (make-temp-name basename) ".asc"))
- status)
- (save-excursion
- (mime-show-echo-buffer)
- (set-buffer mime-echo-buffer-name)
- (set-window-start
- (get-buffer-window mime-echo-buffer-name)
- (point-max))
- )
- (mime-write-entity entity sig-file)
- (unwind-protect
- (with-temp-buffer
- (mime-insert-entity orig-entity)
- (goto-char (point-min))
- (while (progn (end-of-line) (not (eobp)))
- (insert "\r")
- (forward-line 1))
- (setq status (smime-verify-region (point-min)(point-max)
- sig-file))
- (save-excursion
+ (with-temp-buffer
+ (mime-insert-entity (mime-find-root-entity entity))
+ (let ((good-signature (smime-noverify-buffer))
+ (good-certificate
+ (and (or smime-CA-file smime-CA-directory)
+ (smime-verify-buffer))))
+ (if (not good-signature)
+ ;; we couldn't verify message, fail with openssl output as message
+ (save-excursion
+ (mime-show-echo-buffer)
(set-buffer mime-echo-buffer-name)
- (insert-buffer-substring (if status smime-output-buffer
- smime-errors-buffer))))
- (delete-file sig-file))
- ))
+ (set-window-start
+ (get-buffer-window mime-echo-buffer-name)
+ (point-max))
+ (insert-buffer-substring smime-details-buffer))
+ ;; verify mail addresses in mail against those in certificate
+ (when (and (smime-pkcs7-region (point-min)(point-max))
+ (smime-pkcs7-certificates-region (point-min)(point-max)))
+ (if (not (member
+ (downcase
+ (nth 1 (std11-extract-address-components
+ (mime-entity-fetch-field
+ (mime-find-root-entity entity) "From"))))
+ (mime-smime-pkcs7-email-buffer (current-buffer))))
+ (message "Sender address forged")
+ (if good-certificate
+ (message "Ok (sender authenticated)")
+ (message "Integrity OK (sender unknown)"))))))))
+
+(defun mime-smime-pkcs7-email-buffer (buffer)
+ (with-temp-buffer
+ (insert-buffer-substring buffer)
+ (goto-char (point-min))
+ (let (addresses)
+ (while (re-search-forward "-----END CERTIFICATE-----" nil t)
+ (if (smime-pkcs7-email-region (point-min)(point))
+ (setq addresses (append (split-string
+ (buffer-substring (point-min)(point))
+ "[\n\r]+")
+ addresses)))
+ (delete-region (point-min)(point)))
+ (mapcar #'downcase addresses))))
;;; @ Internal method for application/pkcs7-mime
;;;
;;; It is based on RFC 2633 (S/MIME version 3).
-(defun mime-decrypt-application/pkcs7-mime (entity situation)
+(defun mime-view-application/pkcs7-mime (entity situation)
(let* ((p-win (or (get-buffer-window (current-buffer))
(get-largest-window)))
(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))
- (let ((inhibit-read-only t)
- buffer-read-only)
- (erase-buffer)
- (mime-insert-entity entity)
- (smime-decrypt-region (point-min)(point-max))
- (delete-region (point-min)(point-max))
- (insert-buffer smime-output-buffer))
- (setq major-mode 'mime-show-message-mode)
- (save-window-excursion (mime-view-buffer nil preview-buffer mother
- nil 'binary))
- (set-window-buffer p-win preview-buffer)
- ))
+ message-buf)
+ (when (memq (or (cdr (assq 'smime-type situation)) 'enveloped-data)
+ '(enveloped-data signed-data))
+ (set-buffer (setq message-buf (get-buffer-create new-name)))
+ (let ((inhibit-read-only t)
+ buffer-read-only)
+ (erase-buffer)
+ (mime-insert-entity entity)
+ (smime-decrypt-buffer))
+ (setq major-mode 'mime-show-message-mode)
+ (save-window-excursion
+ (mime-view-buffer nil preview-buffer mother
+ nil 'binary)
+ (make-local-variable 'mime-view-temp-message-buffer)
+ (setq mime-view-temp-message-buffer message-buf))
+ (set-window-buffer p-win preview-buffer))))
;;; @ end
projects / elisp / semi.git / blobdiff