From: ueno <ueno>
Date: Sat, 5 May 2001 20:31:09 +0000 (+0000)
Subject: * mime-pgp.el: Add autoload settings for S/MIME functions.
X-Git-Tag: emiko-1_14_0~41
X-Git-Url: http://git.chise.org/gitweb/?a=commitdiff_plain;h=937bca394e2526d36c72eee0865f7b617990f5da;p=elisp%2Fsemi.git

* mime-pgp.el: Add autoload settings for S/MIME functions.
(mime-verify-application/pkcs7-signature): New implementation.

* mime-edit.el (mime-edit-sign-smime): New implementation.
(mime-edit-encrypt-smime): Ditto.

* semi-setup.el: Revive setting for application/x-pkcs7-signature.

* smime.el: Removed.

* SEMI-ELS (semi-modules-to-compile): Don't compile smime.el.
---

diff --git a/SEMI-ELS b/SEMI-ELS
index ad689ab..b77be5a 100644
--- a/SEMI-ELS
+++ b/SEMI-ELS
@@ -7,7 +7,6 @@
 (setq semi-modules-to-compile
       '(signature
 	pgg-def pgg pgg-parse pgg-gpg pgg-pgp5 pgg-pgp mime-pgp
-	smime
 	semi-def mime-view mime-play mime-partial postpet
 	mime-edit
 	semi-setup mail-mime-setup))
diff --git a/mime-edit.el b/mime-edit.el
index 134c076..3ee1983 100644
--- a/mime-edit.el
+++ b/mime-edit.el
@@ -122,12 +122,10 @@
   "PGP signature of current region." t)
 (autoload 'pgg-insert-key "pgg"
   "Insert PGP public key at point." t)
-(autoload 'smime-encrypt-region "smime"
-  "S/MIME encryption of current region.")
-(autoload 'smime-sign-region "smime"
-  "S/MIME signature of current region.")
-(defvar smime-output-buffer)
-(defvar smime-errors-buffer)
+(autoload 'smime-encrypt-buffer "smime"
+  "S/MIME encryption of current buffer.")
+(autoload 'smime-sign-buffer "smime"
+  "S/MIME signature of current buffer.")
 
 
 ;;; @ version
@@ -1825,7 +1823,7 @@ Content-Transfer-Encoding: 7bit
 	  (while (progn (end-of-line) (not (eobp)))
 	    (insert "\r")
 	    (forward-line 1))
-	  (or (prog1 (smime-sign-region (point-min)(point-max))
+	  (or (prog1 (smime-sign-buffer)
 		(push nil buffer-undo-list)
 		(ignore-errors (undo)))
 	      (throw 'mime-edit-error 'pgp-error)))
@@ -1843,7 +1841,6 @@ Content-Disposition: attachment; filename=\"smime.p7s\"
 Content-Description: S/MIME Cryptographic Signature
 
 "  smime-boundary))
-	(insert-buffer-substring smime-output-buffer)
 	(goto-char (point-max))
 	(insert (format "\n--%s--\n" smime-boundary))))))
 
@@ -1864,13 +1861,12 @@ Content-Description: S/MIME Cryptographic Signature
 	(while (progn (end-of-line) (not (eobp)))
 	  (insert "\r")
 	  (forward-line 1))
