From: ueno <ueno>
Date: Sun, 23 Apr 2006 01:12:53 +0000 (+0000)
Subject: * mime-pgp.el (mime-verify-application/pkcs7-signature): Use EasyPG.
X-Git-Tag: emiko-1_14_1-epg-0_0_1~2
X-Git-Url: http://git.chise.org/cgi-bin/gitweb.cgi?a=commitdiff_plain;h=03b99fa0276c246099f7ae96ee66ca9e8b8b52fe;p=elisp%2Fsemi.git

* mime-pgp.el (mime-verify-application/pkcs7-signature): Use EasyPG.
(mime-view-application/pkcs7-mime): Ditto.

* mime-edit.el (mime-edit-sign-smime): Use EasyPG.
(mime-edit-encrypt-smime): Ditto.

* SEMI-ELS (semi-modules-to-compile): Don't install PGG.
---

diff --git a/ChangeLog b/ChangeLog
index 5f789a4..f9ada14 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -1,3 +1,13 @@
+2006-04-23  Daiki Ueno  <ueno@unixuser.org>
+
+	* mime-pgp.el (mime-verify-application/pkcs7-signature): Use EasyPG.
+	(mime-view-application/pkcs7-mime): Ditto.
+
+	* mime-edit.el (mime-edit-sign-smime): Use EasyPG.
+	(mime-edit-encrypt-smime): Ditto.
+
+	* SEMI-ELS (semi-modules-to-compile): Don't install PGG.
+
 2006-04-20  Daiki Ueno  <ueno@unixuser.org>
 
 	* mime-pgp.el (mime-view-application/pgp): Use epg-signature-to-string.
