emacs: lisp/gnus/mml-smime.el annotate

author	Martin Rudalics <rudalics@gmx.at>
date	Thu, 23 Oct 2008 09:05:39 +0000 (2008-10-23)
parents	f42ef85caf91
children	a9dc0e7c3f2b

rev	line source
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	1 ;;; mml-smime.el --- S/MIME support for MML
64754 fafd692d1e40 Update years in copyright notice; nfc. Thien-Thi Nguyen <ttn@gnuvola.org> parents: 64085 diff changeset	2
fafd692d1e40 Update years in copyright notice; nfc. Thien-Thi Nguyen <ttn@gnuvola.org> parents: 64085 diff changeset	3 ;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
79708 1cb31606209f Add 2008 to copyright years. Glenn Morris <rgm@gnu.org> parents: 78224 diff changeset	4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	5
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	6 ;; Author: Simon Josefsson <simon@josefsson.org>
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	7 ;; Keywords: Gnus, MIME, S/MIME, MML
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	8
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	9 ;; This file is part of GNU Emacs.
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	10
94662 f42ef85caf91 Switch to recommended form of GPLv3 permissions notice. Glenn Morris <rgm@gnu.org> parents: 93975 diff changeset	11 ;; GNU Emacs is free software: you can redistribute it and/or modify
f42ef85caf91 Switch to recommended form of GPLv3 permissions notice. Glenn Morris <rgm@gnu.org> parents: 93975 diff changeset	12 ;; it under the terms of the GNU General Public License as published by
f42ef85caf91 Switch to recommended form of GPLv3 permissions notice. Glenn Morris <rgm@gnu.org> parents: 93975 diff changeset	13 ;; the Free Software Foundation, either version 3 of the License, or
f42ef85caf91 Switch to recommended form of GPLv3 permissions notice. Glenn Morris <rgm@gnu.org> parents: 93975 diff changeset	14 ;; (at your option) any later version.
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	15
94662 f42ef85caf91 Switch to recommended form of GPLv3 permissions notice. Glenn Morris <rgm@gnu.org> parents: 93975 diff changeset	16 ;; GNU Emacs is distributed in the hope that it will be useful,
f42ef85caf91 Switch to recommended form of GPLv3 permissions notice. Glenn Morris <rgm@gnu.org> parents: 93975 diff changeset	17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of
f42ef85caf91 Switch to recommended form of GPLv3 permissions notice. Glenn Morris <rgm@gnu.org> parents: 93975 diff changeset	18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
f42ef85caf91 Switch to recommended form of GPLv3 permissions notice. Glenn Morris <rgm@gnu.org> parents: 93975 diff changeset	19 ;; GNU General Public License for more details.
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	20
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	21 ;; You should have received a copy of the GNU General Public License
94662 f42ef85caf91 Switch to recommended form of GPLv3 permissions notice. Glenn Morris <rgm@gnu.org> parents: 93975 diff changeset	22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	23
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	24 ;;; Commentary:
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	25
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	26 ;;; Code:
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	27
87239 4b1974470f60 Add declare-function compatibility definition. Glenn Morris <rgm@gnu.org> parents: 87028 diff changeset	28 ;; For Emacs < 22.2.
4b1974470f60 Add declare-function compatibility definition. Glenn Morris <rgm@gnu.org> parents: 87028 diff changeset	29 (eval-and-compile
4b1974470f60 Add declare-function compatibility definition. Glenn Morris <rgm@gnu.org> parents: 87028 diff changeset	30 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))
4b1974470f60 Add declare-function compatibility definition. Glenn Morris <rgm@gnu.org> parents: 87028 diff changeset	31
57265 cee5a9d8ee71 Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-580 Miles Bader <miles@gnu.org> parents: 56927 diff changeset	32 (eval-when-compile (require 'cl))
cee5a9d8ee71 Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-580 Miles Bader <miles@gnu.org> parents: 56927 diff changeset	33
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	34 (require 'smime)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	35 (require 'mm-decode)
85712 a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	36 (require 'mml-sec)
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	37 (autoload 'message-narrow-to-headers "message")
57265 cee5a9d8ee71 Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-580 Miles Bader <miles@gnu.org> parents: 56927 diff changeset	38 (autoload 'message-fetch-field "message")
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	39
85712 a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	40 (defvar mml-smime-use 'openssl)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	41
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	42 (defvar mml-smime-function-alist
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	43 '((openssl mml-smime-openssl-sign
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	44 mml-smime-openssl-encrypt
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	45 mml-smime-openssl-sign-query
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	46 mml-smime-openssl-encrypt-query
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	47 mml-smime-openssl-verify
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	48 mml-smime-openssl-verify-test)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	49 (epg mml-smime-epg-sign
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	50 mml-smime-epg-encrypt
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	51 nil
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	52 nil
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	53 mml-smime-epg-verify
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	54 mml-smime-epg-verify-test)))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	55
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	56 (defcustom mml-smime-verbose mml-secure-verbose
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	57 "If non-nil, ask the user about the current operation more verbosely."
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	58 :group 'mime-security
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	59 :type 'boolean)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	60
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	61 (defcustom mml-smime-cache-passphrase mml-secure-cache-passphrase
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	62 "If t, cache passphrase."
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	63 :group 'mime-security
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	64 :type 'boolean)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	65
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	66 (defcustom mml-smime-passphrase-cache-expiry mml-secure-passphrase-cache-expiry
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	67 "How many seconds the passphrase is cached.
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	68 Whether the passphrase is cached at all is controlled by
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	69 `mml-smime-cache-passphrase'."
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	70 :group 'mime-security
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	71 :type 'integer)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	72
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	73 (defcustom mml-smime-signers nil
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	74 "A list of your own key ID which will be used to sign a message."
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	75 :group 'mime-security
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	76 :type '(repeat (string :tag "Key ID")))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	77
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	78 (defun mml-smime-sign (cont)
85712 a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	79 (let ((func (nth 1 (assq mml-smime-use mml-smime-function-alist))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	80 (if func
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	81 (funcall func cont)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	82 (error "Cannot find sign function"))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	83
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	84 (defun mml-smime-encrypt (cont)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	85 (let ((func (nth 2 (assq mml-smime-use mml-smime-function-alist))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	86 (if func
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	87 (funcall func cont)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	88 (error "Cannot find encrypt function"))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	89
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	90 (defun mml-smime-sign-query ()
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	91 (let ((func (nth 3 (assq mml-smime-use mml-smime-function-alist))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	92 (if func
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	93 (funcall func))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	94
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	95 (defun mml-smime-encrypt-query ()
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	96 (let ((func (nth 4 (assq mml-smime-use mml-smime-function-alist))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	97 (if func
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	98 (funcall func))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	99
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	100 (defun mml-smime-verify (handle ctl)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	101 (let ((func (nth 5 (assq mml-smime-use mml-smime-function-alist))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	102 (if func
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	103 (funcall func handle ctl)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	104 handle)))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	105
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	106 (defun mml-smime-verify-test (handle ctl)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	107 (let ((func (nth 6 (assq mml-smime-use mml-smime-function-alist))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	108 (if func
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	109 (funcall func handle ctl))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	110
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	111 (defun mml-smime-openssl-sign (cont)
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	112 (when (null smime-keys)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	113 (customize-variable 'smime-keys)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	114 (error "No S/MIME keys configured, use customize to add your key"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	115 (smime-sign-buffer (cdr (assq 'keyfile cont)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	116 (goto-char (point-min))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	117 (while (search-forward "\r\n" nil t)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	118 (replace-match "\n" t t))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	119 (goto-char (point-max)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	120
85712 a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	121 (defun mml-smime-openssl-encrypt (cont)
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	122 (let (certnames certfiles tmp file tmpfiles)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	123 ;; xxx tmp files are always an security issue
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	124 (while (setq tmp (pop cont))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	125 (if (and (consp tmp) (eq (car tmp) 'certfile))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	126 (push (cdr tmp) certnames)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	127 (while (setq tmp (pop certnames))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	128 (if (not (and (not (file-exists-p tmp))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	129 (get-buffer tmp)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	130 (push tmp certfiles)
65279 b7323d13cddd (gnus-extract-address-components): Add defvar. Juanma Barranquero <lekktu@gmail.com> parents: 64754 diff changeset	131 (setq file (mm-make-temp-file (expand-file-name "mml."
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	132 mm-tmp-directory)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	133 (with-current-buffer tmp
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	134 (write-region (point-min) (point-max) file))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	135 (push file certfiles)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	136 (push file tmpfiles)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	137 (if (smime-encrypt-buffer certfiles)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	138 (progn
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	139 (while (setq tmp (pop tmpfiles))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	140 (delete-file tmp))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	141 t)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	142 (while (setq tmp (pop tmpfiles))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	143 (delete-file tmp))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	144 nil))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	145 (goto-char (point-max)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	146
87028 6ffab455d556 (gnus-extract-address-components): Define for compiler. Glenn Morris <rgm@gnu.org> parents: 86154 diff changeset	147 (defvar gnus-extract-address-components)
6ffab455d556 (gnus-extract-address-components): Define for compiler. Glenn Morris <rgm@gnu.org> parents: 86154 diff changeset	148
85712 a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	149 (defun mml-smime-openssl-sign-query ()
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	150 ;; query information (what certificate) from user when MML tag is
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	151 ;; added, for use later by the signing process
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	152 (when (null smime-keys)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	153 (customize-variable 'smime-keys)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	154 (error "No S/MIME keys configured, use customize to add your key"))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	155 (list 'keyfile
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	156 (if (= (length smime-keys) 1)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	157 (cadar smime-keys)
65342 c71b1b2d2d04 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530 Miles Bader <miles@gnu.org> parents: 65279 diff changeset	158 (or (let ((from (cadr (funcall (if (boundp
c71b1b2d2d04 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530 Miles Bader <miles@gnu.org> parents: 65279 diff changeset	159 'gnus-extract-address-components)
c71b1b2d2d04 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530 Miles Bader <miles@gnu.org> parents: 65279 diff changeset	160 gnus-extract-address-components
c71b1b2d2d04 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530 Miles Bader <miles@gnu.org> parents: 65279 diff changeset	161 'mail-extract-address-components)
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	162 (or (save-excursion
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	163 (save-restriction
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	164 (message-narrow-to-headers)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	165 (message-fetch-field "from")))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	166 "")))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	167 (and from (smime-get-key-by-email from)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	168 (smime-get-key-by-email
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	169 (completing-read "Sign this part with what signature? "
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	170 smime-keys nil nil
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	171 (and (listp (car-safe smime-keys))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	172 (caar smime-keys))))))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	173
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	174 (defun mml-smime-get-file-cert ()
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	175 (ignore-errors
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	176 (list 'certfile (read-file-name
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	177 "File with recipient's S/MIME certificate: "
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	178 smime-certificate-directory nil t ""))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	179
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	180 (defun mml-smime-get-dns-cert ()
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	181 ;; todo: deal with comma separated multiple recipients
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	182 (let (result who bad cert)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	183 (condition-case ()
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	184 (while (not result)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	185 (setq who (read-from-minibuffer
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	186 (format "%sLookup certificate for: " (or bad ""))
65342 c71b1b2d2d04 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530 Miles Bader <miles@gnu.org> parents: 65279 diff changeset	187 (cadr (funcall (if (boundp
c71b1b2d2d04 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530 Miles Bader <miles@gnu.org> parents: 65279 diff changeset	188 'gnus-extract-address-components)
c71b1b2d2d04 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530 Miles Bader <miles@gnu.org> parents: 65279 diff changeset	189 gnus-extract-address-components
c71b1b2d2d04 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530 Miles Bader <miles@gnu.org> parents: 65279 diff changeset	190 'mail-extract-address-components)
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	191 (or (save-excursion
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	192 (save-restriction
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	193 (message-narrow-to-headers)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	194 (message-fetch-field "to")))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	195 "")))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	196 (if (setq cert (smime-cert-by-dns who))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	197 (setq result (list 'certfile (buffer-name cert)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	198 (setq bad (format "`%s' not found. " who))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	199 (quit))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	200 result))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	201
85712 a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	202 (defun mml-smime-get-ldap-cert ()
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	203 ;; todo: deal with comma separated multiple recipients
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	204 (let (result who bad cert)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	205 (condition-case ()
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	206 (while (not result)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	207 (setq who (read-from-minibuffer
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	208 (format "%sLookup certificate for: " (or bad ""))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	209 (cadr (funcall gnus-extract-address-components
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	210 (or (save-excursion
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	211 (save-restriction
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	212 (message-narrow-to-headers)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	213 (message-fetch-field "to")))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	214 "")))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	215 (if (setq cert (smime-cert-by-ldap who))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	216 (setq result (list 'certfile (buffer-name cert)))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	217 (setq bad (format "`%s' not found. " who))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	218 (quit))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	219 result))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	220
87239 4b1974470f60 Add declare-function compatibility definition. Glenn Morris <rgm@gnu.org> parents: 87028 diff changeset	221 (autoload 'gnus-completing-read-with-default "gnus-util")
4b1974470f60 Add declare-function compatibility definition. Glenn Morris <rgm@gnu.org> parents: 87028 diff changeset	222
85712 a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	223 (defun mml-smime-openssl-encrypt-query ()
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	224 ;; todo: try dns/ldap automatically first, before prompting user
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	225 (let (certs done)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	226 (while (not done)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	227 (ecase (read (gnus-completing-read-with-default
85712 a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	228 "ldap" "Fetch certificate from"
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	229 '(("dns") ("ldap") ("file")) nil t))
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	230 (dns (setq certs (append certs
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	231 (mml-smime-get-dns-cert))))
85712 a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	232 (ldap (setq certs (append certs
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	233 (mml-smime-get-ldap-cert))))
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	234 (file (setq certs (append certs
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	235 (mml-smime-get-file-cert)))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	236 (setq done (not (y-or-n-p "Add more recipients? "))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	237 certs))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	238
85712 a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	239 (defun mml-smime-openssl-verify (handle ctl)
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	240 (with-temp-buffer
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	241 (insert-buffer-substring (mm-handle-multipart-original-buffer ctl))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	242 (goto-char (point-min))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	243 (insert (format "Content-Type: %s; " (mm-handle-media-type ctl)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	244 (insert (format "protocol=\"%s\"; "
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	245 (mm-handle-multipart-ctl-parameter ctl 'protocol)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	246 (insert (format "micalg=\"%s\"; "
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	247 (mm-handle-multipart-ctl-parameter ctl 'micalg)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	248 (insert (format "boundary=\"%s\"\n\n"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	249 (mm-handle-multipart-ctl-parameter ctl 'boundary)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	250 (when (get-buffer smime-details-buffer)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	251 (kill-buffer smime-details-buffer))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	252 (let ((buf (current-buffer))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	253 (good-signature (smime-noverify-buffer))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	254 (good-certificate (and (or smime-CA-file smime-CA-directory)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	255 (smime-verify-buffer)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	256 addresses openssl-output)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	257 (setq openssl-output (with-current-buffer smime-details-buffer
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	258 (buffer-string)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	259 (if (not good-signature)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	260 (progn
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	261 ;; we couldn't verify message, fail with openssl output as message
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	262 (mm-set-handle-multipart-parameter
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	263 mm-security-handle 'gnus-info "Failed")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	264 (mm-set-handle-multipart-parameter
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	265 mm-security-handle 'gnus-details
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	266 (concat "OpenSSL failed to verify message integrity:\n"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	267 "-------------------------------------------\n"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	268 openssl-output)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	269 ;; verify mail addresses in mail against those in certificate
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	270 (when (and (smime-pkcs7-region (point-min) (point-max))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	271 (smime-pkcs7-certificates-region (point-min) (point-max)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	272 (with-temp-buffer
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	273 (insert-buffer-substring buf)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	274 (goto-char (point-min))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	275 (while (re-search-forward "-----END CERTIFICATE-----" nil t)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	276 (when (smime-pkcs7-email-region (point-min) (point))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	277 (setq addresses (append (smime-buffer-as-string-region
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	278 (point-min) (point)) addresses)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	279 (delete-region (point-min) (point)))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	280 (setq addresses (mapcar 'downcase addresses))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	281 (if (not (member (downcase (or (mm-handle-multipart-from ctl) "")) addresses))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	282 (mm-set-handle-multipart-parameter
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	283 mm-security-handle 'gnus-info "Sender address forged")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	284 (if good-certificate
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	285 (mm-set-handle-multipart-parameter
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	286 mm-security-handle 'gnus-info "Ok (sender authenticated)")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	287 (mm-set-handle-multipart-parameter
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	288 mm-security-handle 'gnus-info "Ok (sender not trusted)")))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	289 (mm-set-handle-multipart-parameter
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	290 mm-security-handle 'gnus-details
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	291 (concat "Sender claimed to be: " (mm-handle-multipart-from ctl) "\n"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	292 (if addresses
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	293 (concat "Addresses in certificate: "
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	294 (mapconcat 'identity addresses ", "))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	295 "No addresses found in certificate. (Requires OpenSSL 0.9.6 or later.)")
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	296 "\n" "\n"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	297 "OpenSSL output:\n"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	298 "---------------\n" openssl-output "\n"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	299 "Certificate(s) inside S/MIME signature:\n"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	300 "---------------------------------------\n"
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	301 (buffer-string) "\n")))))
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	302 handle)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	303
85712 a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	304 (defun mml-smime-openssl-verify-test (handle ctl)
56927 55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	305 smime-openssl-program)
55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523 Miles Bader <miles@gnu.org> parents: diff changeset	306
86154 1cdfc94602cb * smime.el (from): Dan Nicolaescu <dann@ics.uci.edu> parents: 85712 diff changeset	307 (defvar epg-user-id-alist)
1cdfc94602cb * smime.el (from): Dan Nicolaescu <dann@ics.uci.edu> parents: 85712 diff changeset	308 (defvar epg-digest-algorithm-alist)
1cdfc94602cb * smime.el (from): Dan Nicolaescu <dann@ics.uci.edu> parents: 85712 diff changeset	309 (defvar inhibit-redisplay)
1cdfc94602cb * smime.el (from): Dan Nicolaescu <dann@ics.uci.edu> parents: 85712 diff changeset	310 (defvar password-cache-expiry)
85712 a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	311
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	312 (eval-when-compile
86154 1cdfc94602cb * smime.el (from): Dan Nicolaescu <dann@ics.uci.edu> parents: 85712 diff changeset	313 (autoload 'epg-make-context "epg")
85712 a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	314 (autoload 'epg-context-set-armor "epg")
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	315 (autoload 'epg-context-set-signers "epg")
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	316 (autoload 'epg-context-result-for "epg")
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	317 (autoload 'epg-new-signature-digest-algorithm "epg")
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	318 (autoload 'epg-verify-result-to-string "epg")
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	319 (autoload 'epg-list-keys "epg")
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	320 (autoload 'epg-decrypt-string "epg")
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	321 (autoload 'epg-verify-string "epg")
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	322 (autoload 'epg-sign-string "epg")
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	323 (autoload 'epg-encrypt-string "epg")
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	324 (autoload 'epg-passphrase-callback-function "epg")
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	325 (autoload 'epg-context-set-passphrase-callback "epg")
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	326 (autoload 'epg-configuration "epg-config")
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	327 (autoload 'epg-expand-group "epg-config")
87028 6ffab455d556 (gnus-extract-address-components): Define for compiler. Glenn Morris <rgm@gnu.org> parents: 86154 diff changeset	328 (autoload 'epa-select-keys "epa"))
85712 a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	329
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	330 (defvar mml-smime-epg-secret-key-id-list nil)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	331
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	332 (defun mml-smime-epg-passphrase-callback (context key-id ignore)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	333 (if (eq key-id 'SYM)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	334 (epg-passphrase-callback-function context key-id nil)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	335 (let* (entry
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	336 (passphrase
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	337 (password-read
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	338 (if (eq key-id 'PIN)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	339 "Passphrase for PIN: "
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	340 (if (setq entry (assoc key-id epg-user-id-alist))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	341 (format "Passphrase for %s %s: " key-id (cdr entry))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	342 (format "Passphrase for %s: " key-id)))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	343 (if (eq key-id 'PIN)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	344 "PIN"
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	345 key-id))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	346 (when passphrase
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	347 (let ((password-cache-expiry mml-smime-passphrase-cache-expiry))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	348 (password-cache-add key-id passphrase))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	349 (setq mml-smime-epg-secret-key-id-list
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	350 (cons key-id mml-smime-epg-secret-key-id-list))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	351 (copy-sequence passphrase)))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	352
87239 4b1974470f60 Add declare-function compatibility definition. Glenn Morris <rgm@gnu.org> parents: 87028 diff changeset	353 (declare-function epg-key-sub-key-list "ext:epg" (key))
4b1974470f60 Add declare-function compatibility definition. Glenn Morris <rgm@gnu.org> parents: 87028 diff changeset	354 (declare-function epg-sub-key-capability "ext:epg" (sub-key))
4b1974470f60 Add declare-function compatibility definition. Glenn Morris <rgm@gnu.org> parents: 87028 diff changeset	355 (declare-function epg-sub-key-validity "ext:epg" (sub-key))
4b1974470f60 Add declare-function compatibility definition. Glenn Morris <rgm@gnu.org> parents: 87028 diff changeset	356
85712 a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	357 (defun mml-smime-epg-find-usable-key (keys usage)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	358 (catch 'found
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	359 (while keys
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	360 (let ((pointer (epg-key-sub-key-list (car keys))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	361 (while pointer
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	362 (if (and (memq usage (epg-sub-key-capability (car pointer)))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	363 (not (memq (epg-sub-key-validity (car pointer))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	364 '(revoked expired))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	365 (throw 'found (car keys)))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	366 (setq pointer (cdr pointer))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	367 (setq keys (cdr keys)))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	368
87239 4b1974470f60 Add declare-function compatibility definition. Glenn Morris <rgm@gnu.org> parents: 87028 diff changeset	369 (autoload 'mml-compute-boundary "mml")
4b1974470f60 Add declare-function compatibility definition. Glenn Morris <rgm@gnu.org> parents: 87028 diff changeset	370
4b1974470f60 Add declare-function compatibility definition. Glenn Morris <rgm@gnu.org> parents: 87028 diff changeset	371 ;; We require mm-decode, which requires mm-bodies, which autoloads
4b1974470f60 Add declare-function compatibility definition. Glenn Morris <rgm@gnu.org> parents: 87028 diff changeset	372 ;; message-options-get (!).
4b1974470f60 Add declare-function compatibility definition. Glenn Morris <rgm@gnu.org> parents: 87028 diff changeset	373 (declare-function message-options-set "message" (symbol value))
4b1974470f60 Add declare-function compatibility definition. Glenn Morris <rgm@gnu.org> parents: 87028 diff changeset	374
85712 a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	375 (defun mml-smime-epg-sign (cont)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	376 (let* ((inhibit-redisplay t)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	377 (context (epg-make-context 'CMS))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	378 (boundary (mml-compute-boundary cont))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	379 signer-key
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	380 (signers
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	381 (or (message-options-get 'mml-smime-epg-signers)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	382 (message-options-set
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	383 'mml-smime-epg-signers
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	384 (if mml-smime-verbose
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	385 (epa-select-keys context "\
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	386 Select keys for signing.
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	387 If no one is selected, default secret key is used. "
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	388 mml-smime-signers t)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	389 (if mml-smime-signers
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	390 (mapcar
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	391 (lambda (signer)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	392 (setq signer-key (mml-smime-epg-find-usable-key
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	393 (epg-list-keys context signer t)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	394 'sign))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	395 (unless (or signer-key
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	396 (y-or-n-p
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	397 (format "No secret key for %s; skip it? "
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	398 signer)))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	399 (error "No secret key for %s" signer))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	400 signer-key)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	401 mml-smime-signers))))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	402 signature micalg)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	403 (epg-context-set-signers context signers)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	404 (if mml-smime-cache-passphrase
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	405 (epg-context-set-passphrase-callback
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	406 context
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	407 #'mml-smime-epg-passphrase-callback))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	408 (condition-case error
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	409 (setq signature (epg-sign-string context
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	410 (mm-replace-in-string (buffer-string)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	411 "\n" "\r\n")
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	412 t)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	413 mml-smime-epg-secret-key-id-list nil)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	414 (error
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	415 (while mml-smime-epg-secret-key-id-list
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	416 (password-cache-remove (car mml-smime-epg-secret-key-id-list))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	417 (setq mml-smime-epg-secret-key-id-list
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	418 (cdr mml-smime-epg-secret-key-id-list)))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	419 (signal (car error) (cdr error))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	420 (if (epg-context-result-for context 'sign)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	421 (setq micalg (epg-new-signature-digest-algorithm
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	422 (car (epg-context-result-for context 'sign)))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	423 (goto-char (point-min))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	424 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	425 boundary))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	426 (if micalg
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	427 (insert (format "\tmicalg=%s; "
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	428 (downcase
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	429 (cdr (assq micalg
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	430 epg-digest-algorithm-alist))))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	431 (insert "protocol=\"application/pkcs7-signature\"\n")
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	432 (insert (format "\n--%s\n" boundary))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	433 (goto-char (point-max))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	434 (insert (format "\n--%s\n" boundary))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	435 (insert "Content-Type: application/pkcs7-signature; name=smime.p7s
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	436 Content-Transfer-Encoding: base64
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	437 Content-Disposition: attachment; filename=smime.p7s
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	438
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	439 ")
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	440 (insert (base64-encode-string signature) "\n")
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	441 (goto-char (point-max))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	442 (insert (format "--%s--\n" boundary))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	443 (goto-char (point-max))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	444
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	445 (defun mml-smime-epg-encrypt (cont)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	446 (let ((inhibit-redisplay t)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	447 (context (epg-make-context 'CMS))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	448 (config (epg-configuration))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	449 (recipients (message-options-get 'mml-smime-epg-recipients))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	450 cipher signers
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	451 (boundary (mml-compute-boundary cont))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	452 recipient-key)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	453 (unless recipients
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	454 (setq recipients
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	455 (apply #'nconc
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	456 (mapcar
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	457 (lambda (recipient)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	458 (or (epg-expand-group config recipient)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	459 (list recipient)))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	460 (split-string
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	461 (or (message-options-get 'message-recipients)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	462 (message-options-set 'message-recipients
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	463 (read-string "Recipients: ")))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	464 "[ \f\t\n\r\v,]+"))))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	465 (if mml-smime-verbose
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	466 (setq recipients
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	467 (epa-select-keys context "\
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	468 Select recipients for encryption.
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	469 If no one is selected, symmetric encryption will be performed. "
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	470 recipients))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	471 (setq recipients
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	472 (mapcar
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	473 (lambda (recipient)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	474 (setq recipient-key (mml-smime-epg-find-usable-key
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	475 (epg-list-keys context recipient)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	476 'encrypt))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	477 (unless (or recipient-key
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	478 (y-or-n-p
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	479 (format "No public key for %s; skip it? "
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	480 recipient)))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	481 (error "No public key for %s" recipient))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	482 recipient-key)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	483 recipients))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	484 (unless recipients
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	485 (error "No recipient specified")))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	486 (message-options-set 'mml-smime-epg-recipients recipients))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	487 (if mml-smime-cache-passphrase
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	488 (epg-context-set-passphrase-callback
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	489 context
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	490 #'mml-smime-epg-passphrase-callback))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	491 (condition-case error
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	492 (setq cipher
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	493 (epg-encrypt-string context (buffer-string) recipients)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	494 mml-smime-epg-secret-key-id-list nil)
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	495 (error
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	496 (while mml-smime-epg-secret-key-id-list
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	497 (password-cache-remove (car mml-smime-epg-secret-key-id-list))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	498 (setq mml-smime-epg-secret-key-id-list
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	499 (cdr mml-smime-epg-secret-key-id-list)))
a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk Miles Bader <miles@gnu.org> parents: 78224 diff changeset	500 (signal (car error) (cdr error))))

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

1 ;;; mml-smime.el --- S/MIME support for MML

64754

fafd692d1e40 Update years in copyright notice; nfc.

Thien-Thi Nguyen <ttn@gnuvola.org>

parents: 64085

diff changeset

2

fafd692d1e40 Update years in copyright notice; nfc.

Thien-Thi Nguyen <ttn@gnuvola.org>

parents: 64085

diff changeset

79708

1cb31606209f Add 2008 to copyright years.

Glenn Morris <rgm@gnu.org>

parents: 78224

diff changeset

4 ;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

5

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

6 ;; Author: Simon Josefsson <simon@josefsson.org>

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

7 ;; Keywords: Gnus, MIME, S/MIME, MML

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

8

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

9 ;; This file is part of GNU Emacs.

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

10

94662

f42ef85caf91 Switch to recommended form of GPLv3 permissions notice.

Glenn Morris <rgm@gnu.org>

parents: 93975

diff changeset

11 ;; GNU Emacs is free software: you can redistribute it and/or modify

f42ef85caf91 Switch to recommended form of GPLv3 permissions notice.

Glenn Morris <rgm@gnu.org>

parents: 93975

diff changeset

12 ;; it under the terms of the GNU General Public License as published by

f42ef85caf91 Switch to recommended form of GPLv3 permissions notice.

Glenn Morris <rgm@gnu.org>

parents: 93975

diff changeset

13 ;; the Free Software Foundation, either version 3 of the License, or

f42ef85caf91 Switch to recommended form of GPLv3 permissions notice.

Glenn Morris <rgm@gnu.org>

parents: 93975

diff changeset

14 ;; (at your option) any later version.

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

15

94662

f42ef85caf91 Switch to recommended form of GPLv3 permissions notice.

Glenn Morris <rgm@gnu.org>

parents: 93975

diff changeset

16 ;; GNU Emacs is distributed in the hope that it will be useful,

f42ef85caf91 Switch to recommended form of GPLv3 permissions notice.

Glenn Morris <rgm@gnu.org>

parents: 93975

diff changeset

17 ;; but WITHOUT ANY WARRANTY; without even the implied warranty of

f42ef85caf91 Switch to recommended form of GPLv3 permissions notice.

Glenn Morris <rgm@gnu.org>

parents: 93975

diff changeset

18 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the

f42ef85caf91 Switch to recommended form of GPLv3 permissions notice.

Glenn Morris <rgm@gnu.org>

parents: 93975

diff changeset

19 ;; GNU General Public License for more details.

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

20

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

21 ;; You should have received a copy of the GNU General Public License

94662

f42ef85caf91 Switch to recommended form of GPLv3 permissions notice.

Glenn Morris <rgm@gnu.org>

parents: 93975

diff changeset

22 ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>.

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

23

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

24 ;;; Commentary:

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

25

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

26 ;;; Code:

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

27

87239

4b1974470f60 Add declare-function compatibility definition.

Glenn Morris <rgm@gnu.org>

parents: 87028

diff changeset

28 ;; For Emacs < 22.2.

4b1974470f60 Add declare-function compatibility definition.

Glenn Morris <rgm@gnu.org>

parents: 87028

diff changeset

29 (eval-and-compile

4b1974470f60 Add declare-function compatibility definition.

Glenn Morris <rgm@gnu.org>

parents: 87028

diff changeset

30 (unless (fboundp 'declare-function) (defmacro declare-function (&rest r))))

4b1974470f60 Add declare-function compatibility definition.

Glenn Morris <rgm@gnu.org>

parents: 87028

diff changeset

31

57265

cee5a9d8ee71 Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-580

Miles Bader <miles@gnu.org>

parents: 56927

diff changeset

32 (eval-when-compile (require 'cl))

cee5a9d8ee71 Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-580

Miles Bader <miles@gnu.org>

parents: 56927

diff changeset

33

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

34 (require 'smime)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

35 (require 'mm-decode)

85712

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

36 (require 'mml-sec)

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

37 (autoload 'message-narrow-to-headers "message")

57265

cee5a9d8ee71 Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-580

Miles Bader <miles@gnu.org>

parents: 56927

diff changeset

38 (autoload 'message-fetch-field "message")

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

39

85712

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

40 (defvar mml-smime-use 'openssl)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

41

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

42 (defvar mml-smime-function-alist

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

43 '((openssl mml-smime-openssl-sign

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

44 mml-smime-openssl-encrypt

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

45 mml-smime-openssl-sign-query

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

46 mml-smime-openssl-encrypt-query

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

47 mml-smime-openssl-verify

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

48 mml-smime-openssl-verify-test)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

49 (epg mml-smime-epg-sign

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

50 mml-smime-epg-encrypt

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

51 nil

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

52 nil

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

53 mml-smime-epg-verify

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

54 mml-smime-epg-verify-test)))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

55

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

56 (defcustom mml-smime-verbose mml-secure-verbose

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

57 "If non-nil, ask the user about the current operation more verbosely."

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

58 :group 'mime-security

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

59 :type 'boolean)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

60

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

61 (defcustom mml-smime-cache-passphrase mml-secure-cache-passphrase

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

62 "If t, cache passphrase."

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

63 :group 'mime-security

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

64 :type 'boolean)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

65

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

66 (defcustom mml-smime-passphrase-cache-expiry mml-secure-passphrase-cache-expiry

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

67 "How many seconds the passphrase is cached.

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

68 Whether the passphrase is cached at all is controlled by

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

69 `mml-smime-cache-passphrase'."

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

70 :group 'mime-security

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

71 :type 'integer)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

72

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

73 (defcustom mml-smime-signers nil

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

74 "A list of your own key ID which will be used to sign a message."

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

75 :group 'mime-security

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

76 :type '(repeat (string :tag "Key ID")))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

77

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

78 (defun mml-smime-sign (cont)

85712

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

79 (let ((func (nth 1 (assq mml-smime-use mml-smime-function-alist))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

80 (if func

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

81 (funcall func cont)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

82 (error "Cannot find sign function"))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

83

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

84 (defun mml-smime-encrypt (cont)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

85 (let ((func (nth 2 (assq mml-smime-use mml-smime-function-alist))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

86 (if func

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

87 (funcall func cont)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

88 (error "Cannot find encrypt function"))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

89

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

90 (defun mml-smime-sign-query ()

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

91 (let ((func (nth 3 (assq mml-smime-use mml-smime-function-alist))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

92 (if func

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

93 (funcall func))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

94

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

95 (defun mml-smime-encrypt-query ()

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

96 (let ((func (nth 4 (assq mml-smime-use mml-smime-function-alist))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

97 (if func

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

98 (funcall func))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

99

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

100 (defun mml-smime-verify (handle ctl)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

101 (let ((func (nth 5 (assq mml-smime-use mml-smime-function-alist))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

102 (if func

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

103 (funcall func handle ctl)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

104 handle)))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

105

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

106 (defun mml-smime-verify-test (handle ctl)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

107 (let ((func (nth 6 (assq mml-smime-use mml-smime-function-alist))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

108 (if func

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

109 (funcall func handle ctl))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

110

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

111 (defun mml-smime-openssl-sign (cont)

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

112 (when (null smime-keys)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

113 (customize-variable 'smime-keys)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

114 (error "No S/MIME keys configured, use customize to add your key"))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

115 (smime-sign-buffer (cdr (assq 'keyfile cont)))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

116 (goto-char (point-min))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

117 (while (search-forward "\r\n" nil t)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

118 (replace-match "\n" t t))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

119 (goto-char (point-max)))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

120

85712

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

121 (defun mml-smime-openssl-encrypt (cont)

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

122 (let (certnames certfiles tmp file tmpfiles)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

123 ;; xxx tmp files are always an security issue

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

124 (while (setq tmp (pop cont))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

125 (if (and (consp tmp) (eq (car tmp) 'certfile))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

126 (push (cdr tmp) certnames)))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

127 (while (setq tmp (pop certnames))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

128 (if (not (and (not (file-exists-p tmp))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

129 (get-buffer tmp)))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

130 (push tmp certfiles)

65279

b7323d13cddd (gnus-extract-address-components): Add defvar.

Juanma Barranquero <lekktu@gmail.com>

parents: 64754

diff changeset

131 (setq file (mm-make-temp-file (expand-file-name "mml."

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

132 mm-tmp-directory)))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

133 (with-current-buffer tmp

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

134 (write-region (point-min) (point-max) file))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

135 (push file certfiles)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

136 (push file tmpfiles)))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

137 (if (smime-encrypt-buffer certfiles)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

138 (progn

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

139 (while (setq tmp (pop tmpfiles))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

140 (delete-file tmp))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

141 t)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

142 (while (setq tmp (pop tmpfiles))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

143 (delete-file tmp))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

144 nil))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

145 (goto-char (point-max)))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

146

87028

6ffab455d556 (gnus-extract-address-components): Define for compiler.

Glenn Morris <rgm@gnu.org>

parents: 86154

diff changeset

147 (defvar gnus-extract-address-components)

6ffab455d556 (gnus-extract-address-components): Define for compiler.

Glenn Morris <rgm@gnu.org>

parents: 86154

diff changeset

148

85712

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

149 (defun mml-smime-openssl-sign-query ()

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

150 ;; query information (what certificate) from user when MML tag is

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

151 ;; added, for use later by the signing process

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

152 (when (null smime-keys)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

153 (customize-variable 'smime-keys)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

154 (error "No S/MIME keys configured, use customize to add your key"))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

155 (list 'keyfile

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

156 (if (= (length smime-keys) 1)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

157 (cadar smime-keys)

65342

c71b1b2d2d04 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530

Miles Bader <miles@gnu.org>

parents: 65279

diff changeset

158 (or (let ((from (cadr (funcall (if (boundp

c71b1b2d2d04 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530

Miles Bader <miles@gnu.org>

parents: 65279

diff changeset

159 'gnus-extract-address-components)

c71b1b2d2d04 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530

Miles Bader <miles@gnu.org>

parents: 65279

diff changeset

160 gnus-extract-address-components

c71b1b2d2d04 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530

Miles Bader <miles@gnu.org>

parents: 65279

diff changeset

161 'mail-extract-address-components)

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

162 (or (save-excursion

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

163 (save-restriction

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

164 (message-narrow-to-headers)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

165 (message-fetch-field "from")))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

166 "")))))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

167 (and from (smime-get-key-by-email from)))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

168 (smime-get-key-by-email

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

169 (completing-read "Sign this part with what signature? "

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

170 smime-keys nil nil

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

171 (and (listp (car-safe smime-keys))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

172 (caar smime-keys))))))))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

173

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

174 (defun mml-smime-get-file-cert ()

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

175 (ignore-errors

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

176 (list 'certfile (read-file-name

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

177 "File with recipient's S/MIME certificate: "

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

178 smime-certificate-directory nil t ""))))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

179

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

180 (defun mml-smime-get-dns-cert ()

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

181 ;; todo: deal with comma separated multiple recipients

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

182 (let (result who bad cert)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

183 (condition-case ()

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

184 (while (not result)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

185 (setq who (read-from-minibuffer

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

186 (format "%sLookup certificate for: " (or bad ""))

65342

c71b1b2d2d04 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530

Miles Bader <miles@gnu.org>

parents: 65279

diff changeset

187 (cadr (funcall (if (boundp

c71b1b2d2d04 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530

Miles Bader <miles@gnu.org>

parents: 65279

diff changeset

188 'gnus-extract-address-components)

c71b1b2d2d04 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530

Miles Bader <miles@gnu.org>

parents: 65279

diff changeset

189 gnus-extract-address-components

c71b1b2d2d04 Revision: miles@gnu.org--gnu-2005/emacs--cvs-trunk--0--patch-530

Miles Bader <miles@gnu.org>

parents: 65279

diff changeset

190 'mail-extract-address-components)

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

191 (or (save-excursion

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

192 (save-restriction

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

193 (message-narrow-to-headers)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

194 (message-fetch-field "to")))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

195 "")))))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

196 (if (setq cert (smime-cert-by-dns who))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

197 (setq result (list 'certfile (buffer-name cert)))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

198 (setq bad (format "`%s' not found. " who))))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

199 (quit))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

200 result))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

201

85712

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

202 (defun mml-smime-get-ldap-cert ()

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

203 ;; todo: deal with comma separated multiple recipients

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

204 (let (result who bad cert)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

205 (condition-case ()

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

206 (while (not result)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

207 (setq who (read-from-minibuffer

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

208 (format "%sLookup certificate for: " (or bad ""))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

209 (cadr (funcall gnus-extract-address-components

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

210 (or (save-excursion

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

211 (save-restriction

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

212 (message-narrow-to-headers)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

213 (message-fetch-field "to")))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

214 "")))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

215 (if (setq cert (smime-cert-by-ldap who))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

216 (setq result (list 'certfile (buffer-name cert)))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

217 (setq bad (format "`%s' not found. " who))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

218 (quit))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

219 result))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

220

87239

4b1974470f60 Add declare-function compatibility definition.

Glenn Morris <rgm@gnu.org>

parents: 87028

diff changeset

221 (autoload 'gnus-completing-read-with-default "gnus-util")

4b1974470f60 Add declare-function compatibility definition.

Glenn Morris <rgm@gnu.org>

parents: 87028

diff changeset

222

85712

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

223 (defun mml-smime-openssl-encrypt-query ()

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

224 ;; todo: try dns/ldap automatically first, before prompting user

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

225 (let (certs done)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

226 (while (not done)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

227 (ecase (read (gnus-completing-read-with-default

85712

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

228 "ldap" "Fetch certificate from"

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

229 '(("dns") ("ldap") ("file")) nil t))

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

230 (dns (setq certs (append certs

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

231 (mml-smime-get-dns-cert))))

85712

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

232 (ldap (setq certs (append certs

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

233 (mml-smime-get-ldap-cert))))

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

234 (file (setq certs (append certs

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

235 (mml-smime-get-file-cert)))))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

236 (setq done (not (y-or-n-p "Add more recipients? "))))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

237 certs))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

238

85712

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

239 (defun mml-smime-openssl-verify (handle ctl)

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

240 (with-temp-buffer

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

241 (insert-buffer-substring (mm-handle-multipart-original-buffer ctl))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

242 (goto-char (point-min))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

243 (insert (format "Content-Type: %s; " (mm-handle-media-type ctl)))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

244 (insert (format "protocol=\"%s\"; "

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

245 (mm-handle-multipart-ctl-parameter ctl 'protocol)))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

246 (insert (format "micalg=\"%s\"; "

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

247 (mm-handle-multipart-ctl-parameter ctl 'micalg)))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

248 (insert (format "boundary=\"%s\"\n\n"

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

249 (mm-handle-multipart-ctl-parameter ctl 'boundary)))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

250 (when (get-buffer smime-details-buffer)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

251 (kill-buffer smime-details-buffer))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

252 (let ((buf (current-buffer))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

253 (good-signature (smime-noverify-buffer))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

254 (good-certificate (and (or smime-CA-file smime-CA-directory)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

255 (smime-verify-buffer)))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

256 addresses openssl-output)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

257 (setq openssl-output (with-current-buffer smime-details-buffer

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

258 (buffer-string)))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

259 (if (not good-signature)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

260 (progn

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

261 ;; we couldn't verify message, fail with openssl output as message

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

262 (mm-set-handle-multipart-parameter

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

263 mm-security-handle 'gnus-info "Failed")

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

264 (mm-set-handle-multipart-parameter

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

265 mm-security-handle 'gnus-details

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

266 (concat "OpenSSL failed to verify message integrity:\n"

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

267 "-------------------------------------------\n"

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

268 openssl-output)))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

269 ;; verify mail addresses in mail against those in certificate

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

270 (when (and (smime-pkcs7-region (point-min) (point-max))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

271 (smime-pkcs7-certificates-region (point-min) (point-max)))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

272 (with-temp-buffer

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

273 (insert-buffer-substring buf)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

274 (goto-char (point-min))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

275 (while (re-search-forward "-----END CERTIFICATE-----" nil t)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

276 (when (smime-pkcs7-email-region (point-min) (point))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

277 (setq addresses (append (smime-buffer-as-string-region

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

278 (point-min) (point)) addresses)))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

279 (delete-region (point-min) (point)))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

280 (setq addresses (mapcar 'downcase addresses))))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

281 (if (not (member (downcase (or (mm-handle-multipart-from ctl) "")) addresses))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

282 (mm-set-handle-multipart-parameter

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

283 mm-security-handle 'gnus-info "Sender address forged")

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

284 (if good-certificate

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

285 (mm-set-handle-multipart-parameter

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

286 mm-security-handle 'gnus-info "Ok (sender authenticated)")

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

287 (mm-set-handle-multipart-parameter

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

288 mm-security-handle 'gnus-info "Ok (sender not trusted)")))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

289 (mm-set-handle-multipart-parameter

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

290 mm-security-handle 'gnus-details

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

291 (concat "Sender claimed to be: " (mm-handle-multipart-from ctl) "\n"

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

292 (if addresses

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

293 (concat "Addresses in certificate: "

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

294 (mapconcat 'identity addresses ", "))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

295 "No addresses found in certificate. (Requires OpenSSL 0.9.6 or later.)")

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

296 "\n" "\n"

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

297 "OpenSSL output:\n"

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

298 "---------------\n" openssl-output "\n"

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

299 "Certificate(s) inside S/MIME signature:\n"

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

300 "---------------------------------------\n"

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

301 (buffer-string) "\n")))))

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

302 handle)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

303

85712

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

304 (defun mml-smime-openssl-verify-test (handle ctl)

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

305 smime-openssl-program)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

306

86154

1cdfc94602cb * smime.el (from):

Dan Nicolaescu <dann@ics.uci.edu>

parents: 85712

diff changeset

307 (defvar epg-user-id-alist)

1cdfc94602cb * smime.el (from):

Dan Nicolaescu <dann@ics.uci.edu>

parents: 85712

diff changeset

308 (defvar epg-digest-algorithm-alist)

1cdfc94602cb * smime.el (from):

Dan Nicolaescu <dann@ics.uci.edu>

parents: 85712

diff changeset

309 (defvar inhibit-redisplay)

1cdfc94602cb * smime.el (from):

Dan Nicolaescu <dann@ics.uci.edu>

parents: 85712

diff changeset

310 (defvar password-cache-expiry)

85712

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

311

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

312 (eval-when-compile

86154

1cdfc94602cb * smime.el (from):

Dan Nicolaescu <dann@ics.uci.edu>

parents: 85712

diff changeset

313 (autoload 'epg-make-context "epg")

85712

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

314 (autoload 'epg-context-set-armor "epg")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

315 (autoload 'epg-context-set-signers "epg")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

316 (autoload 'epg-context-result-for "epg")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

317 (autoload 'epg-new-signature-digest-algorithm "epg")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

318 (autoload 'epg-verify-result-to-string "epg")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

319 (autoload 'epg-list-keys "epg")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

320 (autoload 'epg-decrypt-string "epg")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

321 (autoload 'epg-verify-string "epg")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

322 (autoload 'epg-sign-string "epg")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

323 (autoload 'epg-encrypt-string "epg")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

324 (autoload 'epg-passphrase-callback-function "epg")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

325 (autoload 'epg-context-set-passphrase-callback "epg")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

326 (autoload 'epg-configuration "epg-config")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

327 (autoload 'epg-expand-group "epg-config")

87028

6ffab455d556 (gnus-extract-address-components): Define for compiler.

Glenn Morris <rgm@gnu.org>

parents: 86154

diff changeset

328 (autoload 'epa-select-keys "epa"))

85712

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

329

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

330 (defvar mml-smime-epg-secret-key-id-list nil)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

331

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

332 (defun mml-smime-epg-passphrase-callback (context key-id ignore)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

333 (if (eq key-id 'SYM)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

334 (epg-passphrase-callback-function context key-id nil)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

335 (let* (entry

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

336 (passphrase

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

337 (password-read

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

338 (if (eq key-id 'PIN)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

339 "Passphrase for PIN: "

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

340 (if (setq entry (assoc key-id epg-user-id-alist))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

341 (format "Passphrase for %s %s: " key-id (cdr entry))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

342 (format "Passphrase for %s: " key-id)))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

343 (if (eq key-id 'PIN)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

344 "PIN"

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

345 key-id))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

346 (when passphrase

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

347 (let ((password-cache-expiry mml-smime-passphrase-cache-expiry))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

348 (password-cache-add key-id passphrase))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

349 (setq mml-smime-epg-secret-key-id-list

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

350 (cons key-id mml-smime-epg-secret-key-id-list))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

351 (copy-sequence passphrase)))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

352

87239

4b1974470f60 Add declare-function compatibility definition.

Glenn Morris <rgm@gnu.org>

parents: 87028

diff changeset

353 (declare-function epg-key-sub-key-list "ext:epg" (key))

4b1974470f60 Add declare-function compatibility definition.

Glenn Morris <rgm@gnu.org>

parents: 87028

diff changeset

354 (declare-function epg-sub-key-capability "ext:epg" (sub-key))

4b1974470f60 Add declare-function compatibility definition.

Glenn Morris <rgm@gnu.org>

parents: 87028

diff changeset

355 (declare-function epg-sub-key-validity "ext:epg" (sub-key))

4b1974470f60 Add declare-function compatibility definition.

Glenn Morris <rgm@gnu.org>

parents: 87028

diff changeset

356

85712

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

357 (defun mml-smime-epg-find-usable-key (keys usage)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

358 (catch 'found

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

359 (while keys

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

360 (let ((pointer (epg-key-sub-key-list (car keys))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

361 (while pointer

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

362 (if (and (memq usage (epg-sub-key-capability (car pointer)))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

363 (not (memq (epg-sub-key-validity (car pointer))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

364 '(revoked expired))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

365 (throw 'found (car keys)))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

366 (setq pointer (cdr pointer))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

367 (setq keys (cdr keys)))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

368

87239

4b1974470f60 Add declare-function compatibility definition.

Glenn Morris <rgm@gnu.org>

parents: 87028

diff changeset

369 (autoload 'mml-compute-boundary "mml")

4b1974470f60 Add declare-function compatibility definition.

Glenn Morris <rgm@gnu.org>

parents: 87028

diff changeset

370

4b1974470f60 Add declare-function compatibility definition.

Glenn Morris <rgm@gnu.org>

parents: 87028

diff changeset

371 ;; We require mm-decode, which requires mm-bodies, which autoloads

4b1974470f60 Add declare-function compatibility definition.

Glenn Morris <rgm@gnu.org>

parents: 87028

diff changeset

372 ;; message-options-get (!).

4b1974470f60 Add declare-function compatibility definition.

Glenn Morris <rgm@gnu.org>

parents: 87028

diff changeset

373 (declare-function message-options-set "message" (symbol value))

4b1974470f60 Add declare-function compatibility definition.

Glenn Morris <rgm@gnu.org>

parents: 87028

diff changeset

374

85712

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

375 (defun mml-smime-epg-sign (cont)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

376 (let* ((inhibit-redisplay t)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

377 (context (epg-make-context 'CMS))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

378 (boundary (mml-compute-boundary cont))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

379 signer-key

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

380 (signers

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

381 (or (message-options-get 'mml-smime-epg-signers)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

382 (message-options-set

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

383 'mml-smime-epg-signers

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

384 (if mml-smime-verbose

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

385 (epa-select-keys context "\

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

386 Select keys for signing.

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

387 If no one is selected, default secret key is used. "

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

388 mml-smime-signers t)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

389 (if mml-smime-signers

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

390 (mapcar

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

391 (lambda (signer)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

392 (setq signer-key (mml-smime-epg-find-usable-key

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

393 (epg-list-keys context signer t)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

394 'sign))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

395 (unless (or signer-key

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

396 (y-or-n-p

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

397 (format "No secret key for %s; skip it? "

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

398 signer)))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

399 (error "No secret key for %s" signer))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

400 signer-key)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

401 mml-smime-signers))))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

402 signature micalg)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

403 (epg-context-set-signers context signers)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

404 (if mml-smime-cache-passphrase

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

405 (epg-context-set-passphrase-callback

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

406 context

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

407 #'mml-smime-epg-passphrase-callback))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

408 (condition-case error

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

409 (setq signature (epg-sign-string context

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

410 (mm-replace-in-string (buffer-string)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

411 "\n" "\r\n")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

412 t)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

413 mml-smime-epg-secret-key-id-list nil)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

414 (error

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

415 (while mml-smime-epg-secret-key-id-list

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

416 (password-cache-remove (car mml-smime-epg-secret-key-id-list))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

417 (setq mml-smime-epg-secret-key-id-list

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

418 (cdr mml-smime-epg-secret-key-id-list)))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

419 (signal (car error) (cdr error))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

420 (if (epg-context-result-for context 'sign)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

421 (setq micalg (epg-new-signature-digest-algorithm

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

422 (car (epg-context-result-for context 'sign)))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

423 (goto-char (point-min))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

424 (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

425 boundary))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

426 (if micalg

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

427 (insert (format "\tmicalg=%s; "

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

428 (downcase

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

429 (cdr (assq micalg

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

430 epg-digest-algorithm-alist))))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

431 (insert "protocol=\"application/pkcs7-signature\"\n")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

432 (insert (format "\n--%s\n" boundary))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

433 (goto-char (point-max))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

434 (insert (format "\n--%s\n" boundary))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

435 (insert "Content-Type: application/pkcs7-signature; name=smime.p7s

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

436 Content-Transfer-Encoding: base64

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

437 Content-Disposition: attachment; filename=smime.p7s

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

438

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

439 ")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

440 (insert (base64-encode-string signature) "\n")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

441 (goto-char (point-max))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

442 (insert (format "--%s--\n" boundary))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

443 (goto-char (point-max))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

444

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

445 (defun mml-smime-epg-encrypt (cont)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

446 (let ((inhibit-redisplay t)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

447 (context (epg-make-context 'CMS))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

448 (config (epg-configuration))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

449 (recipients (message-options-get 'mml-smime-epg-recipients))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

450 cipher signers

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

451 (boundary (mml-compute-boundary cont))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

452 recipient-key)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

453 (unless recipients

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

454 (setq recipients

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

455 (apply #'nconc

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

456 (mapcar

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

457 (lambda (recipient)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

458 (or (epg-expand-group config recipient)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

459 (list recipient)))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

460 (split-string

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

461 (or (message-options-get 'message-recipients)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

462 (message-options-set 'message-recipients

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

463 (read-string "Recipients: ")))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

464 "[ \f\t\n\r\v,]+"))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

465 (if mml-smime-verbose

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

466 (setq recipients

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

467 (epa-select-keys context "\

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

468 Select recipients for encryption.

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

469 If no one is selected, symmetric encryption will be performed. "

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

470 recipients))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

471 (setq recipients

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

472 (mapcar

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

473 (lambda (recipient)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

474 (setq recipient-key (mml-smime-epg-find-usable-key

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

475 (epg-list-keys context recipient)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

476 'encrypt))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

477 (unless (or recipient-key

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

478 (y-or-n-p

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

479 (format "No public key for %s; skip it? "

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

480 recipient)))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

481 (error "No public key for %s" recipient))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

482 recipient-key)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

483 recipients))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

484 (unless recipients

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

485 (error "No recipient specified")))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

486 (message-options-set 'mml-smime-epg-recipients recipients))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

487 (if mml-smime-cache-passphrase

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

488 (epg-context-set-passphrase-callback

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

489 context

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

490 #'mml-smime-epg-passphrase-callback))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

491 (condition-case error

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

492 (setq cipher

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

493 (epg-encrypt-string context (buffer-string) recipients)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

494 mml-smime-epg-secret-key-id-list nil)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

495 (error

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

496 (while mml-smime-epg-secret-key-id-list

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

497 (password-cache-remove (car mml-smime-epg-secret-key-id-list))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

498 (setq mml-smime-epg-secret-key-id-list

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

499 (cdr mml-smime-epg-secret-key-id-list)))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

500 (signal (car error) (cdr error))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

501 (delete-region (point-min) (point-max))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

502 (goto-char (point-min))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

503 (insert "\

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

504 Content-Type: application/pkcs7-mime;

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

505 smime-type=enveloped-data;

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

506 name=smime.p7m

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

507 Content-Transfer-Encoding: base64

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

508 Content-Disposition: attachment; filename=smime.p7m

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

509

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

510 ")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

511 (insert (base64-encode-string cipher))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

512 (goto-char (point-max))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

513

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

514 (defun mml-smime-epg-verify (handle ctl)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

515 (catch 'error

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

516 (let ((inhibit-redisplay t)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

517 context plain signature-file part signature)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

518 (when (or (null (setq part (mm-find-raw-part-by-type

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

519 ctl (or (mm-handle-multipart-ctl-parameter

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

520 ctl 'protocol)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

521 "application/pkcs7-signature")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

522 t)))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

523 (null (setq signature (mm-find-part-by-type

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

524 (cdr handle)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

525 "application/pkcs7-signature"

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

526 nil t))))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

527 (mm-set-handle-multipart-parameter

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

528 mm-security-handle 'gnus-info "Corrupted")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

529 (throw 'error handle))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

530 (setq part (mm-replace-in-string part "\n" "\r\n" t)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

531 context (epg-make-context 'CMS))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

532 (condition-case error

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

533 (setq plain (epg-verify-string context (mm-get-part signature) part))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

534 (error

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

535 (mm-set-handle-multipart-parameter

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

536 mm-security-handle 'gnus-info "Failed")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

537 (if (eq (car error) 'quit)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

538 (mm-set-handle-multipart-parameter

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

539 mm-security-handle 'gnus-details "Quit.")

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

540 (mm-set-handle-multipart-parameter

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

541 mm-security-handle 'gnus-details (format "%S" error)))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

542 (throw 'error handle)))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

543 (mm-set-handle-multipart-parameter

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

544 mm-security-handle 'gnus-info

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

545 (epg-verify-result-to-string (epg-context-result-for context 'verify)))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

546 handle)))

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

547

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

548 (defun mml-smime-epg-verify-test (handle ctl)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

549 t)

a3c27999decb Update Gnus to No Gnus 0.7 from the Gnus CVS trunk

Miles Bader <miles@gnu.org>

parents: 78224

diff changeset

550

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

551 (provide 'mml-smime)

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

552

93975

1e3a407766b9 Fix up comment convention on the arch-tag lines.

Stefan Monnier <monnier@iro.umontreal.ca>

parents: 87649

diff changeset

553 ;; arch-tag: f1bf94d4-f2cd-4c6f-b059-ad69492817e2

56927

55fd4f77387a Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523

Miles Bader <miles@gnu.org>

parents:

diff changeset

554 ;;; mml-smime.el ends here

Mercurial > emacs

annotate lisp/gnus/mml-smime.el @ 99081:781ed56ae566