Commit | Line | Data |
---|---|---|
23f87bed MB |
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." | |
a08b59c9 | 153 | :version "21.4" |
23f87bed MB |
154 | :type '(choice (const :tag "none" nil) |
155 | file) | |
156 | :group 'smime) | |
157 | ||
158 | (defcustom smime-certificate-directory "~/Mail/certs/" | |
159 | "*Directory containing other people's certificates. | |
160 | It should contain files named to the X.509 hash of the certificate, | |
161 | and the files themself should be in PEM format." | |
162 | ;The S/MIME library provide simple functionality for fetching | |
163 | ;certificates into this directory, so there is no need to populate it | |
164 | ;manually. | |
165 | :type 'directory | |
166 | :group 'smime) | |
167 | ||
168 | (defcustom smime-openssl-program | |
169 | (and (condition-case () | |
170 | (eq 0 (call-process "openssl" nil nil nil "version")) | |
171 | (error nil)) | |
172 | "openssl") | |
173 | "*Name of OpenSSL binary." | |
174 | :type 'string | |
175 | :group 'smime) | |
176 | ||
177 | ;; OpenSSL option to select the encryption cipher | |
178 | ||
179 | (defcustom smime-encrypt-cipher "-des3" | |
180 | "*Cipher algorithm used for encryption." | |
a08b59c9 | 181 | :version "21.4" |
23f87bed MB |
182 | :type '(choice (const :tag "Triple DES" "-des3") |
183 | (const :tag "DES" "-des") | |
184 | (const :tag "RC2 40 bits" "-rc2-40") | |
185 | (const :tag "RC2 64 bits" "-rc2-64") | |
186 | (const :tag "RC2 128 bits" "-rc2-128")) | |
187 | :group 'smime) | |
188 | ||
189 | (defcustom smime-crl-check nil | |
190 | "*Check revocation status of signers certificate using CRLs. | |
191 | Enabling this will have OpenSSL check the signers certificate | |
192 | against a certificate revocation list (CRL). | |
193 | ||
194 | For this to work the CRL must be up-to-date and since they are | |
195 | normally updated quite often (ie. several times a day) you | |
196 | probably need some tool to keep them up-to-date. Unfortunately | |
197 | Gnus cannot do this for you. | |
198 | ||
199 | The CRL should either be appended (in PEM format) to your | |
200 | `smime-CA-file' or be located in a file (also in PEM format) in | |
201 | your `smime-certificate-directory' named to the X.509 hash of the | |
202 | certificate with .r0 as file name extension. | |
203 | ||
204 | At least OpenSSL version 0.9.7 is required for this to work." | |
205 | :type '(choice (const :tag "No check" nil) | |
206 | (const :tag "Check certificate" "-crl_check") | |
207 | (const :tag "Check certificate chain" "-crl_check_all")) | |
208 | :group 'smime) | |
209 | ||
210 | (defcustom smime-dns-server nil | |
211 | "*DNS server to query certificates from. | |
212 | If nil, use system defaults." | |
a08b59c9 | 213 | :version "21.4" |
23f87bed MB |
214 | :type '(choice (const :tag "System defaults") |
215 | string) | |
216 | :group 'smime) | |
217 | ||
218 | (defvar smime-details-buffer "*OpenSSL output*") | |
219 | ||
220 | ;; Use mm-util? | |
221 | (eval-and-compile | |
222 | (defalias 'smime-make-temp-file | |
223 | (if (fboundp 'make-temp-file) | |
224 | 'make-temp-file | |
225 | (lambda (prefix &optional dir-flag) ;; Simple implementation | |
226 | (expand-file-name | |
227 | (make-temp-name prefix) | |
228 | (if (fboundp 'temp-directory) | |
229 | (temp-directory) | |
230 | temporary-file-directory)))))) | |
231 | ||
232 | ;; Password dialog function | |
233 | ||
234 | (defun smime-ask-passphrase () | |
235 | "Asks the passphrase to unlock the secret key." | |
236 | (let ((passphrase | |
237 | (read-passwd | |
238 | "Passphrase for secret key (RET for no passphrase): "))) | |
239 | (if (string= passphrase "") | |
240 | nil | |
241 | passphrase))) | |
242 | ||
243 | ;; OpenSSL wrappers. | |
244 | ||
245 | (defun smime-call-openssl-region (b e buf &rest args) | |
246 | (case (apply 'call-process-region b e smime-openssl-program nil buf nil args) | |
247 | (0 t) | |
248 | (1 (message "OpenSSL: An error occurred parsing the command options.") nil) | |
249 | (2 (message "OpenSSL: One of the input files could not be read.") nil) | |
250 | (3 (message "OpenSSL: An error occurred creating the PKCS#7 file or when reading the MIME message.") nil) | |
251 | (4 (message "OpenSSL: An error occurred decrypting or verifying the message.") nil) | |
252 | (t (error "Unknown OpenSSL exitcode") nil))) | |
253 | ||
254 | (defun smime-make-certfiles (certfiles) | |
255 | (if certfiles | |
256 | (append (list "-certfile" (expand-file-name (car certfiles))) | |
257 | (smime-make-certfiles (cdr certfiles))))) | |
258 | ||
259 | ;; Sign+encrypt region | |
260 | ||
261 | (defun smime-sign-region (b e keyfile) | |
262 | "Sign region with certified key in KEYFILE. | |
263 | If signing fails, the buffer is not modified. Region is assumed to | |
264 | have proper MIME tags. KEYFILE is expected to contain a PEM encoded | |
265 | private key and certificate as its car, and a list of additional | |
266 | certificates to include in its caar. If no additional certificates is | |
267 | included, KEYFILE may be the file containing the PEM encoded private | |
268 | key and certificate itself." | |
269 | (smime-new-details-buffer) | |
270 | (let ((keyfile (or (car-safe keyfile) keyfile)) | |
271 | (certfiles (and (cdr-safe keyfile) (cadr keyfile))) | |
272 | (buffer (generate-new-buffer (generate-new-buffer-name " *smime*"))) | |
273 | (passphrase (smime-ask-passphrase)) | |
274 | (tmpfile (smime-make-temp-file "smime"))) | |
275 | (if passphrase | |
276 | (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) | |
277 | (prog1 | |
278 | (when (prog1 | |
279 | (apply 'smime-call-openssl-region b e (list buffer tmpfile) | |
280 | "smime" "-sign" "-signer" (expand-file-name keyfile) | |
281 | (append | |
282 | (smime-make-certfiles certfiles) | |
283 | (if passphrase | |
284 | (list "-passin" "env:GNUS_SMIME_PASSPHRASE")))) | |
285 | (if passphrase | |
286 | (setenv "GNUS_SMIME_PASSPHRASE" "" t)) | |
287 | (with-current-buffer smime-details-buffer | |
288 | (insert-file-contents tmpfile) | |
289 | (delete-file tmpfile))) | |
290 | (delete-region b e) | |
291 | (insert-buffer-substring buffer) | |
292 | (goto-char b) | |
293 | (when (looking-at "^MIME-Version: 1.0$") | |
294 | (delete-region (point) (progn (forward-line 1) (point)))) | |
295 | t) | |
296 | (with-current-buffer smime-details-buffer | |
297 | (goto-char (point-max)) | |
298 | (insert-buffer-substring buffer)) | |
299 | (kill-buffer buffer)))) | |
300 | ||
301 | (defun smime-encrypt-region (b e certfiles) | |
302 | "Encrypt region for recipients specified in CERTFILES. | |
303 | If encryption fails, the buffer is not modified. Region is assumed to | |
304 | have proper MIME tags. CERTFILES is a list of filenames, each file | |
305 | is expected to contain of a PEM encoded certificate." | |
306 | (smime-new-details-buffer) | |
307 | (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*"))) | |
308 | (tmpfile (smime-make-temp-file "smime"))) | |
309 | (prog1 | |
310 | (when (prog1 | |
311 | (apply 'smime-call-openssl-region b e (list buffer tmpfile) | |
312 | "smime" "-encrypt" smime-encrypt-cipher | |
313 | (mapcar 'expand-file-name certfiles)) | |
314 | (with-current-buffer smime-details-buffer | |
315 | (insert-file-contents tmpfile) | |
316 | (delete-file tmpfile))) | |
317 | (delete-region b e) | |
318 | (insert-buffer-substring buffer) | |
319 | (goto-char b) | |
320 | (when (looking-at "^MIME-Version: 1.0$") | |
321 | (delete-region (point) (progn (forward-line 1) (point)))) | |
322 | t) | |
323 | (with-current-buffer smime-details-buffer | |
324 | (goto-char (point-max)) | |
325 | (insert-buffer-substring buffer)) | |
326 | (kill-buffer buffer)))) | |
327 | ||
328 | ;; Sign+encrypt buffer | |
329 | ||
330 | (defun smime-sign-buffer (&optional keyfile buffer) | |
331 | "S/MIME sign BUFFER with key in KEYFILE. | |
332 | KEYFILE should contain a PEM encoded key and certificate." | |
333 | (interactive) | |
334 | (with-current-buffer (or buffer (current-buffer)) | |
335 | (smime-sign-region | |
336 | (point-min) (point-max) | |
337 | (if keyfile | |
338 | keyfile | |
339 | (smime-get-key-with-certs-by-email | |
340 | (completing-read | |
341 | (concat "Sign using which key? " | |
342 | (if smime-keys (concat "(default " (caar smime-keys) ") ") | |
343 | "")) | |
344 | smime-keys nil nil (car-safe (car-safe smime-keys)))))))) | |
345 | ||
346 | (defun smime-encrypt-buffer (&optional certfiles buffer) | |
347 | "S/MIME encrypt BUFFER for recipients specified in CERTFILES. | |
348 | CERTFILES is a list of filenames, each file is expected to consist of | |
349 | a PEM encoded key and certificate. Uses current buffer if BUFFER is | |
350 | nil." | |
351 | (interactive) | |
352 | (with-current-buffer (or buffer (current-buffer)) | |
353 | (smime-encrypt-region | |
354 | (point-min) (point-max) | |
355 | (or certfiles | |
356 | (list (read-file-name "Recipient's S/MIME certificate: " | |
357 | smime-certificate-directory nil)))))) | |
358 | ||
359 | ;; Verify+decrypt region | |
360 | ||
361 | (defun smime-verify-region (b e) | |
362 | "Verify S/MIME message in region between B and E. | |
363 | Returns non-nil on success. | |
364 | Any details (stdout and stderr) are left in the buffer specified by | |
365 | `smime-details-buffer'." | |
366 | (smime-new-details-buffer) | |
367 | (let ((CAs (append (if smime-CA-file | |
368 | (list "-CAfile" | |
369 | (expand-file-name smime-CA-file))) | |
370 | (if smime-CA-directory | |
371 | (list "-CApath" | |
372 | (expand-file-name smime-CA-directory)))))) | |
373 | (unless CAs | |
374 | (error "No CA configured")) | |
375 | (if smime-crl-check | |
376 | (add-to-list 'CAs smime-crl-check)) | |
377 | (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t) | |
378 | "smime" "-verify" "-out" "/dev/null" CAs) | |
379 | t | |
380 | (insert-buffer-substring smime-details-buffer) | |
381 | nil))) | |
382 | ||
383 | (defun smime-noverify-region (b e) | |
384 | "Verify integrity of S/MIME message in region between B and E. | |
385 | Returns non-nil on success. | |
386 | Any details (stdout and stderr) are left in the buffer specified by | |
387 | `smime-details-buffer'." | |
388 | (smime-new-details-buffer) | |
389 | (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t) | |
390 | "smime" "-verify" "-noverify" "-out" '("/dev/null")) | |
391 | t | |
392 | (insert-buffer-substring smime-details-buffer) | |
393 | nil)) | |
394 | ||
395 | (eval-when-compile | |
396 | (defvar from)) | |
397 | ||
398 | (defun smime-decrypt-region (b e keyfile) | |
399 | "Decrypt S/MIME message in region between B and E with key in KEYFILE. | |
400 | On success, replaces region with decrypted data and return non-nil. | |
401 | Any details (stderr on success, stdout and stderr on error) are left | |
402 | in the buffer specified by `smime-details-buffer'." | |
403 | (smime-new-details-buffer) | |
404 | (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*"))) | |
405 | CAs (passphrase (smime-ask-passphrase)) | |
406 | (tmpfile (smime-make-temp-file "smime"))) | |
407 | (if passphrase | |
408 | (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) | |
409 | (if (prog1 | |
410 | (apply 'smime-call-openssl-region b e | |
411 | (list buffer tmpfile) | |
412 | "smime" "-decrypt" "-recip" (expand-file-name keyfile) | |
413 | (if passphrase | |
414 | (list "-passin" "env:GNUS_SMIME_PASSPHRASE"))) | |
415 | (if passphrase | |
416 | (setenv "GNUS_SMIME_PASSPHRASE" "" t)) | |
417 | (with-current-buffer smime-details-buffer | |
418 | (insert-file-contents tmpfile) | |
419 | (delete-file tmpfile))) | |
420 | (progn | |
421 | (delete-region b e) | |
422 | (when (boundp 'from) | |
423 | ;; `from' is dynamically bound in mm-dissect. | |
424 | (insert "From: " from "\n")) | |
425 | (insert-buffer-substring buffer) | |
426 | (kill-buffer buffer) | |
427 | t) | |
428 | (with-current-buffer smime-details-buffer | |
429 | (insert-buffer-substring buffer)) | |
430 | (kill-buffer buffer) | |
431 | (delete-region b e) | |
432 | (insert-buffer-substring smime-details-buffer) | |
433 | nil))) | |
434 | ||
435 | ;; Verify+Decrypt buffer | |
436 | ||
437 | (defun smime-verify-buffer (&optional buffer) | |
438 | "Verify integrity of S/MIME message in BUFFER. | |
439 | Uses current buffer if BUFFER is nil. Returns non-nil on success. | |
440 | Any details (stdout and stderr) are left in the buffer specified by | |
441 | `smime-details-buffer'." | |
442 | (interactive) | |
443 | (with-current-buffer (or buffer (current-buffer)) | |
444 | (smime-verify-region (point-min) (point-max)))) | |
445 | ||
446 | (defun smime-noverify-buffer (&optional buffer) | |
447 | "Verify integrity of S/MIME message in BUFFER. | |
448 | Does NOT verify validity of certificate (only message integrity). | |
449 | Uses current buffer if BUFFER is nil. Returns non-nil on success. | |
450 | Any details (stdout and stderr) are left in the buffer specified by | |
451 | `smime-details-buffer'." | |
452 | (interactive) | |
453 | (with-current-buffer (or buffer (current-buffer)) | |
454 | (smime-noverify-region (point-min) (point-max)))) | |
455 | ||
456 | (defun smime-decrypt-buffer (&optional buffer keyfile) | |
457 | "Decrypt S/MIME message in BUFFER using KEYFILE. | |
458 | Uses current buffer if BUFFER is nil, and query user of KEYFILE if it's nil. | |
459 | On success, replaces data in buffer and return non-nil. | |
460 | Any details (stderr on success, stdout and stderr on error) are left | |
461 | in the buffer specified by `smime-details-buffer'." | |
462 | (interactive) | |
463 | (with-current-buffer (or buffer (current-buffer)) | |
464 | (smime-decrypt-region | |
465 | (point-min) (point-max) | |
466 | (expand-file-name | |
467 | (or keyfile | |
468 | (smime-get-key-by-email | |
469 | (completing-read | |
470 | (concat "Decipher using which key? " | |
471 | (if smime-keys (concat "(default " (caar smime-keys) ") ") | |
472 | "")) | |
473 | smime-keys nil nil (car-safe (car-safe smime-keys))))))))) | |
474 | ||
475 | ;; Various operations | |
476 | ||
477 | (defun smime-new-details-buffer () | |
478 | (with-current-buffer (get-buffer-create smime-details-buffer) | |
479 | (erase-buffer))) | |
480 | ||
481 | (defun smime-pkcs7-region (b e) | |
482 | "Convert S/MIME message between points B and E into a PKCS7 message." | |
483 | (smime-new-details-buffer) | |
484 | (when (smime-call-openssl-region b e smime-details-buffer "smime" "-pk7out") | |
485 | (delete-region b e) | |
486 | (insert-buffer-substring smime-details-buffer) | |
487 | t)) | |
488 | ||
489 | (defun smime-pkcs7-certificates-region (b e) | |
490 | "Extract any certificates enclosed in PKCS7 message between points B and E." | |
491 | (smime-new-details-buffer) | |
492 | (when (smime-call-openssl-region | |
493 | b e smime-details-buffer "pkcs7" "-print_certs" "-text") | |
494 | (delete-region b e) | |
495 | (insert-buffer-substring smime-details-buffer) | |
496 | t)) | |
497 | ||
498 | (defun smime-pkcs7-email-region (b e) | |
499 | "Get email addresses contained in certificate between points B and E. | |
500 | A string or a list of strings is returned." | |
501 | (smime-new-details-buffer) | |
502 | (when (smime-call-openssl-region | |
503 | b e smime-details-buffer "x509" "-email" "-noout") | |
504 | (delete-region b e) | |
505 | (insert-buffer-substring smime-details-buffer) | |
506 | t)) | |
507 | ||
508 | ;; Utility functions | |
509 | ||
510 | (defun smime-get-certfiles (keyfile keys) | |
511 | (if keys | |
512 | (let ((curkey (car keys)) | |
513 | (otherkeys (cdr keys))) | |
514 | (if (string= keyfile (cadr curkey)) | |
515 | (caddr curkey) | |
516 | (smime-get-certfiles keyfile otherkeys))))) | |
517 | ||
518 | ;; Use mm-util? | |
519 | (eval-and-compile | |
520 | (defalias 'smime-point-at-eol | |
521 | (if (fboundp 'point-at-eol) | |
522 | 'point-at-eol | |
523 | 'line-end-position))) | |
524 | ||
525 | (defun smime-buffer-as-string-region (b e) | |
526 | "Return each line in region between B and E as a list of strings." | |
527 | (save-excursion | |
528 | (goto-char b) | |
529 | (let (res) | |
530 | (while (< (point) e) | |
531 | (let ((str (buffer-substring (point) (smime-point-at-eol)))) | |
532 | (unless (string= "" str) | |
533 | (push str res))) | |
534 | (forward-line)) | |
535 | res))) | |
536 | ||
537 | ;; Find certificates | |
538 | ||
539 | (defun smime-mail-to-domain (mailaddr) | |
540 | (if (string-match "@" mailaddr) | |
541 | (replace-match "." 'fixedcase 'literal mailaddr) | |
542 | mailaddr)) | |
543 | ||
544 | (defun smime-cert-by-dns (mail) | |
545 | (let* ((dig-dns-server smime-dns-server) | |
546 | (digbuf (dig-invoke (smime-mail-to-domain mail) "cert" nil nil "+vc")) | |
547 | (retbuf (generate-new-buffer (format "*certificate for %s*" mail))) | |
548 | (certrr (with-current-buffer digbuf | |
549 | (dig-extract-rr (smime-mail-to-domain mail) "cert"))) | |
550 | (cert (and certrr (dig-rr-get-pkix-cert certrr)))) | |
551 | (if cert | |
552 | (with-current-buffer retbuf | |
553 | (insert "-----BEGIN CERTIFICATE-----\n") | |
554 | (let ((i 0) (len (length cert))) | |
555 | (while (> (- len 64) i) | |
556 | (insert (substring cert i (+ i 64)) "\n") | |
557 | (setq i (+ i 64))) | |
558 | (insert (substring cert i len) "\n")) | |
559 | (insert "-----END CERTIFICATE-----\n")) | |
560 | (kill-buffer retbuf) | |
561 | (setq retbuf nil)) | |
562 | (kill-buffer digbuf) | |
563 | retbuf)) | |
564 | ||
565 | ;; User interface. | |
566 | ||
567 | (defvar smime-buffer "*SMIME*") | |
568 | ||
569 | (defvar smime-mode-map nil) | |
570 | (put 'smime-mode 'mode-class 'special) | |
571 | ||
572 | (unless smime-mode-map | |
573 | (setq smime-mode-map (make-sparse-keymap)) | |
574 | (suppress-keymap smime-mode-map) | |
575 | ||
576 | (define-key smime-mode-map "q" 'smime-exit) | |
577 | (define-key smime-mode-map "f" 'smime-certificate-info)) | |
578 | ||
579 | (defun smime-mode () | |
580 | "Major mode for browsing, viewing and fetching certificates. | |
581 | ||
582 | All normal editing commands are switched off. | |
583 | \\<smime-mode-map> | |
584 | ||
585 | The following commands are available: | |
586 | ||
587 | \\{smime-mode-map}" | |
588 | (interactive) | |
589 | (kill-all-local-variables) | |
590 | (setq major-mode 'smime-mode) | |
591 | (setq mode-name "SMIME") | |
592 | (setq mode-line-process nil) | |
593 | (use-local-map smime-mode-map) | |
594 | (buffer-disable-undo) | |
595 | (setq truncate-lines t) | |
596 | (setq buffer-read-only t)) | |
597 | ||
598 | (defun smime-certificate-info (certfile) | |
599 | (interactive "fCertificate file: ") | |
600 | (let ((buffer (get-buffer-create (format "*certificate %s*" certfile)))) | |
601 | (switch-to-buffer buffer) | |
602 | (erase-buffer) | |
603 | (call-process smime-openssl-program nil buffer 'display | |
604 | "x509" "-in" (expand-file-name certfile) "-text") | |
605 | (fundamental-mode) | |
606 | (set-buffer-modified-p nil) | |
607 | (toggle-read-only t) | |
608 | (goto-char (point-min)))) | |
609 | ||
610 | (defun smime-draw-buffer () | |
611 | (with-current-buffer smime-buffer | |
612 | (let (buffer-read-only) | |
613 | (erase-buffer) | |
614 | (insert "\nYour keys:\n") | |
615 | (dolist (key smime-keys) | |
616 | (insert | |
617 | (format "\t\t%s: %s\n" (car key) (cadr key)))) | |
618 | (insert "\nTrusted Certificate Authoritys:\n") | |
619 | (insert "\nKnown Certificates:\n")))) | |
620 | ||
621 | (defun smime () | |
622 | "Go to the SMIME buffer." | |
623 | (interactive) | |
624 | (unless (get-buffer smime-buffer) | |
625 | (save-excursion | |
626 | (set-buffer (get-buffer-create smime-buffer)) | |
627 | (smime-mode))) | |
628 | (smime-draw-buffer) | |
629 | (switch-to-buffer smime-buffer)) | |
630 | ||
631 | (defun smime-exit () | |
632 | "Quit the S/MIME buffer." | |
633 | (interactive) | |
634 | (kill-buffer (current-buffer))) | |
635 | ||
636 | ;; Other functions | |
637 | ||
638 | (defun smime-get-key-by-email (email) | |
639 | (cadr (assoc email smime-keys))) | |
640 | ||
641 | (defun smime-get-key-with-certs-by-email (email) | |
642 | (cdr (assoc email smime-keys))) | |
643 | ||
644 | (provide 'smime) | |
645 | ||
646 | ;;; arch-tag: e3f9b938-5085-4510-8a11-6625269c9a9e | |
647 | ;;; smime.el ends here |