-	(or (smime-encrypt-region (point-min)(point-max))
+	(or (smime-encrypt-buffer)
 	    (throw 'mime-edit-error 'pgp-error))
-	(delete-region (point-min)(point-max))
+	(goto-char beg)
 	(insert "--[[application/pkcs7-mime; name=\"smime.p7m\"
 Content-Disposition: attachment; filename=\"smime.p7m\"
-Content-Description: S/MIME Encrypted Message][base64]]\n")
-	(insert-buffer-substring smime-output-buffer)))))
+Content-Description: S/MIME Encrypted Message][base64]]\n")))))
 
 (defsubst replace-space-with-underline (str)
   (mapconcat (function
diff --git a/mime-pgp.el b/mime-pgp.el
index 2a5a38d..3e39afa 100644
--- a/mime-pgp.el
+++ b/mime-pgp.el
@@ -59,13 +59,21 @@
   "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
 ;;;
@@ -210,41 +218,52 @@
 
 ;;; @ 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
@@ -266,9 +285,7 @@
 	    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
diff --git a/semi-setup.el b/semi-setup.el
index 09bda4e..5c9c82e 100644
--- a/semi-setup.el
+++ b/semi-setup.el
@@ -137,6 +137,12 @@ it is used as hook to set."
 
 	 (mime-add-condition
 	  'action
+	  '((type . application)(subtype . x-pkcs7-signature)
+	    (method . mime-verify-application/pkcs7-signature))
+	  'strict "mime-pgp")
+
+	 (mime-add-condition
+	  'action
 	  '((type . application)(subtype . pkcs7-mime)
 	    (method . mime-view-application/pkcs7-mime))
 	  'strict "mime-pgp"))))
diff --git a/smime.el b/smime.el
deleted file mode 100644
index d0c6471..0000000
--- a/smime.el
+++ /dev/null
@@ -1,322 +0,0 @@
-;;; smime.el --- S/MIME interface.
-
-;; Copyright (C) 1999,2000 Free Software Foundation, Inc.
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1999/12/08
-;; Keywords: S/MIME, OpenSSL
-
-;; This file is part of SEMI (Secure Emacs MIME Interface).
-
-;; This program is free software; you can redistribute it and/or
-;; modify it under the terms of the GNU General Public License as
-;; published by the Free Software Foundation; either version 2, or (at
-;; your option) any later version.
-
-;; This program is distributed in the hope that it will be useful, but
-;; WITHOUT ANY WARRANTY; without even the implied warranty of
-;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
-;; General Public License for more details.
-
-;; You should have received a copy of the GNU General Public License
-;; along with GNU Emacs; see the file COPYING.  If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-
-;;; Commentary:
-
-;;    This module is based on
-
-;;      [SMIMEV3] RFC 2633: "S/MIME Version 3 Message Specification"
-;;          by Crocker, D., Flanigan, B., Hoffman, P., Housley, R.,
-;;          Pawling, J. and Schaad, J. (1999/06)
-
-;;      [SMIMEV2] RFC 2311: "S/MIME Version 2 Message Specification"
-;;          by Dusse, S., Hoffman, P., Ramsdell, B., Lundblade, L.
-;;          and L. Repka. (1998/03)
-
-;;; Code:
-
-(require 'path-util)
-(require 'mel)
-;; binary-funcall, binary-write-decoded-region, binary-insert-encoded-file
-(eval-when-compile (require 'static))
-
-(defgroup smime ()
-  "S/MIME interface"
-  :group 'mime)
-
-(defcustom smime-program "smime" 
-  "The S/MIME executable."
-  :group 'smime
-  :type 'string)
-
-(defcustom smime-shell-file-name "/bin/sh"
-  "File name to load inferior shells from.  Bourne shell or its equivalent
-\(not tcsh) is needed for \"2>\"."
-  :group 'smime
-  :type 'string)
-
-(defcustom smime-shell-command-switch "-c"
-  "Switch used to have the shell execute its command line argument."
-  :group 'smime
-  :type 'string)
-
-(defcustom smime-x509-program
-  (let ((file (exec-installed-p "openssl")))
-    (and file (list file "x509" "-noout")))
-  "External program for x509 parser."
-  :group 'smime
-  :type 'string)
-
-(defcustom smime-cache-passphrase t
-  "Cache passphrase."
-  :group 'smime
-  :type 'boolean)
-
-(defcustom smime-certificate-directory "~/.w3/certs"
-  "Certificate directory."
-  :group 'smime
-  :type 'directory)
-
-(defcustom smime-public-key-file nil
-  "Public key file."
-  :group 'smime
-  :type 'boolean)
-
-(defcustom smime-private-key-file nil
-  "Private key file."
-  :group 'smime
-  :type 'boolean)
-
-(defvar smime-errors-buffer " *S/MIME errors*")
-(defvar smime-output-buffer " *S/MIME output*")
-
-;;; @ utility functions
-;;;
-(put 'smime-process-when-success 'lisp-indent-function 0)
-
-(defmacro smime-process-when-success (&rest body)
-  `(with-current-buffer smime-output-buffer
-     (if (zerop (buffer-size)) nil ,@body t)))
-
-(defvar smime-passphrase-cache-expiry 16)
-(defvar smime-passphrase-cache (make-vector 7 0))
-
-(defvar smime-read-passphrase nil)
-(defun smime-read-passphrase (prompt &optional key)
-  (if (not smime-read-passphrase)
-      (if (functionp 'read-passwd)
-	  (setq smime-read-passphrase 'read-passwd)
-	(if (load "passwd" t)
-	    (setq smime-read-passphrase 'read-passwd)
-	  (autoload 'ange-ftp-read-passwd "ange-ftp")
-	  (setq smime-read-passphrase 'ange-ftp-read-passwd))))
-  (or (and smime-cache-passphrase
-	   (symbol-value (intern-soft key smime-passphrase-cache)))
-      (funcall smime-read-passphrase prompt)))
-
-(defun smime-add-passphrase-cache (key passphrase)
-  (set (intern key smime-passphrase-cache)
-       passphrase)
-  (run-at-time smime-passphrase-cache-expiry nil
-	       #'smime-remove-passphrase-cache
-	       key))
-
-(defun smime-remove-passphrase-cache (key)
-  (let ((passphrase (symbol-value (intern-soft key smime-passphrase-cache))))
-    (when passphrase
-      (fillarray passphrase ?_)
-      (unintern key smime-passphrase-cache))))
-
-(defsubst smime-parse-attribute (string)
-  (delq nil (mapcar 
-	     (lambda (attr)
-	       (if (string-match "=" attr)
-		   (cons (intern (substring attr 0 (match-beginning 0)))
-			 (substring attr (match-end 0)))
-		 nil))
-	     (split-string string "/"))))
-
-(defsubst smime-query-signer (start end)
-  (smime-process-region start end smime-program (list "-qs"))
-  (with-current-buffer smime-output-buffer
-    (if (zerop (buffer-size)) nil
-      (goto-char (point-min))
-      (when (re-search-forward "^/" nil t)
-	(smime-parse-attribute 
-	 (buffer-substring (point) (progn (end-of-line)(point)))))
-      )))
-
-(defsubst smime-x509-hash (cert-file)
-  (with-current-buffer (get-buffer-create smime-output-buffer)
-    (buffer-disable-undo)
-    (erase-buffer)
-    (apply #'call-process (car smime-x509-program) nil t nil 
-	   (append (cdr smime-x509-program) 
-		   (list "-hash" "-in" cert-file)))
-    (if (zerop (buffer-size)) nil
-      (buffer-substring (point-min) (1- (point-max))))))
-
-(defsubst smime-x509-subject (cert-file)
-  (with-current-buffer (get-buffer-create smime-output-buffer)
-    (buffer-disable-undo)
-    (erase-buffer)
-    (apply #'call-process (car smime-x509-program) nil t nil 
-	   (append (cdr smime-x509-program)
-		   (list "-subject" "-in" cert-file)))
-    (if (zerop (buffer-size)) nil
-      (goto-char (point-min))
-      (when (re-search-forward "^subject=" nil t)
-	(smime-parse-attribute
-	 (buffer-substring (point)(progn (end-of-line)(point))))))))
-
-(defsubst smime-find-certificate (attr)
-  (let ((files
-	 (and (file-directory-p smime-certificate-directory)
-	      (delq nil (mapcar (lambda (file) 
-				  (if (file-directory-p file) nil
-				    file))
-				(directory-files 
-				 smime-certificate-directory
-				 'full))))))
-    (catch 'found
-      (while files
-	(if (or (string-equal 
-		 (cdr (assq 'CN (smime-x509-subject (car files))))
-		 (cdr (assq 'CN attr)))
-		(string-equal
-		 (cdr (assq 'Email (smime-x509-subject (car files))))
-		 (cdr (assq 'Email attr))))
-	    (throw 'found (car files)))
-	(pop files)))))
-
-(defun smime-process-region (start end program args)
-  (let* ((errors-file-name
-	  (concat temporary-file-directory 
-		  (make-temp-name "smime-errors")))
-	 (args (append args (list (concat "2>" errors-file-name))))
-	 (shell-file-name smime-shell-file-name)
-	 (shell-command-switch smime-shell-command-switch)
-	 (process-connection-type nil)
-	 process status exit-status)
-    (with-current-buffer (get-buffer-create smime-output-buffer)
-      (buffer-disable-undo)
-      (erase-buffer))
-    (setq process
-	  (apply #'binary-funcall #'start-process-shell-command
-		 "*S/MIME*" smime-output-buffer
-		 program args))
-    (set-process-sentinel process 'ignore)
-    (process-send-region process start end)
-    (process-send-eof process)
-    (while (eq 'run (process-status process))
-      (accept-process-output process 5))
-    (setq status (process-status process)
-	  exit-status (process-exit-status process))
-    (delete-process process)
-    (with-current-buffer smime-output-buffer
-      (goto-char (point-min))
-      (while (re-search-forward "\r$" (point-max) t)
-	(replace-match ""))
-
-      (if (memq status '(stop signal))
-	  (error "%s exited abnormally: '%s'" program exit-status))
-      (if (= 127 exit-status)
-	  (error "%s could not be found" program))
-
-      (set-buffer (get-buffer-create smime-errors-buffer))
-      (buffer-disable-undo)
-      (erase-buffer)
-      (insert-file-contents errors-file-name)
-      (delete-file errors-file-name)
-      
-      (if (and process (eq 'run (process-status process)))
-	  (interrupt-process process))
-      )
-    ))
-
-;;; @ interface functions
-;;;
-
-;;;###autoload
-(defun smime-encrypt-region (start end)
-  "Encrypt the current region between START and END."
-  (let* ((key-file
-	  (or smime-private-key-file
-	      (expand-file-name (read-file-name "Public key file: "))))
-	 (args (list "-e" key-file)))
-    (smime-process-region start end smime-program args)
-    (smime-process-when-success 
-      (goto-char (point-min))
-      (delete-region (point-min) (progn
-				   (re-search-forward "^$" nil t)
-				   (1+ (point)))))))
-
-;;;###autoload
-(defun smime-decrypt-region (start end)
-  "Decrypt the current region between START and END."
-  (let* ((key-file
-	  (or smime-private-key-file
-	      (expand-file-name (read-file-name "Private key file: "))))
-	 (hash (smime-x509-hash key-file))
-	 (passphrase (smime-read-passphrase 
-		      (format "S/MIME passphrase for %s: " hash)
-		      hash))
-	 (args (list "-d" key-file passphrase)))
-    (smime-process-region start end smime-program args)
-    (smime-process-when-success 
-      (when smime-cache-passphrase
-	(smime-add-passphrase-cache hash passphrase)))))
-	 
-;;;###autoload
-(defun smime-sign-region (start end &optional cleartext)
-  "Make the signature from text between START and END.
-If the optional 3rd argument CLEARTEXT is non-nil, it does not create
-a detached signature."
-  (let* ((key-file
-	  (or smime-private-key-file
-	      (expand-file-name (read-file-name "Private key file: "))))
-	 (hash (smime-x509-hash key-file))
-	 (passphrase (smime-read-passphrase 
-		      (format "S/MIME passphrase for %s: " hash)
-		      hash))
-	 (args (list "-ds" key-file passphrase)))
-    (smime-process-region start end smime-program args)
-    (smime-process-when-success 
-      (goto-char (point-min))
-      (delete-region (point-min) (progn
-				   (re-search-forward "^$" nil t)
-				   (1+ (point))))
-      (when smime-cache-passphrase
-	(smime-add-passphrase-cache hash passphrase)))))
-
-;;;###autoload
-(defun smime-verify-region (start end signature)
-  "Verify the current region between START and END.
-If the optional 3rd argument SIGNATURE is non-nil, it is treated as
-the detached signature of the current region."
-  (let* ((basename (expand-file-name "smime" temporary-file-directory))
-	 (orig-file (make-temp-name basename))
-	 (orig-mode (default-file-modes)))
-    (unwind-protect
-	(progn
-	  (set-default-file-modes 448)
-	  (binary-write-decoded-region start end orig-file))
-      (set-default-file-modes orig-mode))
-    (with-temp-buffer
-      (binary-insert-encoded-file signature)
-      (goto-char (point-max))
-      (binary-insert-encoded-file
-       (or (smime-find-certificate 
-	    (smime-query-signer (point-min)(point-max)))
-	   (expand-file-name 
-	    (read-file-name "Certificate file: "))))
-      (smime-process-region (point-min)(point-max) smime-program 
-			    (list "-dv" orig-file)))
-    (smime-process-when-success nil)))
-
-(provide 'smime)
-
-;;; smime.el ends here