* mm-uu.el (mm-uu-pgp-encrypted-extract-1): New function.
(mm-uu-pgp-encrypted-extract): Use it.
(mm-uu-pgp-signed-extract-1): New function.
(mm-uu-pgp-signed-extract): Use it.
* gnus-art.el (gnus-mime-display-security): New function.
(gnus-mime-display-part): Use it.
(gnus-mime-security-verify-or-decrypt): New function.
(gnus-mime-security-press-button): New function.
(gnus-insert-mime-security-button): Use it.
* mm-decode.el (mm-possibly-verify-or-decrypt): Use mm-h-m-c-p.
(mm-find-raw-part-by-type): Ditto.
(mm-verify-function-alist): Add x-gnus-pgp-signature handle.
(mm-decrypt-function-alist): Add x-gnus-pgp-encrypted handle.
(mm-destroy-parts): Kill nested multibyte buffer.
* mml2015.el (mml2015-mailcrypt-verify): Use mm-h-m-c-p.
(mml2015-gpg-verify): Ditto.
+2000-11-19 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * mm-uu.el (mm-uu-pgp-encrypted-extract-1): New function.
+ (mm-uu-pgp-encrypted-extract): Use it.
+ (mm-uu-pgp-signed-extract-1): New function.
+ (mm-uu-pgp-signed-extract): Use it.
+
+ * gnus-art.el (gnus-mime-display-security): New function.
+ (gnus-mime-display-part): Use it.
+ (gnus-mime-security-verify-or-decrypt): New function.
+ (gnus-mime-security-press-button): New function.
+ (gnus-insert-mime-security-button): Use it.
+
+ * mm-decode.el (mm-possibly-verify-or-decrypt): Use mm-h-m-c-p.
+ (mm-find-raw-part-by-type): Ditto.
+ (mm-verify-function-alist): Add x-gnus-pgp-signature handle.
+ (mm-decrypt-function-alist): Add x-gnus-pgp-encrypted handle.
+ (mm-destroy-parts): Kill nested multibyte buffer.
+
+ * mml2015.el (mml2015-mailcrypt-verify): Use mm-h-m-c-p.
+ (mml2015-gpg-verify): Ditto.
+
2000-11-18 Simon Josefsson <sj@extundo.com>
* mml2015.el (mml2015-mailcrypt-clear-verify): New function.
((equal (car handle) "multipart/signed")
(or (memq 'signed gnus-article-wash-types)
(push 'signed gnus-article-wash-types))
- (gnus-insert-mime-security-button handle)
- (gnus-mime-display-mixed (cdr handle)))
+ (gnus-mime-display-security handle))
((equal (car handle) "multipart/encrypted")
(or (memq 'encrypted gnus-article-wash-types)
(push 'encrypted gnus-article-wash-types))
- (gnus-insert-mime-security-button handle)
- (gnus-mime-display-mixed (cdr handle)))
+ (gnus-mime-display-security handle))
;; Other multiparts are handled like multipart/mixed.
(t
(gnus-mime-display-mixed (cdr handle)))))
(defvar gnus-mime-security-details-buffer nil)
+(defun gnus-mime-security-verify-or-decrypt (handle)
+ (mm-remove-parts (cdr handle))
+ (let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region))
+ buffer-read-only)
+ (when region
+ (delete-region (car region) (cdr region))
+ (set-marker (car region) nil)
+ (set-marker (cdr region) nil)))
+ (with-current-buffer (mm-handle-multipart-original-buffer handle)
+ (let* ((mm-verify-option 'known)
+ (mm-decrypt-option 'known)
+ (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle)))
+ (unless (eq nparts (cdr handle))
+ (mm-destroy-parts (cdr handle))
+ (setcdr handle nparts))))
+ (let ((point (point))
+ buffer-read-only)
+ (gnus-mime-display-security handle)
+ (goto-char point)))
+
(defun gnus-mime-security-show-details (handle)
(let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details)))
(if details
(pop-to-buffer gnus-mime-security-details-buffer))
(gnus-message 5 "No details."))))
+(defun gnus-mime-security-press-button (handle)
+ (if (mm-handle-multipart-ctl-parameter handle 'gnus-info)
+ (gnus-mime-security-show-details handle)
+ (gnus-mime-security-verify-or-decrypt handle)))
+
(defun gnus-insert-mime-security-button (handle &optional displayed)
(let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol))
(gnus-tmp-type
gnus-mime-security-button-line-format-alist
`(local-map ,gnus-mime-security-button-map
keymap ,gnus-mime-security-button-map
- gnus-callback gnus-mime-security-show-details
+ gnus-callback gnus-mime-security-press-button
article-type annotation
gnus-data ,handle))
(setq e (point))
"%S: show detail"
(aref gnus-mouse-2 0))))))
+(defun gnus-mime-display-security (handle)
+ (save-restriction
+ (narrow-to-region (point) (point))
+ (gnus-insert-mime-security-button handle)
+ (gnus-mime-display-mixed (cdr handle))
+ (unless (bolp)
+ (insert "\n"))
+ (let ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol)))
+ (insert "[End of "
+ (or (nth 2 (assoc protocol mm-verify-function-alist))
+ (nth 2 (assoc protocol mm-decrypt-function-alist))
+ "Unknown")
+ (if (equal (car handle) "multipart/signed")
+ " Signed" " Encrypted")
+ "]\n"))
+ (mm-set-handle-multipart-parameter handle 'gnus-region
+ (cons (set-marker (make-marker)
+ (point-min))
+ (set-marker (make-marker)
+ (point-max))))))
+
(gnus-ems-redefine)
(provide 'gnus-art)
(defvar mm-verify-function-alist
'(("application/pgp-signature" mml2015-verify "PGP" mml2015-verify-test)
+ ("application/x-gnus-pgp-signature" mm-uu-pgp-signed-extract-1 "PGP"
+ mm-uu-pgp-signed-test)
("application/pkcs7-signature" mml-smime-verify "S/MIME"
mml-smime-verify-test)
("application/x-pkcs7-signature" mml-smime-verify "S/MIME"
(autoload 'mml2015-decrypt-test "mml2015")
(defvar mm-decrypt-function-alist
- '(("application/pgp-encrypted" mml2015-decrypt "PGP" mml2015-decrypt-test)))
+ '(("application/pgp-encrypted" mml2015-decrypt "PGP" mml2015-decrypt-test)
+ ("application/x-gnus-pgp-encrypted" mm-uu-pgp-encrypted-extract-1 "PGP"
+ mm-uu-pgp-encrypted-test)))
(defcustom mm-decrypt-option nil
"Option of decrypting signed parts.
(kill-buffer (get-text-property 0 'buffer handle))))
((and (listp handle)
(stringp (car handle)))
- (mm-destroy-parts (cdr handle)))
+ (mm-destroy-parts handle))
(t
(mm-destroy-part handle)))))))
(defun mm-find-raw-part-by-type (ctl type &optional notp)
(goto-char (point-min))
- (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary)))
- (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$"))
+ (let* ((boundary (concat "--" (mm-handle-multipart-ctl-parameter ctl
+ 'boundary)))
+ (close-delimiter (concat "^" (regexp-quote boundary) "--[ \t]*$"))
start
(end (save-excursion
(goto-char (point-max))
(match-beginning 0)
(point-max))))
result)
- (setq boundary (concat (regexp-quote boundary) "[ \t]*$"))
+ (setq boundary (concat "^" (regexp-quote boundary) "[ \t]*$"))
(while (and (not result)
(re-search-forward boundary end t))
(goto-char (match-beginning 0))
(when start
(save-excursion
(save-restriction
- (narrow-to-region start (point))
+ (narrow-to-region start (1- (point)))
(when (let ((ctl (ignore-errors
(mail-header-parse-content-type
(mail-fetch-field "content-type")))))
(not (equal (car ctl) type))
(equal (car ctl) type)))
(setq result (buffer-substring (point-min) (point-max)))))))
- (forward-line 2)
+ (forward-line 1)
(setq start (point)))
(when (and (not result) start)
(save-excursion
protocol func functest)
(cond
((equal subtype "signed")
- (unless (and (setq protocol (mail-content-type-get ctl 'protocol))
+ (unless (and (setq protocol
+ (mm-handle-multipart-ctl-parameter ctl 'protocol))
(not (equal protocol "multipart/mixed")))
;; The message is broken or draft-ietf-openpgp-multsig-01.
(let ((protocols mm-verify-function-alist))
mm-security-handle 'gnus-details
(format "Unknown sign protocol (%s)" protocol))))))
((equal subtype "encrypted")
- (unless (setq protocol (mail-content-type-get ctl 'protocol))
+ (unless (setq protocol
+ (mm-handle-multipart-ctl-parameter ctl 'protocol))
;; The message is broken.
(let ((parts parts))
(while parts
(defsubst mm-uu-function-2 (entry)
(nth 5 entry))
-(defun mm-uu-copy-to-buffer (from to)
+(defun mm-uu-copy-to-buffer (&optional from to)
"Copy the contents of the current buffer to a fresh buffer."
(save-excursion
(let ((obuf (current-buffer)))
(narrow-to-region (point) end-point)
(mm-dissect-buffer t)))
-(defun mm-uu-pgp-signed-test ()
+(defun mm-uu-pgp-signed-test (&rest rest)
(and
mml2015-use
(mml2015-clear-verify-function)
((eq mm-verify-option 'known) t)
(t (y-or-n-p "Verify pgp signed part?")))))
-(defun mm-uu-pgp-signed-extract ()
- (let ((buf (mm-uu-copy-to-buffer start-point end-point))
- (mm-security-handle (list (format "multipart/signed"))))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'protocol "application/pgp-signature")
+(defun mm-uu-pgp-signed-extract-1 (handles ctl)
+ (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))))
(with-current-buffer buf
(if (mm-uu-pgp-signed-test)
(progn
(delete-region (point-min) (point)))
(if (re-search-forward mm-uu-pgp-beginning-signature nil t)
(delete-region (match-beginning 0) (point-max))))
- (setcdr mm-security-handle
- (list
- (mm-make-handle buf
- '("text/plain" (charset . gnus-decoded)))))
+ (list
+ (mm-make-handle buf
+ '("text/plain" (charset . gnus-decoded))))))
+
+(defun mm-uu-pgp-signed-extract ()
+ (let ((mm-security-handle (list (format "multipart/signed"))))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'protocol "application/x-gnus-pgp-signature")
+ (save-restriction
+ (narrow-to-region start-point end-point)
+ (add-text-properties 0 (length (car mm-security-handle))
+ (list 'buffer (mm-uu-copy-to-buffer))
+ (car mm-security-handle))
+ (setcdr mm-security-handle
+ (mm-uu-pgp-signed-extract-1 nil
+ mm-security-handle)))
mm-security-handle))
-(defun mm-uu-pgp-encrypted-test ()
+(defun mm-uu-pgp-encrypted-test (&rest rest)
(and
mml2015-use
(mml2015-clear-decrypt-function)
((eq mm-decrypt-option 'known) t)
(t (y-or-n-p "Decrypt pgp encrypted part?")))))
-(defun mm-uu-pgp-encrypted-extract ()
- (let ((buf (mm-uu-copy-to-buffer start-point end-point))
- (mm-security-handle (list (format "multipart/encrypted"))))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'protocol "application/pgp-encrypted")
+(defun mm-uu-pgp-encrypted-extract-1 (handles ctl)
+ (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))))
(if (mm-uu-pgp-encrypted-test)
(with-current-buffer buf
(mml2015-clean-buffer)
(funcall (mml2015-clear-decrypt-function))))
- (setcdr mm-security-handle
- (list
- (mm-make-handle buf
- '("text/plain" (charset . gnus-decoded)))))
+ (list
+ (mm-make-handle buf
+ '("text/plain" (charset . gnus-decoded))))))
+
+(defun mm-uu-pgp-encrypted-extract ()
+ (let ((mm-security-handle (list (format "multipart/encrypted"))))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'protocol "application/x-gnus-pgp-encrypted")
+ (save-restriction
+ (narrow-to-region start-point end-point)
+ (add-text-properties 0 (length (car mm-security-handle))
+ (list 'buffer (mm-uu-copy-to-buffer))
+ (car mm-security-handle))
+ (setcdr mm-security-handle
+ (mm-uu-pgp-encrypted-extract-1 nil
+ mm-security-handle)))
mm-security-handle))
(defun mm-uu-gpg-key-skip-to-last ()
(catch 'error
(let (part)
(unless (setq part (mm-find-raw-part-by-type
- ctl (or (mail-content-type-get ctl 'protocol)
+ ctl (or (mm-handle-multipart-ctl-parameter
+ ctl 'protocol)
"application/pgp-signature")
t))
(mm-set-handle-multipart-parameter
(insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
(insert (format "Hash: %s\n\n"
(or (mml2015-fix-micalg
- (mail-content-type-get ctl 'micalg))
+ (mm-handle-multipart-ctl-parameter
+ ctl 'micalg))
"SHA1")))
(save-restriction
(narrow-to-region (point) (point))
(catch 'error
(let (part message signature)
(unless (setq part (mm-find-raw-part-by-type
- ctl (or (mail-content-type-get ctl 'protocol)
+ ctl (or (mm-handle-multipart-ctl-parameter
+ ctl 'protocol)
"application/pgp-signature")
t))
(mm-set-handle-multipart-parameter
projects / gnus / commitdiff