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