[Mew-dist 16286] S/MIME encryption patch

Ryutaroh Matsumoto ryutaroh at example.com
2001年 2月 10日 (土) 03:51:06 JST


まつもとです。

S/MIMEを暗号化とクリア署名でない電子署名もふくめて実装できたのでパッチ
を報告します。パッチは何も変更していない Mew 1.95b102 に対するものです。
OpenSSLを変更しない範囲でできることをだいたいやったのではないかと思い
ます。

使い方はOpenSSL 0.96をインストールして

(defvar mew-smime-digital-id nil
"*Filename containing your digital ID in the PEM format.")
(defvar mew-smime-CA-file nil
"*Filename containing certificates of the trusted CAs, such as VeriSign.")
(defvar mew-smime-pubkey-dir nil
"*Directory storing public keys of others")

の3つの変数を設定します。最初の二つの変数に設定するファイルの作り方は
[Mew-dist 16207]の4節を参照してください。

3つ目の変数で示されるディレクトリは電子署名の中に含まれる送信者の公開
鍵を保存するためのものです。この公開鍵はその人に送るメールを暗号化する
ときに使います。ファイル名は公開鍵の中に記録されているメールアドレスと
同じになります。電子署名を検証する度に署名に含まれる公開鍵をそのディレ
クトリに格納しようとしますが、既にファイルがある場合には上書きしません。

暗号化に使うアルゴリズムは
(defvar mew-smime-encryption-algorithm "-des3"
"*Encryption Algorithm")
で設定できます。どのようなアルゴリズムが使えるかはopensslのマニュアル
ページを見て下さい。

また電子署名の検証において、送信者の公開鍵がどのメールアドレスに対して
発行されたのかX-Mewに表示するようになりました。

署名や暗号化はドラフトモードでメッセージを書いたあと以下の関数を実行し
てください。
mew-smime-sign-message
mew-smime-encrypt-message
mew-smime-sign-encrypt-message
mew-smime-encrypt-sign-message

S/MIMEのパスフレーズの入力が面倒な場合
(setq mew-use-cached-passwd t)
としてください。

このパッチで私の欲しい機能はだいたい実装しました。Outlook Express 5.5
に暗号化した後署名をしたメッセージを送ると電子署名が正しいと認識されま
せん。これはOutlookのバグではないかと疑っています。

またOutlookから暗号化と署名の両方を行ったメッセージを送ると暗号化され
た中にクリア署名でないデジタル署名が入っているので、クリア署名でない電
子署名も解読できる必要があります。

問題点はプログラムの書き方が汚いところと暗号化されたときに「E」マーク
が付かないことです。

--
松本  隆太郎
-------------- next part --------------
diff -aruN mew-1.95b102/Makefile 2-mew-1.95b102-smime/Makefile
--- mew-1.95b102/Makefile	Fri Dec 22 16:44:43 2000
+++ 2-mew-1.95b102-smime/Makefile	Fri Feb  9 21:22:37 2001
@@ -67,7 +67,8 @@
 					mew-vars.elc	\
 	mew-vars2.elc	mew-virtual.elc			\
 	mew-auth.elc	mew-md5.elc     mew-pop.elc     \
-	mew-key.elc     mew-thread.elc  mew.elc
+	mew-key.elc     mew-thread.elc  mew.elc		\
+	mew-smime.elc
 
 SRCS =	mew-addrbook.el	mew-attach.el	mew-blvs.el	\
 	mew-bq.el	mew-cache.el	mew-complete.el	\
@@ -86,7 +87,7 @@
 	mew-vars2.el	mew-virtual.el	mew-win32.el	\
 	mew-xemacs.el	mew-auth.el	mew-md5.el      \
 	mew-gemacs.el   mew-pop.el      mew-key.el      \
-	mew-thread.el	mew.el
+	mew-thread.el	mew.el		mew-smime.el
 
 TEMPFILE = temp.el
 
