smime.el
中川 誠
Makoto.Nakagawa ＠ hp.com
2005年 9月 13日 (火) 04:53:53 JST
中川＠日本ＨＰ(株)です。
In message "Re: smime.el"
on 05/03/18, 中川 誠 <makoto.nakagawa ＠ hp.com> 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: <http://lists.chise.org/pipermail/emacs-mime-ja/attachments/20050913/3f0d8cb5/attachment.p7c>
-------------- next part --------------
テキスト形式以外の添付ファイルを保管しました...
ファイル名: 無し
型: multipart/signed
サイズ: 4146 バイト
説明: 無し
URL: <http://lists.chise.org/pipermail/emacs-mime-ja/attachments/20050913/3f0d8cb5/attachment.bin>
More information about the Emacs-mime-ja
mailing list