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