diff -aruN mew-1.95b102/mew-const.el 2-mew-1.95b102-smime/mew-const.el
--- mew-1.95b102/mew-const.el	Tue Feb  6 17:56:42 2001
+++ 2-mew-1.95b102-smime/mew-const.el	Fri Feb  9 16:22:17 2001
@@ -92,6 +92,8 @@
 (defconst mew-ct-pgs "application/pgp-signature") ;; due to the RFC 1847 bug
 (defconst mew-ct-pge "application/pgp-encrypted") ;; due to the RFC 1847 bug
 (defconst mew-ct-apk "Application/Pgp-Keys")
+(defconst mew-ct-sms "application/x-pkcs7-signature")
+(defconst mew-ct-sme "Application/X-Pkcs7-Mime")
 
 (defconst mew-us-ascii "us-ascii")
 (defconst mew-cs-unknown 'unknown)
diff -aruN mew-1.95b102/mew-decode.el 2-mew-1.95b102-smime/mew-decode.el
--- mew-1.95b102/mew-decode.el	Tue Dec 26 14:17:00 2000
+++ 2-mew-1.95b102-smime/mew-decode.el	Sat Feb 10 03:19:35 2001
@@ -29,7 +29,8 @@
   '(("application/pgp-encrypted" mew-pgp-decrypt mew-pgp-ver mew-prog-pgp)))
 
 (defvar mew-decode-multipart-signed-switch
-  '(("application/pgp-signature" mew-pgp-verify mew-pgp-ver mew-prog-pgp)))
+  '(("application/pgp-signature" mew-pgp-verify mew-pgp-ver mew-prog-pgp)
+    ("application/x-pkcs7-signature" mew-smime-verify mew-smime-ver mew-prog-smime)))
 
 ;;
 
@@ -532,6 +533,11 @@
 	    (setq syntax (mew-decode-multipart-encrypted syntax cnt))))
 	 (t
 	  (setq syntax (mew-decode-multipart syntax cnt nil))))))
+     ;; S/MIME encrypted or signed
+     ((and (string-match mew-ct-sme ct) (or
+        (string-match "signed-data" (mew-syntax-get-param ctl "smime-type"))
+        (string-match "enveloped-data" (mew-syntax-get-param ctl "smime-type"))))
+      (setq syntax (mew-smime-decrypt-or-verify syntax cnt ctl cte)))
      ;; Others
      (t
       (if (and (eq parent 'message) (not (string= mew-ct-txt ct)))
diff -aruN mew-1.95b102/mew-draft.el 2-mew-1.95b102-smime/mew-draft.el
--- mew-1.95b102/mew-draft.el	Mon Feb  5 14:50:02 2001
+++ 2-mew-1.95b102-smime/mew-draft.el	Thu Feb  8 18:16:39 2001
@@ -698,7 +698,7 @@
   (let ((win (mew-current-get-window (mew-frame-id))))
     (if (not (window-configuration-p win))
 	(setq win mew-inbox-window))
-    (set-window-configuration win)
+    (if win (set-window-configuration win))
     (mew-current-set-window (mew-frame-id) nil)
     (mew-summary-toolbar-update)
     (sit-for 0)))
diff -aruN mew-1.95b102/mew-encode.el 2-mew-1.95b102-smime/mew-encode.el
--- mew-1.95b102/mew-encode.el	Fri Jan 19 01:40:46 2001
+++ 2-mew-1.95b102-smime/mew-encode.el	Sat Feb 10 00:17:57 2001
@@ -24,10 +24,12 @@
   (cdr (mew-assoc-case-equal cte switch 0)))
 
 (defvar mew-encode-multipart-encrypted-switch
-  '(("application/pgp-encrypted" mew-pgp-encrypt)))
+  '(("application/pgp-encrypted" mew-pgp-encrypt)
+    ("application/x-pkcs7-mime" mew-smime-encrypt)))
 
 (defvar mew-encode-multipart-signed-switch
-  '(("application/pgp-signature" mew-pgp-sign)))
+  '(("application/pgp-signature" mew-pgp-sign)
+    ("application/x-pkcs7-signature" mew-smime-sign)))
 
 ;;
 
@@ -727,6 +729,25 @@
        (mew-encode-error
 	(format "unknown error for %s. Check %s, anyway" 
 		mew-ct-mle mew-temp-dir))))
