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