smime.el (Re: broken MIME parts)
中川 誠
Makoto.Nakagawa ＠ hp.com
2005年 9月 14日 (水) 10:25:59 JST
中川＠日本ＨＰ(株)です。
In message "broken MIME parts (was Re: smime.el)"
on 05/09/14, Katsumi Yamaoka <yamaoka ＠ jpl.org> 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: <http://lists.chise.org/pipermail/emacs-mime-ja/attachments/20050914/d714a34d/attachment.pgp>
More information about the Emacs-mime-ja
mailing list