+    (if (equal proto "application/x-pkcs7-mime")
+      (progn
+         (setq file2 (nth 0 fc) errmsg (nth 1 fc))
+    (if errmsg
+	(progn
+	  (if (file-exists-p file1) (delete-file file1))
+	  (if (file-exists-p file2) (delete-file file2))
+	  (setq mew-draft-privacy-error t)
+	  (mew-encode-error errmsg))
+(mew-encode-singlepart 
+       (mew-encode-syntax-single file2
+        (list "application/x-pkcs7-mime"
+          (list "smime-type" "enveloped-data")
+          (list "name" "smime.p7m"))
+        mew-b64
+        (list "attachment" (list "filename" "smime.p7m")))))
+      (if (file-exists-p file1) (delete-file file1))
+      (if (file-exists-p file2) (delete-file file2))
+)
     (setq file2 (nth 0 fc) cte2 (nth 1 fc) file3 (nth 2 fc) cte3 (nth 3 fc))
     (setq errmsg (nth 4 fc))
     (if errmsg
@@ -753,14 +774,14 @@
       ;; Throw away the garbage 
       (if (file-exists-p file1) (delete-file file1))
       (if (file-exists-p file2) (delete-file file2))
-      (if (file-exists-p file3) (delete-file file3)))))
+      (if (file-exists-p file3) (delete-file file3))))))
 
 (defun mew-encode-multipart-signed (ct proto depth)
   ;; called in the narrowed region
   (let* ((boundary (mew-security-multipart-boundary depth))
 	 (switch mew-encode-multipart-signed-switch) ;; save length
 	 (func (mew-encode-get-security-func proto switch))
-	 file1 file2 micalg cte2 fmc errmsg)
+	 file1 file2 micalg cte2 fmc errmsg ct2 cd2)
     (setq file1 (mew-save-transfer-form (point-min) (point-max) 'retain))
     ;; The narrowed region still the ORIGINAL part (i.e. line breaks are LF)
     ;; Call the protocol function
@@ -773,6 +794,7 @@
 		mew-ct-mls mew-temp-dir))))
     (setq file2 (nth 0 fmc) cte2 (nth 1 fmc) micalg (nth 2 fmc))
     (setq errmsg (nth 3 fmc))
