;; 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:
(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-buffer "smime"
- "S/MIME encryption of current buffer.")
-(autoload 'smime-sign-buffer "smime"
- "S/MIME signature of current buffer.")
+(require 'epa)
;;; @ version
("application"
("octet-stream" ("type" "" "tar" "shar"))
("postscript")
+ ("pdf")
+ ("msword")
+ ("vnd.ms-excel")
("vnd.ms-powerpoint")
("x-kiss" ("x-cnf")))
("image"
"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"
"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)))
(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")
") "
(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"
;; 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)
(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.")
(define-key mime-edit-mode-enclosure-map
"\C-e" 'mime-edit-enclose-pgp-encrypted-region)
(define-key mime-edit-mode-enclosure-map
+ "s" 'mime-edit-enclose-smime-signed-region)
+(define-key mime-edit-mode-enclosure-map
+ "e" 'mime-edit-enclose-smime-encrypted-region)
+(define-key mime-edit-mode-enclosure-map
"\C-q" 'mime-edit-enclose-quote-region)
(defvar mime-edit-mode-map (make-sparse-keymap)
(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.")
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."))))
(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.
;; 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)
)))
(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)
(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
(ctype (car ret))
(encoding (nth 1 ret))
(pgp-boundary (concat "pgp-sign-" boundary))
- micalg)
+ (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
+ context
+ "\
+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
+Content-Description: OpenPGP Digital Signature
" pgp-boundary))
- (insert-buffer-substring pgg-output-buffer)
+ (insert signature)
(goto-char (point-max))
(insert (format "\n--%s--\n" pgp-boundary))))))
(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))
(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
+ context
+ "\
+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;
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)))))))
(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")
+ "--[[application/pgp; format=mime][7bit]]\n" signature)
))))
(defun mime-edit-encrypt-pgp-kazu (beg end boundary)
(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
+ context
+ "\
+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-convert-lbt-string (string)
+ (let ((index 0))
+ (while (setq index (string-match "\n" string index))
+ (setq string (replace-match "\r\n" nil nil string)
+ index (+ index 2))) ;(length "\r\n")
+ string))
+
(defun mime-edit-sign-smime (beg end boundary)
(save-excursion
(save-restriction
- (let* ((ret (progn
+ (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)))
+ (smime-boundary (concat "smime-sign-" boundary))
+ (context (epg-make-context 'CMS))
+ signature micalg)
(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))
- (or (prog1 (smime-sign-buffer)
- (push nil buffer-undo-list)
- (ignore-errors (undo)))
- (throw 'mime-edit-error 'pgp-error)))
+ (epg-context-set-signers
+ context
+ (epa-select-keys
+ context
+ "\
+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
+ (mime-edit-convert-lbt-string
+ (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\"; micalg=sha1;
+ boundary=\"%s\"%s;
protocol=\"application/pkcs7-signature\"][7bit]]
--%s
-" smime-boundary smime-boundary))
+"
+ smime-boundary
+ (if micalg
+ (concat "; micalg="
+ (downcase
+ (cdr (assq micalg
+ epg-digest-algorithm-alist))))
+ "")
+ smime-boundary))
(goto-char (point-max))
(insert (format "\n--%s
-Content-Type: application/pkcs7-signature; name=\"smime.p7s\"
+Content-Type: application/pkcs7-signature; name=smime.p7s
Content-Transfer-Encoding: base64
-Content-Disposition: attachment; filename=\"smime.p7s\"
-Content-Description: S/MIME Cryptographic Signature
+Content-Disposition: attachment; filename=smime.p7s
+Content-Description: S/MIME Digital Signature
-" smime-boundary))
- (goto-char (point-max))
- (insert (format "\n--%s--\n" smime-boundary))))))
+" smime-boundary)
+ (base64-encode-string signature))))))
(defun mime-edit-encrypt-smime (beg end boundary)
(save-excursion
(save-restriction
- (let* ((ret (progn
- (narrow-to-region beg end)
- (mime-edit-translate-region beg end boundary)))
- (ctype (car ret))
- (encoding (nth 1 ret)))
- (goto-char beg)
- (insert (format "Content-Type: %s\n" ctype))
- (if encoding
- (insert (format "Content-Transfer-Encoding: %s\n" encoding)))
- (insert "\n")
- (goto-char (point-min))
- (while (progn (end-of-line) (not (eobp)))
- (insert "\r")
- (forward-line 1))
- (or (smime-encrypt-buffer)
- (throw 'mime-edit-error 'pgp-error))
- (goto-char beg)
- (insert "--[[application/pkcs7-mime; name=\"smime.p7m\"
-Content-Disposition: attachment; filename=\"smime.p7m\"
-Content-Description: S/MIME Encrypted Message][base64]]\n")))))
+ (let (recipients header)
+ (let ((ret (mime-edit-make-encrypt-recipient-header)))
+ (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))
+ (context (epg-make-context 'CMS))
+ 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")
+ (mime-encode-header-in-buffer)
+ (condition-case error
+ (setq cipher
+ (epg-encrypt-string
+ context
+ (buffer-substring (point-min) (point-max))
+ (epa-select-keys
+ context
+ "\
+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 "--[[application/pkcs7-mime;
+ smime-type=enveloped-data;
+ name=smime.p7m
+Content-Disposition: attachment; filename=smime.p7m][base64]]
+
+")
+ (base64-encode-string cipher)))))))
(defsubst replace-space-with-underline (str)
(mapconcat (function
(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")
(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"))
(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 context t)
+ (epg-export-keys-to-string context
+ (epa-select-keys context
+ "Select keys for export. ")))
(if (and (not (eobp))
(not (looking-at mime-edit-single-part-tag-regexp)))
(insert (mime-make-text-tag) "\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*"))
(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)))
(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)
;;;
(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."
(narrow-to-region beg end)
(cond
((eq subtype 'pgp-encrypted)
- (when (and
- (progn
+ (when (progn
(goto-char (point-min))
(re-search-forward "^-+BEGIN PGP MESSAGE-+$"
nil t))
- (prog1
- (save-window-excursion
- (pgg-decrypt-region (match-beginning 0)
- (point-max)))
- (delete-region (point-min)(point-max))))
- (insert-buffer-substring pgg-output-buffer)
+ (insert (epg-decrypt-string
+ (epg-make-context)
+ (buffer-substring (match-beginning 0)
+ (point-max))))
+ (delete-region (point)(point-max))
(mime-edit-decode-message-in-buffer
nil not-decode-text)
(delete-region (goto-char (point-min))
(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))))
projects / elisp / semi.git / blobdiff