X-Git-Url: https://cgit.sxemacs.org/?p=gnus;a=blobdiff_plain;f=lisp%2Fmml2015.el;h=09c9a964c661a99b3f9f3963c1875d7978c868cf;hp=4bfc3a21121853cf2d2732528bfa531bd2de450c;hb=125d88b46ad2efa065f06d5dac37a245b488985a;hpb=14f63eb4878b32f38454d520f132b758f64a9e09 diff --git a/lisp/mml2015.el b/lisp/mml2015.el index 4bfc3a211..09c9a964c 100644 --- a/lisp/mml2015.el +++ b/lisp/mml2015.el @@ -1,5 +1,5 @@ ;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP) -;; Copyright (C) 2000, 2001, 2002 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: PGP MIME MML @@ -31,11 +31,15 @@ (eval-when-compile (require 'cl)) (require 'mm-decode) (require 'mm-util) +(require 'mml) (defvar mml2015-use (or (progn (ignore-errors - (require 'pgg)) + ;; Avoid the "Recursive load suspected" error + ;; in Emacs 21.1. + (let ((recursive-load-depth-limit 100)) + (require 'pgg))) (and (fboundp 'pgg-sign-region) 'pgg)) (progn @@ -49,7 +53,8 @@ (fboundp 'mc-sign-generic) (fboundp 'mc-cleanup-recipient-headers) 'mailcrypt))) - "The package used for PGP/MIME.") + "The package used for PGP/MIME. +Valid packages include `pgg', `gpg' and `mailcrypt'.") ;; Something is not RFC2015. (defvar mml2015-function-alist @@ -75,17 +80,15 @@ (defvar mml2015-result-buffer nil) -(defvar mml2015-trust-boundaries-alist - '((trust-undefined . nil) - (trust-none . nil) - (trust-marginal . t) - (trust-full . t) - (trust-ultimate . t)) - "Trust boundaries for a signer's GnuPG key. -This alist contains pairs of the form (trust-symbol . boolean), with -symbols that are contained in `gpg-unabbrev-trust-alist'. The boolean -specifies whether the given trust value is good enough to be trusted -by you.") +(defcustom mml2015-unabbrev-trust-alist + '(("TRUST_UNDEFINED" . nil) + ("TRUST_NEVER" . nil) + ("TRUST_MARGINAL" . t) + ("TRUST_FULLY" . t) + ("TRUST_ULTIMATE" . t)) + "Map GnuPG trust output values to a boolean saying if you trust the key." + :type '(repeat (cons (regexp :tag "GnuPG output regexp") + (boolean :tag "Trust key")))) ;;; mailcrypt wrapper @@ -278,8 +281,7 @@ by you.") (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))) + (let ((boundary (mml-compute-boundary cont)) hash point) (goto-char (point-min)) (unless (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\r?$" nil t) @@ -331,7 +333,7 @@ by you.") (or (y-or-n-p "Sign the message? ") 'not)))) 'never))) - (mm-with-unibyte-current-buffer-mule4 + (mm-with-unibyte-current-buffer (mc-encrypt-generic (or (message-options-get 'message-recipients) (message-options-set 'message-recipients @@ -342,8 +344,7 @@ by you.") (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)))) + (let ((boundary (mml-compute-boundary cont))) (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n" boundary)) (insert "\tprotocol=\"application/pgp-encrypted\"\n\n") @@ -383,7 +384,7 @@ by you.") (buffer-string))) (set-buffer cipher) (erase-buffer) - (insert-buffer plain) + (insert-buffer-substring plain) (goto-char (point-min)) (while (search-forward "\r\n" nil t) (replace-match "\n" t t)))) @@ -427,39 +428,36 @@ by you.") (defun mml2015-gpg-extract-signature-details () (goto-char (point-min)) - (if (and (eq mml2015-use 'gpg) - (boundp 'gpg-unabbrev-trust-alist)) - (let* ((expired (re-search-forward - "^\\[GNUPG:\\] SIGEXPIRED$" - nil t)) - (signer (and (re-search-forward - "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$" - nil t) - (cons (match-string 1) (match-string 2)))) - (fprint (and (re-search-forward - "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) " - nil t) - (match-string 1))) - (trust (and (re-search-forward - "^\\[GNUPG:\\] \\(TRUST_.*\\)$" - nil t) - (match-string 1))) - (trust-good-enough-p - (cdr (assoc (cdr (assoc trust gpg-unabbrev-trust-alist)) - mml2015-trust-boundaries-alist)))) - (cond ((and signer fprint) - (concat (cdr signer) - (unless trust-good-enough-p - (concat "\nUntrusted, Fingerprint: " - (mml2015-gpg-pretty-print-fpr fprint))) - (when expired - (format "\nWARNING: Signature from expired key (%s)" - (car signer))))) - (t - "From unknown user"))) - (if (re-search-forward "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t) - (match-string 2) - "From unknown user"))) + (let* ((expired (re-search-forward + "^\\[GNUPG:\\] SIGEXPIRED$" + nil t)) + (signer (and (re-search-forward + "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$" + nil t) + (cons (match-string 1) (match-string 2)))) + (fprint (and (re-search-forward + "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) " + nil t) + (match-string 1))) + (trust (and (re-search-forward + "^\\[GNUPG:\\] \\(TRUST_.*\\)$" + nil t) + (match-string 1))) + (trust-good-enough-p + (cdr (assoc trust mml2015-unabbrev-trust-alist)))) + (cond ((and signer fprint) + (concat (cdr signer) + (unless trust-good-enough-p + (concat "\nUntrusted, Fingerprint: " + (mml2015-gpg-pretty-print-fpr fprint))) + (when expired + (format "\nWARNING: Signature from expired key (%s)" + (car signer))))) + ((re-search-forward + "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t) + (match-string 2)) + (t + "From unknown user")))) (defun mml2015-gpg-verify (handle ctl) (catch 'error @@ -548,8 +546,7 @@ by you.") mm-security-handle 'gnus-info "Failed"))) (defun mml2015-gpg-sign (cont) - (let ((boundary - (funcall mml-boundary-function (incf mml-multipart-number))) + (let ((boundary (mml-compute-boundary cont)) (text (current-buffer)) signature) (goto-char (point-max)) (unless (bolp) @@ -576,17 +573,16 @@ by you.") (goto-char (point-max)) (insert (format "\n--%s\n" boundary)) (insert "Content-Type: application/pgp-signature\n\n") - (insert-buffer signature) + (insert-buffer-substring signature) (goto-char (point-max)) (insert (format "--%s--\n" boundary)) (goto-char (point-max))))) (defun mml2015-gpg-encrypt (cont &optional sign) - (let ((boundary - (funcall mml-boundary-function (incf mml-multipart-number))) + (let ((boundary (mml-compute-boundary cont)) (text (current-buffer)) cipher) - (mm-with-unibyte-current-buffer-mule4 + (mm-with-unibyte-current-buffer (with-temp-buffer ;; set up a function to call the correct gpg encrypt routine ;; with the right arguments. (FIXME: this should be done @@ -630,7 +626,7 @@ by you.") (insert "Version: 1\n\n") (insert (format "--%s\n" boundary)) (insert "Content-Type: application/octet-stream\n\n") - (insert-buffer cipher) + (insert-buffer-substring cipher) (goto-char (point-max)) (insert (format "--%s--\n" boundary)) (goto-char (point-max)))))) @@ -664,7 +660,10 @@ by you.") (pgg-decrypt-region (point-min) (point-max)) (setq decrypt-status (with-current-buffer mml2015-result-buffer - (buffer-string)))) + (buffer-string))) + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-details + decrypt-status)) (error (mm-set-handle-multipart-parameter mm-security-handle 'gnus-details (mml2015-format-error err)) @@ -674,6 +673,9 @@ by you.") mm-security-handle 'gnus-details "Quit.") nil)) (with-current-buffer pgg-output-buffer + (goto-char (point-min)) + (while (search-forward "\r\n" nil t) + (replace-match "\n" t t)) (setq handles (mm-dissect-buffer t)) (mm-destroy-parts handle) (mm-set-handle-multipart-parameter @@ -701,7 +703,10 @@ by you.") (buffer-string)))) (progn (erase-buffer) - (insert-buffer pgg-output-buffer) + (insert-buffer-substring pgg-output-buffer) + (goto-char (point-min)) + (while (search-forward "\r\n" nil t) + (replace-match "\n" t t)) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "OK")) (mm-set-handle-multipart-parameter @@ -737,11 +742,17 @@ by you.") (mm-insert-part signature)) (if (condition-case err (prog1 - (pgg-verify-region (point-min) (point-max) signature-file t) + (pgg-verify-region (point-min) (point-max) + signature-file t) + (goto-char (point-min)) + (while (search-forward "\r\n" nil t) + (replace-match "\n" t t)) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-details - (with-current-buffer pgg-output-buffer - (buffer-string)))) + (concat (with-current-buffer pgg-output-buffer + (buffer-string)) + (with-current-buffer pgg-errors-buffer + (buffer-string))))) (error (mm-set-handle-multipart-parameter mm-security-handle 'gnus-details (mml2015-format-error err)) @@ -754,7 +765,7 @@ by you.") (delete-file signature-file) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info - (with-current-buffer pgg-output-buffer + (with-current-buffer pgg-errors-buffer (mml2015-gpg-extract-signature-details)))) (delete-file signature-file) (mm-set-handle-multipart-parameter @@ -762,14 +773,23 @@ by you.") handle) (defun mml2015-pgg-clear-verify () - (let ((pgg-errors-buffer mml2015-result-buffer)) + (let ((pgg-errors-buffer mml2015-result-buffer) + (text (buffer-string)) + (coding-system buffer-file-coding-system)) (if (condition-case err (prog1 - (pgg-verify-region (point-min) (point-max) nil t) + (mm-with-unibyte-buffer + (insert (encode-coding-string text coding-system)) + (pgg-verify-region (point-min) (point-max) nil t)) + (goto-char (point-min)) + (while (search-forward "\r\n" nil t) + (replace-match "\n" t t)) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-details - (with-current-buffer mml2015-result-buffer - (buffer-string)))) + (concat (with-current-buffer pgg-output-buffer + (buffer-string)) + (with-current-buffer pgg-errors-buffer + (buffer-string))))) (error (mm-set-handle-multipart-parameter mm-security-handle 'gnus-details (mml2015-format-error err)) @@ -780,14 +800,16 @@ by you.") nil)) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info - (with-current-buffer pgg-output-buffer + (with-current-buffer pgg-errors-buffer (mml2015-gpg-extract-signature-details))) (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Failed")))) (defun mml2015-pgg-sign (cont) (let ((pgg-errors-buffer mml2015-result-buffer) - (boundary (funcall mml-boundary-function (incf mml-multipart-number)))) + (boundary (mml-compute-boundary cont)) + (pgg-default-user-id (or (message-options-get 'mml-sender) + pgg-default-user-id))) (unless (pgg-sign-region (point-min) (point-max)) (pop-to-buffer mml2015-result-buffer) (error "Sign error")) @@ -800,21 +822,22 @@ by you.") (goto-char (point-max)) (insert (format "\n--%s\n" boundary)) (insert "Content-Type: application/pgp-signature\n\n") - (insert-buffer pgg-output-buffer) + (insert-buffer-substring pgg-output-buffer) (goto-char (point-max)) (insert (format "--%s--\n" boundary)) (goto-char (point-max)))) (defun mml2015-pgg-encrypt (cont &optional sign) (let ((pgg-errors-buffer mml2015-result-buffer) - (boundary (funcall mml-boundary-function (incf mml-multipart-number)))) + (boundary (mml-compute-boundary cont))) (unless (pgg-encrypt-region (point-min) (point-max) (split-string (or (message-options-get 'message-recipients) (message-options-set 'message-recipients (read-string "Recipients: "))) - "[ \f\t\n\r\v,]+")) + "[ \f\t\n\r\v,]+") + sign) (pop-to-buffer mml2015-result-buffer) (error "Encrypt error")) (delete-region (point-min) (point-max)) @@ -827,7 +850,7 @@ by you.") (insert "Version: 1\n\n") (insert (format "--%s\n" boundary)) (insert "Content-Type: application/octet-stream\n\n") - (insert-buffer pgg-output-buffer) + (insert-buffer-substring pgg-output-buffer) (goto-char (point-max)) (insert (format "--%s--\n" boundary)) (goto-char (point-max)))) @@ -895,4 +918,5 @@ by you.") (provide 'mml2015) +;;; arch-tag: b04701d5-0b09-44d8-bed8-de901bf435f2 ;;; mml2015.el ends here