X-Git-Url: http://git.chise.org/gitweb/?a=blobdiff_plain;f=mime-edit.el;h=f21e16aeefd109f9893e26b2f282ac61d1a4523e;hb=304098ff54ffac983b90be924bc1e92393cc8233;hp=134c0769f6db46352fd6a8e44c706f2b53c5a2f2;hpb=3825ab9242cb8aaa5e6d5dbbae37e526564a09aa;p=elisp%2Fsemi.git diff --git a/mime-edit.el b/mime-edit.el index 134c076..f21e16a 100644 --- a/mime-edit.el +++ b/mime-edit.el @@ -23,8 +23,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -113,21 +113,12 @@ (require 'mime-view) (require 'signature) (require 'alist) -(require 'pgg-def) -(require 'pgg-parse) - -(autoload 'pgg-encrypt-region "pgg" - "PGP encryption of current region." t) -(autoload 'pgg-sign-region "pgg" - "PGP signature of current region." t) -(autoload 'pgg-insert-key "pgg" - "Insert PGP public key at point." t) -(autoload 'smime-encrypt-region "smime" - "S/MIME encryption of current region.") -(autoload 'smime-sign-region "smime" - "S/MIME signature of current region.") -(defvar smime-output-buffer) -(defvar smime-errors-buffer) +(require 'epa) + +(autoload 'smime-encrypt-buffer "smime" + "S/MIME encryption of current buffer.") +(autoload 'smime-sign-buffer "smime" + "S/MIME signature of current buffer.") ;;; @ version @@ -232,6 +223,9 @@ To insert a signature file automatically, call the function ("application" ("octet-stream" ("type" "" "tar" "shar")) ("postscript") + ("pdf") + ("msword") + ("vnd.ms-excel") ("vnd.ms-powerpoint") ("x-kiss" ("x-cnf"))) ("image" @@ -307,6 +301,10 @@ To insert a signature file automatically, call the function "application" "msword" nil "base64" "attachment" (("filename" . file))) + ("\\.xls$" ; MS Excel + "application" "vnd.ms-excel" nil + "base64" + "attachment" (("filename" . file))) ("\\.ppt$" ; MS Power Point "application" "vnd.ms-powerpoint" nil "base64" @@ -318,12 +316,16 @@ To insert a signature file automatically, call the function "inline" (("filename" . file))) ("\\.ps$" "application" "postscript" nil - "quoted-printable" + "base64" + "attachment" (("filename" . file))) + ("\\.pdf$" + "application" "pdf" nil + "base64" "attachment" (("filename" . file))) ;; Pure binary - ("\\.jpg$" + ("\\.jpg$\\|\\.jpeg$" "image" "jpeg" nil "base64" "inline" (("filename" . file))) @@ -458,6 +460,8 @@ If encoding is nil, it is determined from its contents." (iso-8859-7 8 "quoted-printable") (iso-8859-8 8 "quoted-printable") (iso-8859-9 8 "quoted-printable") + (iso-8859-14 8 "quoted-printable") + (iso-8859-15 8 "quoted-printable") (iso-2022-jp 7 "base64") (iso-2022-jp-3 7 "base64") (iso-2022-kr 7 "base64") @@ -608,8 +612,12 @@ If it is not specified for a major-mode, ") " (if (fboundp 'apel-version) (concat (apel-version) " ")) + "EasyPG/ " epg-version-number " " (if (featurep 'xemacs) - (concat (cond ((featurep 'utf-2000) + (concat (cond ((and (featurep 'chise) + (boundp 'xemacs-chise-version)) + (concat "CHISE-MULE/" xemacs-chise-version)) + ((featurep 'utf-2000) (concat "UTF-2000-MULE/" utf-2000-version)) ((featurep 'mule) "MULE")) " XEmacs" @@ -628,7 +636,14 @@ If it is not specified for a major-mode, ;; XEmacs versions earlier than 21.1.1. (format " (patch %d)" emacs-patch-level)) (t "")) - " (" xemacs-codename ") (" + " (" xemacs-codename ")" + ;; `xemacs-extra-name' has appeared in the + ;; development version of XEmacs 21.5-b8. + (if (and (boundp 'xemacs-extra-name) + (symbol-value 'xemacs-extra-name)) + (concat " " (symbol-value 'xemacs-extra-name)) + "") + " (" system-configuration ")") " (" emacs-version ")")) (let ((ver (if (string-match "\\.[0-9]+$" emacs-version) @@ -670,7 +685,7 @@ Tspecials means any character that matches with it in header must be quoted.") (concat "MIME-Version:" (mime-encode-field-body (concat " 1.0 (split by " mime-edit-version ")\n") - "MIME-Version:")) + "MIME-Version")) "MIME version field for message/partial.") @@ -755,9 +770,9 @@ Tspecials means any character that matches with it in header must be quoted.") (encrypted "Enclose as encrypted" mime-edit-enclose-pgp-encrypted-region) (quote "Verbatim region" mime-edit-enclose-quote-region) (key "Insert Public Key" mime-edit-insert-key) - (split "About split" mime-edit-set-split) - (sign "About sign" mime-edit-set-sign) - (encrypt "About encryption" mime-edit-set-encrypt) + (split "Set splitting" mime-edit-set-split) + (sign "PGP sign" mime-edit-set-sign) + (encrypt "PGP encrypt" mime-edit-set-encrypt) (preview "Preview Message" mime-edit-preview-message) (level "Toggle transfer-level" mime-edit-toggle-transfer-level)) "MIME-edit menubar entry.") @@ -993,6 +1008,7 @@ User customizable variables (not documented all of them): paragraph-separate)) (run-hooks 'mime-edit-mode-hook) (message + "%s" (substitute-command-keys "Type \\[mime-edit-exit] to exit MIME mode, and type \\[mime-edit-help] to get help.")))) @@ -1279,7 +1295,8 @@ Optional argument ENCODING specifies an encoding method such as base64." (progn (goto-char (1+ (match-end 0))) (if (get-text-property (point) 'mime-edit-invisible) - (next-single-property-change (point) 'mime-edit-invisible) + (or (next-single-property-change (point) 'mime-edit-invisible) + (point-max)) ;; Move to the end of this text. (if (re-search-forward mime-edit-tag-regexp nil 'move) ;; Don't forget a multiline tag. @@ -1390,7 +1407,7 @@ Nil if no such parameter." ;; Change value (concat (substring ctype 0 (match-beginning 1)) parameter "=" value - (substring contype (match-end 1)) + (substring ctype (match-end 1)) opt-fields) (concat ctype "; " parameter "=" value opt-fields) ))) @@ -1481,7 +1498,7 @@ Optional DELIMITER specifies parameter delimiter (';' by default)." (defun mime-prompt-for-parameter (parameter) "Ask for PARAMETER. -Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." +Parameter must be '(PROMPT CHOICE1 (CHOICE2...))." (let* ((prompt (car parameter)) (choices (mapcar (function (lambda (e) @@ -1633,6 +1650,13 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (defvar mime-edit-pgp-user-id nil) +(defun mime-edit-delete-trailing-whitespace () + (save-match-data + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "[ \t]+$" nil t) + (delete-region (match-beginning 0) (match-end 0)))))) + (defun mime-edit-sign-pgp-mime (beg end boundary) (save-excursion (save-restriction @@ -1643,41 +1667,55 @@ Parameter must be '(PROMPT CHOICE1 (CHOISE2 ...))." (ctype (car ret)) (encoding (nth 1 ret)) (pgp-boundary (concat "pgp-sign-" boundary)) + (context (epg-make-context)) + signature micalg) + (mime-edit-delete-trailing-whitespace) ; RFC3156 (goto-char beg) (insert (format "Content-Type: %s\n" ctype)) (if encoding (insert (format "Content-Transfer-Encoding: %s\n" encoding))) (insert "\n") - (or (let ((pgg-default-user-id - (or mime-edit-pgp-user-id - (if from - (nth 1 (std11-extract-address-components from)) - pgg-default-user-id)))) - (pgg-sign-region (point-min)(point-max))) - (throw 'mime-edit-error 'pgp-error)) - (setq micalg - (cdr (assq 'hash-algorithm - (cdar (with-current-buffer pgg-output-buffer - (pgg-parse-armor-region - (point-min)(point-max)))))) - micalg - (if micalg - (concat "; micalg=pgp-" (downcase (symbol-name micalg))) - "")) + (epg-context-set-armor context t) + (epg-context-set-textmode context t) + (epg-context-set-signers + context + (epa-select-keys + "\ +Select keys for signing. +If no one is selected, default secret key is used. " + (if from + (list (nth 1 (std11-extract-address-components from)))) + t)) + (condition-case error + (setq signature + (epg-sign-string context + (buffer-substring (point-min) (point-max)) + 'detached)) + (error (signal 'mime-edit-error (cdr error)))) + (setq micalg (cdr (assq 'digest-algorithm + (car (epg-context-result-for context 'sign))))) (goto-char beg) (insert (format "--[[multipart/signed; boundary=\"%s\"%s; protocol=\"application/pgp-signature\"][7bit]] --%s -" pgp-boundary micalg pgp-boundary)) +" + pgp-boundary + (if micalg + (concat "; micalg=pgp-" + (downcase + (cdr (assq micalg + epg-digest-algorithm-alist)))) + "") + pgp-boundary)) (goto-char (point-max)) (insert (format "\n--%s Content-Type: application/pgp-signature Content-Transfer-Encoding: 7bit " pgp-boundary)) - (insert-buffer-substring pgg-output-buffer) + (insert signature) (goto-char (point-max)) (insert (format "\n--%s--\n" pgp-boundary)))))) @@ -1713,17 +1751,18 @@ Content-Transfer-Encoding: 7bit (defun mime-edit-encrypt-pgp-mime (beg end boundary) (save-excursion (save-restriction - (let (from recipients header) + (let (recipients header) (let ((ret (mime-edit-make-encrypt-recipient-header))) - (setq from (aref ret 0) - recipients (aref ret 1) + (setq recipients (aref ret 1) header (aref ret 2))) (narrow-to-region beg end) (let* ((ret (mime-edit-translate-region beg end boundary)) (ctype (car ret)) (encoding (nth 1 ret)) - (pgp-boundary (concat "pgp-" boundary))) + (pgp-boundary (concat "pgp-" boundary)) + (context (epg-make-context)) + cipher) (goto-char beg) (insert header) (insert (format "Content-Type: %s\n" ctype)) @@ -1731,19 +1770,22 @@ Content-Transfer-Encoding: 7bit (insert (format "Content-Transfer-Encoding: %s\n" encoding))) (insert "\n") (mime-encode-header-in-buffer) - (or (let ((pgg-default-user-id - (or mime-edit-pgp-user-id - (if from - (nth 1 (std11-extract-address-components from)) - pgg-default-user-id)))) - (pgg-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)) + (epg-context-set-armor context t) + (condition-case error + (setq cipher + (epg-encrypt-string + context + (buffer-substring (point-min) (point-max)) + (epa-select-keys + "\ +Select recipents for encryption. +If no one is selected, symmetric encryption will be performed. " + (mapcar (lambda (recipient) + (nth 1 (std11-extract-address-components + recipient))) + (split-string recipients + "\\([ \t\n]*,[ \t\n]*\\)+"))))) + (error (signal 'mime-edit-error (cdr error)))) (delete-region (point-min)(point-max)) (goto-char beg) (insert (format "--[[multipart/encrypted; @@ -1757,7 +1799,7 @@ Content-Type: application/octet-stream Content-Transfer-Encoding: 7bit " pgp-boundary pgp-boundary pgp-boundary)) - (insert-buffer-substring pgg-output-buffer) + (insert cipher) (goto-char (point-max)) (insert (format "\n--%s--\n" pgp-boundary))))))) @@ -1768,14 +1810,20 @@ Content-Transfer-Encoding: 7bit (let* ((ret (mime-edit-translate-region beg end boundary)) (ctype (car ret)) - (encoding (nth 1 ret))) + (encoding (nth 1 ret)) + (context (epg-make-context)) + signature) (goto-char beg) (insert (format "Content-Type: %s\n" ctype)) (if encoding (insert (format "Content-Transfer-Encoding: %s\n" encoding))) (insert "\n") - (or (pgg-sign-region beg (point-max) 'clearsign) - (throw 'mime-edit-error 'pgp-error)) + (condition-case error + (setq signature + (epg-sign-string context + (buffer-substring beg (point-max)) + 'clearsign)) + (error (signal 'mime-edit-error (cdr error)))) (goto-char beg) (insert "--[[application/pgp; format=mime][7bit]]\n") @@ -1792,18 +1840,34 @@ Content-Transfer-Encoding: 7bit (let* ((ret (mime-edit-translate-region beg end boundary)) (ctype (car ret)) - (encoding (nth 1 ret))) + (encoding (nth 1 ret)) + (context (epg-make-context)) + cipher) (goto-char beg) (insert header) (insert (format "Content-Type: %s\n" ctype)) (if encoding (insert (format "Content-Transfer-Encoding: %s\n" encoding))) (insert "\n") - (or (pgg-encrypt-region beg (point-max) recipients) - (throw 'mime-edit-error 'pgp-error)) + (epg-context-set-armor context t) + (condition-case error + (setq cipher + (epg-encrypt-string + context + (buffer-substring beg (point-max)) + (epa-select-keys + "\ +Select recipents for encryption. +If no one is selected, symmetric encryption will be performed. " + (mapcar (lambda (recipient) + (nth 1 (std11-extract-address-components + recipient))) + (split-string recipients + "\\([ \t\n]*,[ \t\n]*\\)+"))))) + (error (signal 'mime-edit-error (cdr error)))) (goto-char beg) (insert - "--[[application/pgp; format=mime][7bit]]\n") + "--[[application/pgp; format=mime][7bit]]\n" cipher) ))))) (defun mime-edit-sign-smime (beg end boundary) @@ -1825,27 +1889,15 @@ Content-Transfer-Encoding: 7bit (while (progn (end-of-line) (not (eobp))) (insert "\r") (forward-line 1)) - (or (prog1 (smime-sign-region (point-min)(point-max)) - (push nil buffer-undo-list) - (ignore-errors (undo))) + (or (smime-sign-buffer) (throw 'mime-edit-error 'pgp-error))) (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)))))) + (if (re-search-forward "^Content-Type:\\s-*" nil t) + (let* ((start (match-beginning 0)) + (body (buffer-substring (match-end 0) (std11-field-end)))) + (delete-region start (line-beginning-position 2)) + (goto-char beg) + (insert "--[[" body "][7bit]]\n"))))))) (defun mime-edit-encrypt-smime (beg end boundary) (save-excursion @@ -1864,13 +1916,15 @@ Content-Description: S/MIME Cryptographic Signature (while (progn (end-of-line) (not (eobp))) (insert "\r") (forward-line 1)) - (or (smime-encrypt-region (point-min)(point-max)) + (or (smime-encrypt-buffer) (throw 'mime-edit-error 'pgp-error)) - (delete-region (point-min)(point-max)) - (insert "--[[application/pkcs7-mime; name=\"smime.p7m\" -Content-Disposition: attachment; filename=\"smime.p7m\" -Content-Description: S/MIME Encrypted Message][base64]]\n") - (insert-buffer-substring smime-output-buffer))))) + (goto-char beg) + (if (re-search-forward "^Content-Type:\\s-*" nil t) + (let* ((start (match-beginning 0)) + (body (buffer-substring (match-end 0) (std11-field-end)))) + (delete-region start (line-beginning-position 2)) + (goto-char beg) + (insert "--[[" body "]]\n"))))))) (defsubst replace-space-with-underline (str) (mapconcat (function @@ -2037,7 +2091,7 @@ Content-Description: S/MIME Encrypted Message][base64]]\n") (or (looking-at mime-edit-beginning-tag-regexp) (eobp) (insert (mime-make-text-tag) "\n"))) - (visible-region beg end) + (remove-text-properties beg end '(invisible mime-edit-invisible)) (goto-char beg)) (cond ((mime-test-content-type contype "message") @@ -2109,7 +2163,13 @@ Content-Description: S/MIME Encrypted Message][base64]]\n") (narrow-to-region beg (mime-edit-content-end)) (goto-char beg) (while (re-search-forward "\\(\\=\\|[^\r]\\)\n" nil t) - (replace-match "\\1\r\n")))) + ;; In a certain period, `replace-match' with "\\N" + ;; converted 8-bit characters into multibyte string, + ;; but it has been fixed at 2004-01-15. + ;;(replace-match "\\1\r\n")))) + (backward-char 1) + (insert "\r") + (forward-char 1)))) (goto-char beg) (mime-encode-region beg (mime-edit-content-end) (or encoding "7bit")) @@ -2255,7 +2315,10 @@ and insert data encoded as ENCODING." (interactive "P") (mime-edit-insert-tag "application" "pgp-keys") (mime-edit-define-encoding "7bit") - (pgg-insert-key) + (let ((context (epg-make-context))) + (epg-context-set-armor t) + (epg-export-keys-to-string context + (epa-select-keys "Select keys for export. "))) (if (and (not (eobp)) (not (looking-at mime-edit-single-part-tag-regexp))) (insert (mime-make-text-tag) "\n"))) @@ -2372,14 +2435,10 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (setq mime-edit-message-max-length (or (cdr (assq major-mode mime-edit-message-max-lines-alist)) mime-edit-message-default-max-lines))) - (let* ((mime-edit-draft-file-name - (or (buffer-file-name) - (make-temp-name - (expand-file-name "mime-draft" temporary-file-directory)))) - (separator mail-header-separator) - (id (concat "\"" - (replace-space-with-underline (current-time-string)) - "@" (system-name) "\""))) + (let ((separator mail-header-separator) + (id (concat "\"" + (replace-space-with-underline (current-time-string)) + "@" (system-name) "\""))) (run-hooks 'mime-edit-before-split-hook) (let ((the-buf (current-buffer)) (copy-buf (get-buffer-create " *Original Message*")) @@ -2431,7 +2490,7 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (message (format "Sending %d/%d..." mime-edit-partial-number total)) (call-interactively command) - (message (format "Sending %d/%d... done" + (message (format "Sending %d/%d...done" mime-edit-partial-number total))) (setq mime-edit-partial-number (1+ mime-edit-partial-number))) @@ -2446,7 +2505,7 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (save-excursion (message (format "Sending %d/%d..." mime-edit-partial-number total)) - (message (format "Sending %d/%d... done" + (message (format "Sending %d/%d...done" mime-edit-partial-number total)))))) (defun mime-edit-maybe-split-and-send (&optional cmd) @@ -2465,6 +2524,7 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" ;;; (defvar mime-edit-buffer nil) ; buffer local variable +(defvar mime-edit-temp-message-buffer nil) ; buffer local variable (defun mime-edit-preview-message () "preview editing MIME message." @@ -2572,8 +2632,11 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" nil t)) (prog1 (save-window-excursion - (pgg-decrypt-region (match-beginning 0) - (point-max))) + (epg-decrypt-string + (epg-make-context) + (buffer-substring + (match-beginning 0) + (point-max)))) (delete-region (point-min)(point-max)))) (insert-buffer-substring pgg-output-buffer) (mime-edit-decode-message-in-buffer @@ -2674,14 +2737,15 @@ Content-Type: message/partial; id=%s; number=%d; total=%d\n%s\n" (match-end 0)(point-max) encoding) (setq encoded t encoding nil)))))))) - (if (or encoded (not not-decode-text)) - (progn - (save-excursion - (goto-char (point-min)) - (while (re-search-forward "\r\n" nil t) - (replace-match "\n"))) - (decode-mime-charset-region (point-min)(point-max) - (or charset default-mime-charset)))) + (if (and (eq type 'text) + (or encoded (not not-decode-text))) + (progn + (save-excursion + (goto-char (point-min)) + (while (re-search-forward "\r\n" nil t) + (replace-match "\n"))) + (decode-mime-charset-region (point-min)(point-max) + (or charset default-mime-charset)))) (let ((he (if (re-search-forward "^$" nil t) (match-end 0) (point-min))))