From Makoto.Nakagawa ＠ hp.com Tue Sep 13 04:53:53 2005 From: Makoto.Nakagawa ＠ hp.com (=?ISO-2022-JP?B?GyRCQ2ZAbhsoQiAbJEJAPxsoQg==?=) Date: Tue, 13 Sep 2005 04:53:53 +0900 Subject: smime.el In-Reply-To: =?ISO-2022-JP?B?GyRCQ2ZAbhsoQiAbJEJAPxsoQidz?= message of "Fri, 18 Mar 2005 19:13:48 +0900" <4179-Fri18Mar2005191348+0900-nakagawa@manakagawa-debian2.asiapacific.hpqcorp.net> References: <5973-Thu10Mar2005222024+0900-nakagawa@manakagawa-debian2.asiapacific.hpqcorp.net> <1191-Fri11Mar2005150225+0900-nakagawa@manakagawa-debian2.asiapacific.hpqcorp.net> <4179-Fri18Mar2005191348+0900-nakagawa@manakagawa-debian2.asiapacific.hpqcorp.net> Message-ID: <5734-Tue13Sep2005045353+0900-nakagawa@manakagawa-debian2.asiapacific.hpqcorp.net> 中川＠日本ＨＰ(株)です。 In message "Re: smime.el" on 05/03/18, 中川 誠 wrote: >> ここまで調べて頂いただけでも大変恐縮なのですが、せっかくなので Gnus の >> smime.el を利用するように改造してみませんか？ ^^;;; > なるほど。上野さんがおっしゃるのであれば、Gnus の smime.el を使うのが本 > 筋のようですね。 > ある程度までは私でもできそうな気がしているので、挑戦してみます。 随分と間が空いてしまいました。とりあえずは動作するものができたので投稿し てみます。ご意見をお聞かせください。 当初は Gnus の smime.el を改造しようとしましたが、どうもまともに使用され ていると思えない節がありましたので、上野さん版を改造することにしました。 本来は mime-edit.el に対する修正も含めた形になっています。pgg のように smime とのインターフェース部分を抽象化できればよいのですが、そこまでは私 では手が出ません。 ldap とのやり取りなども実装してみたいのですが、しばらく時間が取れそうに ないです。ぼちぼちやりたいと思います。 個人的には 5月頃からは使っています。ただ、自分の中だけで閉じているので、 本当にうまく動作しているのはは確証が持ててません。 SEMI で書名したメールが、Exchange/Mozilla/Firefox で検証できることは確認 しています。Exchange で書名/暗号化したメールを SEMI 側で検証/復号化でき ることも確認しています。 (setq smime-certificate-directory "/etc/ssl/certs") (setq smime-certificate-file (expand-file-name "~/.smime/myca.pem")) (setq smime-private-key-file (expand-file-name "~/.smime/mykey.pem")) (setq smime-public-keys '(("makoto.nakagawa ＠ hp.com" "~/.smime/cert.pem" '()))) -- /*** Hewlett-Packard Japan, Ltd. ***/ /*** Consulting & Integration ***/ /*** Life Science Solution Practice ***/ /*** Nakagawa, Makoto（中川 誠） ***/ /*** PGP: 0B33 EAC3 F2F6 3D10 D9E9 AE7F 8EDA 44F9 1D29 D44A ***/ -------------- next part -------------- diff -u /usr/share/emacs21/site-lisp/semi/smime.el smime.el --- /usr/share/emacs21/site-lisp/semi/smime.el 2004-08-12 00:12:56.000000000 +0900 +++ smime.el 2005-09-13 04:22:40.000000000 +0900 @@ -47,11 +47,40 @@ "S/MIME interface" :group 'mime) -(defcustom smime-program "smime" +(defcustom smime-program "openssl" "The S/MIME executable." :group 'smime :type 'string) +(defcustom smime-verify-program + (let ((file (exec-installed-p smime-program))) + (and file (append (list file "smime" "-verify")))) + "External program for verifing S/MIME." + :group 'smime + :type 'string) + +(defcustom smime-sign-program + ;; ... sign 時に追加する証明書(-certfile)も考慮すべし + (let ((file (exec-installed-p smime-program))) + (and file (list file "smime" "-sign"))) + "External program for signing S/MIME." + :group 'smime + :type 'string) + +(defcustom smime-encrypt-program + (let ((file (exec-installed-p smime-program))) + (and file (list file "smime" "-encrypt" "-nocerts"))) + "External program for signing S/MIME." + :group 'smime + :type 'string) + +(defcustom smime-decrypt-program + (let ((file (exec-installed-p smime-program))) + (and file (list file "smime" "-decrypt"))) + "External program for signing S/MIME." + :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>\"." @@ -64,8 +93,8 @@ :type 'string) (defcustom smime-x509-program - (let ((file (exec-installed-p "openssl"))) - (and file (list file "x509" "-noout"))) + (let ((file (exec-installed-p smime-program))) + (and file (list file "x509" "-noout" "-nameopt" "RFC2253"))) "External program for x509 parser." :group 'smime :type 'string) @@ -80,6 +109,11 @@ :group 'smime :type 'directory) +(defcustom smime-certificate-file "~/.w3/certs" + "Certificate file." + :group 'smime + :type 'directory) + (defcustom smime-public-key-file nil "Public key file." :group 'smime @@ -137,8 +171,9 @@ (cons (intern (substring attr 0 (match-beginning 0))) (substring attr (match-end 0))) nil)) - (split-string string "/")))) + (split-string string ",")))) +;; not used (defsubst smime-query-signer (start end) (smime-process-region start end smime-program (list "-qs")) (with-current-buffer smime-output-buffer @@ -168,10 +203,14 @@ (list "-subject" "-in" cert-file))) (if (zerop (buffer-size)) nil (goto-char (point-min)) - (when (re-search-forward "^subject=" nil t) + (when (re-search-forward "^subject= " nil t) (smime-parse-attribute (buffer-substring (point)(progn (end-of-line)(point)))))))) +(defun smime-x509-email (cert-file) + (cdr (assoc 'emailAddress (smime-x509-subject cert-file)))) + +;; not used (defsubst smime-find-certificate (attr) (let ((files (and (file-directory-p smime-certificate-directory) @@ -235,85 +274,492 @@ ) )) +(defun smime-map-address-to-certificate (recipient mapping) + (let* ((email-address (downcase + (nth 1 (std11-extract-address-components + recipient)))) + (file (cadr (assoc email-address mapping)))) + (if file (with-temp-buffer + (insert-file-contents file) + (buffer-string)) + ;; ... LDAP + ))) + +(setq smime-function-map-address-to-certificate + (function + (lambda (recipient) + (smime-map-address-to-certificate recipient smime-public-keys)))) + +;(setq smime-function-map-address-to-key +; (function +; (lambda (recipient) +; (smime-map-address-to-certificate recipient smime-private-keys)))) + ;;; @ interface functions ;;; ;;;###autoload -(defun smime-encrypt-region (start end) +(defun smime-encrypt-region (start end rcpts) "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) + ;; ... pgg に合わせるのなら rcpts は相手のメールアドレス + ;; ... メールアドレスから対応する証明書を探すのは MUA の仕事でしょう。 + ;; ... pgp であれば、pgp 側がやってくれる。 + (interactive + (list (region-beginning) (region-end) + (split-string (read-string "Recipients: ") "[ \t,]+"))) + (debug) + (let* ((keys + (and rcpts + (mapcar smime-function-map-address-to-certificate rcpts))) + (recpt-key-pairs + (mapcar + (function + (lambda (pair) + (let ((file)) + (when (null (cdr pair)) + (setq file (expand-file-name + (read-file-name + (format "Certificate file for %s: " (car pair))))) + (if (file-readable-p file) + (setcdr pair + (with-temp-buffer + (insert-file-contents file) + (buffer-string)))))))) + ;; (reqire 'cl) + (mapcar* 'cons recpts keys))) + (key-files + (remq nil + (mapcar + (function + (lambda (key) + (let ((file (make-temp-file "smimecertfile"))) + (with-temp-file file + (insert (cdr key)))))) + recpt-key-pairs)))) + (unwind-protect + (smime-process-region start end + (car smime-encrypt-program) + (append (cdr smime-encrypt-program) key-files)) + (mapc delete-file key-files)) (smime-process-when-success + (delete-region (point-max) (1- (point-max))) (goto-char (point-min)) (delete-region (point-min) (progn (re-search-forward "^$" nil t) (1+ (point))))))) ;;;###autoload +;; ... decrypt の時は自分宛てで固定で考えてよいのかね。pgg はそうなっているようだが。 (defun smime-decrypt-region (start end) "Decrypt the current region between START and END." - (let* ((key-file + (interactive "r") + (let* ((orig-file (make-temp-file "smime")) + (orig-mode (default-file-modes)) + (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) + (email (smime-x509-email key-file)) + (passphrase (smime-read-passphrase + (format "S/MIME passphrase for %s: " + (concat email " (" 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))))) + (args (list "-in" orig-file "-recip" key-file "-passin" "fd:0"))) + (unwind-protect + (progn + (set-default-file-modes 448) + (binary-write-decoded-region start end orig-file) + (with-temp-buffer + (insert passphrase) + (smime-process-region (point-min) (point-max) + (car smime-decrypt-program) + (append (cdr smime-decrypt-program) args)) + (smime-process-when-success + (when smime-cache-passphrase + (smime-add-passphrase-cache hash passphrase))))) + (set-default-file-modes orig-mode) + (delete-file orig-file)))) ;;;###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 + (interactive "r") + (let* ((orig-file (make-temp-file "smime")) + (orig-mode (default-file-modes)) + (key-file (or smime-private-key-file (expand-file-name (read-file-name "Private key file: ")))) (hash (smime-x509-hash key-file)) + (email (smime-x509-email key-file)) (passphrase (smime-read-passphrase - (format "S/MIME passphrase for %s: " hash) + (format "S/MIME passphrase for %s: " + (concat email " (" 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))))) + ;; ... --nocerts, --certfile の追加処理!! + (args (list (if cleartext "-nodetach") + "-binary" "-in" orig-file "-signer" key-file "-passin" "fd:0"))) + (unwind-protect + (progn + (set-default-file-modes 448) + (binary-write-decoded-region start end orig-file) + (with-temp-buffer + (insert passphrase) + (smime-process-region (point-min) (point-max) + (car smime-sign-program) + (append (cdr smime-sign-program) args))) + (smime-process-when-success + (cond (cleartext + (goto-char (point-min)) + (delete-region (point-min) + (progn (re-search-forward "^$") + (1+ (point)))) + (re-search-forward "^$") + (delete-region (point) (point-max))) + (t + (goto-char (point-max)) + (re-search-backward "^------[^-]*--$" nil t) + (delete-region (point-max) (progn + (re-search-backward "^$" nil t) + (point))) + (goto-char (1- (point))) + (re-search-backward "^$" nil t) + (delete-region (1+ (point)) (point-min)))) + (when smime-cache-passphrase + (smime-add-passphrase-cache hash passphrase)))) + (set-default-file-modes orig-mode) + (delete-file orig-file)))) +(defvar smime-after-verified-hook '()) ;;;###autoload -(defun smime-verify-region (start end signature) +(defun smime-verify-region (start end &optional 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." + (interactive "r") (let* ((orig-file (make-temp-file "smime")) + (signer-certificate (make-temp-file "smimesigner")) (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))) + (binary-write-decoded-region start end orig-file) + ;; -> TODO: + ;; ... -CAfile を設定できるようにする？ + ;; ... あるいは CApath を複数設定できるようにしとくか。 + ;; ... 証明書が付いていないケース + (with-temp-buffer + (when signature + (buffer-disable-undo) + (binary-insert-encoded-file signature)) + (smime-process-region + (point-min) (point-max) (car smime-verify-program) + (append (cdr smime-verify-program) + (list "-signer" signer-certificate) + (if smime-certificate-file + (list "-CAfile" + (expand-file-name smime-certificate-file))) + (if smime-certificate-directory + (list "-CApath" + (expand-file-name smime-certificate-directory))) + (if signature + (list "-inform DER" + "-content" orig-file) + (list "-in" orig-file))))) + (smime-process-when-success + (run-hooks smime-after-verified-hook))) + ;; <- + (set-default-file-modes orig-mode) + (delete-file signer-certificate) + (delete-file orig-file)))) (provide 'smime) ;;; smime.el ends here + +;;; mime-smime.el ? +(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))) + (sig-file (make-temp-file "tm" nil ".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))) + ;; -> signature の取り出しとして抽象化すべき (利用する外部プログラムに依って、取り出しの形式が異なる可能性あり) + (mime-write-entity-content entity sig-file) + ;; ... てゆうか処理結果の表示を含めて考えると、この関数自体が openssl と不可分かな。 + ;; <- + ;; TODO + ;; ... sig-file に証明書が付いているかは、ここでチェックする必要あり。 +; (with-temp-buffer +; (mime-insert-entity-content entity) + (smime-process-region + (point) (point) "/usr/bin/openssl" + (list "pkcs7" "-in" sig-file "-inform" "DER" "-print_certs" "-noout"));) + (with-current-buffer smime-output-buffer + (when (zerop (buffer-size)) + ;; ... 証明書なし + (debug) + (funcall smime-function-map-address-to-certificate + (mime-entity-fetch-field mother "from")) + )) + (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 + (set-buffer mime-echo-buffer-name) + ;; ... smime-output-buffer には本文が出力されているはず。 + (insert-buffer-substring smime-errors-buffer))) + (delete-file sig-file)))) + +(defun mime-view-application/pkcs7-mime (entity situation) + (let* ((p-win (or (get-buffer-window (current-buffer)) + (get-largest-window))) + (new-name + (format "%s-%s" (buffer-name) (mime-entity-number entity))) + (mother (current-buffer)) + (preview-buffer (concat "*Preview-" (buffer-name) "*")) + (smime-type (or (cdr (assoc "smime-type" situation)) "enveloped-data")) ;; + message-buf status) +; (debug) + (when (member smime-type '("enveloped-data" "signed-data")) + (set-buffer (setq message-buf (get-buffer-create new-name))) + (let ((inhibit-read-only t) + buffer-read-only) + (erase-buffer) + ;; -> signature の取り出しとして抽象化すべき (利用する外部プログラムに依って、取り出しの形式が異なる可能性あり) + (mime-insert-entity entity) + ;; <- + (if (equal smime-type "enveloped-data") + (setq status (smime-decrypt-region (point-min) (point-max))) + (save-excursion + (set-buffer mother) + (mime-show-echo-buffer) + (set-buffer mime-echo-buffer-name) + (set-window-start + (get-buffer-window mime-echo-buffer-name) + (point-max))) + ;; TODO + ;; ... 証明書が付いているかは、ここでチェックする必要あり。 + (smime-process-region + (point-min) (point-max) "/usr/bin/openssl" + (append (list "smime" "-verify" "-noverify" "-pk7out" + "|" + "/usr/bin/openssl" "pkcs7" "-inform" "PEM" "-print_certs" "-noout"))) + (with-current-buffer smime-output-buffer + (when (zerop (buffer-size)) + ;; ... 証明書なし + (debug) + (funcall smime-function-map-address-to-certificate + (mime-entity-fetch-field entity "from")) + )) + (setq status (smime-verify-region (point-min) (point-max)))) + (when status + (delete-region (point-min)(point-max)) + (insert-buffer smime-output-buffer) + (setq major-mode 'mime-show-message-mode) + (save-window-excursion + (mime-view-buffer nil preview-buffer mother + nil 'binary) + (make-local-variable 'mime-view-temp-message-buffer) + (setq mime-view-temp-message-buffer message-buf)) + (set-window-buffer p-win preview-buffer)) + (save-excursion + (set-buffer mime-echo-buffer-name) + ;; ... smime-output-buffer には本文が出力されているはず。 + (insert-buffer-substring smime-errors-buffer)))))) + +;; mime-edit.el +(defvar mime-edit-smime-processing nil) +(make-variable-buffer-local 'mime-edit-smime-processing) +(defun mime-edit-smime-enclose-buffer () + (let ((beg (save-excursion + (goto-char (point-min)) + (if (search-forward (concat "\n" mail-header-separator "\n")) + (match-end 0))))) + (if beg + (dolist (smime-processing mime-edit-smime-processing) + (case smime-processing + (sign + (mime-edit-enclose-smime-signed-region + beg (point-max))) + (encrypt + (mime-edit-enclose-smime-encrypted-region + beg (point-max)))))))) +(add-hook 'mime-edit-translate-buffer-hook 'mime-edit-smime-enclose-buffer) + +(defun mime-edit-sign-smime (beg end boundary) + (save-excursion + (save-restriction + (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))) + (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)) + (let ((opaque + (progn (goto-char beg) + (re-search-forward + "^Content-Type: application/pkcs7-mime" + (save-excursion (re-search-forward "^\r$" nil t) + (point)) + 't)))) + (or (prog1 (smime-sign-region (point-min) (point-max) opaque) + (push nil buffer-undo-list) + (ignore-errors (undo))) + (throw 'mime-edit-error 'pgp-error) + ) + (cond (opaque + (delete-region (point-min)(point-max)) + (insert " -------------- next part -------------- テキスト形式以外の添付ファイルを保管しました... ファイル名: \"smime.p7m\" 型: application/pkcs7-mime サイズ: 111 バイト 説明: 無し URL: -------------- next part -------------- テキスト形式以外の添付ファイルを保管しました... ファイル名: 無し 型: multipart/signed サイズ: 4146 バイト 説明: 無し URL: From yamaoka ＠ jpl.org Wed Sep 14 08:35:58 2005 From: yamaoka ＠ jpl.org (Katsumi Yamaoka) Date: Wed, 14 Sep 2005 08:35:58 +0900 Subject: broken MIME parts (was Re: smime.el) References: <5973-Thu10Mar2005222024+0900-nakagawa@manakagawa-debian2.asiapa cific.hpqcorp.net><1191-Fri11Mar2005150225+0900-na kagawa@manakagawa-debian2.asiapacific.hpqcorp.net><4179-Fri18Mar2005191348+0900-nakagawa@ma nakagawa-debian2.asiapacific.hpqcorp.net> <5734-Tue13Sep2005045353+0900-nakagawa@manakagawa-debian2.asiapacific.hpqcorp.net> Message-ID: 本題と関係無くてすみません。 ぼくは emacs-mime-ja を自宅と会社の二箇所に配送してもらっている のですが、双方に届いた中川さんの同じメールにかなりの差異がありま した。 Content-Type が一方は multipart/signed で片や multipart/mixed と いう大きな違い以外にも、わけのわからない差があります。想像するに、 中川さんが発信した時点でパッチの以下の部分がパートで区切られてし まったのが発端になって、いろんなことが起きたのかなあ、と。 + (insert (format " + boundary=\"%s\"; micalg=sha1; + protocol=\"application/pkcs7-signature\" +--%s +" smime-boundary 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 Cryptographic Signature + +" smime-boundary)) 興味とお暇のあるかたはどうぞ。:) 自宅に届いたもの: http://www.jpl.org/99991.gz 会社に届いたもの: http://www.jpl.org/99992.gz -- 山岡 From Makoto.Nakagawa ＠ hp.com Wed Sep 14 10:25:59 2005 From: Makoto.Nakagawa ＠ hp.com (=?ISO-2022-JP?B?GyRCQ2ZAbhsoQiAbJEJAPxsoQg==?=) Date: Wed, 14 Sep 2005 10:25:59 +0900 Subject: smime.el (Re: broken MIME parts) In-Reply-To: Katsumi Yamaoka's message of "Wed, 14 Sep 2005 08:35:58 +0900" References: <5973-Thu10Mar2005222024+0900-nakagawa@manakagawa-debian2.asiapa cific.hpqcorp.net> <1191-Fri11Mar2005150225+0900-na kagawa@manakagawa-debian2.asiapacific.hpqcorp.net> <4179-Fri18Mar2005191348+0900-nakagawa@ma nakagawa-debian2.asiapacific.hpqcorp.net> <5734-Tue13Sep2005045353+0900-nakagawa@manakagawa-debian2.asiapacific.hpqcorp.net> Message-ID: <9569-Wed14Sep2005102559+0900-nakagawa@manakagawa-debian2.asiapacific.hpqcorp.net> 中川＠日本ＨＰ(株)です。 In message "broken MIME parts (was Re: smime.el)" on 05/09/14, Katsumi Yamaoka wrote: > Content-Type が一方は multipart/signed で片や multipart/mixed と > いう大きな違い以外にも、わけのわからない差があります。想像するに、 > 中川さんが発信した時点でパッチの以下の部分がパートで区切られてし > まったのが発端になって、いろんなことが起きたのかなあ、と。 base64 にして再送します。 -- /*** Hewlett-Packard Japan, Ltd. ***/ /*** Consulting & Integration ***/ /*** Life Science Solution Practice ***/ /*** Nakagawa, Makoto（中川 誠） ***/ /*** PGP: 0B33 EAC3 F2F6 3D10 D9E9 AE7F 8EDA 44F9 1D29 D44A ***/ -------------- next part -------------- --- /usr/share/emacs21/site-lisp/semi/smime.el 2004-08-12 00:12:56.000000000 +0900 +++ smime.el 2005-09-13 04:22:40.000000000 +0900 @@ -47,11 +47,40 @@ "S/MIME interface" :group 'mime) -(defcustom smime-program "smime" +(defcustom smime-program "openssl" "The S/MIME executable." :group 'smime :type 'string) +(defcustom smime-verify-program + (let ((file (exec-installed-p smime-program))) + (and file (append (list file "smime" "-verify")))) + "External program for verifing S/MIME." + :group 'smime + :type 'string) + +(defcustom smime-sign-program + ;; ... sign ??????????????????(-certfile)???????????? + (let ((file (exec-installed-p smime-program))) + (and file (list file "smime" "-sign"))) + "External program for signing S/MIME." + :group 'smime + :type 'string) + +(defcustom smime-encrypt-program + (let ((file (exec-installed-p smime-program))) + (and file (list file "smime" "-encrypt" "-nocerts"))) + "External program for signing S/MIME." + :group 'smime + :type 'string) + +(defcustom smime-decrypt-program + (let ((file (exec-installed-p smime-program))) + (and file (list file "smime" "-decrypt"))) + "External program for signing S/MIME." + :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>\"." @@ -64,8 +93,8 @@ :type 'string) (defcustom smime-x509-program - (let ((file (exec-installed-p "openssl"))) - (and file (list file "x509" "-noout"))) + (let ((file (exec-installed-p smime-program))) + (and file (list file "x509" "-noout" "-nameopt" "RFC2253"))) "External program for x509 parser." :group 'smime :type 'string) @@ -80,6 +109,11 @@ :group 'smime :type 'directory) +(defcustom smime-certificate-file "~/.w3/certs" + "Certificate file." + :group 'smime + :type 'directory) + (defcustom smime-public-key-file nil "Public key file." :group 'smime @@ -137,8 +171,9 @@ (cons (intern (substring attr 0 (match-beginning 0))) (substring attr (match-end 0))) nil)) - (split-string string "/")))) + (split-string string ",")))) +;; not used (defsubst smime-query-signer (start end) (smime-process-region start end smime-program (list "-qs")) (with-current-buffer smime-output-buffer @@ -168,10 +203,14 @@ (list "-subject" "-in" cert-file))) (if (zerop (buffer-size)) nil (goto-char (point-min)) - (when (re-search-forward "^subject=" nil t) + (when (re-search-forward "^subject= " nil t) (smime-parse-attribute (buffer-substring (point)(progn (end-of-line)(point)))))))) +(defun smime-x509-email (cert-file) + (cdr (assoc 'emailAddress (smime-x509-subject cert-file)))) + +;; not used (defsubst smime-find-certificate (attr) (let ((files (and (file-directory-p smime-certificate-directory) @@ -235,85 +274,492 @@ ) )) +(defun smime-map-address-to-certificate (recipient mapping) + (let* ((email-address (downcase + (nth 1 (std11-extract-address-components + recipient)))) + (file (cadr (assoc email-address mapping)))) + (if file (with-temp-buffer + (insert-file-contents file) + (buffer-string)) + ;; ... LDAP + ))) + +(setq smime-function-map-address-to-certificate + (function + (lambda (recipient) + (smime-map-address-to-certificate recipient smime-public-keys)))) + +;(setq smime-function-map-address-to-key +; (function +; (lambda (recipient) +; (smime-map-address-to-certificate recipient smime-private-keys)))) + ;;; @ interface functions ;;; ;;;###autoload -(defun smime-encrypt-region (start end) +(defun smime-encrypt-region (start end rcpts) "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) + ;; ... pgg ???????????????? rcpts ?????????????????????? + ;; ... ?????????????????????????????????????????? MUA ???????????????? + ;; ... pgp ??????????pgp ?????????????????? + (interactive + (list (region-beginning) (region-end) + (split-string (read-string "Recipients: ") "[ \t,]+"))) + (debug) + (let* ((keys + (and rcpts + (mapcar smime-function-map-address-to-certificate rcpts))) + (recpt-key-pairs + (mapcar + (function + (lambda (pair) + (let ((file)) + (when (null (cdr pair)) + (setq file (expand-file-name + (read-file-name + (format "Certificate file for %s: " (car pair))))) + (if (file-readable-p file) + (setcdr pair + (with-temp-buffer + (insert-file-contents file) + (buffer-string)))))))) + ;; (reqire 'cl) + (mapcar* 'cons recpts keys))) + (key-files + (remq nil + (mapcar + (function + (lambda (key) + (let ((file (make-temp-file "smimecertfile"))) + (with-temp-file file + (insert (cdr key)))))) + recpt-key-pairs)))) + (unwind-protect + (smime-process-region start end + (car smime-encrypt-program) + (append (cdr smime-encrypt-program) key-files)) + (mapc delete-file key-files)) (smime-process-when-success + (delete-region (point-max) (1- (point-max))) (goto-char (point-min)) (delete-region (point-min) (progn (re-search-forward "^$" nil t) (1+ (point))))))) ;;;###autoload +;; ... decrypt ????????????????????????????????????????pgg ?????????????????????????? (defun smime-decrypt-region (start end) "Decrypt the current region between START and END." - (let* ((key-file + (interactive "r") + (let* ((orig-file (make-temp-file "smime")) + (orig-mode (default-file-modes)) + (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) + (email (smime-x509-email key-file)) + (passphrase (smime-read-passphrase + (format "S/MIME passphrase for %s: " + (concat email " (" 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))))) + (args (list "-in" orig-file "-recip" key-file "-passin" "fd:0"))) + (unwind-protect + (progn + (set-default-file-modes 448) + (binary-write-decoded-region start end orig-file) + (with-temp-buffer + (insert passphrase) + (smime-process-region (point-min) (point-max) + (car smime-decrypt-program) + (append (cdr smime-decrypt-program) args)) + (smime-process-when-success + (when smime-cache-passphrase + (smime-add-passphrase-cache hash passphrase))))) + (set-default-file-modes orig-mode) + (delete-file orig-file)))) ;;;###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 + (interactive "r") + (let* ((orig-file (make-temp-file "smime")) + (orig-mode (default-file-modes)) + (key-file (or smime-private-key-file (expand-file-name (read-file-name "Private key file: ")))) (hash (smime-x509-hash key-file)) + (email (smime-x509-email key-file)) (passphrase (smime-read-passphrase - (format "S/MIME passphrase for %s: " hash) + (format "S/MIME passphrase for %s: " + (concat email " (" 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))))) + ;; ... --nocerts, --certfile ??????????!! + (args (list (if cleartext "-nodetach") + "-binary" "-in" orig-file "-signer" key-file "-passin" "fd:0"))) + (unwind-protect + (progn + (set-default-file-modes 448) + (binary-write-decoded-region start end orig-file) + (with-temp-buffer + (insert passphrase) + (smime-process-region (point-min) (point-max) + (car smime-sign-program) + (append (cdr smime-sign-program) args))) + (smime-process-when-success + (cond (cleartext + (goto-char (point-min)) + (delete-region (point-min) + (progn (re-search-forward "^$") + (1+ (point)))) + (re-search-forward "^$") + (delete-region (point) (point-max))) + (t + (goto-char (point-max)) + (re-search-backward "^------[^-]*--$" nil t) + (delete-region (point-max) (progn + (re-search-backward "^$" nil t) + (point))) + (goto-char (1- (point))) + (re-search-backward "^$" nil t) + (delete-region (1+ (point)) (point-min)))) + (when smime-cache-passphrase + (smime-add-passphrase-cache hash passphrase)))) + (set-default-file-modes orig-mode) + (delete-file orig-file)))) +(defvar smime-after-verified-hook '()) ;;;###autoload -(defun smime-verify-region (start end signature) +(defun smime-verify-region (start end &optional 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." + (interactive "r") (let* ((orig-file (make-temp-file "smime")) + (signer-certificate (make-temp-file "smimesigner")) (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))) + (binary-write-decoded-region start end orig-file) + ;; -> TODO: + ;; ... -CAfile ???????????????????????? + ;; ... ???????? CApath ???????????????????????????????? + ;; ... ?????????????????????????? + (with-temp-buffer + (when signature + (buffer-disable-undo) + (binary-insert-encoded-file signature)) + (smime-process-region + (point-min) (point-max) (car smime-verify-program) + (append (cdr smime-verify-program) + (list "-signer" signer-certificate) + (if smime-certificate-file + (list "-CAfile" + (expand-file-name smime-certificate-file))) + (if smime-certificate-directory + (list "-CApath" + (expand-file-name smime-certificate-directory))) + (if signature + (list "-inform DER" + "-content" orig-file) + (list "-in" orig-file))))) + (smime-process-when-success + (run-hooks smime-after-verified-hook))) + ;; <- + (set-default-file-modes orig-mode) + (delete-file signer-certificate) + (delete-file orig-file)))) (provide 'smime) ;;; smime.el ends here + +;;; mime-smime.el ? +(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))) + (sig-file (make-temp-file "tm" nil ".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))) + ;; -> signature ???????????????????????????? (????????????????????????????????????????????????????????????????) + (mime-write-entity-content entity sig-file) + ;; ... ?????????????????????????????????????????????????????? openssl ?????????????? + ;; <- + ;; TODO + ;; ... sig-file ?????????????????????????????????????????????????????? +; (with-temp-buffer +; (mime-insert-entity-content entity) + (smime-process-region + (point) (point) "/usr/bin/openssl" + (list "pkcs7" "-in" sig-file "-inform" "DER" "-print_certs" "-noout"));) + (with-current-buffer smime-output-buffer + (when (zerop (buffer-size)) + ;; ... ?????????? + (debug) + (funcall smime-function-map-address-to-certificate + (mime-entity-fetch-field mother "from")) + )) + (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 + (set-buffer mime-echo-buffer-name) + ;; ... smime-output-buffer ?????????????????????????????? + (insert-buffer-substring smime-errors-buffer))) + (delete-file sig-file)))) + +(defun mime-view-application/pkcs7-mime (entity situation) + (let* ((p-win (or (get-buffer-window (current-buffer)) + (get-largest-window))) + (new-name + (format "%s-%s" (buffer-name) (mime-entity-number entity))) + (mother (current-buffer)) + (preview-buffer (concat "*Preview-" (buffer-name) "*")) + (smime-type (or (cdr (assoc "smime-type" situation)) "enveloped-data")) ;; + message-buf status) +; (debug) + (when (member smime-type '("enveloped-data" "signed-data")) + (set-buffer (setq message-buf (get-buffer-create new-name))) + (let ((inhibit-read-only t) + buffer-read-only) + (erase-buffer) + ;; -> signature ???????????????????????????? (????????????????????????????????????????????????????????????????) + (mime-insert-entity entity) + ;; <- + (if (equal smime-type "enveloped-data") + (setq status (smime-decrypt-region (point-min) (point-max))) + (save-excursion + (set-buffer mother) + (mime-show-echo-buffer) + (set-buffer mime-echo-buffer-name) + (set-window-start + (get-buffer-window mime-echo-buffer-name) + (point-max))) + ;; TODO + ;; ... ???????????????????????????????????????????????????? + (smime-process-region + (point-min) (point-max) "/usr/bin/openssl" + (append (list "smime" "-verify" "-noverify" "-pk7out" + "|" + "/usr/bin/openssl" "pkcs7" "-inform" "PEM" "-print_certs" "-noout"))) + (with-current-buffer smime-output-buffer + (when (zerop (buffer-size)) + ;; ... ?????????? + (debug) + (funcall smime-function-map-address-to-certificate + (mime-entity-fetch-field entity "from")) + )) + (setq status (smime-verify-region (point-min) (point-max)))) + (when status + (delete-region (point-min)(point-max)) + (insert-buffer smime-output-buffer) + (setq major-mode 'mime-show-message-mode) + (save-window-excursion + (mime-view-buffer nil preview-buffer mother + nil 'binary) + (make-local-variable 'mime-view-temp-message-buffer) + (setq mime-view-temp-message-buffer message-buf)) + (set-window-buffer p-win preview-buffer)) + (save-excursion + (set-buffer mime-echo-buffer-name) + ;; ... smime-output-buffer ?????????????????????????????? + (insert-buffer-substring smime-errors-buffer)))))) + +;; mime-edit.el +(defvar mime-edit-smime-processing nil) +(make-variable-buffer-local 'mime-edit-smime-processing) +(defun mime-edit-smime-enclose-buffer () + (let ((beg (save-excursion + (goto-char (point-min)) + (if (search-forward (concat "\n" mail-header-separator "\n")) + (match-end 0))))) + (if beg + (dolist (smime-processing mime-edit-smime-processing) + (case smime-processing + (sign + (mime-edit-enclose-smime-signed-region + beg (point-max))) + (encrypt + (mime-edit-enclose-smime-encrypted-region + beg (point-max)))))))) +(add-hook 'mime-edit-translate-buffer-hook 'mime-edit-smime-enclose-buffer) + +(defun mime-edit-sign-smime (beg end boundary) + (save-excursion + (save-restriction + (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))) + (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)) + (let ((opaque + (progn (goto-char beg) + (re-search-forward + "^Content-Type: application/pkcs7-mime" + (save-excursion (re-search-forward "^\r$" nil t) + (point)) + 't)))) + (or (prog1 (smime-sign-region (point-min) (point-max) opaque) + (push nil buffer-undo-list) + (ignore-errors (undo))) + (throw 'mime-edit-error 'pgp-error) + ) + (cond (opaque + (delete-region (point-min)(point-max)) + (insert "--[[application/pkcs7-mime; smime-type=signed-data; name=\"smime.p7m\" +Content-Disposition: attachment; filename=\"smime.p7m\" +Content-Description: S/MIME Encrypted Message][base64]]\n") + (insert-buffer-substring smime-output-buffer)) + (t + (goto-char beg) + (insert (format "--[[multipart/signed; + boundary=\"%s\"; micalg=sha1; + protocol=\"application/pkcs7-signature\"][7bit]] +--%s +" smime-boundary 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 Cryptographic Signature + +" smime-boundary)) + (insert-buffer-substring smime-output-buffer) + (goto-char (point-max)) + (insert (format "\n--%s--\n" smime-boundary)) + )))))))) + +(defun mime-edit-encrypt-smime (beg end boundary) + (save-excursion + (save-restriction + (let (from recipients header) + (let ((ret (mime-edit-make-encrypt-recipient-header))) + (setq from (aref ret 0) + 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))) + (goto-char beg) + (insert header) ; !! + (insert (format "Content-Type: %s\n" ctype)) + (if encoding + (insert (format "Content-Transfer-Encoding: %s\n" encoding)) + ) + (insert "\n") + (let (mail-header-separator) + (mime-encode-header-in-buffer)) ; !! -> encrypt-pgp, too + (goto-char (point-min)) + (while (progn (end-of-line) (not (eobp))) + (insert "\r") + (forward-line 1)) + ;; ... from ???? signer ???????????? + (or (smime-encrypt-region + (point-min) (point-max) + (mapcar (lambda (recipient) + (nth 1 (std11-extract-address-components + recipient))) + (split-string recipients + "\\([ \t\n]*,[ \t\n]*\\)+"))) + (throw 'mime-edit-error 'pgp-error) + ) + (delete-region (point-min)(point-max)) + (insert "--[[application/pkcs7-mime; smime-type=enveloped-data; name=\"smime.p7m\" +Content-Disposition: attachment; filename=\"smime.p7m\" +Content-Description: S/MIME Encrypted Message][base64]]\n") + (insert-buffer-substring smime-output-buffer) + ))))) + +(defun mime-edit-process-multipart-1 (boundary) + (let ((ret (mime-edit-find-inmost))) + (if ret + (let ((type (car ret)) + (bb (nth 1 ret))(be (nth 2 ret)) + (eb (nth 3 ret)) + ) + (narrow-to-region bb eb) + (delete-region bb be) + (setq bb (point-min)) + (setq eb (point-max)) + (widen) + (goto-char eb) +; (debug) + (if (looking-at mime-edit-multipart-end-regexp) + (let ((beg (match-beginning 0)) + (end (match-end 0)) + ) + (delete-region beg end) + (or (looking-at mime-edit-beginning-tag-regexp) + (looking-at mime-edit-multipart-end-regexp) + (eobp) + (insert (concat (mime-make-text-tag) "\n")) + ))) + (cond ((string-equal type "quote") + (mime-edit-enquote-region bb eb) + ) + ((string-equal type "pgp-signed") + (mime-edit-sign-pgp-mime bb eb boundary) + ) + ((string-equal type "pgp-encrypted") + (mime-edit-encrypt-pgp-mime bb eb boundary) + ) + ((string-equal type "kazu-signed") + (mime-edit-sign-pgp-kazu bb eb boundary) + ) + ((string-equal type "kazu-encrypted") + (mime-edit-encrypt-pgp-kazu bb eb boundary) + ) + ((string-equal type "smime-signed") + (mime-edit-sign-smime bb eb boundary) + ) + ((string-equal type "smime-encrypted") + (mime-edit-encrypt-smime bb eb boundary) + ) + (t + (setq boundary + (nth 2 (mime-edit-translate-region bb eb + boundary t))) + (goto-char bb) + (insert + (format "--[[multipart/%s; + boundary=\"%s\"][7bit]]\n" + type boundary)) + )) + boundary)))) -------------- next part -------------- テキスト形式以外の添付ファイルを保管しました... ファイル名: 無し 型: application/pgp-signature サイズ: 307 バイト 説明: 無し URL: From okada ＠ opaopa.org Wed Sep 14 10:44:05 2005 From: okada ＠ opaopa.org (=?ISO-2022-JP?B?GyRCMixFRBsoQiAbJEI3cjBsGyhC?= / Kenichi OKADA) Date: Wed, 14 Sep 2005 10:44:05 +0900 Subject: smime.el (Re: broken MIME parts) In-Reply-To: <9569-Wed14Sep2005102559+0900-nakagawa@manakagawa-debian2.asiapacific.hpqcorp.net> Message-ID: おかだです． > [1.2 patch.txt ] > --- /usr/share/emacs21/site-lisp/semi/smime.el 2004-08-12 00:12:56.000000000 +0900 > +++ smime.el 2005-09-13 04:22:40.000000000 +0900 .. 前から気になっていたのですが、非US-ASCIIなテキストを mime-edit-insert-file すると、charset が US-ASCII に なってしまいます． ;; なおそうと思ったのですが、もう、どこに何が書いて ;; あるかもわからない状態に…． -- 岡田 健一 mailto:okada ＠ opaopa.org