From 05a5b19a052e831ac19b97b8875638e17e53e157 Mon Sep 17 00:00:00 2001
From: Daiki Ueno <ueno@unixuser.org>
Date: Tue, 14 Nov 2006 07:48:14 +0000
Subject: [PATCH] Fixed the last commit.

---
 lisp/mm-view.el   |   1 -
 lisp/mml-sec.el   |   7 +-
 lisp/mml-smime.el | 285 +---------------------------------------------
 3 files changed, 6 insertions(+), 287 deletions(-)

diff --git a/lisp/mm-view.el b/lisp/mm-view.el
index f52490537..526858225 100644
--- a/lisp/mm-view.el
+++ b/lisp/mm-view.el
@@ -30,7 +30,6 @@
 (require 'mailcap)
 (require 'mm-bodies)
 (require 'mm-decode)
-(require 'smime)
 
 (eval-and-compile
   (autoload 'gnus-article-prepare-display "gnus-art")
diff --git a/lisp/mml-sec.el b/lisp/mml-sec.el
index 835b8bb20..cac0a9f43 100644
--- a/lisp/mml-sec.el
+++ b/lisp/mml-sec.el
@@ -26,6 +26,7 @@
 
 ;;; Code:
 
+(require 'mml-smime)
 (eval-when-compile (require 'cl))
 (require 'password)
 (autoload 'mml2015-sign "mml2015")
@@ -34,12 +35,6 @@
 (autoload 'mml1991-encrypt "mml1991")
 (autoload 'message-goto-body "message")
 (autoload 'mml-insert-tag "mml")
-(autoload 'mml-smime-sign "mml-smime")
-(autoload 'mml-smime-encrypt "mml-smime")
-(autoload 'mml-smime-sign-query "mml-smime")
-(autoload 'mml-smime-encrypt-query "mml-smime")
-(autoload 'mml-smime-verify "mml-smime")
-(autoload 'mml-smime-verify-test "mml-smime")
 
 (defvar mml-sign-alist
   '(("smime"     mml-smime-sign-buffer     mml-smime-sign-query)
diff --git a/lisp/mml-smime.el b/lisp/mml-smime.el
index 2ef6d51f6..9d9d9418e 100644
--- a/lisp/mml-smime.el
+++ b/lisp/mml-smime.el
@@ -31,82 +31,10 @@
 
 (require 'smime)
 (require 'mm-decode)
-(require 'mml-sec)
 (autoload 'message-narrow-to-headers "message")
 (autoload 'message-fetch-field "message")
 
-(defvar mml-smime-use 'openssl)
-
-(defvar mml-smime-function-alist
-  '((openssl mml-smime-openssl-sign
-	     mml-smime-openssl-encrypt
-	     mml-smime-openssl-sign-query
-	     mml-smime-openssl-encrypt-query
-	     mml-smime-openssl-verify
-	     mml-smime-openssl-verify-test)
-    (epg mml-smime-epg-sign
-	 mml-smime-epg-encrypt
-	 nil
-	 nil
-	 mml-smime-epg-verify
-	 mml-smime-epg-verify-test)))
-
-(defcustom mml-smime-verbose mml-secure-verbose
-  "If non-nil, ask the user about the current operation more verbosely."
-  :group 'mime-security
-  :type 'boolean)
-
-(defcustom mml-smime-cache-passphrase mml-secure-cache-passphrase
-  "If t, cache passphrase."
-  :group 'mime-security
-  :type 'boolean)
-
-(defcustom mml-smime-passphrase-cache-expiry mml-secure-passphrase-cache-expiry
-  "How many seconds the passphrase is cached.
-Whether the passphrase is cached at all is controlled by
-`mml-smime-cache-passphrase'."
-  :group 'mime-security
-  :type 'integer)
-
-(defcustom mml-smime-signers nil
-  "A list of your own key ID which will be used to sign a message."
-  :group 'mime-security
-  :type '(repeat (string :tag "Key ID")))
-
 (defun mml-smime-sign (cont)
-  (let ((func (nth 1 (assq mml-smime-use mml-smime-function-alist))))
-    (if func
-	(funcall func cont)
-      (error "Cannot find sign function"))))
-
-(defun mml-smime-encrypt (cont)
-  (let ((func (nth 2 (assq mml-smime-use mml-smime-function-alist))))
-    (if func
-	(funcall func cont)
-      (error "Cannot find encrypt function"))))
-
-(defun mml-smime-sign-query ()
-  (let ((func (nth 3 (assq mml-smime-use mml-smime-function-alist))))
-    (if func
-	(funcall func))))
-
-(defun mml-smime-encrypt-query ()
-  (let ((func (nth 4 (assq mml-smime-use mml-smime-function-alist))))
-    (if func
-	(funcall func))))
-
-(defun mml-smime-verify (handle ctl)
-  (let ((func (nth 5 (assq mml-smime-use mml-smime-function-alist))))
-    (if func
-	(funcall func handle ctl)
-      handle)))
-
-(defun mml-smime-verify-test (handle ctl)
-  (let ((func (nth 6 (assq mml-smime-use mml-smime-function-alist))))
-    (if func
-	(funcall func handle ctl))))
-
-(defun mml-smime-openssl-sign (cont)
   (when (null smime-keys)
     (customize-variable 'smime-keys)
     (error "No S/MIME keys configured, use customize to add your key"))
@@ -116,7 +44,7 @@ Whether the passphrase is cached at all is controlled by
     (replace-match "\n" t t))
   (goto-char (point-max)))
 
-(defun mml-smime-openssl-encrypt (cont)
+(defun mml-smime-encrypt (cont)
   (let (certnames certfiles tmp file tmpfiles)
     ;; xxx tmp files are always an security issue
     (while (setq tmp (pop cont))
@@ -142,7 +70,7 @@ Whether the passphrase is cached at all is controlled by
       nil))
   (goto-char (point-max)))
 
-(defun mml-smime-openssl-sign-query ()
+(defun mml-smime-sign-query ()
   ;; query information (what certificate) from user when MML tag is
   ;; added, for use later by the signing process
   (when (null smime-keys)
@@ -214,7 +142,7 @@ Whether the passphrase is cached at all is controlled by
       (quit))
     result))
 
-(defun mml-smime-openssl-encrypt-query ()
+(defun mml-smime-encrypt-query ()
   ;; todo: try dns/ldap automatically first, before prompting user
   (let (certs done)
     (while (not done)
@@ -230,7 +158,7 @@ Whether the passphrase is cached at all is controlled by
       (setq done (not (y-or-n-p "Add more recipients? "))))
     certs))
 
-(defun mml-smime-openssl-verify (handle ctl)
+(defun mml-smime-verify (handle ctl)
   (with-temp-buffer
     (insert-buffer-substring (mm-handle-multipart-original-buffer ctl))
     (goto-char (point-min))
@@ -295,212 +223,9 @@ Whether the passphrase is cached at all is controlled by
 		 (buffer-string) "\n")))))
   handle)
 
-(defun mml-smime-openssl-verify-test (handle ctl)
+(defun mml-smime-verify-test (handle ctl)
   smime-openssl-program)
 
-(eval-and-compile
-  (autoload 'epg-make-context "epg"))
-
-(eval-when-compile
-  (defvar epg-user-id-alist)
-  (defvar epg-digest-algorithm-alist)
-  (defvar inhibit-redisplay)
-  (autoload 'epg-context-set-armor "epg")
-  (autoload 'epg-context-set-textmode "epg")
-  (autoload 'epg-context-set-signers "epg")
-  (autoload 'epg-context-result-for "epg")
-  (autoload 'epg-new-signature-digest-algorithm "epg")
-  (autoload 'epg-verify-result-to-string "epg")
-  (autoload 'epg-list-keys "epg")
-  (autoload 'epg-decrypt-string "epg")
-  (autoload 'epg-verify-string "epg")
-  (autoload 'epg-sign-string "epg")
-  (autoload 'epg-encrypt-string "epg")
-  (autoload 'epg-passphrase-callback-function "epg")
-  (autoload 'epg-context-set-passphrase-callback "epg")
-  (autoload 'epg-configuration "epg-config")
-  (autoload 'epg-expand-group "epg-config")
-  (autoload 'epa-select-keys "epa"))
-
-(eval-when-compile
-  (defvar password-cache-expiry)
-  (autoload 'password-read "password")
-  (autoload 'password-cache-add "password")
-  (autoload 'password-cache-remove "password"))
-
-(defvar mml-smime-epg-secret-key-id-list nil)
-
-(defun mml-smime-epg-passphrase-callback (context key-id ignore)
-  (if (eq key-id 'SYM)
-      (epg-passphrase-callback-function context key-id nil)
-    (let* (entry
-	   (passphrase
-	    (password-read
-	     (if (eq key-id 'PIN)
-		 "Passphrase for PIN: "
-	       (if (setq entry (assoc key-id epg-user-id-alist))
-		   (format "Passphrase for %s %s: " key-id (cdr entry))
-		 (format "Passphrase for %s: " key-id)))
-	     (if (eq key-id 'PIN)
-		 "PIN"
-	       key-id))))
-      (when passphrase
-	(let ((password-cache-expiry mml-smime-passphrase-cache-expiry))
-	  (password-cache-add key-id passphrase))
-	(setq mml-smime-epg-secret-key-id-list
-	      (cons key-id mml-smime-epg-secret-key-id-list))
-	(copy-sequence passphrase)))))
-
-(defun mml-smime-epg-sign (cont)
-  (let* ((inhibit-redisplay t)
-	 (context (epg-make-context 'CMS))
-	 (boundary (mml-compute-boundary cont))
-	 (signers
-	  (or (message-options-get 'mml-smime-epg-signers)
-	      (message-options-set
-	      'mml-smime-epg-signers
-	      (if mml-smime-verbose
-		  (epa-select-keys context "\
-Select keys for signing.
-If no one is selected, default secret key is used.  "
-				   mml-smime-signers t)
-		(if mml-smime-signers
-		    (mapcar (lambda (name)
-			      (car (epg-list-keys context name t)))
-			    mml-smime-signers))))))
-	signature micalg)
-    (epg-context-set-signers context signers)
-    (if mml-smime-cache-passphrase
-	(epg-context-set-passphrase-callback
-	 context
-	 #'mml-smime-epg-passphrase-callback))
-    (condition-case error
-	(setq signature (epg-sign-string context (buffer-string) t)
-	      mml-smime-epg-secret-key-id-list nil)
-      (error
-       (while mml-smime-epg-secret-key-id-list
-	 (password-cache-remove (car mml-smime-epg-secret-key-id-list))
-	 (setq mml-smime-epg-secret-key-id-list
-	       (cdr mml-smime-epg-secret-key-id-list)))
-       (signal (car error) (cdr error))))
-    (if (epg-context-result-for context 'sign)
-	(setq micalg (epg-new-signature-digest-algorithm
-		      (car (epg-context-result-for context 'sign)))))
-    (goto-char (point-min))
-    (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
-		    boundary))
-    (if micalg
-	(insert (format "\tmicalg=%s; "
-			(downcase
-			 (cdr (assq micalg
-				    epg-digest-algorithm-alist))))))
-    (insert "protocol=\"application/pkcs7-signature\"\n")
-    (insert (format "\n--%s\n" boundary))
-    (goto-char (point-max))
-    (insert (format "\n--%s\n" boundary))
-    (insert "Content-Type: application/pkcs7-signature; name=smime.p7s
-Content-Transfer-Encoding: base64
-Content-Disposition: attachment; filename=smime.p7s
-
-")
-    (insert (base64-encode-string signature) "\n")
-    (goto-char (point-max))
-    (insert (format "--%s--\n" boundary))
-    (goto-char (point-max))))
-
-(defun mml-smime-epg-encrypt (cont)
-  (let ((inhibit-redisplay t)
-	(context (epg-make-context 'CMS))
-	(config (epg-configuration))
-	(recipients (message-options-get 'mml-smime-epg-recipients))
-	cipher signers
-	(boundary (mml-compute-boundary cont)))
-    (unless recipients
-      (setq recipients
-	    (apply #'nconc
-		   (mapcar
-		    (lambda (recipient)
-		      (or (epg-expand-group config recipient)
-			  (list recipient)))
-		    (split-string
-		     (or (message-options-get 'message-recipients)
-			 (message-options-set 'message-recipients
-					      (read-string "Recipients: ")))
-		     "[ \f\t\n\r\v,]+"))))
-      (if mml-smime-verbose
-	  (setq recipients
-		(epa-select-keys context "\
-Select recipients for encryption.
-If no one is selected, symmetric encryption will be performed.  "
-				 recipients))
-	(setq recipients
-	      (delq nil (mapcar (lambda (name)
-				  (car (epg-list-keys context name)))
-				recipients))))
-      (message-options-set 'mml-smime-epg-recipients recipients))
-    (if mml-smime-cache-passphrase
-	(epg-context-set-passphrase-callback
-	 context
-	 #'mml-smime-epg-passphrase-callback))
-    (condition-case error
-	(setq cipher
-	      (epg-encrypt-string context (buffer-string) recipients)
-	      mml-smime-epg-secret-key-id-list nil)
-      (error
-       (while mml-smime-epg-secret-key-id-list
-	 (password-cache-remove (car mml-smime-epg-secret-key-id-list))
-	 (setq mml-smime-epg-secret-key-id-list
-	       (cdr mml-smime-epg-secret-key-id-list)))
-       (signal (car error) (cdr error))))
-    (delete-region (point-min) (point-max))
-    (goto-char (point-min))
-    (insert "\
-Content-Type: application/pkcs7-mime;
- smime-type=enveloped-data;
- name=smime.p7m
-Content-Transfer-Encoding: base64
-Content-Disposition: attachment; filename=smime.p7m
-
-")
-    (insert (base64-encode-string cipher))
-    (goto-char (point-max))))
-
-(defun mml-smime-epg-verify (handle ctl)
-  (catch 'error
-    (let ((inhibit-redisplay t)
-	  context plain signature-file part signature)
-      (when (or (null (setq part (mm-find-raw-part-by-type
-				  ctl (or (mm-handle-multipart-ctl-parameter
-					   ctl 'protocol)
-					  "application/pkcs7-signature")
-				  t)))
-		(null (setq signature (mm-find-part-by-type
-				       (cdr handle)
-				       "application/pkcs7-signature"
-				       nil t))))
-	(mm-set-handle-multipart-parameter
-	 mm-security-handle 'gnus-info "Corrupted")
-	(throw 'error handle))
-      (setq context (epg-make-context 'CMS))
-      (condition-case error
-	  (setq plain (epg-verify-string context (mm-get-part signature) part))
-	(error
-	 (mm-set-handle-multipart-parameter
-	  mm-security-handle 'gnus-info "Failed")
-	 (if (eq (car error) 'quit)
-	     (mm-set-handle-multipart-parameter
-	      mm-security-handle 'gnus-details "Quit.")
-	   (mm-set-handle-multipart-parameter
-	    mm-security-handle 'gnus-details (format "%S" error)))
-	 (throw 'error handle)))
-      (mm-set-handle-multipart-parameter
-       mm-security-handle 'gnus-info
-       (epg-verify-result-to-string (epg-context-result-for context 'verify)))
-      handle)))
-
-(defun mml-smime-epg-verify-test (handle ctl)
-  t)
-
 (provide 'mml-smime)
 
 ;;; arch-tag: f1bf94d4-f2cd-4c6f-b059-ad69492817e2
-- 
2.25.1