X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmml2015.el;h=4c67096ad76c3676dd0b7be4c8c9f3df89dc41aa;hb=82d219ce980dc263c9288225f901635336101fb4;hp=dfd62be406989805e9e08ea6e0b501cd89d317f4;hpb=9b54d771227e20c07aca6e1e3019f7169720726c;p=gnus diff --git a/lisp/mml2015.el b/lisp/mml2015.el index dfd62be40..4c67096ad 100644 --- a/lisp/mml2015.el +++ b/lisp/mml2015.el @@ -53,7 +53,7 @@ mml2015-gpg-encrypt mml2015-gpg-verify mml2015-gpg-decrypt - nil + mml2015-gpg-clear-verify mml2015-gpg-clear-decrypt)) "Alist of PGP/MIME functions.") @@ -77,27 +77,57 @@ (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) + (quit + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + 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) + (quit + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + 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 @@ -106,42 +136,85 @@ 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 (mm-handle-multipart-ctl-parameter + 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 + (mm-handle-multipart-ctl-parameter + ctl 'micalg)) + "SHA1"))) + (save-restriction + (narrow-to-region (point) (point)) + (insert part "\n") + (goto-char (point-min)) + (while (not (eobp)) + (if (looking-at "^-") + (insert "- ")) + (forward-line))) + (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)) + (save-restriction + (narrow-to-region (point) (point)) + (mm-insert-part part) + (goto-char (point-min)) + (if (re-search-forward "^-----BEGIN PGP [^-]+-----\r?$" nil t) + (replace-match "-----BEGIN PGP SIGNATURE-----" t t)) + (if (re-search-forward "^-----END PGP [^-]+-----\r?$" nil t) + (replace-match "-----END PGP SIGNATURE-----" t t))) + (unless (condition-case err + (funcall mml2015-verify-function) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (cadr err)) + nil) + (quit + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + 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) + (quit + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + 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) nil nil nil nil) (let ((boundary (funcall mml-boundary-function (incf mml-multipart-number))) - (scheme-alist (funcall (or mc-default-scheme - (cdr (car mc-schemes))))) - hash) + hash point) (goto-char (point-min)) - (unless (re-search-forward (cdr (assq 'signed-begin-line scheme-alist))) + (unless (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\r?$" nil t) (error "Cannot find signed begin line." )) (goto-char (match-beginning 0)) (forward-line 1) @@ -157,13 +230,23 @@ (insert (format "\tmicalg=pgp-%s; protocol=\"application/pgp-signature\"\n" (downcase hash))) (insert (format "\n--%s\n" boundary)) + (setq point (point)) (goto-char (point-max)) - (unless (re-search-backward (cdr (assq 'signed-end-line scheme-alist))) + (unless (re-search-backward "^-----END PGP SIGNATURE-----\r?$" nil t) (error "Cannot find signature part." )) + (replace-match "-----END PGP MESSAGE-----" t t) (goto-char (match-beginning 0)) - (unless (re-search-backward "^-+BEGIN" nil t) + (unless (re-search-backward "^-----BEGIN PGP SIGNATURE-----\r?$" + nil t) (error "Cannot find signature part." )) + (replace-match "-----BEGIN PGP MESSAGE-----" t t) (goto-char (match-beginning 0)) + (save-restriction + (narrow-to-region point (point)) + (goto-char point) + (while (re-search-forward "^- -" nil t) + (replace-match "-" t t)) + (goto-char (point-max))) (insert (format "--%s\n" boundary)) (insert "Content-Type: application/pgp-signature\n\n") (goto-char (point-max)) @@ -179,16 +262,19 @@ (or (y-or-n-p "Sign the message? ") 'not)))) 'never))) - (mc-encrypt-generic - (or (message-options-get 'message-recipients) - (message-options-set 'message-recipients + (mm-with-unibyte-current-buffer-mule4 + (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))) + nil nil nil + (message-options-get 'message-sender)))) + (goto-char (point-min)) + (unless (looking-at "-----BEGIN PGP MESSAGE-----") + (error "Fail to encrypt the message.")) (let ((boundary (funcall mml-boundary-function (incf mml-multipart-number)))) - (goto-char (point-min)) (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n" boundary)) (insert "\tprotocol=\"application/pgp-encrypted\"\n\n") @@ -227,7 +313,10 @@ ;; 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 + (with-current-buffer mml2015-result-buffer + (buffer-string))) nil)))) (defun mml2015-gpg-decrypt (handle ctl) @@ -237,29 +326,70 @@ (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 (mm-handle-multipart-ctl-parameter + 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 (condition-case err + (gpg-verify message signature mml2015-result-buffer) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (cadr err)) + nil) + (quit + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + nil)) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + (with-current-buffer mml2015-result-buffer + (buffer-string))) + (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-gpg-clear-verify () + (if (condition-case err + (funcall mml2015-verify-function) + (error + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details (cadr err)) + nil) + (quit + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details "Quit.") + 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-gpg-sign (cont) (let ((boundary @@ -297,36 +427,37 @@ (funcall mml-boundary-function (incf mml-multipart-number))) (text (current-buffer)) cipher) - (with-temp-buffer - (unless (gpg-sign-encrypt - text (setq cipher (current-buffer)) - mml2015-result-buffer - (split-string - (or - (message-options-get 'message-recipients) - (message-options-set 'message-recipients - (read-string "Recipients: "))) - "[ \f\t\n\r\v,]+") - nil - (message-options-get 'message-sender) - t t) ; armor & textmode - (unless (> (point-max) (point-min)) - (pop-to-buffer mml2015-result-buffer) - (error "Encrypt error."))) - (set-buffer text) - (delete-region (point-min) (point-max)) - (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n" - boundary)) - (insert "\tprotocol=\"application/pgp-encrypted\"\n\n") - (insert (format "--%s\n" boundary)) - (insert "Content-Type: application/pgp-encrypted\n\n") - (insert "Version: 1\n\n") - (insert (format "--%s\n" boundary)) - (insert "Content-Type: application/octet-stream\n\n") - (insert-buffer cipher) - (goto-char (point-max)) - (insert (format "--%s--\n" boundary)) - (goto-char (point-max))))) + (mm-with-unibyte-current-buffer-mule4 + (with-temp-buffer + (unless (gpg-sign-encrypt + text (setq cipher (current-buffer)) + mml2015-result-buffer + (split-string + (or + (message-options-get 'message-recipients) + (message-options-set 'message-recipients + (read-string "Recipients: "))) + "[ \f\t\n\r\v,]+") + nil + (message-options-get 'message-sender) + t t) ; armor & textmode + (unless (> (point-max) (point-min)) + (pop-to-buffer mml2015-result-buffer) + (error "Encrypt error."))) + (set-buffer text) + (delete-region (point-min) (point-max)) + (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n" + boundary)) + (insert "\tprotocol=\"application/pgp-encrypted\"\n\n") + (insert (format "--%s\n" boundary)) + (insert "Content-Type: application/pgp-encrypted\n\n") + (insert "Version: 1\n\n") + (insert (format "--%s\n" boundary)) + (insert "Content-Type: application/octet-stream\n\n") + (insert-buffer cipher) + (goto-char (point-max)) + (insert (format "--%s--\n" boundary)) + (goto-char (point-max)))))) ;;; General wrapper