+2000-11-06 16:02:52 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-uu.el (mm-uu-gpg-key-skip-to-last): New function.
+ (mm-uu-pgp-key-extract): Use application/pgp-keys, don't snarf,
+ let mailcap do it.
+ * mml2015.el: Remove snarf code.
+ * mm-decode.el: Remove snarf code.
+
+2000-11-06 14:03:10 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mml.el (mml-insert-mml-markup): Ignore internal stuff.
+ (mml-insert-mime): Understand gnus-decoded.
+ (mime-to-mml): New parameter handles.
+ * gnus-art.el (gnus-mime-save-part-and-strip): Use it.
+ * gnus-sum.el (gnus-summary-edit-article): Add argument `3'.
+
+2000-11-06 13:51:37 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-decode.el (mime-security): New group.
+ (mm-verify-function-alist): Add test function.
+ (mm-decrypt-function-alist): Ditto.
+ (mm-snarf-option): Set default value as nil.
+ (mm-find-part-by-type): Recursive parameter.
+ (mm-possibly-verify-or-decrypt): Support draft-ietf-openpgp-multsig.
+ * mml2015.el: Support draft-ietf-openpgp-multsig.
+
+2000-11-06 13:01:27 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mime-view-part-as-charset): New function.
+ (gnus-article-view-part-as-charset): New function.
+
2000-11-05 22:34:07 ShengHuo ZHU <zsh@cs.rochester.edu>
* mm-decode.el (mm-verify-option): Default value.
("view the part" . gnus-mime-view-part)
("pipe to command" . gnus-mime-pipe-part)
("toggle display" . gnus-article-press-button)
+ ("toggle display" . gnus-article-view-part-as-charset)
("view as type" . gnus-mime-view-part-as-type)
("internalize type" . gnus-mime-internalize-part)
("externalize type" . gnus-mime-externalize-part))
'((gnus-article-press-button "\r" "Toggle Display")
(gnus-mime-view-part "v" "View Interactively...")
(gnus-mime-view-part-as-type "t" "View As Type...")
+ (gnus-mime-view-part-as-charset "C" "View As charset...")
(gnus-mime-save-part "o" "Save...")
(gnus-mime-save-part-and-strip "\C-o" "Save and Strip")
(gnus-mime-copy-part "c" "View As Text, In Other Buffer")
(or gnus-article-ignored-charsets
',gnus-newsgroup-ignored-charsets))
(mbl mml-buffer-list))
- (insert-buffer gnus-original-article-buffer)
- (save-restriction
- (message-narrow-to-head)
- (message-remove-header "Content-Type")
- (message-remove-header "MIME-Version")
- (message-remove-header "Content-Transfer-Encoding")
- (mail-decode-encoded-word-region (point-min) (point-max))
- (goto-char (point-max)))
- (forward-char 1)
- (delete-region (point) (point-max))
(setq mml-buffer-list nil)
- (if (stringp (car gnus-article-mime-handles))
- (mml-insert-mime gnus-article-mime-handles)
- (mml-insert-mime gnus-article-mime-handles t))
- (mm-destroy-parts gnus-article-mime-handles)
+ (insert-buffer gnus-original-article-buffer)
+ (mime-to-mml gnus-article-mime-handles)
(setq gnus-article-mime-handles nil)
(make-local-hook 'kill-buffer-hook)
(let ((mbl1 mml-buffer-list))
contents charset
(b (point))
buffer-read-only)
- (if (mm-handle-undisplayer handle)
+ (if (and (not arg) (mm-handle-undisplayer handle))
(mm-remove-part handle)
(setq contents (mm-get-part handle))
(cond
(mm-handle-type handle) 'charset)
gnus-newsgroup-charset)))
((numberp arg)
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle))
(setq charset
(or (cdr (assq arg
gnus-summary-show-article-charset-alist))
contents))
(goto-char b))))
+(defun gnus-mime-view-part-as-charset (&optional handle arg)
+ "Insert the MIME part under point into the current buffer."
+ (interactive (list nil current-prefix-arg))
+ (gnus-article-check-buffer)
+ (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
+ contents charset
+ (b (point))
+ buffer-read-only)
+ (if (mm-handle-undisplayer handle)
+ (mm-remove-part handle))
+ (let ((gnus-newsgroup-charset
+ (or (cdr (assq arg
+ gnus-summary-show-article-charset-alist))
+ (read-coding-system "Charset: ")))
+ (gnus-newsgroup-ignored-charsets 'gnus-all))
+ (gnus-article-press-button))))
+
(defun gnus-mime-externalize-part (&optional handle)
"View the MIME part under point with an external viewer."
(interactive)
(interactive "p")
(gnus-article-part-wrapper n 'gnus-mime-copy-part))
+(defun gnus-article-view-part-as-charset (n)
+ "Copy MIME part N, which is the numerical prefix."
+ (interactive "p")
+ (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset))
+
(defun gnus-article-externalize-part (n)
"View MIME part N externally, which is the numerical prefix."
(interactive "p")
"v" gnus-article-view-part
"o" gnus-article-save-part
"c" gnus-article-copy-part
+ "C" gnus-article-view-part-as-charset
"e" gnus-article-externalize-part
"i" gnus-article-inline-part
"|" gnus-article-pipe-part))
:group 'news
:group 'multimedia)
+(defgroup mime-security ()
+ "MIME security in mail and news articles."
+ :link '(custom-manual "(emacs-mime)Customization")
+ :group 'mail
+ :group 'news
+ :group 'multimedia)
+
;;; Convenience macros.
(defmacro mm-handle-buffer (handle)
(defvar mm-dissect-default-type "text/plain")
(autoload 'mml2015-verify "mml2015")
+(autoload 'mml2015-verify-test "mml2015")
(autoload 'mml-smime-verify "mml-smime")
(defvar mm-verify-function-alist
- '(("application/pgp-signature" mml2015-verify "PGP")
- ("application/pkcs7-signature" mml-smime-verify "S/MIME")
- ("application/x-pkcs7-signature" mml-smime-verify "S/MIME")))
+ '(("application/pgp-signature" mml2015-verify "PGP" mml2015-verify-test)
+ ("application/pkcs7-signature" mml-smime-verify "S/MIME" nil)
+ ("application/x-pkcs7-signature" mml-smime-verify "S/MIME" nil)))
(defcustom mm-verify-option 'known
"Option of verifying signed parts.
(item never)
(item :tag "only known protocols" known)
(item :tag "ask" nil))
- :group 'gnus-article)
+ :group 'mime-security)
(autoload 'mml2015-decrypt "mml2015")
+(autoload 'mml2015-decrypt-test "mml2015")
(defvar mm-decrypt-function-alist
- '(("application/pgp-encrypted" mml2015-decrypt "PGP")))
+ '(("application/pgp-encrypted" mml2015-decrypt "PGP" mml2015-decrypt-test)))
(defcustom mm-decrypt-option 'known
"Option of decrypting signed parts.
(item never)
(item :tag "only known protocols" known)
(item :tag "ask" nil))
- :group 'gnus-article)
-
-(defcustom mm-snarf-option 'known
- "Option of snarfing PGP key.
-`never', not snarf; `always', always snarf;
-`known', only snarf known protocols. Otherwise, ask user."
- :type '(choice (item always)
- (item never)
- (item :tag "only known protocols" known)
- (item :tag "ask" nil))
- :group 'gnus-article)
+ :group 'mime-security)
(defvar mm-viewer-completion-map
(let ((map (make-sparse-keymap 'mm-viewer-completion-map)))
(and (mm-valid-image-format-p format)
(mm-image-fit-p handle)))
-(defun mm-find-part-by-type (handles type &optional notp)
+(defun mm-find-part-by-type (handles type &optional notp recursive)
"Search in HANDLES for part with TYPE.
-If NOTP, returns first non-matching part."
+If NOTP, returns first non-matching part.
+If RECURSIVE, search recursively."
(let (handle)
(while handles
- (if (if notp
- (not (equal (mm-handle-media-type (car handles)) type))
- (equal (mm-handle-media-type (car handles)) type))
- (setq handle (car handles)
- handles nil))
+ (if (and recursive (stringp (caar handles)))
+ (if (setq handle (mm-find-part-by-type (cdar handles) type
+ notp recursive))
+ (setq handles nil))
+ (if (if notp
+ (not (equal (mm-handle-media-type (car handles)) type))
+ (equal (mm-handle-media-type (car handles)) type))
+ (setq handle (car handles)
+ handles nil)))
(setq handles (cdr handles)))
handle))
(defun mm-possibly-verify-or-decrypt (parts ctl)
(let ((subtype (cadr (split-string (car ctl) "/")))
- protocol func)
+ protocol func functest)
(cond
((equal subtype "signed")
- (unless (setq protocol (mail-content-type-get ctl 'protocol))
- ;; The message is broken.
- (let ((parts parts))
- (while parts
- (if (assoc (mm-handle-media-type (car parts))
- mm-verify-function-alist)
- (setq protocol (mm-handle-media-type (car parts))
- parts nil)
- (setq parts (cdr parts))))))
+ (unless (and (setq protocol (mail-content-type-get ctl 'protocol))
+ (not (equal protocol "multipart/mixed")))
+ ;; The message is broken or draft-ietf-openpgp-multsig-01.
+ (let ((protocols mm-verify-function-alist))
+ (while protocols
+ (if (and (or (not (setq functest (nth 3 (car protocols))))
+ (funcall functest parts ctl))
+ (mm-find-part-by-type parts (caar protocols) nil t))
+ (setq protocol (caar protocols)
+ protocols nil)
+ (setq protocols (cdr protocols))))))
(setq func (nth 1 (assoc protocol mm-verify-function-alist)))
+ (setq functest (nth 3 (assoc protocol mm-verify-function-alist)))
(if (cond
((eq mm-verify-option 'never) nil)
((eq mm-verify-option 'always) t)
- ((eq mm-verify-option 'known) func)
+ ((eq mm-verify-option 'known)
+ (and func (funcall functest parts ctl)))
(t (y-or-n-p
(format "Verify signed (%s) part? "
(or (nth 2 (assoc protocol mm-verify-function-alist))
parts nil)
(setq parts (cdr parts))))))
(setq func (nth 1 (assoc protocol mm-decrypt-function-alist)))
+ (setq functest (nth 3 (assoc protocol mm-decrypt-function-alist)))
(if (cond
((eq mm-decrypt-option 'never) nil)
((eq mm-decrypt-option 'always) t)
- ((eq mm-decrypt-option 'known) func)
+ ((eq mm-decrypt-option 'known)
+ (and func (funcall functest parts ctl)))
(t (y-or-n-p
(format "Decrypt (%s) part? "
(or (nth 2 (assoc protocol mm-decrypt-function-alist))
(item :tag "external" binhex-decode-region-external))
:group 'gnus-article-mime)
-(defvar mm-uu-pgp-begin-signature
+(defvar mm-uu-pgp-beginning-signature
"^-----BEGIN PGP SIGNATURE-----")
-(defvar mm-uu-begin-line nil)
+(defvar mm-uu-beginning-regexp nil)
(defvar mm-dissect-disposition "inline"
"The default disposition of uu parts.
"^-----BEGIN PGP PUBLIC KEY BLOCK-----"
"^-----END PGP PUBLIC KEY BLOCK-----"
mm-uu-pgp-key-extract
- nil
- mm-uu-pgp-key-test)))
+ mm-uu-gpg-key-skip-to-last
+ nil)))
(defcustom mm-uu-configure-list nil
"A list of mm-uu configuration.
(defsubst mm-uu-type (entry)
(car entry))
-(defsubst mm-uu-begin-regexp (entry)
+(defsubst mm-uu-beginning-regexp (entry)
(nth 1 entry))
(defsubst mm-uu-end-regexp (entry)
(defun mm-uu-configure (&optional symbol value)
(if symbol (set-default symbol value))
- (setq mm-uu-begin-line nil)
+ (setq mm-uu-beginning-regexp nil)
(mapcar (lambda (entry)
(if (mm-uu-configure-p (mm-uu-type entry) 'disabled)
nil
- (setq mm-uu-begin-line
- (concat mm-uu-begin-line
- (if mm-uu-begin-line "\\|")
- (mm-uu-begin-regexp entry)))))
+ (setq mm-uu-beginning-regexp
+ (concat mm-uu-beginning-regexp
+ (if mm-uu-beginning-regexp "\\|")
+ (mm-uu-beginning-regexp entry)))))
mm-uu-type-alist))
(mm-uu-configure)
(goto-char (point-min))
(if (search-forward "\n\n" nil t)
(delete-region (point-min) (point)))
- (if (re-search-forward mm-uu-pgp-begin-signature nil t)
+ (if (re-search-forward mm-uu-pgp-beginning-signature nil t)
(delete-region (match-beginning 0) (point-max))))
(mm-make-handle buf
'("text/plain" (charset . gnus-decoded)))))
(mm-make-handle buf
'("text/plain" (charset . gnus-decoded)))))
-(defun mm-uu-pgp-key-test ()
- (and
- mml2015-use
- (mml2015-clear-snarf-function)
- (cond
- ((eq mm-snarf-option 'never) nil)
- ((eq mm-snarf-option 'always) t)
- ((eq mm-snarf-option 'known) t)
- (t (y-or-n-p "Snarf pgp signed part?")))))
+(defun mm-uu-gpg-key-skip-to-last ()
+ (let ((point (point))
+ (end-regexp (mm-uu-end-regexp entry))
+ (beginning-regexp (mm-uu-beginning-regexp entry)))
+ (when (and end-regexp
+ (not (mm-uu-configure-p (mm-uu-type entry) 'disabled)))
+ (while (re-search-forward end-regexp nil t)
+ (skip-chars-forward " \t\n\r")
+ (if (looking-at beginning-regexp)
+ (setq point (match-end 0)))))
+ (goto-char point)))
(defun mm-uu-pgp-key-extract ()
(let ((buf (mm-uu-copy-to-buffer start-point end-point)))
- (with-current-buffer buf
- (funcall (mml2015-clear-snarf-function)))
(mm-make-handle buf
- '("application/x-pgp-key"))))
+ '("application/pgp-keys"))))
;;;### autoload
(defun mm-uu-dissect ()
;;; decoding.
(setq text-start (point)
text-plain-type '("text/plain" (charset . gnus-decoded)))
- (while (re-search-forward mm-uu-begin-line nil t)
+ (while (re-search-forward mm-uu-beginning-regexp nil t)
(setq start-point (match-beginning 0))
(let ((alist mm-uu-type-alist)
- (begin-line (match-string 0)))
+ (beginning-regexp (match-string 0)))
(while (not entry)
- (if (string-match (mm-uu-begin-regexp (car alist)) begin-line)
+ (if (string-match (mm-uu-beginning-regexp (car alist))
+ beginning-regexp)
(setq entry (car alist))
(pop alist))))
(if (setq func (mm-uu-function-1 entry))
(funcall func))
(forward-line);; in case of failure
(when (and (not (mm-uu-configure-p (mm-uu-type entry) 'disabled))
- (let ((end-line (mm-uu-end-regexp entry)))
- (if (not end-line)
+ (let ((end-regexp (mm-uu-end-regexp entry)))
+ (if (not end-regexp)
(or (setq end-point (point-max)) t)
(prog1
- (re-search-forward end-line nil t)
+ (re-search-forward end-regexp nil t)
(forward-line)
(setq end-point (point)))))
(or (not (setq func (mm-uu-function-2 entry)))
;;; Transforming MIME to MML
;;;
-(defun mime-to-mml ()
- "Translate the current buffer (which should be a message) into MML."
+(defun mime-to-mml (&optional handles)
+ "Translate the current buffer (which should be a message) into MML.
+If HANDLES is non-nil, use it instead reparsing the buffer."
;; First decode the head.
(save-restriction
(message-narrow-to-head)
(mail-decode-encoded-word-region (point-min) (point-max)))
- (let ((handles (mm-dissect-buffer t)))
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
- (delete-region (point) (point-max))
- (if (stringp (car handles))
- (mml-insert-mime handles)
- (mml-insert-mime handles t))
- (mm-destroy-parts handles))
+ (unless handles
+ (setq handles (mm-dissect-buffer t)))
+ (goto-char (point-min))
+ (search-forward "\n\n" nil t)
+ (delete-region (point) (point-max))
+ (if (stringp (car handles))
+ (mml-insert-mime handles)
+ (mml-insert-mime handles t))
+ (mm-destroy-parts handles)
(save-restriction
(message-narrow-to-head)
;; Remove them, they are confusing.
(mapcar 'mml-insert-mime (cdr handle))
(insert "<#/multipart>\n"))
(textp
- (let ((text (mm-get-part handle))
- (charset (mail-content-type-get
+ (let ((charset (mail-content-type-get
(mm-handle-type handle) 'charset)))
- (insert (mm-decode-string text charset)))
+ (if (eq charset 'gnus-decoded)
+ (mm-insert-part handle)
+ (insert (mm-decode-string (mm-get-part handle) charset))))
(goto-char (point-max)))
(t
(insert "<#/part>\n")))))
(insert "<#part type=" (mm-handle-media-type handle)))
(dolist (elem (append (cdr (mm-handle-type handle))
(cdr (mm-handle-disposition handle))))
- (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\""))
+ (unless (symbolp (cdr elem))
+ (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\"")))
(when (mm-handle-disposition handle)
(insert " disposition=" (car (mm-handle-disposition handle))))
(when buffer
mml2015-mailcrypt-verify
mml2015-mailcrypt-decrypt
mml2015-mailcrypt-clear-verify
- mml2015-mailcrypt-clear-decrypt
- mml2015-mailcrypt-clear-snarf)
+ mml2015-mailcrypt-clear-decrypt)
(gpg mml2015-gpg-sign
mml2015-gpg-encrypt
mml2015-gpg-verify
mml2015-gpg-decrypt
nil
- mml2015-gpg-clear-decrypt
- nil))
+ mml2015-gpg-clear-decrypt))
"Alist of PGP/MIME functions.")
(defvar mml2015-result-buffer nil)
(autoload 'mc-pgp-always-sign "mailcrypt")
(autoload 'mc-encrypt-generic "mc-toplev")
(autoload 'mc-cleanup-recipient-headers "mc-toplev")
- (autoload 'mc-sign-generic "mc-toplev")
- (autoload 'mc-snarf-keys "mc-toplev"))
+ (autoload 'mc-sign-generic "mc-toplev"))
(eval-when-compile
(defvar mc-default-scheme)
(defvar mml2015-decrypt-function 'mailcrypt-decrypt)
(defvar mml2015-verify-function 'mailcrypt-verify)
-(defvar mml2015-snarf-function 'mc-snarf-keys)
(defun mml2015-mailcrypt-decrypt (handle ctl)
(let (child handles result)
- (unless (setq child (mm-find-part-by-type (cdr handle)
- "application/octet-stream"))
+ (unless (setq child (mm-find-part-by-type
+ (cdr handle)
+ "application/octet-stream" nil t))
(error "Corrupted pgp-encrypted part."))
(with-temp-buffer
(mm-insert-part child)
(defun mml2015-mailcrypt-verify (handle ctl)
(let (part)
(unless (setq part (mm-find-raw-part-by-type
- ctl "application/pgp-signature" t))
+ ctl (or (mail-content-type-get ctl 'protocol)
+ "application/pgp-signature")
+ t))
(error "Corrupted pgp-signature part."))
(with-temp-buffer
(insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
(insert part "\n")
(goto-char (point-max))
(unless (setq part (mm-find-part-by-type
- (cdr handle) "application/pgp-signature"))
+ (cdr handle) "application/pgp-signature" nil t))
(error "Corrupted pgp-signature part."))
(mm-insert-part part)
(unless (funcall mml2015-verify-function)
(unless (funcall mml2015-verify-function)
(error "Verify error.")))
-(defun mml2015-mailcrypt-clear-snarf ()
- (funcall mml2015-snarf-function))
-
(defun mml2015-mailcrypt-sign (cont)
(mc-sign-generic (message-options-get 'message-sender)
nil nil nil nil)
(defun mml2015-gpg-verify (handle ctl)
(let (part message signature)
(unless (setq part (mm-find-raw-part-by-type
- ctl "application/pgp-signature" t))
+ ctl (or (mail-content-type-get ctl 'protocol)
+ "application/pgp-signature")
+ t))
(error "Corrupted pgp-signature part."))
(with-temp-buffer
(setq message (current-buffer))
(with-temp-buffer
(setq signature (current-buffer))
(unless (setq part (mm-find-part-by-type
- (cdr handle) "application/pgp-signature"))
+ (cdr handle) "application/pgp-signature" nil t))
(error "Corrupted pgp-signature part."))
(mm-insert-part part)
(unless (gpg-verify message signature mml2015-result-buffer)
(gnus-get-buffer-create "*MML2015 Result*"))
nil))
-(defsubst mml2015-clear-snarf-function ()
- (nth 7 (assq mml2015-use mml2015-function-alist)))
-
(defsubst mml2015-clear-decrypt-function ()
(nth 6 (assq mml2015-use mml2015-function-alist)))
handle)))
;;;###autoload
+(defun mml2015-decrypt-test (handle ctl)
+ mml2015-use)
+
+;;;###autoload
(defun mml2015-verify (handle ctl)
(mml2015-clean-buffer)
(let ((func (nth 3 (assq mml2015-use mml2015-function-alist))))
handle)))
;;;###autoload
+(defun mml2015-verify-test (handle ctl)
+ mml2015-use)
+
+;;;###autoload
(defun mml2015-encrypt (cont)
(mml2015-clean-buffer)
(let ((func (nth 2 (assq mml2015-use mml2015-function-alist))))
projects / elisp / gnus.git- / commitdiff