X-Git-Url: http://cgit.sxemacs.org/?a=blobdiff_plain;f=lisp%2Fmml2015.el;h=838813e0f19e27d3bc7fa1f2cd20494fc46e2b3f;hb=ab79c967548f6323a2b8a527ee40644f4630649b;hp=3332270b5f7294ff5bef53e2b3132c750a1186b7;hpb=66bdab9437e3af3753c05c7394bcfdeca3e13628;p=gnus diff --git a/lisp/mml2015.el b/lisp/mml2015.el index 3332270b5..838813e0f 100644 --- a/lisp/mml2015.el +++ b/lisp/mml2015.el @@ -1,27 +1,25 @@ ;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP) -;; Copyright (C) 2000, 2001, 2002, 2003, 2004, -;; 2005, 2006 Free Software Foundation, Inc. +;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, +;; 2008, 2009, 2010 Free Software Foundation, Inc. ;; Author: Shenghuo Zhu ;; Keywords: PGP MIME MML ;; This file is part of GNU Emacs. -;; GNU Emacs is free software; you can redistribute it and/or modify -;; it under the terms of the GNU General Public License as published -;; by the Free Software Foundation; either version 2, or (at your -;; option) any later version. +;; GNU Emacs is free software: you can redistribute it and/or modify +;; it under the terms of the GNU General Public License as published by +;; the Free Software Foundation, either version 3 of the License, or +;; (at your option) any later version. -;; GNU Emacs is distributed in the hope that it will be useful, but -;; WITHOUT ANY WARRANTY; without even the implied warranty of -;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -;; General Public License for more details. +;; GNU Emacs is distributed in the hope that it will be useful, +;; but WITHOUT ANY WARRANTY; without even the implied warranty of +;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the +;; GNU General Public License for more details. ;; 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., 51 Franklin Street, Fifth Floor, -;; Boston, MA 02110-1301, USA. +;; along with GNU Emacs. If not, see . ;;; Commentary: @@ -30,6 +28,14 @@ ;;; Code: +;; For Emacs < 22.2. +(eval-and-compile + (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))) + + (if (locate-library "password-cache") + (require 'password-cache) + (require 'password))) + (eval-when-compile (require 'cl)) (require 'mm-decode) (require 'mm-util) @@ -38,6 +44,10 @@ (defvar mc-pgp-always-sign) +(declare-function epg-check-configuration "ext:epg-config" + (config &optional minimum-version)) +(declare-function epg-configuration "ext:epg-config" ()) + (defvar mml2015-use (or (condition-case nil (progn @@ -136,19 +146,55 @@ Whether the passphrase is cached at all is controlled by :group 'mime-security :type 'boolean) +(defcustom mml2015-always-trust t + "If t, GnuPG skip key validation on encryption." + :group 'mime-security + :type 'boolean) + +;; Extract plaintext from cleartext signature. IMO, this kind of task +;; should be done by GnuPG rather than Elisp, but older PGP backends +;; (such as Mailcrypt, PGG, and gpg.el) discard the output from GnuPG. +(defun mml2015-extract-cleartext-signature () + ;; Daiki Ueno in + ;; <54a15d860801080142l70b95d7dkac4bf51a86196011@mail.gmail.com>: ``I still + ;; believe that the right way is to use the plaintext output from GnuPG as + ;; it is, and mml2015-extract-cleartext-signature is just a kludge for + ;; misdesigned libraries like PGG, which have no ability to do that. So, I + ;; think it should not have descriptive documentation.'' + ;; + ;; This function doesn't handle NotDashEscaped correctly. EasyPG handles it + ;; correctly. + ;; http://thread.gmane.org/gmane.emacs.gnus.general/66062/focus=66082 + ;; http://thread.gmane.org/gmane.emacs.gnus.general/65087/focus=65109 + (goto-char (point-min)) + (forward-line) + ;; We need to be careful not to strip beyond the armor headers. + ;; Previously, an attacker could replace the text inside our + ;; markup with trailing garbage by injecting whitespace into the + ;; message. + (while (looking-at "Hash:") ; The only header allowed in cleartext + (forward-line)) ; signatures according to RFC2440. + (when (looking-at "[\t ]*$") + (forward-line)) + (delete-region (point-min) (point)) + (if (re-search-forward "^-----BEGIN PGP SIGNATURE-----" nil t) + (delete-region (match-beginning 0) (point-max))) + (goto-char (point-min)) + (while (re-search-forward "^- " nil t) + (replace-match "" t t) + (forward-line 1))) + ;;; mailcrypt wrapper -(eval-and-compile - (autoload 'mailcrypt-decrypt "mailcrypt") - (autoload 'mailcrypt-verify "mailcrypt") - (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 'mailcrypt-decrypt "mailcrypt") +(autoload 'mailcrypt-verify "mailcrypt") +(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") -(eval-when-compile - (defvar mc-default-scheme) - (defvar mc-schemes)) +(defvar mc-default-scheme) +(defvar mc-schemes) (defvar mml2015-decrypt-function 'mailcrypt-decrypt) (defvar mml2015-verify-function 'mailcrypt-verify) @@ -322,7 +368,8 @@ Whether the passphrase is cached at all is controlled by (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "OK") (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed")))) + mm-security-handle 'gnus-info "Failed"))) + (mml2015-extract-cleartext-signature)) (defun mml2015-mailcrypt-sign (cont) (mc-sign-generic (message-options-get 'message-sender) @@ -369,6 +416,10 @@ Whether the passphrase is cached at all is controlled by (insert (format "--%s--\n" boundary)) (goto-char (point-max)))) +;; We require mm-decode, which requires mm-bodies, which autoloads +;; message-options-get (!). +(declare-function message-options-set "message" (symbol value)) + (defun mml2015-mailcrypt-encrypt (cont &optional sign) (let ((mc-pgp-always-sign (or mc-pgp-always-sign @@ -405,14 +456,13 @@ Whether the passphrase is cached at all is controlled by ;;; gpg wrapper -(eval-and-compile - (autoload 'gpg-decrypt "gpg") - (autoload 'gpg-verify "gpg") - (autoload 'gpg-verify-cleartext "gpg") - (autoload 'gpg-sign-detached "gpg") - (autoload 'gpg-sign-encrypt "gpg") - (autoload 'gpg-encrypt "gpg") - (autoload 'gpg-passphrase-read "gpg")) +(autoload 'gpg-decrypt "gpg") +(autoload 'gpg-verify "gpg") +(autoload 'gpg-verify-cleartext "gpg") +(autoload 'gpg-sign-detached "gpg") +(autoload 'gpg-sign-encrypt "gpg") +(autoload 'gpg-encrypt "gpg") +(autoload 'gpg-passphrase-read "gpg") (defun mml2015-gpg-passphrase () (or (message-options-get 'gpg-passphrase) @@ -519,9 +569,8 @@ Whether the passphrase is cached at all is controlled by (with-temp-buffer (setq message (current-buffer)) (insert part) - ;; Convert to in verify mode. Sign and - ;; clearsign use --textmode. The conversion is not necessary. - ;; In clearverify, the conversion is not necessary either. + ;; Convert to in signed text. If --textmode is + ;; specified when signing, the conversion is not necessary. (goto-char (point-min)) (end-of-line) (while (not (eobp)) @@ -589,7 +638,8 @@ Whether the passphrase is cached at all is controlled by (with-current-buffer mml2015-result-buffer (mml2015-gpg-extract-signature-details))) (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed"))) + mm-security-handle 'gnus-info "Failed")) + (mml2015-extract-cleartext-signature)) (defun mml2015-gpg-sign (cont) (let ((boundary (mml-compute-boundary cont)) @@ -630,6 +680,7 @@ Whether the passphrase is cached at all is controlled by cipher) (mm-with-unibyte-current-buffer (with-temp-buffer + (mm-disable-multibyte) ;; set up a function to call the correct gpg encrypt routine ;; with the right arguments. (FIXME: this should be done ;; differently.) @@ -679,17 +730,15 @@ Whether the passphrase is cached at all is controlled by ;;; pgg wrapper -(eval-when-compile - (defvar pgg-default-user-id) - (defvar pgg-errors-buffer) - (defvar pgg-output-buffer)) +(defvar pgg-default-user-id) +(defvar pgg-errors-buffer) +(defvar pgg-output-buffer) -(eval-and-compile - (autoload 'pgg-decrypt-region "pgg") - (autoload 'pgg-verify-region "pgg") - (autoload 'pgg-sign-region "pgg") - (autoload 'pgg-encrypt-region "pgg") - (autoload 'pgg-parse-armor "pgg-parse")) +(autoload 'pgg-decrypt-region "pgg") +(autoload 'pgg-verify-region "pgg") +(autoload 'pgg-sign-region "pgg") +(autoload 'pgg-encrypt-region "pgg") +(autoload 'pgg-parse-armor "pgg-parse") (defun mml2015-pgg-decrypt (handle ctl) (catch 'error @@ -778,9 +827,8 @@ Whether the passphrase is cached at all is controlled by handle) (with-temp-buffer (insert part) - ;; Convert to in verify mode. Sign and - ;; clearsign use --textmode. The conversion is not necessary. - ;; In clearverify, the conversion is not necessary either. + ;; Convert to in signed text. If --textmode is + ;; specified when signing, the conversion is not necessary. (goto-char (point-min)) (end-of-line) (while (not (eobp)) @@ -829,7 +877,7 @@ Whether the passphrase is cached at all is controlled by (if (condition-case err (prog1 (mm-with-unibyte-buffer - (insert (encode-coding-string text coding-system)) + (insert (mm-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) @@ -853,7 +901,8 @@ Whether the passphrase is cached at all is controlled by (with-current-buffer pgg-errors-buffer (mml2015-gpg-extract-signature-details))) (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "Failed")))) + mm-security-handle 'gnus-info "Failed"))) + (mml2015-extract-cleartext-signature)) (defun mml2015-pgg-sign (cont) (let ((pgg-errors-buffer mml2015-result-buffer) @@ -917,57 +966,69 @@ Whether the passphrase is cached at all is controlled by ;;; epg wrapper -(eval-and-compile - (autoload 'epg-make-context "epg")) - -(eval-when-compile - (defvar epg-user-id-alist) - (defvar epg-digest-algorithm-alist) - (defvar inhibit-redisplay) - (autoload 'epg-context-set-armor "epg") - (autoload 'epg-context-set-textmode "epg") - (autoload 'epg-context-set-signers "epg") - (autoload 'epg-context-result-for "epg") - (autoload 'epg-new-signature-digest-algorithm "epg") - (autoload 'epg-verify-result-to-string "epg") - (autoload 'epg-list-keys "epg") - (autoload 'epg-decrypt-string "epg") - (autoload 'epg-verify-string "epg") - (autoload 'epg-sign-string "epg") - (autoload 'epg-encrypt-string "epg") - (autoload 'epg-passphrase-callback-function "epg") - (autoload 'epg-context-set-passphrase-callback "epg") - (autoload 'epg-configuration "epg-config") - (autoload 'epg-expand-group "epg-config")) - -(eval-when-compile - (defvar password-cache-expiry) - (autoload 'password-read "password") - (autoload 'password-cache-add "password") - (autoload 'password-cache-remove "password")) +(defvar epg-user-id-alist) +(defvar epg-digest-algorithm-alist) +(defvar inhibit-redisplay) + +(autoload 'epg-make-context "epg") +(autoload 'epg-context-set-armor "epg") +(autoload 'epg-context-set-textmode "epg") +(autoload 'epg-context-set-signers "epg") +(autoload 'epg-context-result-for "epg") +(autoload 'epg-new-signature-digest-algorithm "epg") +(autoload 'epg-verify-result-to-string "epg") +(autoload 'epg-list-keys "epg") +(autoload 'epg-decrypt-string "epg") +(autoload 'epg-verify-string "epg") +(autoload 'epg-sign-string "epg") +(autoload 'epg-encrypt-string "epg") +(autoload 'epg-passphrase-callback-function "epg") +(autoload 'epg-context-set-passphrase-callback "epg") +(autoload 'epg-key-sub-key-list "epg") +(autoload 'epg-sub-key-capability "epg") +(autoload 'epg-sub-key-validity "epg") +(autoload 'epg-configuration "epg-config") +(autoload 'epg-expand-group "epg-config") +(autoload 'epa-select-keys "epa") (defvar mml2015-epg-secret-key-id-list nil) (defun mml2015-epg-passphrase-callback (context key-id ignore) (if (eq key-id 'SYM) (epg-passphrase-callback-function context key-id nil) - (let* ((entry (assoc key-id epg-user-id-alist)) + (let* ((password-cache-key-id + (if (eq key-id 'PIN) + "PIN" + key-id)) + entry (passphrase (password-read - (format "GnuPG passphrase for %s: " - (if entry - (cdr entry) - key-id)) (if (eq key-id 'PIN) - "PIN" - key-id)))) + "Passphrase for PIN: " + (if (setq entry (assoc key-id epg-user-id-alist)) + (format "Passphrase for %s %s: " key-id (cdr entry)) + (format "Passphrase for %s: " key-id))) + password-cache-key-id))) (when passphrase (let ((password-cache-expiry mml2015-passphrase-cache-expiry)) - (password-cache-add key-id passphrase)) + (password-cache-add password-cache-key-id passphrase)) (setq mml2015-epg-secret-key-id-list - (cons key-id mml2015-epg-secret-key-id-list)) + (cons password-cache-key-id mml2015-epg-secret-key-id-list)) (copy-sequence passphrase))))) +(defun mml2015-epg-find-usable-key (keys usage) + (catch 'found + (while keys + (let ((pointer (epg-key-sub-key-list (car keys)))) + (while pointer + (if (and (memq usage (epg-sub-key-capability (car pointer))) + (not (memq 'disabled (epg-sub-key-capability (car pointer)))) + (not (memq (epg-sub-key-validity (car pointer)) + '(revoked expired)))) + (throw 'found (car keys))) + (setq pointer (cdr pointer)))) + (setq keys (cdr keys))))) + (defun mml2015-epg-decrypt (handle ctl) (catch 'error (let ((inhibit-redisplay t) @@ -1053,14 +1114,13 @@ Whether the passphrase is cached at all is controlled by (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") (if (epg-context-result-for context 'verify) (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info - (concat "OK\n" - (epg-verify-result-to-string - (epg-context-result-for context 'verify)))) - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info "OK"))))) + mm-security-handle 'gnus-details + (epg-verify-result-to-string + (epg-context-result-for context 'verify))))))) (defun mml2015-epg-verify (handle ctl) (catch 'error @@ -1077,9 +1137,11 @@ Whether the passphrase is cached at all is controlled by (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Corrupted") (throw 'error handle)) - (setq context (epg-make-context)) + (setq part (mm-replace-in-string part "\n" "\r\n" t) + signature (mm-get-part signature) + context (epg-make-context)) (condition-case error - (setq plain (epg-verify-string context (mm-get-part signature) part)) + (setq plain (epg-verify-string context signature part)) (error (mm-set-handle-multipart-parameter mm-security-handle 'gnus-info "Failed") @@ -1097,8 +1159,8 @@ Whether the passphrase is cached at all is controlled by (defun mml2015-epg-clear-verify () (let ((inhibit-redisplay t) (context (epg-make-context)) - (signature (encode-coding-string (buffer-string) - buffer-file-coding-system)) + (signature (mm-encode-coding-string (buffer-string) + coding-system-for-write)) plain) (condition-case error (setq plain (epg-verify-string context signature)) @@ -1111,24 +1173,45 @@ Whether the passphrase is cached at all is controlled by (mm-set-handle-multipart-parameter mm-security-handle 'gnus-details (mml2015-format-error error))))) (if plain - (mm-set-handle-multipart-parameter - mm-security-handle 'gnus-info - (epg-verify-result-to-string - (epg-context-result-for context 'verify)))))) + (progn + (mm-set-handle-multipart-parameter + mm-security-handle 'gnus-info + (epg-verify-result-to-string + (epg-context-result-for context 'verify))) + (delete-region (point-min) (point-max)) + (insert (mm-decode-coding-string plain coding-system-for-read))) + (mml2015-extract-cleartext-signature)))) (defun mml2015-epg-sign (cont) - (let ((inhibit-redisplay t) - (context (epg-make-context)) - (boundary (mml-compute-boundary cont)) - signers signature micalg) - (if mml2015-verbose - (setq signers (epa-select-keys context "Select keys for signing. + (let* ((inhibit-redisplay t) + (context (epg-make-context)) + (boundary (mml-compute-boundary cont)) + signer-key + (signers + (or (message-options-get 'mml2015-epg-signers) + (message-options-set + 'mml2015-epg-signers + (if (eq mm-sign-option 'guided) + (epa-select-keys context "\ +Select keys for signing. If no one is selected, default secret key is used. " - mml2015-signers t)) - (if mml2015-signers - (setq signers (mapcar (lambda (name) - (car (epg-list-keys context name t))) - mml2015-signers)))) + mml2015-signers t) + (if mml2015-signers + (delq nil + (mapcar + (lambda (signer) + (setq signer-key (mml2015-epg-find-usable-key + (epg-list-keys context signer t) + 'sign)) + (unless (or signer-key + (y-or-n-p + (format + "No secret key for %s; skip it? " + signer))) + (error "No secret key for %s" signer)) + signer-key) + mml2015-signers))))))) + signature micalg) (epg-context-set-armor context t) (epg-context-set-textmode context t) (epg-context-set-signers context signers) @@ -1152,7 +1235,7 @@ If no one is selected, default secret key is used. " (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n" boundary)) (if micalg - (insert (format "\tmicalg=%s; " + (insert (format "\tmicalg=pgp-%s; " (downcase (cdr (assq micalg epg-digest-algorithm-alist)))))) @@ -1169,51 +1252,75 @@ If no one is selected, default secret key is used. " (defun mml2015-epg-encrypt (cont &optional sign) (let ((inhibit-redisplay t) (context (epg-make-context)) - (recipients - (if (message-options-get 'message-recipients) - (split-string - (message-options-get 'message-recipients) - "[ \f\t\n\r\v,]+"))) - cipher signers config - (boundary (mml-compute-boundary cont))) - ;; We should remove this check if epg-0.0.6 is released. - (if (and (condition-case nil - (require 'epg-config) - (error)) - (functionp #'epg-expand-group)) - (setq config (epg-configuration) - recipients - (apply #'nconc - (mapcar (lambda (recipient) - (or (epg-expand-group config recipient) - (list recipient))) - recipients)))) - (if mml2015-verbose - (setq recipients - (epa-select-keys context "Select recipients for encryption. -If no one is selected, symmetric encryption will be performed. " - recipients)) + (config (epg-configuration)) + (recipients (message-options-get 'mml2015-epg-recipients)) + cipher signers + (boundary (mml-compute-boundary cont)) + recipient-key signer-key) + (unless recipients (setq recipients - (delq nil (mapcar (lambda (name) - (car (epg-list-keys context name))) - recipients)))) - (if mml2015-encrypt-to-self - (if mml2015-signers - (setq recipients - (nconc recipients - (mapcar (lambda (name) - (car (epg-list-keys context name))) - mml2015-signers))) - (error "mml2015-signers not set"))) + (apply #'nconc + (mapcar + (lambda (recipient) + (or (epg-expand-group config recipient) + (list (concat "<" recipient ">")))) + (split-string + (or (message-options-get 'message-recipients) + (message-options-set 'message-recipients + (read-string "Recipients: "))) + "[ \f\t\n\r\v,]+")))) + (when mml2015-encrypt-to-self + (unless mml2015-signers + (error "mml2015-signers not set")) + (setq recipients (nconc recipients mml2015-signers))) + (if (eq mm-encrypt-option 'guided) + (setq recipients + (epa-select-keys context "\ +Select recipients for encryption. +If no one is selected, symmetric encryption will be performed. " + recipients)) + (setq recipients + (delq nil + (mapcar + (lambda (recipient) + (setq recipient-key (mml2015-epg-find-usable-key + (epg-list-keys context recipient) + 'encrypt)) + (unless (or recipient-key + (y-or-n-p + (format "No public key for %s; skip it? " + recipient))) + (error "No public key for %s" recipient)) + recipient-key) + recipients))) + (unless recipients + (error "No recipient specified"))) + (message-options-set 'mml2015-epg-recipients recipients)) (when sign - (if mml2015-verbose - (setq signers (epa-select-keys context "Select keys for signing. + (setq signers + (or (message-options-get 'mml2015-epg-signers) + (message-options-set + 'mml2015-epg-signers + (if (eq mm-sign-option 'guided) + (epa-select-keys context "\ +Select keys for signing. If no one is selected, default secret key is used. " - mml2015-signers t)) - (if mml2015-signers - (setq signers (mapcar (lambda (name) - (car (epg-list-keys context name t))) - mml2015-signers)))) + mml2015-signers t) + (if mml2015-signers + (delq nil + (mapcar + (lambda (signer) + (setq signer-key (mml2015-epg-find-usable-key + (epg-list-keys context signer t) + 'sign)) + (unless (or signer-key + (y-or-n-p + (format + "No secret key for %s; skip it? " + signer))) + (error "No secret key for %s" signer)) + signer-key) + mml2015-signers))))))) (epg-context-set-signers context signers)) (epg-context-set-armor context t) (epg-context-set-textmode context t) @@ -1223,7 +1330,8 @@ If no one is selected, default secret key is used. " #'mml2015-epg-passphrase-callback)) (condition-case error (setq cipher - (epg-encrypt-string context (buffer-string) recipients sign) + (epg-encrypt-string context (buffer-string) recipients sign + mml2015-always-trust) mml2015-epg-secret-key-id-list nil) (error (while mml2015-epg-secret-key-id-list @@ -1248,6 +1356,9 @@ If no one is selected, default secret key is used. " ;;; General wrapper +(autoload 'gnus-buffer-live-p "gnus-util") +(autoload 'gnus-get-buffer-create "gnus") + (defun mml2015-clean-buffer () (if (gnus-buffer-live-p mml2015-result-buffer) (with-current-buffer mml2015-result-buffer @@ -1309,5 +1420,4 @@ If no one is selected, default secret key is used. " (provide 'mml2015) -;;; arch-tag: b04701d5-0b09-44d8-bed8-de901bf435f2 ;;; mml2015.el ends here