;; Copyright (C) 1995,1996,1997,1998,1999,2000 Free Software Foundation, Inc.
;; Author: MORIOKA Tomohiko <tomo@m17n.org>
-;; Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
+;; 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.")
-(defvar smime-output-buffer)
-(defvar smime-errors-buffer)
-
+(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
;;;
;;; @ 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."
;;; @ 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))
;;; @ 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
;;; @ 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
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))
+ (smime-decrypt-buffer))
(setq major-mode 'mime-show-message-mode)
(save-window-excursion
(mime-view-buffer nil preview-buffer mother
projects / elisp / semi.git / blobdiff