Mercurial > emacs
comparison lisp/gnus/smime.el @ 56927:55fd4f77387a after-merge-gnus-5_10
Revision: miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-523
Merge from emacs--gnus--5.10, gnus--rel--5.10
Patches applied:
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--base-0
tag of miles@gnu.org--gnu-2004/emacs--cvs-trunk--0--patch-464
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-1
Import from CVS branch gnus-5_10-branch
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-2
Merge from lorentey@elte.hu--2004/emacs--multi-tty--0, emacs--cvs-trunk--0
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-3
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/emacs--gnus--5.10--patch-4
Merge from gnus--rel--5.10
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-18
Update from CVS
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-19
Remove autoconf-generated files from archive
* miles@gnu.org--gnu-2004/gnus--rel--5.10--patch-20
Update from CVS
author | Miles Bader <miles@gnu.org> |
---|---|
date | Sat, 04 Sep 2004 13:13:48 +0000 |
parents | |
children | 497f0d2ca551 |
comparison
equal
deleted
inserted
replaced
56926:f8e248e9a717 | 56927:55fd4f77387a |
---|---|
1 ;;; smime.el --- S/MIME support library | |
2 ;; Copyright (c) 2000, 2001, 2003 Free Software Foundation, Inc. | |
3 | |
4 ;; Author: Simon Josefsson <simon@josefsson.org> | |
5 ;; Keywords: SMIME X.509 PEM OpenSSL | |
6 | |
7 ;; This file is part of GNU Emacs. | |
8 | |
9 ;; GNU Emacs is free software; you can redistribute it and/or modify | |
10 ;; it under the terms of the GNU General Public License as published | |
11 ;; by the Free Software Foundation; either version 2, or (at your | |
12 ;; option) any later version. | |
13 | |
14 ;; GNU Emacs is distributed in the hope that it will be useful, but | |
15 ;; WITHOUT ANY WARRANTY; without even the implied warranty of | |
16 ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU | |
17 ;; General Public License for more details. | |
18 | |
19 ;; You should have received a copy of the GNU General Public License | |
20 ;; along with GNU Emacs; see the file COPYING. If not, write to the | |
21 ;; Free Software Foundation, Inc., 59 Temple Place - Suite 330, | |
22 ;; Boston, MA 02111-1307, USA. | |
23 | |
24 ;;; Commentary: | |
25 | |
26 ;; This library perform S/MIME operations from within Emacs. | |
27 ;; | |
28 ;; Functions for fetching certificates from public repositories are | |
29 ;; provided, currently only from DNS. LDAP support (via EUDC) is planned. | |
30 ;; | |
31 ;; It uses OpenSSL (tested with version 0.9.5a and 0.9.6) for signing, | |
32 ;; encryption and decryption. | |
33 ;; | |
34 ;; Some general knowledge of S/MIME, X.509, PKCS#12, PEM etc is | |
35 ;; probably required to use this library in any useful way. | |
36 ;; Especially, don't expect this library to buy security for you. If | |
37 ;; you don't understand what you are doing, you're as likely to lose | |
38 ;; security than gain any by using this library. | |
39 ;; | |
40 ;; This library is not intended to provide a "raw" API for S/MIME, | |
41 ;; PKCSx or similar, it's intended to perform common operations | |
42 ;; done on messages encoded in these formats. The terminology chosen | |
43 ;; reflect this. | |
44 ;; | |
45 ;; The home of this file is in Gnus CVS, but also available from | |
46 ;; http://josefsson.org/smime.html. | |
47 | |
48 ;;; Quick introduction: | |
49 | |
50 ;; Get your S/MIME certificate from VeriSign or someplace. I used | |
51 ;; Netscape to generate the key and certificate request and stuff, and | |
52 ;; Netscape can export the key into PKCS#12 format. | |
53 ;; | |
54 ;; Enter OpenSSL. To be able to use this library, it need to have the | |
55 ;; SMIME key readable in PEM format. OpenSSL is used to convert the | |
56 ;; key: | |
57 ;; | |
58 ;; $ openssl pkcs12 -in mykey.p12 -clcerts -nodes > mykey.pem | |
59 ;; ... | |
60 ;; | |
61 ;; Now, use M-x customize-variable smime-keys and add mykey.pem as | |
62 ;; a key. | |
63 ;; | |
64 ;; Now you should be able to sign messages! Create a buffer and write | |
65 ;; something and run M-x smime-sign-buffer RET RET and you should see | |
66 ;; your message MIME armoured and a signature. Encryption, M-x | |
67 ;; smime-encrypt-buffer, should also work. | |
68 ;; | |
69 ;; To be able to verify messages you need to build up trust with | |
70 ;; someone. Perhaps you trust the CA that issued your certificate, at | |
71 ;; least I did, so I export it's certificates from my PKCS#12 | |
72 ;; certificate with: | |
73 ;; | |
74 ;; $ openssl pkcs12 -in mykey.p12 -cacerts -nodes > cacert.pem | |
75 ;; ... | |
76 ;; | |
77 ;; Now, use M-x customize-variable smime-CAs and add cacert.pem as a | |
78 ;; CA certificate. | |
79 ;; | |
80 ;; You should now be able to sign messages, and even verify messages | |
81 ;; sent by others that use the same CA as you. | |
82 | |
83 ;; Bugs: | |
84 ;; | |
85 ;; Don't complain that this package doesn't do encrypted PEM files, | |
86 ;; submit a patch instead. I store my keys in a safe place, so I | |
87 ;; didn't need the encryption. Also, programming was made easier by | |
88 ;; that decision. One might think that this even influenced were I | |
89 ;; store my keys, and one would probably be right. :-) | |
90 ;; | |
91 ;; Update: Mathias Herberts sent the patch. However, it uses | |
92 ;; environment variables to pass the password to OpenSSL, which is | |
93 ;; slightly insecure. Hence a new todo: use a better -passin method. | |
94 ;; | |
95 ;; Cache password for e.g. 1h | |
96 ;; | |
97 ;; Suggestions and comments are appreciated, mail me at simon@josefsson.org. | |
98 | |
99 ;; begin rant | |
100 ;; | |
101 ;; I would include pointers to introductory text on concepts used in | |
102 ;; this library here, but the material I've read are so horrible I | |
103 ;; don't want to recomend them. | |
104 ;; | |
105 ;; Why can't someone write a simple introduction to all this stuff? | |
106 ;; Until then, much of this resemble security by obscurity. | |
107 ;; | |
108 ;; Also, I'm not going to mention anything about the wonders of | |
109 ;; cryptopolitics. Oops, I just did. | |
110 ;; | |
111 ;; end rant | |
112 | |
113 ;;; Revision history: | |
114 | |
115 ;; 2000-06-05 initial version, committed to Gnus CVS contrib/ | |
116 ;; 2000-10-28 retrieve certificates via DNS CERT RRs | |
117 ;; 2001-10-14 posted to gnu.emacs.sources | |
118 | |
119 ;;; Code: | |
120 | |
121 (require 'dig) | |
122 (eval-when-compile (require 'cl)) | |
123 | |
124 (defgroup smime nil | |
125 "S/MIME configuration.") | |
126 | |
127 (defcustom smime-keys nil | |
128 "*Map mail addresses to a file containing Certificate (and private key). | |
129 The file is assumed to be in PEM format. You can also associate additional | |
130 certificates to be sent with every message to each address." | |
131 :type '(repeat (list (string :tag "Mail address") | |
132 (file :tag "File name") | |
133 (repeat :tag "Additional certificate files" | |
134 (file :tag "File name")))) | |
135 :group 'smime) | |
136 | |
137 (defcustom smime-CA-directory nil | |
138 "*Directory containing certificates for CAs you trust. | |
139 Directory should contain files (in PEM format) named to the X.509 | |
140 hash of the certificate. This can be done using OpenSSL such as: | |
141 | |
142 $ ln -s ca.pem `openssl x509 -noout -hash -in ca.pem`.0 | |
143 | |
144 where `ca.pem' is the file containing a PEM encoded X.509 CA | |
145 certificate." | |
146 :type '(choice (const :tag "none" nil) | |
147 directory) | |
148 :group 'smime) | |
149 | |
150 (defcustom smime-CA-file nil | |
151 "*Files containing certificates for CAs you trust. | |
152 File should contain certificates in PEM format." | |
153 :type '(choice (const :tag "none" nil) | |
154 file) | |
155 :group 'smime) | |
156 | |
157 (defcustom smime-certificate-directory "~/Mail/certs/" | |
158 "*Directory containing other people's certificates. | |
159 It should contain files named to the X.509 hash of the certificate, | |
160 and the files themself should be in PEM format." | |
161 ;The S/MIME library provide simple functionality for fetching | |
162 ;certificates into this directory, so there is no need to populate it | |
163 ;manually. | |
164 :type 'directory | |
165 :group 'smime) | |
166 | |
167 (defcustom smime-openssl-program | |
168 (and (condition-case () | |
169 (eq 0 (call-process "openssl" nil nil nil "version")) | |
170 (error nil)) | |
171 "openssl") | |
172 "*Name of OpenSSL binary." | |
173 :type 'string | |
174 :group 'smime) | |
175 | |
176 ;; OpenSSL option to select the encryption cipher | |
177 | |
178 (defcustom smime-encrypt-cipher "-des3" | |
179 "*Cipher algorithm used for encryption." | |
180 :type '(choice (const :tag "Triple DES" "-des3") | |
181 (const :tag "DES" "-des") | |
182 (const :tag "RC2 40 bits" "-rc2-40") | |
183 (const :tag "RC2 64 bits" "-rc2-64") | |
184 (const :tag "RC2 128 bits" "-rc2-128")) | |
185 :group 'smime) | |
186 | |
187 (defcustom smime-crl-check nil | |
188 "*Check revocation status of signers certificate using CRLs. | |
189 Enabling this will have OpenSSL check the signers certificate | |
190 against a certificate revocation list (CRL). | |
191 | |
192 For this to work the CRL must be up-to-date and since they are | |
193 normally updated quite often (ie. several times a day) you | |
194 probably need some tool to keep them up-to-date. Unfortunately | |
195 Gnus cannot do this for you. | |
196 | |
197 The CRL should either be appended (in PEM format) to your | |
198 `smime-CA-file' or be located in a file (also in PEM format) in | |
199 your `smime-certificate-directory' named to the X.509 hash of the | |
200 certificate with .r0 as file name extension. | |
201 | |
202 At least OpenSSL version 0.9.7 is required for this to work." | |
203 :type '(choice (const :tag "No check" nil) | |
204 (const :tag "Check certificate" "-crl_check") | |
205 (const :tag "Check certificate chain" "-crl_check_all")) | |
206 :group 'smime) | |
207 | |
208 (defcustom smime-dns-server nil | |
209 "*DNS server to query certificates from. | |
210 If nil, use system defaults." | |
211 :type '(choice (const :tag "System defaults") | |
212 string) | |
213 :group 'smime) | |
214 | |
215 (defvar smime-details-buffer "*OpenSSL output*") | |
216 | |
217 ;; Use mm-util? | |
218 (eval-and-compile | |
219 (defalias 'smime-make-temp-file | |
220 (if (fboundp 'make-temp-file) | |
221 'make-temp-file | |
222 (lambda (prefix &optional dir-flag) ;; Simple implementation | |
223 (expand-file-name | |
224 (make-temp-name prefix) | |
225 (if (fboundp 'temp-directory) | |
226 (temp-directory) | |
227 temporary-file-directory)))))) | |
228 | |
229 ;; Password dialog function | |
230 | |
231 (defun smime-ask-passphrase () | |
232 "Asks the passphrase to unlock the secret key." | |
233 (let ((passphrase | |
234 (read-passwd | |
235 "Passphrase for secret key (RET for no passphrase): "))) | |
236 (if (string= passphrase "") | |
237 nil | |
238 passphrase))) | |
239 | |
240 ;; OpenSSL wrappers. | |
241 | |
242 (defun smime-call-openssl-region (b e buf &rest args) | |
243 (case (apply 'call-process-region b e smime-openssl-program nil buf nil args) | |
244 (0 t) | |
245 (1 (message "OpenSSL: An error occurred parsing the command options.") nil) | |
246 (2 (message "OpenSSL: One of the input files could not be read.") nil) | |
247 (3 (message "OpenSSL: An error occurred creating the PKCS#7 file or when reading the MIME message.") nil) | |
248 (4 (message "OpenSSL: An error occurred decrypting or verifying the message.") nil) | |
249 (t (error "Unknown OpenSSL exitcode") nil))) | |
250 | |
251 (defun smime-make-certfiles (certfiles) | |
252 (if certfiles | |
253 (append (list "-certfile" (expand-file-name (car certfiles))) | |
254 (smime-make-certfiles (cdr certfiles))))) | |
255 | |
256 ;; Sign+encrypt region | |
257 | |
258 (defun smime-sign-region (b e keyfile) | |
259 "Sign region with certified key in KEYFILE. | |
260 If signing fails, the buffer is not modified. Region is assumed to | |
261 have proper MIME tags. KEYFILE is expected to contain a PEM encoded | |
262 private key and certificate as its car, and a list of additional | |
263 certificates to include in its caar. If no additional certificates is | |
264 included, KEYFILE may be the file containing the PEM encoded private | |
265 key and certificate itself." | |
266 (smime-new-details-buffer) | |
267 (let ((keyfile (or (car-safe keyfile) keyfile)) | |
268 (certfiles (and (cdr-safe keyfile) (cadr keyfile))) | |
269 (buffer (generate-new-buffer (generate-new-buffer-name " *smime*"))) | |
270 (passphrase (smime-ask-passphrase)) | |
271 (tmpfile (smime-make-temp-file "smime"))) | |
272 (if passphrase | |
273 (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) | |
274 (prog1 | |
275 (when (prog1 | |
276 (apply 'smime-call-openssl-region b e (list buffer tmpfile) | |
277 "smime" "-sign" "-signer" (expand-file-name keyfile) | |
278 (append | |
279 (smime-make-certfiles certfiles) | |
280 (if passphrase | |
281 (list "-passin" "env:GNUS_SMIME_PASSPHRASE")))) | |
282 (if passphrase | |
283 (setenv "GNUS_SMIME_PASSPHRASE" "" t)) | |
284 (with-current-buffer smime-details-buffer | |
285 (insert-file-contents tmpfile) | |
286 (delete-file tmpfile))) | |
287 (delete-region b e) | |
288 (insert-buffer-substring buffer) | |
289 (goto-char b) | |
290 (when (looking-at "^MIME-Version: 1.0$") | |
291 (delete-region (point) (progn (forward-line 1) (point)))) | |
292 t) | |
293 (with-current-buffer smime-details-buffer | |
294 (goto-char (point-max)) | |
295 (insert-buffer-substring buffer)) | |
296 (kill-buffer buffer)))) | |
297 | |
298 (defun smime-encrypt-region (b e certfiles) | |
299 "Encrypt region for recipients specified in CERTFILES. | |
300 If encryption fails, the buffer is not modified. Region is assumed to | |
301 have proper MIME tags. CERTFILES is a list of filenames, each file | |
302 is expected to contain of a PEM encoded certificate." | |
303 (smime-new-details-buffer) | |
304 (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*"))) | |
305 (tmpfile (smime-make-temp-file "smime"))) | |
306 (prog1 | |
307 (when (prog1 | |
308 (apply 'smime-call-openssl-region b e (list buffer tmpfile) | |
309 "smime" "-encrypt" smime-encrypt-cipher | |
310 (mapcar 'expand-file-name certfiles)) | |
311 (with-current-buffer smime-details-buffer | |
312 (insert-file-contents tmpfile) | |
313 (delete-file tmpfile))) | |
314 (delete-region b e) | |
315 (insert-buffer-substring buffer) | |
316 (goto-char b) | |
317 (when (looking-at "^MIME-Version: 1.0$") | |
318 (delete-region (point) (progn (forward-line 1) (point)))) | |
319 t) | |
320 (with-current-buffer smime-details-buffer | |
321 (goto-char (point-max)) | |
322 (insert-buffer-substring buffer)) | |
323 (kill-buffer buffer)))) | |
324 | |
325 ;; Sign+encrypt buffer | |
326 | |
327 (defun smime-sign-buffer (&optional keyfile buffer) | |
328 "S/MIME sign BUFFER with key in KEYFILE. | |
329 KEYFILE should contain a PEM encoded key and certificate." | |
330 (interactive) | |
331 (with-current-buffer (or buffer (current-buffer)) | |
332 (smime-sign-region | |
333 (point-min) (point-max) | |
334 (if keyfile | |
335 keyfile | |
336 (smime-get-key-with-certs-by-email | |
337 (completing-read | |
338 (concat "Sign using which key? " | |
339 (if smime-keys (concat "(default " (caar smime-keys) ") ") | |
340 "")) | |
341 smime-keys nil nil (car-safe (car-safe smime-keys)))))))) | |
342 | |
343 (defun smime-encrypt-buffer (&optional certfiles buffer) | |
344 "S/MIME encrypt BUFFER for recipients specified in CERTFILES. | |
345 CERTFILES is a list of filenames, each file is expected to consist of | |
346 a PEM encoded key and certificate. Uses current buffer if BUFFER is | |
347 nil." | |
348 (interactive) | |
349 (with-current-buffer (or buffer (current-buffer)) | |
350 (smime-encrypt-region | |
351 (point-min) (point-max) | |
352 (or certfiles | |
353 (list (read-file-name "Recipient's S/MIME certificate: " | |
354 smime-certificate-directory nil)))))) | |
355 | |
356 ;; Verify+decrypt region | |
357 | |
358 (defun smime-verify-region (b e) | |
359 "Verify S/MIME message in region between B and E. | |
360 Returns non-nil on success. | |
361 Any details (stdout and stderr) are left in the buffer specified by | |
362 `smime-details-buffer'." | |
363 (smime-new-details-buffer) | |
364 (let ((CAs (append (if smime-CA-file | |
365 (list "-CAfile" | |
366 (expand-file-name smime-CA-file))) | |
367 (if smime-CA-directory | |
368 (list "-CApath" | |
369 (expand-file-name smime-CA-directory)))))) | |
370 (unless CAs | |
371 (error "No CA configured")) | |
372 (if smime-crl-check | |
373 (add-to-list 'CAs smime-crl-check)) | |
374 (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t) | |
375 "smime" "-verify" "-out" "/dev/null" CAs) | |
376 t | |
377 (insert-buffer-substring smime-details-buffer) | |
378 nil))) | |
379 | |
380 (defun smime-noverify-region (b e) | |
381 "Verify integrity of S/MIME message in region between B and E. | |
382 Returns non-nil on success. | |
383 Any details (stdout and stderr) are left in the buffer specified by | |
384 `smime-details-buffer'." | |
385 (smime-new-details-buffer) | |
386 (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t) | |
387 "smime" "-verify" "-noverify" "-out" '("/dev/null")) | |
388 t | |
389 (insert-buffer-substring smime-details-buffer) | |
390 nil)) | |
391 | |
392 (eval-when-compile | |
393 (defvar from)) | |
394 | |
395 (defun smime-decrypt-region (b e keyfile) | |
396 "Decrypt S/MIME message in region between B and E with key in KEYFILE. | |
397 On success, replaces region with decrypted data and return non-nil. | |
398 Any details (stderr on success, stdout and stderr on error) are left | |
399 in the buffer specified by `smime-details-buffer'." | |
400 (smime-new-details-buffer) | |
401 (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*"))) | |
402 CAs (passphrase (smime-ask-passphrase)) | |
403 (tmpfile (smime-make-temp-file "smime"))) | |
404 (if passphrase | |
405 (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) | |
406 (if (prog1 | |
407 (apply 'smime-call-openssl-region b e | |
408 (list buffer tmpfile) | |
409 "smime" "-decrypt" "-recip" (expand-file-name keyfile) | |
410 (if passphrase | |
411 (list "-passin" "env:GNUS_SMIME_PASSPHRASE"))) | |
412 (if passphrase | |
413 (setenv "GNUS_SMIME_PASSPHRASE" "" t)) | |
414 (with-current-buffer smime-details-buffer | |
415 (insert-file-contents tmpfile) | |
416 (delete-file tmpfile))) | |
417 (progn | |
418 (delete-region b e) | |
419 (when (boundp 'from) | |
420 ;; `from' is dynamically bound in mm-dissect. | |
421 (insert "From: " from "\n")) | |
422 (insert-buffer-substring buffer) | |
423 (kill-buffer buffer) | |
424 t) | |
425 (with-current-buffer smime-details-buffer | |
426 (insert-buffer-substring buffer)) | |
427 (kill-buffer buffer) | |
428 (delete-region b e) | |
429 (insert-buffer-substring smime-details-buffer) | |
430 nil))) | |
431 | |
432 ;; Verify+Decrypt buffer | |
433 | |
434 (defun smime-verify-buffer (&optional buffer) | |
435 "Verify integrity of S/MIME message in BUFFER. | |
436 Uses current buffer if BUFFER is nil. Returns non-nil on success. | |
437 Any details (stdout and stderr) are left in the buffer specified by | |
438 `smime-details-buffer'." | |
439 (interactive) | |
440 (with-current-buffer (or buffer (current-buffer)) | |
441 (smime-verify-region (point-min) (point-max)))) | |
442 | |
443 (defun smime-noverify-buffer (&optional buffer) | |
444 "Verify integrity of S/MIME message in BUFFER. | |
445 Does NOT verify validity of certificate (only message integrity). | |
446 Uses current buffer if BUFFER is nil. Returns non-nil on success. | |
447 Any details (stdout and stderr) are left in the buffer specified by | |
448 `smime-details-buffer'." | |
449 (interactive) | |
450 (with-current-buffer (or buffer (current-buffer)) | |
451 (smime-noverify-region (point-min) (point-max)))) | |
452 | |
453 (defun smime-decrypt-buffer (&optional buffer keyfile) | |
454 "Decrypt S/MIME message in BUFFER using KEYFILE. | |
455 Uses current buffer if BUFFER is nil, and query user of KEYFILE if it's nil. | |
456 On success, replaces data in buffer and return non-nil. | |
457 Any details (stderr on success, stdout and stderr on error) are left | |
458 in the buffer specified by `smime-details-buffer'." | |
459 (interactive) | |
460 (with-current-buffer (or buffer (current-buffer)) | |
461 (smime-decrypt-region | |
462 (point-min) (point-max) | |
463 (expand-file-name | |
464 (or keyfile | |
465 (smime-get-key-by-email | |
466 (completing-read | |
467 (concat "Decipher using which key? " | |
468 (if smime-keys (concat "(default " (caar smime-keys) ") ") | |
469 "")) | |
470 smime-keys nil nil (car-safe (car-safe smime-keys))))))))) | |
471 | |
472 ;; Various operations | |
473 | |
474 (defun smime-new-details-buffer () | |
475 (with-current-buffer (get-buffer-create smime-details-buffer) | |
476 (erase-buffer))) | |
477 | |
478 (defun smime-pkcs7-region (b e) | |
479 "Convert S/MIME message between points B and E into a PKCS7 message." | |
480 (smime-new-details-buffer) | |
481 (when (smime-call-openssl-region b e smime-details-buffer "smime" "-pk7out") | |
482 (delete-region b e) | |
483 (insert-buffer-substring smime-details-buffer) | |
484 t)) | |
485 | |
486 (defun smime-pkcs7-certificates-region (b e) | |
487 "Extract any certificates enclosed in PKCS7 message between points B and E." | |
488 (smime-new-details-buffer) | |
489 (when (smime-call-openssl-region | |
490 b e smime-details-buffer "pkcs7" "-print_certs" "-text") | |
491 (delete-region b e) | |
492 (insert-buffer-substring smime-details-buffer) | |
493 t)) | |
494 | |
495 (defun smime-pkcs7-email-region (b e) | |
496 "Get email addresses contained in certificate between points B and E. | |
497 A string or a list of strings is returned." | |
498 (smime-new-details-buffer) | |
499 (when (smime-call-openssl-region | |
500 b e smime-details-buffer "x509" "-email" "-noout") | |
501 (delete-region b e) | |
502 (insert-buffer-substring smime-details-buffer) | |
503 t)) | |
504 | |
505 ;; Utility functions | |
506 | |
507 (defun smime-get-certfiles (keyfile keys) | |
508 (if keys | |
509 (let ((curkey (car keys)) | |
510 (otherkeys (cdr keys))) | |
511 (if (string= keyfile (cadr curkey)) | |
512 (caddr curkey) | |
513 (smime-get-certfiles keyfile otherkeys))))) | |
514 | |
515 ;; Use mm-util? | |
516 (eval-and-compile | |
517 (defalias 'smime-point-at-eol | |
518 (if (fboundp 'point-at-eol) | |
519 'point-at-eol | |
520 'line-end-position))) | |
521 | |
522 (defun smime-buffer-as-string-region (b e) | |
523 "Return each line in region between B and E as a list of strings." | |
524 (save-excursion | |
525 (goto-char b) | |
526 (let (res) | |
527 (while (< (point) e) | |
528 (let ((str (buffer-substring (point) (smime-point-at-eol)))) | |
529 (unless (string= "" str) | |
530 (push str res))) | |
531 (forward-line)) | |
532 res))) | |
533 | |
534 ;; Find certificates | |
535 | |
536 (defun smime-mail-to-domain (mailaddr) | |
537 (if (string-match "@" mailaddr) | |
538 (replace-match "." 'fixedcase 'literal mailaddr) | |
539 mailaddr)) | |
540 | |
541 (defun smime-cert-by-dns (mail) | |
542 (let* ((dig-dns-server smime-dns-server) | |
543 (digbuf (dig-invoke (smime-mail-to-domain mail) "cert" nil nil "+vc")) | |
544 (retbuf (generate-new-buffer (format "*certificate for %s*" mail))) | |
545 (certrr (with-current-buffer digbuf | |
546 (dig-extract-rr (smime-mail-to-domain mail) "cert"))) | |
547 (cert (and certrr (dig-rr-get-pkix-cert certrr)))) | |
548 (if cert | |
549 (with-current-buffer retbuf | |
550 (insert "-----BEGIN CERTIFICATE-----\n") | |
551 (let ((i 0) (len (length cert))) | |
552 (while (> (- len 64) i) | |
553 (insert (substring cert i (+ i 64)) "\n") | |
554 (setq i (+ i 64))) | |
555 (insert (substring cert i len) "\n")) | |
556 (insert "-----END CERTIFICATE-----\n")) | |
557 (kill-buffer retbuf) | |
558 (setq retbuf nil)) | |
559 (kill-buffer digbuf) | |
560 retbuf)) | |
561 | |
562 ;; User interface. | |
563 | |
564 (defvar smime-buffer "*SMIME*") | |
565 | |
566 (defvar smime-mode-map nil) | |
567 (put 'smime-mode 'mode-class 'special) | |
568 | |
569 (unless smime-mode-map | |
570 (setq smime-mode-map (make-sparse-keymap)) | |
571 (suppress-keymap smime-mode-map) | |
572 | |
573 (define-key smime-mode-map "q" 'smime-exit) | |
574 (define-key smime-mode-map "f" 'smime-certificate-info)) | |
575 | |
576 (defun smime-mode () | |
577 "Major mode for browsing, viewing and fetching certificates. | |
578 | |
579 All normal editing commands are switched off. | |
580 \\<smime-mode-map> | |
581 | |
582 The following commands are available: | |
583 | |
584 \\{smime-mode-map}" | |
585 (interactive) | |
586 (kill-all-local-variables) | |
587 (setq major-mode 'smime-mode) | |
588 (setq mode-name "SMIME") | |
589 (setq mode-line-process nil) | |
590 (use-local-map smime-mode-map) | |
591 (buffer-disable-undo) | |
592 (setq truncate-lines t) | |
593 (setq buffer-read-only t)) | |
594 | |
595 (defun smime-certificate-info (certfile) | |
596 (interactive "fCertificate file: ") | |
597 (let ((buffer (get-buffer-create (format "*certificate %s*" certfile)))) | |
598 (switch-to-buffer buffer) | |
599 (erase-buffer) | |
600 (call-process smime-openssl-program nil buffer 'display | |
601 "x509" "-in" (expand-file-name certfile) "-text") | |
602 (fundamental-mode) | |
603 (set-buffer-modified-p nil) | |
604 (toggle-read-only t) | |
605 (goto-char (point-min)))) | |
606 | |
607 (defun smime-draw-buffer () | |
608 (with-current-buffer smime-buffer | |
609 (let (buffer-read-only) | |
610 (erase-buffer) | |
611 (insert "\nYour keys:\n") | |
612 (dolist (key smime-keys) | |
613 (insert | |
614 (format "\t\t%s: %s\n" (car key) (cadr key)))) | |
615 (insert "\nTrusted Certificate Authoritys:\n") | |
616 (insert "\nKnown Certificates:\n")))) | |
617 | |
618 (defun smime () | |
619 "Go to the SMIME buffer." | |
620 (interactive) | |
621 (unless (get-buffer smime-buffer) | |
622 (save-excursion | |
623 (set-buffer (get-buffer-create smime-buffer)) | |
624 (smime-mode))) | |
625 (smime-draw-buffer) | |
626 (switch-to-buffer smime-buffer)) | |
627 | |
628 (defun smime-exit () | |
629 "Quit the S/MIME buffer." | |
630 (interactive) | |
631 (kill-buffer (current-buffer))) | |
632 | |
633 ;; Other functions | |
634 | |
635 (defun smime-get-key-by-email (email) | |
636 (cadr (assoc email smime-keys))) | |
637 | |
638 (defun smime-get-key-with-certs-by-email (email) | |
639 (cdr (assoc email smime-keys))) | |
640 | |
641 (provide 'smime) | |
642 | |
643 ;;; arch-tag: e3f9b938-5085-4510-8a11-6625269c9a9e | |
644 ;;; smime.el ends here |