diff --git a/SEMI-ELS b/SEMI-ELS
index b77be5a..d86e6a9 100644
--- a/SEMI-ELS
+++ b/SEMI-ELS
@@ -6,7 +6,7 @@
 
 (setq semi-modules-to-compile
       '(signature
-	pgg-def pgg pgg-parse pgg-gpg pgg-pgp5 pgg-pgp mime-pgp
+	mime-pgp
 	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 3b76e6d..70cfbed 100644
--- a/mime-edit.el
+++ b/mime-edit.el
@@ -115,11 +115,6 @@
 (require 'alist)
 (require 'epa)
 
-(autoload 'smime-encrypt-buffer "smime"
-  "S/MIME encryption of current buffer.")
-(autoload 'smime-sign-buffer "smime"
-  "S/MIME signature of current buffer.")
-
 
 ;;; @ version
 ;;;
@@ -740,6 +735,10 @@ Tspecials means any character that matches with it in header must be quoted.")
 (define-key mime-edit-mode-enclosure-map
   "\C-e" 'mime-edit-enclose-pgp-encrypted-region)
 (define-key mime-edit-mode-enclosure-map
+  "s" 'mime-edit-enclose-smime-signed-region)
+(define-key mime-edit-mode-enclosure-map
+  "e" 'mime-edit-enclose-smime-encrypted-region)
+(define-key mime-edit-mode-enclosure-map
   "\C-q" 'mime-edit-enclose-quote-region)
 
 (defvar mime-edit-mode-map (make-sparse-keymap)
@@ -1668,8 +1667,7 @@ Parameter must be '(PROMPT CHOICE1 (CHOICE2...))."
 	     (encoding (nth 1 ret))
 	     (pgp-boundary (concat "pgp-sign-" boundary))
 	     (context (epg-make-context))
-	     signature
-	     micalg)
+	     signature micalg)
 	(mime-edit-delete-trailing-whitespace) ; RFC3156
 	(goto-char beg)
 	(insert (format "Content-Type: %s\n" ctype))
@@ -1681,6 +1679,7 @@ Parameter must be '(PROMPT CHOICE1 (CHOICE2...))."
 	(epg-context-set-signers
 	 context
 	 (epa-select-keys
+	  context
 	  "\
 Select keys for signing.
 If no one is selected, default secret key is used.  "
@@ -1713,6 +1712,7 @@ If no one is selected, default secret key is used.  "
 	(insert (format "\n--%s
 Content-Type: application/pgp-signature
 Content-Transfer-Encoding: 7bit
+Content-Description: OpenPGP Digital Signature
 
 " pgp-boundary))
 	(insert signature)
@@ -1777,6 +1777,7 @@ Content-Transfer-Encoding: 7bit
 		     context
 		     (buffer-substring (point-min) (point-max))
 		     (epa-select-keys
+		      context
 		      "\
 Select recipents for encryption.
 If no one is selected, symmetric encryption will be performed.  "
@@ -1856,6 +1857,7 @@ Content-Transfer-Encoding: 7bit
 		     context
 		     (buffer-substring beg (point-max))
 		     (epa-select-keys
+		      context
 		      "\
 Select recipents for encryption.
 If no one is selected, symmetric encryption will be performed.  "
@@ -1870,61 +1872,120 @@ If no one is selected, symmetric encryption will be performed.  "
 	   "--[[application/pgp; format=mime][7bit]]\n" cipher)
 	  )))))
 
+(defun mime-edit-convert-lbt-string (string)
+  (let ((index 0)
+	(length (length string)))
+    (while (setq index (string-match "\n" string index))
+      (setq string (replace-match "\r\n" nil nil string)
+	    index (+ index 2)))		;(length "\r\n")
+    string))
+      
 (defun mime-edit-sign-smime (beg end boundary)
   (save-excursion
     (save-restriction
-      (let* ((ret (progn 
+      (let* ((from (std11-field-body "From" mail-header-separator))
+	     (ret (progn 
 		    (narrow-to-region beg end)
 		    (mime-edit-translate-region beg end boundary)))
 	     (ctype    (car ret))
 	     (encoding (nth 1 ret))
-	     (smime-boundary (concat "smime-sign-" boundary)))
+	     (smime-boundary (concat "smime-sign-" boundary))
+	     (context (epg-make-context 'CMS))
+	     signature micalg)
 	(goto-char beg)
 	(insert (format "Content-Type: %s\n" ctype))
 	(if encoding
 	    (insert (format "Content-Transfer-Encoding: %s\n" encoding)))
 	(insert "\n")
-	(let (buffer-undo-list)
-	  (goto-char (point-min))
-	  (while (progn (end-of-line) (not (eobp)))
-	    (insert "\r")
-	    (forward-line 1))
-	  (or (smime-sign-buffer)
-	      (throw 'mime-edit-error 'pgp-error)))
+	(epg-context-set-signers
+	 context
+	 (epa-select-keys
+	  context
+	  "\
+Select keys for signing.
+If no one is selected, default secret key is used.  "
+	  (if from 
+	      (list (nth 1 (std11-extract-address-components from))))
+	  t))
+	(condition-case error
+	    (setq signature
+		  (epg-sign-string context
+				   (mime-edit-convert-lbt-string
+				    (buffer-substring (point-min) (point-max)))
+				   'detached))
+	  (error (signal 'mime-edit-error (cdr error))))
+	(setq micalg (cdr (assq 'digest-algorithm
+				(car (epg-context-result-for context 'sign)))))
 	(goto-char beg)
-	(if (re-search-forward "^Content-Type:\\s-*" nil t)
-	    (let* ((start (match-beginning 0))
-		   (body (buffer-substring (match-end 0) (std11-field-end))))
-	      (delete-region start (line-beginning-position 2))
-	      (goto-char beg)
-	      (insert "--[[" body "][7bit]]\n")))))))
+	(insert (format "--[[multipart/signed;
+ boundary=\"%s\"%s;
+ protocol=\"application/pkcs7-signature\"][7bit]]
+--%s
+"
+			smime-boundary
+			(if micalg
+			    (concat "; micalg="
+				    (downcase
+				     (cdr (assq micalg
+						epg-digest-algorithm-alist))))
+			  "")
+			smime-boundary))
+	(goto-char (point-max))
+	(insert (format "\n--%s
+Content-Type: application/pkcs7-signature; name=smime.p7s
+Content-Transfer-Encoding: base64
+Content-Disposition: attachment; filename=smime.p7s
+Content-Description: S/MIME Digital Signature
+
+" smime-boundary)
+		(base64-encode-string signature))))))
 
 (defun mime-edit-encrypt-smime (beg end boundary)
   (save-excursion
     (save-restriction
-      (let* ((ret (progn 
-		    (narrow-to-region beg end)
-		    (mime-edit-translate-region beg end boundary)))
-	     (ctype    (car ret))
-	     (encoding (nth 1 ret)))
-	(goto-char beg)
-	(insert (format "Content-Type: %s\n" ctype))
-	(if encoding
-	    (insert (format "Content-Transfer-Encoding: %s\n" encoding)))
-	(insert "\n")
-	(goto-char (point-min))
-	(while (progn (end-of-line) (not (eobp)))
-	  (insert "\r")
-	  (forward-line 1))
-	(or (smime-encrypt-buffer)
-	    (throw 'mime-edit-error 'pgp-error))
-	(goto-char beg)
-	(if (re-search-forward "^Content-Type:\\s-*" nil t)
-	    (let* ((start (match-beginning 0))
-		   (body (buffer-substring (match-end 0) (std11-field-end))))
-	      (delete-region start (line-beginning-position 2))
-	      (goto-char beg)
-	      (insert "--[[" body "]]\n")))))))
+      (let (recipients header)
+        (let ((ret (mime-edit-make-encrypt-recipient-header)))
+          (setq recipients (aref ret 1)
+                header (aref ret 2)))
+        (narrow-to-region beg end)
+        (let* ((ret
+                (mime-edit-translate-region beg end boundary))
+               (ctype    (car ret))
+               (encoding (nth 1 ret))
+	       (context (epg-make-context 'CMS))
+	       cipher)
+          (goto-char beg)
+          (insert header)
+          (insert (format "Content-Type: %s\n" ctype))
+          (if encoding
+              (insert (format "Content-Transfer-Encoding: %s\n" encoding)))
+          (insert "\n")
+	  (mime-encode-header-in-buffer)
+	  (condition-case error
+	      (setq cipher
+		    (epg-encrypt-string
+		     context
+		     (buffer-substring (point-min) (point-max))
+		     (epa-select-keys
+		      context
+		      "\
+Select recipents for encryption.
+If no one is selected, symmetric encryption will be performed.  "
+		      (mapcar (lambda (recipient)
+				(nth 1 (std11-extract-address-components
+					recipient)))
+			      (split-string recipients 
+					    "\\([ \t\n]*,[ \t\n]*\\)+")))))
+	    (error (signal 'mime-edit-error (cdr error))))
+	  (delete-region (point-min)(point-max))
+	  (goto-char beg)
+	  (insert (format "--[[application/pkcs7-mime;
+ smime-type=enveloped-data;
+ name=smime.p7m
+Content-Disposition: attachment; filename=smime.p7m][base64]]
+
+")
+		  (base64-encode-string cipher)))))))
 
 (defsubst replace-space-with-underline (str)
   (mapconcat (function
@@ -2318,7 +2379,8 @@ and insert data encoded as ENCODING."
   (let ((context (epg-make-context)))
     (epg-context-set-armor t)
     (epg-export-keys-to-string context
-			       (epa-select-keys "Select keys for export.  ")))
+			       (epa-select-keys context
+						"Select keys for export.  ")))
   (if (and (not (eobp))
 	   (not (looking-at mime-edit-single-part-tag-regexp)))
       (insert (mime-make-text-tag) "\n")))
@@ -2625,20 +2687,15 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n"
 		(narrow-to-region beg end)
 		(cond
 		 ((eq subtype 'pgp-encrypted)
-		  (when (and
-			 (progn
+		  (when (progn
 			   (goto-char (point-min))
 			   (re-search-forward "^-+BEGIN PGP MESSAGE-+$"
 					      nil t))
-			 (prog1 
-			     (save-window-excursion
-			       (epg-decrypt-string
-				(epg-make-context)
-				(buffer-substring
-				 (match-beginning 0)
-				 (point-max))))
-			   (delete-region (point-min)(point-max))))
-		    (insert-buffer-substring pgg-output-buffer)
+		    (insert (epg-decrypt-string
+			     (epg-make-context)
+			     (buffer-substring (match-beginning 0)
+					       (point-max))))
+		    (delete-region (point)(point-max))
 		    (mime-edit-decode-message-in-buffer 
 		     nil not-decode-text)
 		    (delete-region (goto-char (point-min))
diff --git a/mime-pgp.el b/mime-pgp.el
index 056e5e9..bbaea2c 100644
--- a/mime-pgp.el
+++ b/mime-pgp.el
@@ -192,48 +192,36 @@
 
 (defun mime-verify-application/pkcs7-signature (entity situation)
   "Internal method to check S/MIME signature."
-  (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)
-	    (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))))
+  (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)))
+	 (context (epg-make-context 'CMS))
+	 verify-result)
+    (epg-verify-string context
+		       (mime-entity-content entity)
+		       (with-temp-buffer
+			 (if (fboundp 'set-buffer-multibyte)
+			     (set-buffer-multibyte nil))
+			 (mime-insert-entity orig-entity)
+			 (goto-char (point-min))
+			 (while (search-forward "\n" nil t)
+			   (replace-match "\r\n"))
+			 (buffer-substring)))
+    (setq verify-result
+	  (mapcar (lambda (signature)
+		    (unless (stringp (epg-signature-user-id signature))
+		      (setq signature (copy-sequence signature))
+		      (epg-signature-set-user-id
+		       signature
+		       (epg-decode-dn (epg-signature-user-id signature))))
+		    signature)
+		  (epg-context-result-for context 'verify)))
+    (message "%s"
+	     (epg-verify-result-to-string verify-result))))
 
 
 ;;; @ Internal method for application/pkcs7-mime
@@ -247,6 +235,7 @@
 	  (format "%s-%s" (buffer-name) (mime-entity-number entity)))
 	 (mother (current-buffer))
 	 (preview-buffer (concat "*Preview-" (buffer-name) "*"))
+	 (context (epg-make-context 'CMS))
 	 message-buf)
     (when (memq (or (cdr (assq 'smime-type situation)) 'enveloped-data)
 		'(enveloped-data signed-data))
@@ -254,8 +243,7 @@
       (let ((inhibit-read-only t)
 	    buffer-read-only)
 	(erase-buffer)
-	(mime-insert-entity entity)
-	(smime-decrypt-buffer))
+	(insert (epg-decrypt-string context (mime-entity-content entity))))
       (setq major-mode 'mime-show-message-mode)
       (save-window-excursion
 	(mime-view-buffer nil preview-buffer mother