X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmml2015.el;h=973d50ffd04d53b169309c568192a0e1e9976ebf;hb=8ea1f15fd54f5a6b6bc71dd0b6c155ab77f474c1;hp=e4bf3d9512bff70d446e1a6efe095559a2fa8e9d;hpb=71d9510a61230c0ce89512eb25037af553991b40;p=gnus diff --git a/lisp/mml2015.el b/lisp/mml2015.el index e4bf3d951..973d50ffd 100644 --- a/lisp/mml2015.el +++ b/lisp/mml2015.el @@ -48,15 +48,13 @@ 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) @@ -69,8 +67,7 @@ (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) @@ -78,29 +75,51 @@ (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")) - (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 @@ -109,32 +128,53 @@ alg))) (defun mml2015-mailcrypt-verify (handle ctl) - (let (part) - (unless (setq part (mm-find-raw-part-by-type - ctl "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")) - (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."))) - -(defun mml2015-mailcrypt-clear-snarf () - (funcall mml2015-snarf-function)) + (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) @@ -175,19 +215,21 @@ (goto-char (point-max)))) (defun mml2015-mailcrypt-encrypt (cont) - (mc-encrypt-generic - (or (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (mc-cleanup-recipient-headers - (read-string "Recipients: ")))) - nil nil nil - (message-options-get 'message-sender) - (or mc-pgp-always-sign - (eq t - (or (message-options-get 'message-sign-encrypt) - (message-options-set 'message-sign-encrypt - (or (y-or-n-p "Sign the message? ") - 'not)))))) + (let ((mc-pgp-always-sign + (or mc-pgp-always-sign + (eq t (or (message-options-get 'message-sign-encrypt) + (message-options-set + 'message-sign-encrypt + (or (y-or-n-p "Sign the message? ") + 'not)))) + 'never))) + (mc-encrypt-generic + (or (message-options-get 'message-recipients) + (message-options-set 'message-recipients + (mc-cleanup-recipient-headers + (read-string "Recipients: ")))) + nil nil nil + (message-options-get 'message-sender))) (let ((boundary (funcall mml-boundary-function (incf mml-multipart-number)))) (goto-char (point-min)) @@ -229,7 +271,9 @@ ;; 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) @@ -239,27 +283,41 @@ (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 "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")) - (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 @@ -339,9 +397,6 @@ (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))) @@ -356,6 +411,10 @@ (funcall func handle ctl) handle))) +;;;###autoload +(defun mml2015-decrypt-test (handle ctl) + mml2015-use) + ;;;###autoload (defun mml2015-verify (handle ctl) (mml2015-clean-buffer) @@ -364,6 +423,10 @@ (funcall func handle ctl) handle))) +;;;###autoload +(defun mml2015-verify-test (handle ctl) + mml2015-use) + ;;;###autoload (defun mml2015-encrypt (cont) (mml2015-clean-buffer) @@ -380,6 +443,10 @@ (funcall func cont) (error "Cannot find sign function.")))) +;;;###autoload +(defun mml2015-self-encrypt () + (mml2015-encrypt nil)) + (provide 'mml2015) ;;; mml2015.el ends here