Commit | Line | Data |
---|---|---|
23f87bed | 1 | ;;; smime.el --- S/MIME support library |
e84b4b86 | 2 | |
3615c80c GM |
3 | ;; Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008, |
4 | ;; 2009, 2010 Free Software Foundation, Inc. | |
23f87bed MB |
5 | |
6 | ;; Author: Simon Josefsson <simon@josefsson.org> | |
7 | ;; Keywords: SMIME X.509 PEM OpenSSL | |
8 | ||
9 | ;; This file is part of GNU Emacs. | |
10 | ||
5e809f55 GM |
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 by | |
13 | ;; the Free Software Foundation, either version 3 of the License, or | |
14 | ;; (at your option) any later version. | |
23f87bed | 15 | |
5e809f55 GM |
16 | ;; GNU Emacs is distributed in the hope that it will be useful, |
17 | ;; but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ;; GNU General Public License for more details. | |
23f87bed MB |
20 | |
21 | ;; You should have received a copy of the GNU General Public License | |
5e809f55 | 22 | ;; along with GNU Emacs. If not, see <http://www.gnu.org/licenses/>. |
23f87bed MB |
23 | |
24 | ;;; Commentary: | |
25 | ||
26 | ;; This library perform S/MIME operations from within Emacs. | |
27 | ;; | |
28 | ;; Functions for fetching certificates from public repositories are | |
01c52d31 | 29 | ;; provided, currently from DNS and LDAP. |
23f87bed MB |
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 | ;; | |
bff3818b | 45 | ;; The home of this file is in Gnus, but also available from |
23f87bed MB |
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 | |
6772c8e1 | 66 | ;; your message MIME armored and a signature. Encryption, M-x |
23f87bed MB |
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 | |
01c52d31 | 118 | ;; 2005-02-13 retrieve certificates via LDAP |
23f87bed MB |
119 | |
120 | ;;; Code: | |
121 | ||
f0b7f5a8 | 122 | ;; For Emacs <22.2 and XEmacs. |
8d0f97a4 GM |
123 | (eval-and-compile |
124 | (unless (fboundp 'declare-function) (defmacro declare-function (&rest r)))) | |
23f87bed | 125 | (require 'dig) |
87035689 MB |
126 | |
127 | (if (locate-library "password-cache") | |
128 | (require 'password-cache) | |
129 | (require 'password)) | |
130 | ||
23f87bed MB |
131 | (eval-when-compile (require 'cl)) |
132 | ||
01c52d31 MB |
133 | (eval-and-compile |
134 | (cond | |
135 | ((fboundp 'replace-in-string) | |
136 | (defalias 'smime-replace-in-string 'replace-in-string)) | |
137 | ((fboundp 'replace-regexp-in-string) | |
138 | (defun smime-replace-in-string (string regexp newtext &optional literal) | |
139 | "Replace all matches for REGEXP with NEWTEXT in STRING. | |
140 | If LITERAL is non-nil, insert NEWTEXT literally. Return a new | |
141 | string containing the replacements. | |
142 | ||
143 | This is a compatibility function for different Emacsen." | |
144 | (replace-regexp-in-string regexp newtext string nil literal))))) | |
145 | ||
23f87bed | 146 | (defgroup smime nil |
d0859c9a MB |
147 | "S/MIME configuration." |
148 | :group 'mime) | |
23f87bed MB |
149 | |
150 | (defcustom smime-keys nil | |
151 | "*Map mail addresses to a file containing Certificate (and private key). | |
152 | The file is assumed to be in PEM format. You can also associate additional | |
153 | certificates to be sent with every message to each address." | |
154 | :type '(repeat (list (string :tag "Mail address") | |
155 | (file :tag "File name") | |
156 | (repeat :tag "Additional certificate files" | |
157 | (file :tag "File name")))) | |
158 | :group 'smime) | |
159 | ||
160 | (defcustom smime-CA-directory nil | |
161 | "*Directory containing certificates for CAs you trust. | |
162 | Directory should contain files (in PEM format) named to the X.509 | |
163 | hash of the certificate. This can be done using OpenSSL such as: | |
164 | ||
165 | $ ln -s ca.pem `openssl x509 -noout -hash -in ca.pem`.0 | |
166 | ||
167 | where `ca.pem' is the file containing a PEM encoded X.509 CA | |
168 | certificate." | |
169 | :type '(choice (const :tag "none" nil) | |
170 | directory) | |
171 | :group 'smime) | |
172 | ||
173 | (defcustom smime-CA-file nil | |
174 | "*Files containing certificates for CAs you trust. | |
175 | File should contain certificates in PEM format." | |
bf247b6e | 176 | :version "22.1" |
23f87bed MB |
177 | :type '(choice (const :tag "none" nil) |
178 | file) | |
179 | :group 'smime) | |
180 | ||
181 | (defcustom smime-certificate-directory "~/Mail/certs/" | |
182 | "*Directory containing other people's certificates. | |
183 | It should contain files named to the X.509 hash of the certificate, | |
184 | and the files themself should be in PEM format." | |
185 | ;The S/MIME library provide simple functionality for fetching | |
186 | ;certificates into this directory, so there is no need to populate it | |
187 | ;manually. | |
188 | :type 'directory | |
189 | :group 'smime) | |
190 | ||
191 | (defcustom smime-openssl-program | |
192 | (and (condition-case () | |
193 | (eq 0 (call-process "openssl" nil nil nil "version")) | |
194 | (error nil)) | |
195 | "openssl") | |
196 | "*Name of OpenSSL binary." | |
197 | :type 'string | |
198 | :group 'smime) | |
199 | ||
200 | ;; OpenSSL option to select the encryption cipher | |
201 | ||
202 | (defcustom smime-encrypt-cipher "-des3" | |
203 | "*Cipher algorithm used for encryption." | |
bf247b6e | 204 | :version "22.1" |
23f87bed MB |
205 | :type '(choice (const :tag "Triple DES" "-des3") |
206 | (const :tag "DES" "-des") | |
207 | (const :tag "RC2 40 bits" "-rc2-40") | |
208 | (const :tag "RC2 64 bits" "-rc2-64") | |
209 | (const :tag "RC2 128 bits" "-rc2-128")) | |
210 | :group 'smime) | |
211 | ||
212 | (defcustom smime-crl-check nil | |
213 | "*Check revocation status of signers certificate using CRLs. | |
214 | Enabling this will have OpenSSL check the signers certificate | |
215 | against a certificate revocation list (CRL). | |
216 | ||
217 | For this to work the CRL must be up-to-date and since they are | |
218 | normally updated quite often (ie. several times a day) you | |
219 | probably need some tool to keep them up-to-date. Unfortunately | |
220 | Gnus cannot do this for you. | |
221 | ||
222 | The CRL should either be appended (in PEM format) to your | |
223 | `smime-CA-file' or be located in a file (also in PEM format) in | |
224 | your `smime-certificate-directory' named to the X.509 hash of the | |
225 | certificate with .r0 as file name extension. | |
226 | ||
227 | At least OpenSSL version 0.9.7 is required for this to work." | |
228 | :type '(choice (const :tag "No check" nil) | |
229 | (const :tag "Check certificate" "-crl_check") | |
230 | (const :tag "Check certificate chain" "-crl_check_all")) | |
231 | :group 'smime) | |
232 | ||
233 | (defcustom smime-dns-server nil | |
234 | "*DNS server to query certificates from. | |
235 | If nil, use system defaults." | |
bf247b6e | 236 | :version "22.1" |
23f87bed MB |
237 | :type '(choice (const :tag "System defaults") |
238 | string) | |
239 | :group 'smime) | |
240 | ||
01c52d31 MB |
241 | (defcustom smime-ldap-host-list nil |
242 | "A list of LDAP hosts with S/MIME user certificates. | |
243 | If needed search base, binddn, passwd, etc. for the LDAP host | |
244 | must be set in `ldap-host-parameters-alist'." | |
245 | :type '(repeat (string :tag "Host name")) | |
330f707b | 246 | :version "23.1" ;; No Gnus |
01c52d31 MB |
247 | :group 'smime) |
248 | ||
23f87bed MB |
249 | (defvar smime-details-buffer "*OpenSSL output*") |
250 | ||
251 | ;; Use mm-util? | |
252 | (eval-and-compile | |
253 | (defalias 'smime-make-temp-file | |
254 | (if (fboundp 'make-temp-file) | |
255 | 'make-temp-file | |
256 | (lambda (prefix &optional dir-flag) ;; Simple implementation | |
257 | (expand-file-name | |
258 | (make-temp-name prefix) | |
259 | (if (fboundp 'temp-directory) | |
260 | (temp-directory) | |
261 | temporary-file-directory)))))) | |
262 | ||
263 | ;; Password dialog function | |
8d0f97a4 | 264 | (declare-function password-read-and-add "password-cache" (prompt &optional key)) |
23f87bed | 265 | |
01c52d31 MB |
266 | (defun smime-ask-passphrase (&optional cache-key) |
267 | "Asks the passphrase to unlock the secret key. | |
268 | If `cache-key' and `password-cache' is non-nil then cache the | |
269 | password under `cache-key'." | |
23f87bed | 270 | (let ((passphrase |
01c52d31 MB |
271 | (password-read-and-add |
272 | "Passphrase for secret key (RET for no passphrase): " cache-key))) | |
23f87bed MB |
273 | (if (string= passphrase "") |
274 | nil | |
275 | passphrase))) | |
276 | ||
277 | ;; OpenSSL wrappers. | |
278 | ||
279 | (defun smime-call-openssl-region (b e buf &rest args) | |
280 | (case (apply 'call-process-region b e smime-openssl-program nil buf nil args) | |
281 | (0 t) | |
282 | (1 (message "OpenSSL: An error occurred parsing the command options.") nil) | |
283 | (2 (message "OpenSSL: One of the input files could not be read.") nil) | |
284 | (3 (message "OpenSSL: An error occurred creating the PKCS#7 file or when reading the MIME message.") nil) | |
285 | (4 (message "OpenSSL: An error occurred decrypting or verifying the message.") nil) | |
286 | (t (error "Unknown OpenSSL exitcode") nil))) | |
287 | ||
288 | (defun smime-make-certfiles (certfiles) | |
289 | (if certfiles | |
290 | (append (list "-certfile" (expand-file-name (car certfiles))) | |
291 | (smime-make-certfiles (cdr certfiles))))) | |
292 | ||
293 | ;; Sign+encrypt region | |
294 | ||
295 | (defun smime-sign-region (b e keyfile) | |
296 | "Sign region with certified key in KEYFILE. | |
297 | If signing fails, the buffer is not modified. Region is assumed to | |
298 | have proper MIME tags. KEYFILE is expected to contain a PEM encoded | |
299 | private key and certificate as its car, and a list of additional | |
300 | certificates to include in its caar. If no additional certificates is | |
301 | included, KEYFILE may be the file containing the PEM encoded private | |
302 | key and certificate itself." | |
303 | (smime-new-details-buffer) | |
01c52d31 MB |
304 | (let* ((certfiles (and (cdr-safe keyfile) (cadr keyfile))) |
305 | (keyfile (or (car-safe keyfile) keyfile)) | |
e7ec307c | 306 | (buffer (generate-new-buffer " *smime*")) |
01c52d31 MB |
307 | (passphrase (smime-ask-passphrase (expand-file-name keyfile))) |
308 | (tmpfile (smime-make-temp-file "smime"))) | |
23f87bed MB |
309 | (if passphrase |
310 | (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) | |
311 | (prog1 | |
312 | (when (prog1 | |
313 | (apply 'smime-call-openssl-region b e (list buffer tmpfile) | |
314 | "smime" "-sign" "-signer" (expand-file-name keyfile) | |
315 | (append | |
316 | (smime-make-certfiles certfiles) | |
317 | (if passphrase | |
318 | (list "-passin" "env:GNUS_SMIME_PASSPHRASE")))) | |
319 | (if passphrase | |
320 | (setenv "GNUS_SMIME_PASSPHRASE" "" t)) | |
321 | (with-current-buffer smime-details-buffer | |
322 | (insert-file-contents tmpfile) | |
323 | (delete-file tmpfile))) | |
324 | (delete-region b e) | |
325 | (insert-buffer-substring buffer) | |
326 | (goto-char b) | |
327 | (when (looking-at "^MIME-Version: 1.0$") | |
328 | (delete-region (point) (progn (forward-line 1) (point)))) | |
329 | t) | |
330 | (with-current-buffer smime-details-buffer | |
331 | (goto-char (point-max)) | |
332 | (insert-buffer-substring buffer)) | |
333 | (kill-buffer buffer)))) | |
334 | ||
335 | (defun smime-encrypt-region (b e certfiles) | |
336 | "Encrypt region for recipients specified in CERTFILES. | |
337 | If encryption fails, the buffer is not modified. Region is assumed to | |
338 | have proper MIME tags. CERTFILES is a list of filenames, each file | |
339 | is expected to contain of a PEM encoded certificate." | |
340 | (smime-new-details-buffer) | |
e7ec307c | 341 | (let ((buffer (generate-new-buffer " *smime*")) |
23f87bed MB |
342 | (tmpfile (smime-make-temp-file "smime"))) |
343 | (prog1 | |
344 | (when (prog1 | |
345 | (apply 'smime-call-openssl-region b e (list buffer tmpfile) | |
346 | "smime" "-encrypt" smime-encrypt-cipher | |
347 | (mapcar 'expand-file-name certfiles)) | |
348 | (with-current-buffer smime-details-buffer | |
349 | (insert-file-contents tmpfile) | |
350 | (delete-file tmpfile))) | |
351 | (delete-region b e) | |
352 | (insert-buffer-substring buffer) | |
353 | (goto-char b) | |
354 | (when (looking-at "^MIME-Version: 1.0$") | |
355 | (delete-region (point) (progn (forward-line 1) (point)))) | |
356 | t) | |
357 | (with-current-buffer smime-details-buffer | |
358 | (goto-char (point-max)) | |
359 | (insert-buffer-substring buffer)) | |
360 | (kill-buffer buffer)))) | |
361 | ||
362 | ;; Sign+encrypt buffer | |
363 | ||
364 | (defun smime-sign-buffer (&optional keyfile buffer) | |
365 | "S/MIME sign BUFFER with key in KEYFILE. | |
366 | KEYFILE should contain a PEM encoded key and certificate." | |
367 | (interactive) | |
368 | (with-current-buffer (or buffer (current-buffer)) | |
ff4d3926 MB |
369 | (unless (smime-sign-region |
370 | (point-min) (point-max) | |
371 | (if keyfile | |
372 | keyfile | |
373 | (smime-get-key-with-certs-by-email | |
229b59da G |
374 | (gnus-completing-read |
375 | "Sign using key" | |
376 | smime-keys nil (car-safe (car-safe smime-keys)))))) | |
ff4d3926 | 377 | (error "Signing failed")))) |
23f87bed MB |
378 | |
379 | (defun smime-encrypt-buffer (&optional certfiles buffer) | |
380 | "S/MIME encrypt BUFFER for recipients specified in CERTFILES. | |
381 | CERTFILES is a list of filenames, each file is expected to consist of | |
382 | a PEM encoded key and certificate. Uses current buffer if BUFFER is | |
383 | nil." | |
384 | (interactive) | |
385 | (with-current-buffer (or buffer (current-buffer)) | |
ff4d3926 MB |
386 | (unless (smime-encrypt-region |
387 | (point-min) (point-max) | |
388 | (or certfiles | |
389 | (list (read-file-name "Recipient's S/MIME certificate: " | |
390 | smime-certificate-directory nil)))) | |
391 | (error "Encryption failed")))) | |
23f87bed MB |
392 | |
393 | ;; Verify+decrypt region | |
394 | ||
395 | (defun smime-verify-region (b e) | |
396 | "Verify S/MIME message in region between B and E. | |
397 | Returns non-nil on success. | |
398 | Any details (stdout and stderr) are left in the buffer specified by | |
399 | `smime-details-buffer'." | |
400 | (smime-new-details-buffer) | |
401 | (let ((CAs (append (if smime-CA-file | |
402 | (list "-CAfile" | |
403 | (expand-file-name smime-CA-file))) | |
404 | (if smime-CA-directory | |
405 | (list "-CApath" | |
406 | (expand-file-name smime-CA-directory)))))) | |
407 | (unless CAs | |
408 | (error "No CA configured")) | |
409 | (if smime-crl-check | |
410 | (add-to-list 'CAs smime-crl-check)) | |
411 | (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t) | |
412 | "smime" "-verify" "-out" "/dev/null" CAs) | |
413 | t | |
414 | (insert-buffer-substring smime-details-buffer) | |
415 | nil))) | |
416 | ||
417 | (defun smime-noverify-region (b e) | |
418 | "Verify integrity of S/MIME message in region between B and E. | |
419 | Returns non-nil on success. | |
420 | Any details (stdout and stderr) are left in the buffer specified by | |
421 | `smime-details-buffer'." | |
422 | (smime-new-details-buffer) | |
423 | (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t) | |
424 | "smime" "-verify" "-noverify" "-out" '("/dev/null")) | |
425 | t | |
426 | (insert-buffer-substring smime-details-buffer) | |
427 | nil)) | |
428 | ||
b0feab7d | 429 | (defun smime-decrypt-region (b e keyfile &optional from) |
23f87bed | 430 | "Decrypt S/MIME message in region between B and E with key in KEYFILE. |
2ff71e9b | 431 | Optional FROM specifies sender's mail address. |
23f87bed MB |
432 | On success, replaces region with decrypted data and return non-nil. |
433 | Any details (stderr on success, stdout and stderr on error) are left | |
434 | in the buffer specified by `smime-details-buffer'." | |
435 | (smime-new-details-buffer) | |
e7ec307c | 436 | (let ((buffer (generate-new-buffer " *smime*")) |
01c52d31 | 437 | CAs (passphrase (smime-ask-passphrase (expand-file-name keyfile))) |
23f87bed MB |
438 | (tmpfile (smime-make-temp-file "smime"))) |
439 | (if passphrase | |
440 | (setenv "GNUS_SMIME_PASSPHRASE" passphrase)) | |
441 | (if (prog1 | |
442 | (apply 'smime-call-openssl-region b e | |
443 | (list buffer tmpfile) | |
444 | "smime" "-decrypt" "-recip" (expand-file-name keyfile) | |
445 | (if passphrase | |
446 | (list "-passin" "env:GNUS_SMIME_PASSPHRASE"))) | |
447 | (if passphrase | |
448 | (setenv "GNUS_SMIME_PASSPHRASE" "" t)) | |
449 | (with-current-buffer smime-details-buffer | |
450 | (insert-file-contents tmpfile) | |
451 | (delete-file tmpfile))) | |
452 | (progn | |
453 | (delete-region b e) | |
b0feab7d | 454 | (when from |
23f87bed MB |
455 | (insert "From: " from "\n")) |
456 | (insert-buffer-substring buffer) | |
457 | (kill-buffer buffer) | |
458 | t) | |
459 | (with-current-buffer smime-details-buffer | |
460 | (insert-buffer-substring buffer)) | |
461 | (kill-buffer buffer) | |
462 | (delete-region b e) | |
463 | (insert-buffer-substring smime-details-buffer) | |
464 | nil))) | |
465 | ||
466 | ;; Verify+Decrypt buffer | |
467 | ||
468 | (defun smime-verify-buffer (&optional buffer) | |
469 | "Verify integrity of S/MIME message in BUFFER. | |
470 | Uses current buffer if BUFFER is nil. Returns non-nil on success. | |
471 | Any details (stdout and stderr) are left in the buffer specified by | |
472 | `smime-details-buffer'." | |
473 | (interactive) | |
474 | (with-current-buffer (or buffer (current-buffer)) | |
475 | (smime-verify-region (point-min) (point-max)))) | |
476 | ||
477 | (defun smime-noverify-buffer (&optional buffer) | |
478 | "Verify integrity of S/MIME message in BUFFER. | |
479 | Does NOT verify validity of certificate (only message integrity). | |
480 | Uses current buffer if BUFFER is nil. Returns non-nil on success. | |
481 | Any details (stdout and stderr) are left in the buffer specified by | |
482 | `smime-details-buffer'." | |
483 | (interactive) | |
484 | (with-current-buffer (or buffer (current-buffer)) | |
485 | (smime-noverify-region (point-min) (point-max)))) | |
486 | ||
487 | (defun smime-decrypt-buffer (&optional buffer keyfile) | |
488 | "Decrypt S/MIME message in BUFFER using KEYFILE. | |
489 | Uses current buffer if BUFFER is nil, and query user of KEYFILE if it's nil. | |
490 | On success, replaces data in buffer and return non-nil. | |
491 | Any details (stderr on success, stdout and stderr on error) are left | |
492 | in the buffer specified by `smime-details-buffer'." | |
493 | (interactive) | |
494 | (with-current-buffer (or buffer (current-buffer)) | |
495 | (smime-decrypt-region | |
496 | (point-min) (point-max) | |
497 | (expand-file-name | |
498 | (or keyfile | |
499 | (smime-get-key-by-email | |
229b59da G |
500 | (gnus-completing-read |
501 | "Decipher using key" | |
502 | smime-keys nil (car-safe (car-safe smime-keys))))))))) | |
23f87bed MB |
503 | |
504 | ;; Various operations | |
505 | ||
506 | (defun smime-new-details-buffer () | |
507 | (with-current-buffer (get-buffer-create smime-details-buffer) | |
508 | (erase-buffer))) | |
509 | ||
510 | (defun smime-pkcs7-region (b e) | |
511 | "Convert S/MIME message between points B and E into a PKCS7 message." | |
512 | (smime-new-details-buffer) | |
513 | (when (smime-call-openssl-region b e smime-details-buffer "smime" "-pk7out") | |
514 | (delete-region b e) | |
515 | (insert-buffer-substring smime-details-buffer) | |
516 | t)) | |
517 | ||
518 | (defun smime-pkcs7-certificates-region (b e) | |
519 | "Extract any certificates enclosed in PKCS7 message between points B and E." | |
520 | (smime-new-details-buffer) | |
521 | (when (smime-call-openssl-region | |
522 | b e smime-details-buffer "pkcs7" "-print_certs" "-text") | |
523 | (delete-region b e) | |
524 | (insert-buffer-substring smime-details-buffer) | |
525 | t)) | |
526 | ||
527 | (defun smime-pkcs7-email-region (b e) | |
528 | "Get email addresses contained in certificate between points B and E. | |
529 | A string or a list of strings is returned." | |
530 | (smime-new-details-buffer) | |
531 | (when (smime-call-openssl-region | |
532 | b e smime-details-buffer "x509" "-email" "-noout") | |
533 | (delete-region b e) | |
534 | (insert-buffer-substring smime-details-buffer) | |
535 | t)) | |
536 | ||
537 | ;; Utility functions | |
538 | ||
539 | (defun smime-get-certfiles (keyfile keys) | |
540 | (if keys | |
541 | (let ((curkey (car keys)) | |
542 | (otherkeys (cdr keys))) | |
543 | (if (string= keyfile (cadr curkey)) | |
544 | (caddr curkey) | |
545 | (smime-get-certfiles keyfile otherkeys))))) | |
546 | ||
23f87bed MB |
547 | (defun smime-buffer-as-string-region (b e) |
548 | "Return each line in region between B and E as a list of strings." | |
549 | (save-excursion | |
550 | (goto-char b) | |
551 | (let (res) | |
552 | (while (< (point) e) | |
01c52d31 | 553 | (let ((str (buffer-substring (point) (point-at-eol)))) |
23f87bed MB |
554 | (unless (string= "" str) |
555 | (push str res))) | |
556 | (forward-line)) | |
557 | res))) | |
558 | ||
559 | ;; Find certificates | |
560 | ||
561 | (defun smime-mail-to-domain (mailaddr) | |
562 | (if (string-match "@" mailaddr) | |
563 | (replace-match "." 'fixedcase 'literal mailaddr) | |
564 | mailaddr)) | |
565 | ||
566 | (defun smime-cert-by-dns (mail) | |
01c52d31 | 567 | "Find certificate via DNS for address MAIL." |
23f87bed MB |
568 | (let* ((dig-dns-server smime-dns-server) |
569 | (digbuf (dig-invoke (smime-mail-to-domain mail) "cert" nil nil "+vc")) | |
570 | (retbuf (generate-new-buffer (format "*certificate for %s*" mail))) | |
571 | (certrr (with-current-buffer digbuf | |
572 | (dig-extract-rr (smime-mail-to-domain mail) "cert"))) | |
573 | (cert (and certrr (dig-rr-get-pkix-cert certrr)))) | |
574 | (if cert | |
575 | (with-current-buffer retbuf | |
576 | (insert "-----BEGIN CERTIFICATE-----\n") | |
577 | (let ((i 0) (len (length cert))) | |
578 | (while (> (- len 64) i) | |
579 | (insert (substring cert i (+ i 64)) "\n") | |
580 | (setq i (+ i 64))) | |
581 | (insert (substring cert i len) "\n")) | |
582 | (insert "-----END CERTIFICATE-----\n")) | |
583 | (kill-buffer retbuf) | |
584 | (setq retbuf nil)) | |
585 | (kill-buffer digbuf) | |
586 | retbuf)) | |
587 | ||
b10d32ef GM |
588 | (declare-function ldap-search "ldap" |
589 | (filter &optional host attributes attrsonly withdn)) | |
590 | ||
01c52d31 MB |
591 | (defun smime-cert-by-ldap-1 (mail host) |
592 | "Get cetificate for MAIL from the ldap server at HOST." | |
145cc6b9 RS |
593 | (let ((ldapresult |
594 | (funcall | |
3615c80c | 595 | (if (featurep 'xemacs) |
145cc6b9 RS |
596 | (progn |
597 | (require 'smime-ldap) | |
598 | 'smime-ldap-search) | |
b10d32ef GM |
599 | (progn |
600 | (require 'ldap) | |
601 | 'ldap-search)) | |
145cc6b9 RS |
602 | (concat "mail=" mail) |
603 | host '("userCertificate") nil)) | |
01c52d31 MB |
604 | (retbuf (generate-new-buffer (format "*certificate for %s*" mail))) |
605 | cert) | |
606 | (if (and (>= (length ldapresult) 1) | |
607 | (> (length (cadaar ldapresult)) 0)) | |
608 | (with-current-buffer retbuf | |
609 | ;; Certificates on LDAP servers _should_ be in DER format, | |
610 | ;; but there are some servers out there that distributes the | |
611 | ;; certificates in PEM format (with or without | |
612 | ;; header/footer) so we try to handle them anyway. | |
613 | (if (or (string= (substring (cadaar ldapresult) 0 27) | |
614 | "-----BEGIN CERTIFICATE-----") | |
615 | (string= (substring (cadaar ldapresult) 0 3) | |
616 | "MII")) | |
617 | (setq cert | |
618 | (smime-replace-in-string | |
619 | (cadaar ldapresult) | |
620 | (concat "\\(\n\\|\r\\|-----BEGIN CERTIFICATE-----\\|" | |
621 | "-----END CERTIFICATE-----\\)") | |
622 | "" t)) | |
623 | (setq cert (base64-encode-string (cadaar ldapresult) t))) | |
624 | (insert "-----BEGIN CERTIFICATE-----\n") | |
625 | (let ((i 0) (len (length cert))) | |
626 | (while (> (- len 64) i) | |
627 | (insert (substring cert i (+ i 64)) "\n") | |
628 | (setq i (+ i 64))) | |
629 | (insert (substring cert i len) "\n")) | |
630 | (insert "-----END CERTIFICATE-----\n")) | |
631 | (kill-buffer retbuf) | |
632 | (setq retbuf nil)) | |
633 | retbuf)) | |
634 | ||
635 | (defun smime-cert-by-ldap (mail) | |
636 | "Find certificate via LDAP for address MAIL." | |
637 | (if smime-ldap-host-list | |
638 | (catch 'certbuf | |
639 | (dolist (host smime-ldap-host-list) | |
640 | (let ((retbuf (smime-cert-by-ldap-1 mail host))) | |
641 | (when retbuf | |
642 | (throw 'certbuf retbuf))))))) | |
643 | ||
23f87bed MB |
644 | ;; User interface. |
645 | ||
646 | (defvar smime-buffer "*SMIME*") | |
647 | ||
ec54e7a4 SM |
648 | (defvar smime-mode-map |
649 | (let ((map (make-sparse-keymap))) | |
650 | (suppress-keymap map) | |
651 | (define-key map "q" 'smime-exit) | |
652 | (define-key map "f" 'smime-certificate-info) | |
653 | map)) | |
23f87bed | 654 | |
229b59da | 655 | (autoload 'gnus-completing-read "gnus-util") |
48fd2675 | 656 | |
ec54e7a4 SM |
657 | (put 'smime-mode 'mode-class 'special) |
658 | (define-derived-mode smime-mode fundamental-mode ;special-mode | |
659 | "SMIME" | |
23f87bed MB |
660 | "Major mode for browsing, viewing and fetching certificates. |
661 | ||
662 | All normal editing commands are switched off. | |
663 | \\<smime-mode-map> | |
664 | ||
665 | The following commands are available: | |
666 | ||
667 | \\{smime-mode-map}" | |
23f87bed | 668 | (setq mode-line-process nil) |
23f87bed MB |
669 | (buffer-disable-undo) |
670 | (setq truncate-lines t) | |
ec54e7a4 | 671 | (setq buffer-read-only t)) |
23f87bed MB |
672 | |
673 | (defun smime-certificate-info (certfile) | |
674 | (interactive "fCertificate file: ") | |
675 | (let ((buffer (get-buffer-create (format "*certificate %s*" certfile)))) | |
676 | (switch-to-buffer buffer) | |
677 | (erase-buffer) | |
678 | (call-process smime-openssl-program nil buffer 'display | |
679 | "x509" "-in" (expand-file-name certfile) "-text") | |
680 | (fundamental-mode) | |
681 | (set-buffer-modified-p nil) | |
682 | (toggle-read-only t) | |
683 | (goto-char (point-min)))) | |
684 | ||
685 | (defun smime-draw-buffer () | |
686 | (with-current-buffer smime-buffer | |
687 | (let (buffer-read-only) | |
688 | (erase-buffer) | |
689 | (insert "\nYour keys:\n") | |
690 | (dolist (key smime-keys) | |
691 | (insert | |
692 | (format "\t\t%s: %s\n" (car key) (cadr key)))) | |
693 | (insert "\nTrusted Certificate Authoritys:\n") | |
694 | (insert "\nKnown Certificates:\n")))) | |
695 | ||
696 | (defun smime () | |
697 | "Go to the SMIME buffer." | |
698 | (interactive) | |
699 | (unless (get-buffer smime-buffer) | |
20a673b2 | 700 | (with-current-buffer (get-buffer-create smime-buffer) |
23f87bed MB |
701 | (smime-mode))) |
702 | (smime-draw-buffer) | |
703 | (switch-to-buffer smime-buffer)) | |
704 | ||
705 | (defun smime-exit () | |
706 | "Quit the S/MIME buffer." | |
707 | (interactive) | |
708 | (kill-buffer (current-buffer))) | |
709 | ||
710 | ;; Other functions | |
711 | ||
712 | (defun smime-get-key-by-email (email) | |
713 | (cadr (assoc email smime-keys))) | |
714 | ||
715 | (defun smime-get-key-with-certs-by-email (email) | |
716 | (cdr (assoc email smime-keys))) | |
717 | ||
718 | (provide 'smime) | |
719 | ||
23f87bed | 720 | ;;; smime.el ends here |