X-Git-Url: https://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmml2015.el;h=a9d56a3edbfeb717699bded0164aae8bce3e7e76;hb=00a79e1b6666d1ed70f193296865da0f0dd54cda;hp=9b118500be148fd3850b5169bf063f54cfd93d7d;hpb=bbaa6736e285258f29be9409b7b75751bb847e96;p=gnus diff --git a/lisp/mml2015.el b/lisp/mml2015.el index 9b118500b..a9d56a3ed 100644 --- a/lisp/mml2015.el +++ b/lisp/mml2015.el @@ -1,5 +1,7 @@ ;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP) -;; Copyright (C) 2000, 2001, 2002, 2003, 2004 Free Software Foundation, Inc. + +;; Copyright (C) 2000, 2001, 2002, 2003, 2004, +;; 2005 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: PGP MIME MML @@ -18,8 +20,8 @@ ;; You should have received a copy of the GNU General Public License ;; along with GNU Emacs; see the file COPYING. If not, write to the -;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, -;; Boston, MA 02111-1307, USA. +;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor, +;; Boston, MA 02110-1301, USA. ;;; Commentary: @@ -33,6 +35,8 @@ (require 'mm-util) (require 'mml) +(defvar mc-pgp-always-sign) + (defvar mml2015-use (or (progn (ignore-errors @@ -87,6 +91,7 @@ Valid packages include `pgg', `gpg' and `mailcrypt'.") ("TRUST_FULLY" . t) ("TRUST_ULTIMATE" . t)) "Map GnuPG trust output values to a boolean saying if you trust the key." + :version "22.1" :group 'mime-security :type '(repeat (cons (regexp :tag "GnuPG output regexp") (boolean :tag "Trust key")))) @@ -588,7 +593,7 @@ Valid packages include `pgg', `gpg' and `mailcrypt'.") ;; set up a function to call the correct gpg encrypt routine ;; with the right arguments. (FIXME: this should be done ;; differently.) - (flet ((gpg-encrypt-func + (flet ((gpg-encrypt-func (sign plaintext ciphertext result recipients &optional passphrase sign-with-key armor textmode) (if sign @@ -635,6 +640,7 @@ Valid packages include `pgg', `gpg' and `mailcrypt'.") ;;; pgg wrapper (eval-when-compile + (defvar pgg-default-user-id) (defvar pgg-errors-buffer) (defvar pgg-output-buffer)) @@ -642,7 +648,8 @@ Valid packages include `pgg', `gpg' and `mailcrypt'.") (autoload 'pgg-decrypt-region "pgg") (autoload 'pgg-verify-region "pgg") (autoload 'pgg-sign-region "pgg") - (autoload 'pgg-encrypt-region "pgg")) + (autoload 'pgg-encrypt-region "pgg") + (autoload 'pgg-parse-armor "pgg-parse")) (defun mml2015-pgg-decrypt (handle ctl) (catch 'error @@ -659,7 +666,7 @@ Valid packages include `pgg', `gpg' and `mailcrypt'.") (if (condition-case err (prog1 (pgg-decrypt-region (point-min) (point-max)) - (setq decrypt-status + (setq decrypt-status (with-current-buffer mml2015-result-buffer (buffer-string))) (mm-set-handle-multipart-parameter @@ -743,7 +750,7 @@ Valid packages include `pgg', `gpg' and `mailcrypt'.") (mm-insert-part signature)) (if (condition-case err (prog1 - (pgg-verify-region (point-min) (point-max) + (pgg-verify-region (point-min) (point-max) signature-file t) (goto-char (point-min)) (while (search-forward "\r\n" nil t) @@ -810,15 +817,23 @@ Valid packages include `pgg', `gpg' and `mailcrypt'.") (let ((pgg-errors-buffer mml2015-result-buffer) (boundary (mml-compute-boundary cont)) (pgg-default-user-id (or (message-options-get 'mml-sender) - pgg-default-user-id))) + pgg-default-user-id)) + entry) (unless (pgg-sign-region (point-min) (point-max)) (pop-to-buffer mml2015-result-buffer) (error "Sign error")) (goto-char (point-min)) (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" boundary)) - ;;; FIXME: what is the micalg? - (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n") + (if (setq entry (assq 2 (pgg-parse-armor + (with-current-buffer pgg-output-buffer + (buffer-string))))) + (setq entry (assq 'hash-algorithm (cdr entry)))) + (insert (format "\tmicalg=%s; " + (if (cdr entry) + (downcase (format "pgp-%s" (cdr entry))) + "pgp-sha1"))) + (insert "protocol=\"application/pgp-signature\"\n") (insert (format "\n--%s\n" boundary)) (goto-char (point-max)) (insert (format "\n--%s\n" boundary)) @@ -864,7 +879,7 @@ Valid packages include `pgg', `gpg' and `mailcrypt'.") (erase-buffer) t) (setq mml2015-result-buffer - (gnus-get-buffer-create "*MML2015 Result*")) + (gnus-get-buffer-create " *MML2015 Result*")) nil)) (defsubst mml2015-clear-decrypt-function ()