+2000-11-07 14:33:19 ShengHuo ZHU <zsh@cs.rochester.edu>
+
+ * gnus-art.el (gnus-mime-display-part): Show MIME security button.
+ (gnus-insert-mime-security-button): New function.
+ * mm-decode.el (mm-possibly-verify-or-decrypt): Add security info.
+ * mml2015.el: Add security info when verify or decrypt.
+ * mm-uu.el (mm-uu-pgp-signed-extract): Use multipart.
+ (mm-uu-pgp-encrypted-extract): Ditto.
+
2000-11-07 08:49:36 ShengHuo ZHU <zsh@cs.rochester.edu>
* mm-decode.el (mm-display-parts): 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)))
((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)))
(t
(gnus-mime-display-mixed (cdr handle)))))
(gnus-cache-update-article
(car gnus-article-current) (cdr gnus-article-current))))))))
+(defvar gnus-mime-security-button-line-format "%{%([[%t:%i]]%)%}\n"
+ "The following specs can be used:
+%t The security MIME type
+%i Additional info")
+
+(defvar gnus-mime-security-button-line-format-alist
+ '((?t gnus-tmp-type ?s)
+ (?i gnus-tmp-info ?s)))
+
+(defvar gnus-mime-security-button-map
+ (let ((map (make-sparse-keymap)))
+ (set-keymap-parent map gnus-article-mode-map)
+ (define-key map gnus-mouse-2 'gnus-article-push-button)
+ (define-key map "\r" 'gnus-article-press-button)
+ map))
+
+(defvar gnus-mime-security-details-buffer nil)
+
+(defun gnus-mime-security-show-details (handle)
+ (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details)))
+ (if details
+ (progn
+ (if (gnus-buffer-live-p gnus-mime-security-details-buffer)
+ (with-current-buffer gnus-mime-security-details-buffer
+ (erase-buffer)
+ t)
+ (setq gnus-mime-security-details-buffer
+ (gnus-get-buffer-create "*MIME Security Details*")))
+ (with-current-buffer gnus-mime-security-details-buffer
+ (insert details))
+ (pop-to-buffer gnus-mime-security-details-buffer))
+ (gnus-message 5 "No details."))))
+
+(defun gnus-insert-mime-security-button (handle &optional displayed)
+ (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol))
+ (gnus-tmp-type
+ (concat
+ (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")))
+ (gnus-tmp-info
+ (or (mm-handle-multipart-ctl-parameter handle 'gnus-info)
+ "Undecided"))
+ b e)
+ (unless (bolp)
+ (insert "\n"))
+ (setq b (point))
+ (gnus-eval-format
+ gnus-mime-security-button-line-format
+ 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
+ article-type annotation
+ gnus-data ,handle))
+ (setq e (point))
+ (widget-convert-button
+ 'link b e
+ :mime-handle handle
+ :action 'gnus-widget-press-button
+ :button-keymap gnus-mime-security-button-map
+ :help-echo
+ (lambda (widget/window &optional overlay pos)
+ ;; Needed to properly clear the message due to a bug in
+ ;; wid-edit (XEmacs only).
+ (if (boundp 'help-echo-owns-message)
+ (setq help-echo-owns-message t))
+ (format
+ "%S: show detail"
+ (aref gnus-mouse-2 0))))))
+
(gnus-ems-redefine)
(provide 'gnus-art)
(setq result (buffer-substring (point-min) (point-max)))))))
result))
+(defvar mm-security-handle nil)
+
+(defsubst mm-set-handle-multipart-parameter (handle parameter value)
+ ;; HANDLE could be a CTL.
+ (if handle
+ (put-text-property 0 (length (car handle)) parameter value
+ (car handle))))
+
(defun mm-possibly-verify-or-decrypt (parts ctl)
(let ((subtype (cadr (split-string (car ctl) "/")))
+ (mm-security-handle ctl) ;; (car CTL) is the type.
protocol func functest)
(cond
((equal subtype "signed")
(format "Verify signed (%s) part? "
(or (nth 2 (assoc protocol mm-verify-function-alist))
(format "protocol=%s" protocol))))))
- (condition-case err
- (save-excursion
- (if func
- (funcall func parts ctl)
- (error (format "Unknown sign protocol (%s)" protocol))))
- (error
- (unless (y-or-n-p (format "%s, continue? " err))
- (error "Verify failure."))))))
+ (save-excursion
+ (if func
+ (funcall func parts ctl)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (format "Unknown sign protocol (%s)" protocol))))))
((equal subtype "encrypted")
(unless (setq protocol (mail-content-type-get ctl 'protocol))
;; The message is broken.
(format "Decrypt (%s) part? "
(or (nth 2 (assoc protocol mm-decrypt-function-alist))
(format "protocol=%s" protocol))))))
- (condition-case err
- (save-excursion
- (if func
- (setq parts (funcall func parts ctl))
- (error (format "Unknown encrypt protocol (%s)" protocol))))
- (error
- (unless (y-or-n-p (format "%s, continue? " err))
- (error "Decrypt failure."))))))
+ (save-excursion
+ (if func
+ (setq parts (funcall func parts ctl))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (format "Unknown encrypt protocol (%s)" protocol))))))
(t nil))
parts))
(t (y-or-n-p "Verify pgp signed part?")))))
(defun mm-uu-pgp-signed-extract ()
- (or (memq 'signed gnus-article-wash-types)
- (push 'signed gnus-article-wash-types))
- (let ((buf (mm-uu-copy-to-buffer start-point end-point)))
+ (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")
(with-current-buffer buf
- (condition-case err
- (funcall (mml2015-clear-verify-function))
- (error
- (unless (y-or-n-p (format "%s, continue?" err))
- (kill-buffer buf)
- (error "Verify failure."))))
+ (funcall (mml2015-clear-verify-function))
(goto-char (point-min))
(if (search-forward "\n\n" nil t)
(delete-region (point-min) (point)))
(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)))))
+ (setcdr mm-security-handle
+ (list
+ (mm-make-handle buf
+ '("text/plain" (charset . gnus-decoded)))))
+ mm-security-handle))
(defun mm-uu-pgp-encrypted-test ()
(and
(t (y-or-n-p "Decrypt pgp encrypted part?")))))
(defun mm-uu-pgp-encrypted-extract ()
- (or (memq 'encrypted gnus-article-wash-types)
- (push 'encrypted gnus-article-wash-types))
- (let ((buf (mm-uu-copy-to-buffer start-point end-point)))
+ (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")
(with-current-buffer buf
- (condition-case err
- (funcall (mml2015-clear-decrypt-function))
- (error
- (unless (y-or-n-p (format "%s, continue?" err))
- (kill-buffer buf)
- (error "Decrypt failure.")))))
- (mm-make-handle buf
- '("text/plain" (charset . gnus-decoded)))))
+ (funcall (mml2015-clear-decrypt-function)))
+ (setcdr mm-security-handle
+ (list
+ (mm-make-handle buf
+ '("text/plain" (charset . gnus-decoded)))))
+ mm-security-handle))
(defun mm-uu-gpg-key-skip-to-last ()
(let ((point (point))
(defvar mml2015-verify-function 'mailcrypt-verify)
(defun mml2015-mailcrypt-decrypt (handle ctl)
- (let (child handles result)
- (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)
- (setq result (funcall mml2015-decrypt-function))
- (unless (car result)
- (error "Decrypting error."))
- (setq handles (mm-dissect-buffer t)))
- (mm-destroy-parts handle)
- (if (listp (car handles))
- handles
- (list handles))))
+ (catch 'error
+ (let (child handles result)
+ (unless (setq child (mm-find-part-by-type
+ (cdr handle)
+ "application/octet-stream" nil t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Corrupted")
+ (throw 'error handle))
+ (with-temp-buffer
+ (mm-insert-part child)
+ (setq result
+ (condition-case err
+ (funcall mml2015-decrypt-function)
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (cadr err))
+ nil)))
+ (unless (car result)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed")
+ (throw 'error handle))
+ (setq handles (mm-dissect-buffer t)))
+ (mm-destroy-parts handle)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "OK")
+ (if (listp (car handles))
+ handles
+ (list handles)))))
(defun mml2015-mailcrypt-clear-decrypt ()
(let (result)
- (setq result (funcall mml2015-decrypt-function))
- (unless (car result)
- (error "Decrypting error."))))
+ (setq result
+ (condition-case err
+ (funcall mml2015-decrypt-function)
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (cadr err))
+ nil)))
+ (if (car result)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "OK")
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed"))))
(defun mml2015-fix-micalg (alg)
(upcase
alg)))
(defun mml2015-mailcrypt-verify (handle ctl)
- (let (part)
- (unless (setq part (mm-find-raw-part-by-type
- 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 (format "Hash: %s\n\n"
- (or (mml2015-fix-micalg
- (mail-content-type-get ctl 'micalg))
- "SHA1")))
- (insert part "\n")
- (goto-char (point-max))
- (unless (setq part (mm-find-part-by-type
- (cdr handle) "application/pgp-signature" nil t))
- (error "Corrupted pgp-signature part."))
- (mm-insert-part part)
- (unless (funcall mml2015-verify-function)
- (error "Verify error.")))
- handle))
+ (catch 'error
+ (let (part)
+ (unless (setq part (mm-find-raw-part-by-type
+ ctl (or (mail-content-type-get ctl 'protocol)
+ "application/pgp-signature")
+ t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Corrupted")
+ (throw 'error handle))
+ (with-temp-buffer
+ (insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
+ (insert (format "Hash: %s\n\n"
+ (or (mml2015-fix-micalg
+ (mail-content-type-get ctl 'micalg))
+ "SHA1")))
+ (insert part "\n")
+ (goto-char (point-max))
+ (unless (setq part (mm-find-part-by-type
+ (cdr handle) "application/pgp-signature" nil t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Corrupted")
+ (throw 'error handle))
+ (mm-insert-part part)
+ (unless (condition-case err
+ (funcall mml2015-verify-function)
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (cadr err))
+ nil))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed")
+ (throw 'error handle)))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "OK")
+ handle)))
(defun mml2015-mailcrypt-clear-verify ()
- (unless (funcall mml2015-verify-function)
- (error "Verify error.")))
+ (if (condition-case err
+ (funcall mml2015-verify-function)
+ (error
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details (cadr err))
+ nil))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "OK")
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed")))
(defun mml2015-mailcrypt-sign (cont)
(mc-sign-generic (message-options-get 'message-sender)
;; Some wrong with the return value, check plain text buffer.
(if (> (point-max) (point-min))
'(t)
- (pop-to-buffer mml2015-result-buffer)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (buffer-string mml2015-result-buffer))
nil))))
(defun mml2015-gpg-decrypt (handle ctl)
(defun mml2015-gpg-clear-decrypt ()
(let (result)
(setq result (mml2015-gpg-decrypt-1))
- (unless (car result)
- (error "Decrypting error."))))
+ (if (car result)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "OK")
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed"))))
(defun mml2015-gpg-verify (handle ctl)
- (let (part message signature)
- (unless (setq part (mm-find-raw-part-by-type
- ctl (or (mail-content-type-get ctl 'protocol)
- "application/pgp-signature")
- t))
- (error "Corrupted pgp-signature part."))
- (with-temp-buffer
- (setq message (current-buffer))
- (insert part)
+ (catch 'error
+ (let (part message signature)
+ (unless (setq part (mm-find-raw-part-by-type
+ ctl (or (mail-content-type-get ctl 'protocol)
+ "application/pgp-signature")
+ t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Corrupted")
+ (throw 'error handle))
(with-temp-buffer
- (setq signature (current-buffer))
- (unless (setq part (mm-find-part-by-type
- (cdr handle) "application/pgp-signature" nil t))
- (error "Corrupted pgp-signature part."))
- (mm-insert-part part)
- (unless (gpg-verify message signature mml2015-result-buffer)
- (pop-to-buffer mml2015-result-buffer)
- (error "Verify error.")))))
- handle)
+ (setq message (current-buffer))
+ (insert part)
+ (with-temp-buffer
+ (setq signature (current-buffer))
+ (unless (setq part (mm-find-part-by-type
+ (cdr handle) "application/pgp-signature" nil t))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Corrupted")
+ (throw 'error handle))
+ (mm-insert-part part)
+ (unless (gpg-verify message signature mml2015-result-buffer)
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-details
+ (buffer-string mml2015-result-buffer))
+ (mm-set-handle-multipart-parameter
+ mm-security-handle 'gnus-info "Failed")
+ (throw 'error handle))))
+ handle)))
(defun mml2015-gpg-sign (cont)
(let ((boundary
projects / gnus / commitdiff