+    (setq ct2 (nth 4 fmc) cd2 (nth 5 fmc))
     (if errmsg
 	(progn
 	  (if (file-exists-p file1) (delete-file file1))
@@ -792,7 +814,8 @@
       ;; After the sigend part
       (insert (format "\n--%s\n" boundary))
       (mew-encode-singlepart 
-       (mew-encode-syntax-single file2 (list proto) cte2))
+       (mew-encode-syntax-single file2 (if ct2 ct2 (list protocol))
+        cte2 cd2))
       (insert (format "\n--%s--\n" boundary))
       ;; Throw away the garbage 
       (if (file-exists-p file1) (delete-file file1))
diff -aruN mew-1.95b102/mew-smime.el 2-mew-1.95b102-smime/mew-smime.el
--- mew-1.95b102/mew-smime.el	Thu Jan  1 09:00:00 1970
+++ 2-mew-1.95b102-smime/mew-smime.el	Sat Feb 10 02:05:36 2001
@@ -0,0 +1,246 @@
+; This file is based on mew-pgp.el in Mew 1.94.2, whose copyright also 
+; applies to this file. This file is originally written by Ryutaroh
+; Matsumoto <ryutaroh at example.com>, February 7, 2001.
+
+(provide 'mew-smime)
+
+; configuration variables
+(defvar mew-smime-digital-id nil
+"*Filename containing your digital ID in the PEM format.")
+(defvar mew-smime-CA-file nil
+"*Filename containing certificates of the trusted CAs, such as VeriSign.")
+(defvar mew-smime-pubkey-dir nil
+"*Directory storing public keys of others")
+(defvar mew-smime-encryption-algorithm "-des3"
+"*Encryption Algorithm")
+
+
+(defun mew-smime-configuration-check ()
+   (cond
+     ((not mew-smime-digital-id) "Please set mew-smime-digital-id")
+     ((not mew-smime-CA-file) "Please set mew-smime-CA-file")
+     ((not mew-smime-pubkey-dir) "Please set mew-smime-pubkey-dir")
+     ((not (mew-which-exec "openssl")) "OpenSSL is not installed.")))
+
+; internal variables
+(defvar mew-smime-running nil)
+(defvar mew-smime-prompt-enter-pass   "Enter S/MIME pass phrase: ")
+(defvar mew-smime-prompt-reenter-pass "Re-enter S/MIME pass phrase: ")
+(defconst mew-smime-msg-enter-pass "Enter PEM pass phrase:")
+(defvar mew-smime-string nil)
+(defvar mew-smime-sign-error nil)
+
+; The following variables are used only in the variable
+; mew-decode-multipart-signed-switch in mew-decode.el.
+(defvar mew-smime-ver 0)
+(defvar mew-prog-smime "openssl")
+
+
+(defun mew-smime-passphrase (&optional again)
+  (let ((prompt (if again
+		    mew-smime-prompt-reenter-pass
+		  mew-smime-prompt-enter-pass)))
+      (mew-input-passwd prompt "S/MIME")))
+
+
+(defun mew-smime-process-filter1 (process string)
+  ;; sign or decrypt, not verify
+  (setq mew-smime-string (concat mew-smime-string string))
+  (cond
+   ;; pass phrase for sign or decrypt
+   ((string-match mew-smime-msg-enter-pass string)
+    (process-send-string process (format "%s\n" (mew-smime-passphrase)))
+    (set-process-filter process nil))))
+
+
+(defun mew-smime-process-sentinel (process event)
+(if (string-match "finished" event) (progn
+  (setq mew-smime-running nil)
+  (setq mew-smime-sign-error nil)))
+(if (string-match "exited abnormally" event) (progn
+  (setq mew-smime-running nil)
+  (setq mew-smime-sign-error "openssl exited abnormally."))))
+
+
+(defun mew-smime-sign (file1)
+  (if (mew-smime-configuration-check)
+   (list nil nil nil (mew-smime-configuration-check))
+  (progn 
+  (message "S/MIME signing ... ")
+  (setq mew-smime-string nil)
+  (setq mew-smime-running 'signing)
+  (let ((process-connection-type mew-connection-type2)
+	file2 process)
+    (setq file2 (mew-make-temp-name))
+    ;; not perfectly unique but OK
+    (setq process
+	  (mew-start-process-lang
+	   "S/MIME sign"
+	   nil
+	   "openssl"
+	   "smime" "-sign" "-in" file1 "-out" file2 "-outform" "DER" "-signer" mew-smime-digital-id))
+    (mew-set-process-cs process mew-cs-autoconv mew-cs-dummy)
+    (set-process-filter process 'mew-smime-process-filter1)
+    (set-process-sentinel process 'mew-smime-process-sentinel)
+    ;; Wait for the termination of OpenSSL.
+    ;; Emacs doesn't provide synchronize mechanism with
+    ;; an asynchronous process. So, take this way. 
+    (while mew-smime-running
+	(if mew-xemacs-p
+	    (accept-process-output)
+	  (sit-for 1)
+	  ;; accept-process-output or sleep-for is not enough
+	  (discard-input)))
+    (message "S/MIME signing ... done")
+    (list file2 mew-b64 "sha1" mew-smime-sign-error
+     (list "application/x-pkcs7-signature" (list "name" "smime.p7s"))
+     (list "attachment" (list "filename" "smime.p7s"))))))) ;; return
+
+
+
+(defun mew-smime-sign-message ()
+  "Sign the entire draft with S/MIME. Input your passphrase."
+  (interactive)
+  (mew-draft-make-message 'smime-signature))
+
+
+(defun mew-smime-verify (file1 file2)
+  (message "S/MIME verifying ... ")
+  (if (mew-smime-configuration-check)
+   (mew-smime-configuration-check)
+   (let ((pubkey-file (mew-make-temp-name)) email-addr pubkey-moved)
+   (if (equal 0 (mew-call-process-lang "openssl" nil nil nil
+     "smime" "-verify" "-inform" "DER" "-in" file2 "-content" file1
+     "-CAfile" mew-smime-CA-file "-signer" pubkey-file))
+     
+     (concat "valid S/MIME digital signatuer signed by " 
+     (mew-smime-move-pubkey-and-extract-email pubkey-file))
+    "S/MIME signature verification failed"))))
+
+(defun mew-smime-move-pubkey-and-extract-email (pubkey-file)
+  (let (email-addr pubkey-moved)
+   (save-excursion
+     (mew-set-buffer-tmp)
+     (mew-call-process-lang "openssl" nil t nil
+        "x509" "-noout" "-email" "-in" pubkey-file)
+     (goto-char (point-min))
+     (replace-string "\n" "")
+     (setq email-addr (mew-buffer-substring (point-min) (point-max)))
+     (setq pubkey-moved (concat mew-smime-pubkey-dir "/" email-addr))
+     (if (and (not (file-exists-p pubkey-moved))
+              (file-writable-p pubkey-moved))
+          (copy-file pubkey-file pubkey-moved))
+     (delete-file pubkey-file))
+     email-addr))
+
+
+; The followin function is based on mew-decode-multipart-encrypted.
+
+(defun mew-smime-decrypt-or-verify (syntax cnt ctl cte)
+  ;; called in narrowed region
+  ;;
+  ;;     CT: Application/X-Pkcs7-Mime
+  ;;
+  (if (mew-smime-configuration-check)
+  syntax
+  (message "S/MIME decrypting ...")
+  (mew-decode-mime-body ctl cte)
+  (let ((encrypted-file (mew-make-temp-name)) (decrypted-file (mew-make-temp-name)) process file1 file2 file3 syntax1 syntax3 func unknown existp proto
+	 start result file3result privacy bregex (pubkey-file (mew-make-temp-name)))
+
+; XXX WHY DON'T YOU USE mew-save-decode-form!!!
+  (mew-flet
+   (write-region (mew-syntax-get-begin syntax)
+		 (point-max)
+		 encrypted-file nil 'no-msg))
+  (if (string-match "signed-data" (mew-syntax-get-param ctl "smime-type"))
+
+;; signature verification
+     (progn
+     (if (equal 0 (mew-call-process-lang "openssl" nil nil nil
+     "smime" "-verify" "-inform" "DER" "-in" encrypted-file
+     "-CAfile" mew-smime-CA-file "-signer" pubkey-file "-out" decrypted-file))
+   (setq result (concat "valid S/MIME digital signatuer signed by " 
+     (mew-smime-move-pubkey-and-extract-email pubkey-file)))
+    (setq mew-decode-not-decrypted t)))
+
+;; decryption
+    (setq mew-smime-running 'decrypt)
+  (setq mew-smime-string nil)
+   (setq process (mew-start-process-lang "S/MIME decrypt" nil "openssl" "smime" "-decrypt"
+   "-inform" "DER" "-in" encrypted-file "-recip" mew-smime-digital-id 
+   "-out" decrypted-file))
+    (mew-set-process-cs process mew-cs-autoconv mew-cs-dummy)
+    (set-process-filter process 'mew-smime-process-filter1)
+    (set-process-sentinel process 'mew-smime-process-sentinel)
+
+; XXX WHAT IS THE FOLLOWING LINE!!!!!
+;(process-send-string process (format "%s\n" (mew-smime-passphrase)))
+
+    ;; Wait for the termination of OpenSSL.
+    ;; Emacs doesn't provide synchronize mechanism with
+    ;; an asynchronous process. So, take this way. 
+    (while mew-smime-running
+	(if mew-xemacs-p
+	    (accept-process-output)
+	  (sit-for 1)
+	  ;; accept-process-output or sleep-for is not enough
+	  (discard-input)))
+    (message "S/MIME decrypting ... done")
+  (if (null mew-smime-sign-error)
+     (setq result "S/MIME decrypted")
+     (setq mew-decode-not-decrypted t)))
+  (if result
+     (progn
+       (delete-region (point-min) (point-max))
+       (mew-flet 
+	 (insert-file-contents decrypted-file)
+	 (put-text-property (point-min) (point-max) 'mew-noncontents nil)
+	 ;; because of RICH functionality of RFC1847... Gee dirty!
+	 (mew-decode-crlf-magic))
+         ))
+    (and encrypted-file (file-exists-p encrypted-file) (delete-file encrypted-file))
+    (and decrypted-file (file-exists-p decrypted-file) (delete-file decrypted-file))
+    ;; Analyze the decrypted part
+    (if (not result) syntax
+    (goto-char (point-min))
+    (setq syntax3 (mew-decode-singlepart cnt nil nil))
+    (setq privacy (mew-syntax-get-privacy syntax3))
+    (if privacy (setq result (concat result "\n\t")))
+    (mew-syntax-set-privacy
+     syntax3 (cons (list mew-ct-mle proto result) privacy))
+    syntax3))))
+     
+(defun mew-smime-encrypt (file1 decrypters)
+  (if (mew-smime-configuration-check)
+    (list nil (mew-smime-configuration-check))
+  (message "S/MIME encrypting ... ")
+;  (print decrypters)
+  (let ((pubkey-list (mapcar '(lambda (file)
+      (concat mew-smime-pubkey-dir "/" file)) decrypters))
+       (encrypt-file (mew-make-temp-name)))
+  (print pubkey-list)
+  (print encrypt-file)
+  (if (eval (cons 'and (mapcar 'file-readable-p pubkey-list)))
+  (if (equal 0 (eval (append '(mew-call-process-lang "openssl" nil nil nil
+     "smime" "-encrypt" mew-smime-encryption-algorithm
+     "-outform" "DER" "-in" file1 "-out" encrypt-file) pubkey-list)))
+     (list encrypt-file nil)
+     (list encrypt-file "openssl exited abnormally."))
+; XXX Is this English correct??
+     (list nil "Not all public keys of reciepients are available.")))))
+
+(defun mew-smime-encrypt-message ()
+  "Encrypt the entire draft with S/MIME."
+  (interactive)
+  (mew-draft-make-message 'smime-encryption))
+
+(defun mew-smime-sign-encrypt-message (&optional arg)
+  "Sign then encrypt the entire draft with S/MIME. Input your passphrase."
+  (interactive "P")
+  (mew-draft-make-message 'smime-signature-encryption))
+
+(defun mew-smime-encrypt-sign-message (&optional arg)
+  "Encrypt then sign the entire draft with S/MIME. Input your passphrase."
+  (interactive "P")
+  (mew-draft-make-message 'smime-encryption-signature))
diff -aruN mew-1.95b102/mew-vars2.el 2-mew-1.95b102-smime/mew-vars2.el
--- mew-1.95b102/mew-vars2.el	Mon Feb  5 14:50:03 2001
+++ 2-mew-1.95b102-smime/mew-vars2.el	Fri Feb  9 20:21:11 2001
@@ -389,7 +389,13 @@
 ;;;
 
 (defcustom mew-privacy-database
-  `((pgp-signature  ((,mew-ct-mls ,mew-ct-pgs)) "PS")
+  `((smime-signature ((,mew-ct-mls ,mew-ct-sms)) "SS")
+    (smime-encryption ((,mew-ct-mle ,"application/x-pkcs7-mime")) "SE")
+    (smime-signature-encryption
+     ((,mew-ct-mls ,mew-ct-sms) (,mew-ct-mle ,"application/x-pkcs7-mime")) "SSSE")
+    (smime-encryption-signature
+     ((,mew-ct-mle ,"application/x-pkcs7-mime") (,mew-ct-mls ,mew-ct-sms)) "SESS")
+    (pgp-signature  ((,mew-ct-mls ,mew-ct-pgs)) "PS")
     (pgp-encryption ((,mew-ct-mle ,mew-ct-pge)) "PE")
     (pgp-signature-encryption
      ((,mew-ct-mls ,mew-ct-pgs) (,mew-ct-mle ,mew-ct-pge)) "PSPE")
diff -aruN mew-1.95b102/mew.el 2-mew-1.95b102-smime/mew.el
--- mew-1.95b102/mew.el	Tue Feb  6 18:04:50 2001
+++ 2-mew-1.95b102-smime/mew.el	Wed Feb  7 20:39:28 2001
@@ -785,6 +785,7 @@
 (require 'mew-mark)
 (require 'mew-header)
 (require 'mew-pgp)
+(require 'mew-smime)
 (require 'mew-bq)
 (require 'mew-syntax)
 (require 'mew-scan)


Mew-dist メーリングリストの案内