Mercurial > hg > xemacs-beta

comparison src/tls.c @ 5814:a216b3c2b09e

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
Add TLS support. See xemacs-patches message with ID <CAHCOHQk6FNm2xf=XiGEpPq43+7WOzNZ=SuD9V79o3wb9WVCTrQ@mail.gmail.com>.
author Jerry James <james@xemacs.org>
date Tue, 07 Oct 2014 21:16:10 -0600
parents
children d59bfb050ca8
comparison
equal deleted inserted replaced
5813:36dddf9d90d1 5814:a216b3c2b09e
1 /* Transport Layer Security implementation.
2 Copyright (C) 2014 Jerry James
3
4 This file is part of XEmacs.
5
6 XEmacs is free software: you can redistribute it and/or modify it
7 under the terms of the GNU General Public License as published by the
8 Free Software Foundation, either version 3 of the License, or (at your
9 option) any later version.
10
11 XEmacs is distributed in the hope that it will be useful, but WITHOUT
12 ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
13 FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License
14 for more details.
15
16 You should have received a copy of the GNU General Public License
17 along with XEmacs. If not, see <http://www.gnu.org/licenses/>. */
18
19 /* Synched up with: Not in FSF. */
20
21 /* Written by Jerry James. */
22
23 #include <config.h>
24 #include "lisp.h"
25 #include "lstream.h"
26 #include "tls.h"
27 #include <errno.h>
28 #include <netinet/in.h>
29 #include <netinet/tcp.h>
30
31 static Lisp_Object prompt;
32 static Lisp_Object Qread_password;
33 Lisp_Object Qtls_error;
34
35 #ifdef HAVE_NSS
36 #include <prinit.h>
37 #include <private/pprio.h>
38 #include <nss.h>
39 #include <pk11pub.h>
40 #include <secerr.h>
41 #include <secmod.h>
42 #include <ssl.h>
43
44 #define NSS_ERRSTR build_extstring (PR_ErrorToName (PR_GetError ()), Qnative)
45
46 /* 0 == initialization of NSPR or NSS failed
47 * 1 == the NSPR and NSS libraries have been initialized successfully
48 */
49 static int nss_inited;
50
51 /* The model file descriptor */
52 static PRFileDesc *nss_model;
53
54 /* The PEM module */
55 static SECMODModule *nss_pem_module;
56
57 /* CA and trust objects go into slot 0. User certificates start in slot 1. */
58 static CK_SLOT_ID nss_slot_count = 1;
59
60 int
61 tls_get_fd (tls_state_t *state)
62 {
63 return PR_FileDesc2NativeHandle (state->tls_file_desc);
64 }
65
66 Bytecount
67 tls_read (tls_state_t *state, unsigned char *data, Bytecount size,
68 unsigned int allow_quit)
69 {
70 if (allow_quit)
71 QUIT;
72 return (Bytecount) PR_Recv (state->tls_file_desc, data, size, 0, 0);
73 }
74
75 Bytecount
76 tls_write (tls_state_t *state, const unsigned char *data, Bytecount size,
77 unsigned int allow_quit)
78 {
79 if (allow_quit)
80 QUIT;
81 return (Bytecount) PR_Send (state->tls_file_desc, data, size, 0, 0);
82 }
83
84 int
85 tls_close (tls_state_t *state)
86 {
87 if (--state->tls_refcount == 0)
88 {
89 PRStatus status = PR_Shutdown (state->tls_file_desc, PR_SHUTDOWN_BOTH);
90 PR_Close (state->tls_file_desc);
91 xfree (state);
92 return (int) status;
93 }
94 return 0;
95 }
96
97 tls_state_t *
98 tls_open (int s, const Extbyte *hostname)
99 {
100 struct sockaddr *addr;
101 socklen_t addrlen;
102 PRNetAddr pr_addr;
103 tls_state_t *nspr;
104 const int val = 1;
105
106 /* Disable Nagle's algorithm */
107 setsockopt (s, IPPROTO_TCP, TCP_NODELAY, &val, sizeof(val));
108
109 if (!nss_inited)
110 {
111 warn_when_safe (Qtls_error, Qerror, "Cannot use NSS functions");
112 return NULL;
113 }
114
115 /* Get the socket address */
116 addrlen = 256;
117 addr = (struct sockaddr *) xmalloc (addrlen);
118 if (getsockname (s, addr, &addrlen) == 0 && addrlen > 256)
119 {
120 addr = (struct sockaddr *) xrealloc (addr, addrlen);
121 getsockname (s, addr, &addrlen);
122 }
123
124 /* Create the socket */
125 nspr = xmalloc (sizeof (*nspr));
126 nspr->tls_refcount = 2;
127 nspr->tls_file_desc =
128 SSL_ImportFD (nss_model, PR_OpenTCPSocket (addr->sa_family));
129 if (nspr->tls_file_desc == NULL)
130 {
131 xfree (addr);
132 xfree (nspr);
133 warn_when_safe (Qtls_error, Qerror, "NSS unable to open socket: %s",
134 PR_ErrorToName (PR_GetError ()));
135 return NULL;
136 }
137
138 /* Connect to the server */
139 memset (&pr_addr, 0, sizeof (pr_addr));
140 if (addr->sa_family == AF_INET)
141 {
142 struct sockaddr_in *in_addr = (struct sockaddr_in *) addr;
143 pr_addr.inet.family = in_addr->sin_family;
144 pr_addr.inet.port = in_addr->sin_port;
145 pr_addr.inet.ip = in_addr->sin_addr.s_addr;
146 }
147 else
148 {
149 struct sockaddr_in6 *in_addr = (struct sockaddr_in6 *) addr;
150 pr_addr.ipv6.family = in_addr->sin6_family;
151 pr_addr.ipv6.port = in_addr->sin6_port;
152 pr_addr.ipv6.flowinfo = in_addr->sin6_flowinfo;
153 memcpy (pr_addr.ipv6.ip.pr_s6_addr, in_addr->sin6_addr.s6_addr,
154 sizeof (pr_addr.ipv6.ip.pr_s6_addr));
155 pr_addr.ipv6.scope_id = in_addr->sin6_scope_id;
156 }
157 xfree (addr);
158 if (PR_Connect (nspr->tls_file_desc, &pr_addr, PR_INTERVAL_NO_TIMEOUT)
159 != PR_SUCCESS)
160 {
161 if (PR_GetError () == PR_IN_PROGRESS_ERROR)
162 {
163 PRPollDesc pollset[2];
164
165 pollset[0].in_flags = PR_POLL_WRITE | PR_POLL_EXCEPT;
166 pollset[0].out_flags = 0;
167 pollset[0].fd = nspr->tls_file_desc;
168 for (;;)
169 {
170 PRInt32 num_fds = PR_Poll (pollset, 1, PR_INTERVAL_NO_TIMEOUT);
171 if (num_fds < 0)
172 {
173 PR_Close (nspr->tls_file_desc);
174 xfree (nspr);
175 warn_when_safe (Qtls_error, Qerror,
176 "NSS unable to connect: %s",
177 PR_ErrorToName (PR_GetError ()));
178 return NULL;
179 }
180 if (PR_GetConnectStatus (pollset) == PR_SUCCESS)
181 break;
182 }
183 }
184 else
185 {
186 PR_Close (nspr->tls_file_desc);
187 xfree (nspr);
188 warn_when_safe (Qtls_error, Qerror, "NSS unable to connect: %s",
189 PR_ErrorToName (PR_GetError ()));
190 return NULL;
191 }
192 }
193
194 /* Perform the handshake */
195 if (SSL_ResetHandshake (nspr->tls_file_desc, PR_FALSE) != SECSuccess)
196 {
197 PR_Close (nspr->tls_file_desc);
198 xfree (nspr);
199 warn_when_safe (Qtls_error, Qerror, "NSS unable to reset handshake: %s",
200 PR_ErrorToName (PR_GetError ()));
201 errno = EACCES;
202 return NULL;
203 }
204 if (hostname != NULL &&
205 SSL_SetURL (nspr->tls_file_desc, hostname) != SECSuccess)
206 {
207 PR_Close (nspr->tls_file_desc);
208 xfree (nspr);
209 warn_when_safe (Qtls_error, Qerror, "NSS unable to set URL (%s): %s",
210 hostname, PR_ErrorToName (PR_GetError ()));
211 errno = EACCES;
212 return NULL;
213 }
214 if (SSL_ForceHandshake (nspr->tls_file_desc) != SECSuccess)
215 {
216 PR_Close (nspr->tls_file_desc);
217 xfree (nspr);
218 warn_when_safe (Qtls_error, Qerror,
219 "NSS unable to complete handshake: %s",
220 PR_ErrorToName (PR_GetError ()));
221 errno = EACCES;
222 return NULL;
223 }
224 return nspr;
225 }
226
227 /* Set the key and certificate files to use */
228 static void
229 tls_set_x509_key_file (const Extbyte *certfile, const Extbyte *keyfile)
230 {
231 char name[32];
232 void *proto_win = NULL;
233 PK11SlotInfo *slot = NULL;
234 PK11GenericObject *obj;
235 CERTCertificate *cert;
236 CK_ATTRIBUTE attrs[4];
237 CK_BBOOL cktrue = CK_TRUE, ckfalse = CK_FALSE;
238 CK_OBJECT_CLASS objClass = CKO_PRIVATE_KEY;
239 CK_SLOT_ID slot_id = nss_slot_count++;
240 int retry_count = 0;
241
242 /* Load the PEM module if it hasn't already been loaded */
243 if (nss_pem_module == NULL)
244 {
245 nss_pem_module = SECMOD_LoadUserModule ("library=%s name=PEM parameters=\"\"", NULL, PR_FALSE);
246 if (nss_pem_module == NULL)
247 signal_error (Qtls_error, "Cannot find NSS PEM module", NSS_ERRSTR);
248 if (!nss_pem_module->loaded)
249 signal_error (Qtls_error, "Cannot load NSS PEM module", NSS_ERRSTR);
250 }
251
252 snprintf (name, 32U, "PEM_Token %ld", slot_id);
253 slot = PK11_FindSlotByName (name);
254 if (slot == NULL)
255 signal_error (Qtls_error, "Error finding NSS slot", NSS_ERRSTR);
256
257 /* Set up the attributes for the keyfile */
258 attrs[0].type = CKA_CLASS;
259 attrs[0].pValue = &objClass;
260 attrs[0].ulValueLen = sizeof (objClass);
261 attrs[1].type = CKA_TOKEN;
262 attrs[1].pValue = &cktrue;
263 attrs[1].ulValueLen = sizeof (CK_BBOOL);
264 attrs[2].type = CKA_LABEL;
265 attrs[2].pValue = (void *) keyfile;
266 attrs[2].ulValueLen = strlen (keyfile) + 1U;
267
268 /* When adding an encrypted key, the PKCS#11 will be set as removed. */
269 obj = PK11_CreateGenericObject (slot, attrs, 3, PR_FALSE);
270 if (obj == NULL)
271 {
272 PR_SetError (SEC_ERROR_BAD_KEY, 0);
273 signal_error (Qtls_error, "Bad key file", NSS_ERRSTR);
274 }
275
276 /* This will force the token to be seen as reinserted */
277 SECMOD_WaitForAnyTokenEvent (nss_pem_module, 0, 0);
278 PK11_IsPresent (slot);
279
280 if (PK11_Authenticate (slot, PR_TRUE, &retry_count) != SECSuccess)
281 signal_error (Qtls_error, "NSS: Unable to authenticate", NSS_ERRSTR);
282
283 /* Set up the attributes for the certfile */
284 objClass = CKO_CERTIFICATE;
285 attrs[2].pValue = (void *) certfile;
286 attrs[2].ulValueLen = strlen (certfile) + 1U;
287 attrs[3].type = CKA_TRUST;
288 attrs[3].pValue = &ckfalse;
289 attrs[3].ulValueLen = sizeof (CK_BBOOL);
290
291 obj = PK11_CreateGenericObject (slot, attrs, 4, PR_FALSE);
292 PK11_FreeSlot (slot);
293 if (obj == NULL)
294 signal_error (Qtls_error, "Bad certificate file", NSS_ERRSTR);
295 cert = PK11_FindCertFromNickname (name, proto_win);
296 if (cert == NULL)
297 signal_error (Qtls_error, "Cannot find certificate nickname", NSS_ERRSTR);
298 CERT_DestroyCertificate (cert);
299 }
300
301 /* Function that gathers passwords for PKCS #11 tokens. */
302 static char *
303 nss_pk11_password (PK11SlotInfo *slot, PRBool retry, void * UNUSED (arg))
304 {
305 Lisp_Object lsp_password, args[2];
306 Extbyte *c_password, *nss_password;
307 const Extbyte *token_name;
308
309 if (retry)
310 return NULL;
311
312 token_name = PK11_GetTokenName (slot);
313 if (token_name == NULL)
314 token_name = "security token";
315 lsp_password =
316 call1 (Qread_password, concat2 (prompt,
317 build_extstring (token_name, Qnative)));
318 c_password = LISP_STRING_TO_EXTERNAL (lsp_password, Qnative);
319 nss_password = PL_strdup (c_password);
320
321 /* Wipe out the password on the stack and in the Lisp string */
322 args[0] = lsp_password;
323 args[1] = make_char ('*');
324 Ffill (2, args);
325 memset (c_password, '*', strlen (c_password));
326 return nss_password;
327 }
328
329 void
330 init_tls (void)
331 {
332 SECMODModule *module;
333
334 /* Check that we are using compatible versions */
335 if (PR_VersionCheck(PR_VERSION) == PR_FALSE)
336 signal_error (Qinternal_error,
337 "NSPR version mismatch: expected " PR_VERSION, Qnil);
338 if (NSS_VersionCheck(NSS_VERSION) == PR_FALSE)
339 signal_error (Qinternal_error,
340 "NSS version mismatch: expected " NSS_VERSION, Qnil);
341
342 /* Basic initialization of both libraries */
343 PR_Init (PR_USER_THREAD, PR_PRIORITY_NORMAL, 0);
344 if (NSS_Init ("sql:/etc/pki/nssdb") != SECSuccess)
345 signal_error (Qtls_error, "Error initializing NSS", NSS_ERRSTR);
346
347 /* Set the cipher suite policy */
348 if (NSS_SetDomesticPolicy() != SECSuccess)
349 signal_error (Qtls_error, "NSS unable to set policy", NSS_ERRSTR);
350
351 /* Load the root certificates */
352 module = SECMOD_LoadUserModule ("library=libnssckbi.so name=\"Root Certs\"",
353 NULL, PR_FALSE);
354 if (module == NULL || !module->loaded)
355 signal_error (Qtls_error, "NSS unable to load root certificates",
356 NSS_ERRSTR);
357
358 /* Setup password gathering */
359 PK11_SetPasswordFunc (nss_pk11_password);
360
361 /* Create the model file descriptors */
362 nss_model = SSL_ImportFD (NULL, PR_OpenTCPSocket (PR_AF_INET));
363 if (nss_model == NULL)
364 {
365 nss_model = SSL_ImportFD (NULL, PR_OpenTCPSocket (PR_AF_INET6));
366 if (nss_model == NULL)
367 signal_error (Qtls_error, "NSS cannot create model socket",
368 NSS_ERRSTR);
369 }
370
371 /* Set options on the model socket */
372 if (SSL_OptionSet (nss_model, SSL_SECURITY, PR_TRUE) != SECSuccess)
373 signal_error (Qtls_error, "NSS cannot enable model socket", NSS_ERRSTR);
374 if (SSL_OptionSet (nss_model, SSL_ENABLE_SSL2, PR_FALSE) != SECSuccess)
375 signal_error (Qtls_error, "NSS unable to disable SSLv2", NSS_ERRSTR);
376 if (SSL_OptionSet (nss_model, SSL_V2_COMPATIBLE_HELLO, PR_FALSE)
377 != SECSuccess)
378 signal_error (Qtls_error, "NSS unable to disable SSLv2 handshake",
379 NSS_ERRSTR);
380 if (SSL_OptionSet (nss_model, SSL_ENABLE_DEFLATE, PR_FALSE) != SECSuccess)
381 signal_error (Qtls_error, "NSS unable to disable deflate", NSS_ERRSTR);
382 if (SSL_OptionSet (nss_model, SSL_HANDSHAKE_AS_CLIENT, PR_TRUE)
383 != SECSuccess)
384 signal_error (Qtls_error, "NSS unable to ensable handshake as client",
385 NSS_ERRSTR);
386
387 nss_inited = 1;
388 }
389 #endif /* HAVE_NSS */
390
391 #ifdef HAVE_GNUTLS
392 #include <gnutls/pkcs11.h>
393 #include <gnutls/x509.h>
394 #include "sysfile.h"
395
396 #define GNUTLS_ERRSTR(err) build_extstring (gnutls_strerror (err), Qnative)
397
398 /* The global credentials object */
399 static gnutls_certificate_credentials_t global_cred;
400
401 int
402 tls_get_fd (tls_state_t *state)
403 {
404 return (int)(unsigned long)gnutls_transport_get_ptr (state->tls_session);
405 }
406
407 Bytecount
408 tls_read (tls_state_t *state, unsigned char *data, Bytecount size,
409 unsigned int allow_quit)
410 {
411 ssize_t bytes;
412
413 again:
414 do
415 {
416 if (allow_quit)
417 QUIT;
418 bytes = gnutls_record_recv (state->tls_session, data, size);
419 }
420 while (bytes == GNUTLS_E_INTERRUPTED || bytes == GNUTLS_E_AGAIN);
421 switch (bytes)
422 {
423 case GNUTLS_E_UNEXPECTED_PACKET_LENGTH:
424 bytes = 0;
425 break;
426 case GNUTLS_E_REHANDSHAKE:
427 {
428 int err;
429
430 do
431 err = gnutls_handshake (state->tls_session);
432 while (err == GNUTLS_E_AGAIN || err == GNUTLS_E_INTERRUPTED);
433 if (err == GNUTLS_E_SUCCESS)
434 goto again;
435 }
436 errno = EACCES;
437 bytes = -1;
438 break;
439 default:
440 if (bytes < 0 && errno == 0)
441 {
442 errno = EPIPE;
443 bytes = -1;
444 }
445 break;
446 }
447 return (Bytecount) bytes;
448 }
449
450 Bytecount
451 tls_write (tls_state_t *state, const unsigned char *data, Bytecount size,
452 unsigned int allow_quit)
453 {
454 ssize_t bytes;
455
456 do
457 {
458 if (allow_quit)
459 QUIT;
460 bytes = gnutls_record_send (state->tls_session, data, size);
461 }
462 while (bytes == GNUTLS_E_INTERRUPTED || bytes == GNUTLS_E_AGAIN);
463 if (bytes == GNUTLS_E_LARGE_PACKET)
464 {
465 errno = EMSGSIZE;
466 bytes = -1;
467 }
468 else if (bytes < 0 && errno == 0)
469 {
470 errno = EPIPE;
471 bytes = -1;
472 }
473 return (Bytecount) bytes;
474 }
475
476 int
477 tls_close (tls_state_t *state)
478 {
479 if (--state->tls_refcount == 0)
480 {
481 int fd, err;
482
483 fd = (int)(unsigned long)gnutls_transport_get_ptr (state->tls_session);
484 gnutls_bye (state->tls_session, GNUTLS_SHUT_RDWR);
485 err = retry_close (fd);
486 gnutls_deinit (state->tls_session);
487 xfree (state);
488 return err;
489 }
490 return 0;
491 }
492
493 tls_state_t *
494 tls_open (int s, const Extbyte *hostname)
495 {
496 #ifndef HAVE_GNUTLS_CERTIFICATE_VERIFY_PEERS3
497 gnutls_x509_crt_t cert;
498 #endif
499 tls_state_t *gnutls;
500 const char *errptr = NULL;
501 const gnutls_datum_t *certs;
502 unsigned int status, certslen = 0U;
503 int err;
504 const int val = 1;
505
506 /* Disable Nagle's algorithm */
507 setsockopt (s, IPPROTO_TCP, TCP_NODELAY, &val, sizeof(val));
508
509 /* Create the state object */
510 gnutls = xmalloc (sizeof (*gnutls));
511 gnutls->tls_refcount = 2;
512
513 /* Initialize the session object */
514 err = gnutls_init (&gnutls->tls_session, GNUTLS_CLIENT);
515 if (err != GNUTLS_E_SUCCESS)
516 {
517 xfree (gnutls);
518 warn_when_safe (Qtls_error, Qerror, "GNUTLS error in gnutls_init: %s",
519 gnutls_strerror (err));
520 errno = EACCES;
521 return NULL;
522 }
523
524 /* Configure the cipher preferences */
525 err = gnutls_priority_set_direct (gnutls->tls_session, "NORMAL", &errptr);
526 if (err != GNUTLS_E_SUCCESS)
527 {
528 xfree (gnutls);
529 warn_when_safe (Qtls_error, Qerror,
530 "GNUTLS error in gnutls_priority_set_direct: %s at %s",
531 gnutls_strerror (err), errptr);
532 errno = EACCES;
533 return NULL;
534 }
535
536 /* Install the trusted certificates */
537 err = gnutls_credentials_set (gnutls->tls_session, GNUTLS_CRD_CERTIFICATE,
538 global_cred);
539 if (err != GNUTLS_E_SUCCESS)
540 {
541 xfree (gnutls);
542 warn_when_safe (Qtls_error, Qerror,
543 "GNUTLS error in gnutls_credentials_set: %s",
544 gnutls_strerror (err));
545 errno = EACCES;
546 return NULL;
547 }
548
549 /* Associate the socket with the session object */
550 gnutls_transport_set_ptr (gnutls->tls_session,
551 (gnutls_transport_ptr_t)(unsigned long)s);
552
553 /* Set the server name */
554 if (hostname != NULL)
555 {
556 err = gnutls_server_name_set (gnutls->tls_session, GNUTLS_NAME_DNS,
557 hostname, strlen (hostname));
558 if (err != GNUTLS_E_SUCCESS)
559 {
560 xfree (gnutls);
561 warn_when_safe (Qtls_error, Qerror,
562 "GNUTLS error in gnutls_server_name_set: %s",
563 gnutls_strerror (err));
564 errno = EACCES;
565 return NULL;
566 }
567 }
568
569 /* Perform the handshake */
570 do
571 err = gnutls_handshake (gnutls->tls_session);
572 while (err == GNUTLS_E_AGAIN || err == GNUTLS_E_INTERRUPTED);
573 if (err != GNUTLS_E_SUCCESS)
574 {
575 xfree (gnutls);
576 warn_when_safe (Qtls_error, Qerror,
577 "GNUTLS error in gnutls_handshake: %s",
578 gnutls_strerror (err));
579 errno = EACCES;
580 return NULL;
581 }
582
583 /* Get the server certificate chain */
584 certs = gnutls_certificate_get_peers (gnutls->tls_session, &certslen);
585 if (certs == NULL || certslen == 0U)
586 {
587 xfree (gnutls);
588 warn_when_safe (Qtls_error, Qerror,
589 "GNUTLS could not get peer certificate: %s",
590 gnutls_strerror (err));
591 errno = EACCES;
592 return NULL;
593 }
594
595 /* Validate the server certificate chain */
596 status = (unsigned int) -1;
597 #ifdef HAVE_GNUTLS_CERTIFICATE_VERIFY_PEERS3
598 if (hostname != NULL)
599 err = gnutls_certificate_verify_peers3 (gnutls->tls_session, hostname,
600 &status);
601 else
602 #endif /* HAVE_GNUTLS_CERTIFICATE_VERIFY_PEERS3 */
603 err = gnutls_certificate_verify_peers2 (gnutls->tls_session, &status);
604 if (err != GNUTLS_E_SUCCESS)
605 {
606 xfree (gnutls);
607 warn_when_safe (Qtls_error, Qerror,
608 "GNUTLS could not verify peer certificate: %s",
609 gnutls_strerror (err));
610 errno = EACCES;
611 return NULL;
612 }
613 if (status != 0U)
614 {
615 gnutls_datum_t msg;
616
617 #ifdef HAVE_GNUTLS_CERTIFICATE_VERIFICATION_STATUS_PRINT
618 int type = gnutls_certificate_type_get (gnutls->tls_session);
619 err =
620 gnutls_certificate_verification_status_print (status, type, &msg, 0);
621 #else
622 err = -1;
623 #endif /* HAVE_GNUTLS_CERTIFICATE_VERIFICATION_STATUS_PRINT */
624 xfree (gnutls);
625 if (err == 0)
626 {
627 warn_when_safe (Qtls_error, Qerror,
628 "GNUTLS: certificate validation failed: %s",
629 msg.data);
630 gnutls_free(msg.data);
631 errno = EACCES;
632 return NULL;
633 }
634 else
635 {
636 warn_when_safe (Qtls_error, Qerror,
637 "GNUTLS: certificate validation failed with code %u",
638 status);
639 errno = EACCES;
640 return NULL;
641 }
642 }
643
644 #ifndef HAVE_GNUTLS_CERTIFICATE_VERIFY_PEERS3
645 if (hostname != NULL)
646 {
647 /* Match the peer certificate against the host name */
648 err = gnutls_x509_crt_init (&cert);
649 if (err != GNUTLS_E_SUCCESS)
650 {
651 xfree (gnutls);
652 warn_when_safe (Qtls_error, Qerror,
653 "GNUTLS error in gnutls_x509_crt_init: %s",
654 gnutls_strerror (err));
655 errno = EACCES;
656 return NULL;
657 }
658
659 /* The peer certificate is the first certificate in the list */
660 err = gnutls_x509_crt_import (cert, certs, GNUTLS_X509_FMT_DER);
661 if (err != GNUTLS_E_SUCCESS)
662 {
663 xfree (gnutls);
664 warn_when_safe (Qtls_error, Qerror,
665 "GNUTLS error in gnutls_x509_crt_import: %s",
666 gnutls_strerror (err));
667 gnutls_x509_crt_deinit (cert);
668 errno = EACCES;
669 return NULL;
670 }
671
672 err = gnutls_x509_crt_check_hostname (cert, hostname);
673 if (err == 0)
674 {
675 xfree (gnutls);
676 warn_when_safe (Qtls_error, Qerror,
677 "GNUTLS: hostname does not match certificate: %s",
678 gnutls_strerror (err));
679 gnutls_x509_crt_deinit (cert);
680 errno = EACCES;
681 return NULL;
682 }
683 gnutls_x509_crt_deinit (cert);
684 }
685 #endif /* HAVE_GNUTLS_CERTIFICATE_VERIFY_PEERS3 */
686
687 return gnutls;
688 }
689
690 /* Set the key and certificate files to use */
691 static void
692 tls_set_x509_key_file (const Extbyte *certfile, const Extbyte *keyfile)
693 {
694 int err;
695
696 err = gnutls_certificate_set_x509_key_file (global_cred, certfile, keyfile,
697 GNUTLS_X509_FMT_PEM);
698 if (err < GNUTLS_E_SUCCESS)
699 signal_error (Qtls_error, "gnutls_certificate_set_x509_key_file",
700 GNUTLS_ERRSTR (err));
701 }
702
703 /* Function that gathers PKCS #11 passwords. */
704 static int
705 gnutls_pk11_password (void * UNUSED (userdata), int UNUSED (attempt),
706 const char *token_url, const char *token_label,
707 unsigned int UNUSED (flags), char *pin, size_t pin_max)
708 {
709 Lisp_Object lsp_password, args[5];
710 Extbyte *c_password;
711 size_t len;
712
713 /* Get the password from the user */
714 args[0] = prompt;
715 args[1] = build_extstring (token_label, Qnative);
716 args[2] = build_ascstring (" (");
717 args[3] = build_extstring (token_url, Qnative);
718 args[4] = build_ascstring (")");
719 lsp_password = call1 (Qread_password, Fconcat (5, args));
720 c_password = LISP_STRING_TO_EXTERNAL (lsp_password, Qnative);
721
722 /* Insert the password */
723 len = strlen (c_password);
724 if (len > pin_max)
725 len = pin_max;
726 memcpy (pin, c_password, len);
727 pin[len] = '\0';
728
729 /* Wipe out the password on the stack and in the Lisp string */
730 args[0] = lsp_password;
731 args[1] = make_char ('*');
732 Ffill (2, args);
733 memset (c_password, '*', strlen (c_password));
734 return GNUTLS_E_SUCCESS;
735 }
736
737 static void xfree_for_gnutls (void *ptr)
738 {
739 /* GnuTLS sometimes tries to free NULL */
740 if (ptr != NULL)
741 xfree (ptr);
742 }
743
744 void
745 init_tls (void)
746 {
747 int err = GNUTLS_E_SUCCESS;
748
749 /* Tell gnutls to use our memory allocation functions */
750 gnutls_global_set_mem_functions ((void * (*)(size_t)) xmalloc,
751 (void * (*)(size_t)) xmalloc,
752 NULL,
753 (void * (*)(void *, size_t)) xrealloc,
754 xfree_for_gnutls);
755
756 /* Initialize the library */
757 err = gnutls_global_init ();
758 if (err != GNUTLS_E_SUCCESS)
759 signal_error (Qtls_error, "gnutls_global_init", GNUTLS_ERRSTR (err));
760
761 /* Load the trusted CA certificates */
762 err = gnutls_certificate_allocate_credentials (&global_cred);
763 if (err != GNUTLS_E_SUCCESS)
764 signal_error (Qtls_error, "gnutls_certificate_allocate_credentials",
765 GNUTLS_ERRSTR (err));
766 err = gnutls_certificate_set_x509_system_trust (global_cred);
767 if (err == 0)
768 signal_error (Qtls_error, "gnutls: no system certificates found", Qnil);
769 if (err < 0)
770 signal_error (Qtls_error, "gnutls_certificate_set_x509_system_trust",
771 GNUTLS_ERRSTR (err));
772
773 /* Setup password gathering */
774 gnutls_pkcs11_set_pin_function (gnutls_pk11_password, NULL);
775 }
776 #endif /* HAVE_GNUTLS */
777
778 #ifdef HAVE_OPENSSL
779 #include <unistd.h>
780 #include <openssl/conf.h>
781 #include <openssl/err.h>
782
783 /* The context used to create connections */
784 static SSL_CTX *ssl_ctx;
785
786 static Lisp_Object
787 openssl_error_string (void)
788 {
789 Lisp_Object args[5];
790 unsigned long err = ERR_get_error ();
791
792 args[0] = build_ascstring (ERR_lib_error_string (err));
793 args[1] = build_ascstring (":");
794 args[2] = build_ascstring (ERR_func_error_string (err));
795 args[3] = build_ascstring (":");
796 args[4] = build_ascstring (ERR_reason_error_string (err));
797 return Fconcat (5, args);
798 }
799
800 static unsigned long
801 openssl_report_error_stack (const char *msg, const SSL *ssl)
802 {
803 unsigned long err = ERR_get_error ();
804 if (err > 0UL)
805 {
806 if (ERR_GET_LIB (err) == ERR_LIB_SSL &&
807 ERR_GET_REASON (err) == SSL_R_CERTIFICATE_VERIFY_FAILED)
808 {
809 long cert_err = SSL_get_verify_result (ssl);
810 warn_when_safe (Qtls_error, Qerror, "%s:%s", msg,
811 X509_verify_cert_error_string (cert_err));
812 }
813 else
814 {
815 const char *lib = ERR_lib_error_string (err);
816 const char *func = ERR_func_error_string (err);
817 const char *reason = ERR_reason_error_string (err);
818 warn_when_safe (Qtls_error, Qerror, "%s:%s:%s:%s", msg,
819 lib == NULL ? "<unknown>" : lib,
820 func == NULL ? "<unknown>" : func,
821 reason == NULL ? "<unknown>" : reason);
822 }
823 }
824 return err;
825 }
826
827 /* Return values:
828 * -1 = fatal error, caller should exit
829 * 0 = no error, caller should continue
830 * 1 = nonfatal error, caller should retry
831 */
832 static int
833 openssl_report_error_num (const char *msg, const SSL *ssl, int ret, int retry)
834 {
835 int errno_copy = errno;
836 int ssl_error = SSL_get_error (ssl, ret);
837 int err;
838
839 switch (ssl_error)
840 {
841 case SSL_ERROR_NONE:
842 case SSL_ERROR_ZERO_RETURN:
843 err = 0;
844 break;
845 case SSL_ERROR_WANT_READ:
846 case SSL_ERROR_WANT_WRITE:
847 err = retry;
848 break;
849 case SSL_ERROR_WANT_CONNECT:
850 case SSL_ERROR_WANT_ACCEPT:
851 case SSL_ERROR_WANT_X509_LOOKUP:
852 err = 1;
853 break;
854 case SSL_ERROR_SYSCALL:
855 if (openssl_report_error_stack (msg, ssl) == 0UL && ret < 0)
856 warn_when_safe (Qtls_error, Qerror, "%s: %s", msg,
857 strerror (errno_copy));
858 err = ret;
859 break;
860 case SSL_ERROR_SSL:
861 openssl_report_error_stack (msg, ssl);
862 err = -1;
863 break;
864 default:
865 warn_when_safe (Qtls_error, Qerror, "%s: error %d", msg, ssl_error);
866 err = -1;
867 break;
868 }
869 errno = errno_copy;
870 return err;
871 }
872
873 int
874 tls_get_fd (tls_state_t *state)
875 {
876 return SSL_get_fd (state->tls_connection);
877 }
878
879 Bytecount
880 tls_read (tls_state_t *state, unsigned char *data, Bytecount size,
881 unsigned int allow_quit)
882 {
883 int action, bytes;
884
885 if (SSL_get_shutdown (state->tls_connection))
886 return 0;
887
888 bytes = SSL_read (state->tls_connection, data, size);
889 action = (bytes > 0) ? 0
890 : openssl_report_error_num ("SSL_read", state->tls_connection, bytes, 0);
891 while (bytes <= 0 && action > 0)
892 {
893 if (allow_quit)
894 QUIT;
895 bytes = SSL_read (state->tls_connection, data, size);
896 action = (bytes > 0) ? 0
897 : openssl_report_error_num ("SSL_read", state->tls_connection,
898 bytes, 0);
899 }
900 return (Bytecount) bytes;
901 }
902
903 Bytecount
904 tls_write (tls_state_t *state, const unsigned char *data, Bytecount size,
905 unsigned int allow_quit)
906 {
907 int action, bytes;
908
909 if (SSL_get_shutdown (state->tls_connection))
910 return 0;
911
912 bytes = SSL_write (state->tls_connection, data, size);
913 action = (bytes > 0) ? 0
914 : openssl_report_error_num ("SSL_write", state->tls_connection, bytes, 0);
915 while (bytes <= 0 && action > 0)
916 {
917 if (allow_quit)
918 QUIT;
919 bytes = SSL_write (state->tls_connection, data, size);
920 action = (bytes > 0) ? 0
921 : openssl_report_error_num ("SSL_write", state->tls_connection,
922 bytes, 0);
923 }
924 return (Bytecount) bytes;
925 }
926
927 int
928 tls_close (tls_state_t *state)
929 {
930 if (--state->tls_refcount == 0)
931 {
932 int err, fd;
933
934 fd = SSL_get_fd (state->tls_connection);
935 if (SSL_get_shutdown (state->tls_connection) == 0)
936 {
937 err = SSL_shutdown (state->tls_connection);
938 if (err < 0 && errno == EBADF)
939 err = 0;
940 if (err < 0)
941 openssl_report_error_num ("SSL_shutdown failed",
942 state->tls_connection, err, 0);
943 }
944 else
945 {
946 err = 0;
947 }
948 close (fd);
949 SSL_free (state->tls_connection);
950 xfree (state);
951 return err > 0 ? 0 : err;
952 }
953 return 0;
954 }
955
956 tls_state_t *
957 tls_open (int s, const Extbyte *hostname)
958 {
959 tls_state_t *openssl;
960 X509 *peer_cert = NULL;
961 const int val = 1;
962 int err;
963 long cert_err;
964
965 /* Disable Nagle's algorithm */
966 setsockopt (s, IPPROTO_TCP, TCP_NODELAY, &val, sizeof(val));
967
968 /* Create the state object */
969 openssl = xmalloc (sizeof (*openssl));
970 openssl->tls_refcount = 2;
971
972 /* Create the connection object */
973 openssl->tls_connection = SSL_new (ssl_ctx);
974 if (openssl->tls_connection == NULL)
975 {
976 openssl_report_error_stack ("SSL_new failed", NULL);
977 goto error;
978 }
979 if (SSL_set_fd (openssl->tls_connection, s) == 0)
980 {
981 openssl_report_error_stack ("SSL_set_fd", openssl->tls_connection);
982 goto error;
983 }
984
985 /* Enable the ServerNameIndication extension */
986 if (hostname != NULL &&
987 !SSL_set_tlsext_host_name (openssl->tls_connection, hostname))
988 {
989 openssl_report_error_stack ("SSL_set_tlsext_host_name failed",
990 openssl->tls_connection);
991 goto error;
992 }
993
994 /* Perform the handshake */
995 err = SSL_connect (openssl->tls_connection);
996 while (err != 1)
997 {
998 int action = openssl_report_error_num ("SSL_connect failed",
999 openssl->tls_connection, err, 1);
1000 if (action < 0)
1001 goto error;
1002 err = SSL_connect (openssl->tls_connection);
1003 }
1004
1005 /* Get the server certificate */
1006 peer_cert = SSL_get_peer_certificate (openssl->tls_connection);
1007 if (peer_cert == NULL)
1008 {
1009 warn_when_safe (Qtls_error, Qerror,
1010 "Peer did not present a certificate");
1011 goto error;
1012 }
1013
1014 cert_err = SSL_get_verify_result (openssl->tls_connection);
1015 if (cert_err != X509_V_OK)
1016 {
1017 warn_when_safe (Qtls_error, Qerror,
1018 "Peer certificate verification failure:%s",
1019 X509_verify_cert_error_string (cert_err));
1020 goto error;
1021 }
1022
1023 #ifdef HAVE_X509_CHECK_HOST
1024 err = X509_check_host (peer_cert, (const unsigned char *) hostname,
1025 strlen (hostname), 0);
1026 if (err < 0)
1027 {
1028 warn_when_safe (Qtls_error, Qerror,
1029 "Out of memory while checking certificate");
1030 goto error;
1031 }
1032 if (err == 0)
1033 {
1034 warn_when_safe (Qtls_error, Qerror,
1035 "Peer certificate verification failure");
1036 goto error;
1037 }
1038 #endif
1039 X509_free (peer_cert);
1040
1041 return openssl;
1042
1043 error:
1044 if (openssl->tls_connection != NULL)
1045 SSL_free (openssl->tls_connection);
1046 xfree (openssl);
1047 errno = EACCES;
1048 return NULL;
1049 }
1050
1051 /* Set the key and certificate files to use */
1052 static void
1053 tls_set_x509_key_file (const Extbyte *certfile, const Extbyte *keyfile)
1054 {
1055 int err;
1056
1057 err = SSL_CTX_use_PrivateKey_file (ssl_ctx, keyfile, SSL_FILETYPE_PEM);
1058 if (err <= 0)
1059 signal_error (Qtls_error, "SSL_CTX_use_PrivateKey_file",
1060 openssl_error_string ());
1061 err = SSL_CTX_use_certificate_file (ssl_ctx, certfile, SSL_FILETYPE_PEM);
1062 if (err <= 0)
1063 signal_error (Qtls_error, "SSL_CTX_use_certificate_file",
1064 openssl_error_string ());
1065 }
1066
1067 /* Function that gathers passwords for PKCS #11 tokens. */
1068 static int
1069 openssl_password (char *buf, int size, int UNUSED (rwflag),
1070 void *UNUSED (userdata))
1071 {
1072 Lisp_Object lsp_password, args[2];
1073 Extbyte *c_password;
1074
1075 lsp_password =
1076 call1 (Qread_password, concat2 (prompt, build_ascstring ("PEM")));
1077 c_password = LISP_STRING_TO_EXTERNAL (lsp_password, Qnative);
1078 strncpy (buf, c_password, size);
1079
1080 /* Wipe out the password on the stack and in the Lisp string */
1081 args[0] = lsp_password;
1082 args[1] = make_char ('*');
1083 Ffill (2, args);
1084 memset (c_password, '*', strlen (c_password));
1085 return (int) strlen (buf);
1086 }
1087
1088 void
1089 init_tls (void)
1090 {
1091 /* Load the default configuration */
1092 OPENSSL_config (NULL);
1093
1094 /* Tell openssl to use our memory allocation functions */
1095 CRYPTO_set_mem_functions ((void * (*)(size_t)) xmalloc,
1096 (void * (*)(void *, size_t)) xrealloc,
1097 xfree_1);
1098
1099 /* Load human-readable error messages */
1100 SSL_load_error_strings ();
1101
1102 /* Initialize the library */
1103 SSL_library_init ();
1104
1105 /* Configure a client connection context, and send a handshake for the
1106 * highest supported TLS version. */
1107 ssl_ctx = SSL_CTX_new (SSLv23_client_method ());
1108 if (ssl_ctx == NULL)
1109 signal_error (Qtls_error, "SSL_CTX_new failed", openssl_error_string ());
1110
1111 /* Disallow SSLv2 and disable compression. */
1112 SSL_CTX_set_options (ssl_ctx, SSL_OP_NO_SSLv2 | SSL_OP_NO_COMPRESSION);
1113
1114 /* Set various useful mode bits */
1115 SSL_CTX_set_mode (ssl_ctx, SSL_MODE_ENABLE_PARTIAL_WRITE |
1116 SSL_MODE_AUTO_RETRY | SSL_MODE_RELEASE_BUFFERS);
1117
1118 /* Let the system select the ciphers */
1119 if (SSL_CTX_set_cipher_list (ssl_ctx, "PROFILE=SYSTEM") != 1)
1120 signal_error (Qtls_error, "SSL_CTX_set_cipher_list failed",
1121 openssl_error_string ());
1122
1123 /* Load the set of trusted root certificates. */
1124 if (!SSL_CTX_set_default_verify_paths (ssl_ctx))
1125 signal_error (Qtls_error, "SSL_CTX_set_default_verify_paths failed",
1126 openssl_error_string ());
1127
1128 /* Setup password gathering */
1129 SSL_CTX_set_default_passwd_cb (ssl_ctx, openssl_password);
1130 }
1131 #endif /* HAVE_OPENSSL */
1132
1133 #ifdef WITH_TLS
1134 tls_state_t *
1135 tls_negotiate (int fd, const Extbyte *host, Lisp_Object keylist)
1136 {
1137 Lisp_Object tail;
1138
1139 for (tail = keylist; CONSP (tail); tail = XCDR (tail))
1140 {
1141 Lisp_Object keyfile = Fcar (XCAR (tail));
1142 Lisp_Object certfile = Fcar (Fcdr (XCAR (tail)));
1143 Extbyte *c_keyfile, *c_certfile;
1144
1145 if (!STRINGP (keyfile))
1146 invalid_argument ("Keyfile must be a filename", keyfile);
1147 if (!STRINGP (certfile))
1148 invalid_argument ("Certfile must be a filename", certfile);
1149
1150 c_keyfile = LISP_STRING_TO_EXTERNAL (keyfile, Qfile_name);
1151 c_certfile = LISP_STRING_TO_EXTERNAL (certfile, Qfile_name);
1152 tls_set_x509_key_file (c_certfile, c_keyfile);
1153 }
1154 return tls_open (fd, host);
1155 }
1156 #endif /* WITH_TLS */
1157
1158 #ifndef WITH_TLS
1159 void
1160 init_tls (void)
1161 {
1162 }
1163 #endif /* !WITH_TLS */
1164
1165 void
1166 syms_of_tls (void)
1167 {
1168 #ifdef WITH_TLS
1169 DEFSYMBOL (Qread_password);
1170 #endif
1171 DEFERROR (Qtls_error, "TLS error", Qerror);
1172 }
1173
1174 void
1175 vars_of_tls (void)
1176 {
1177 #ifdef WITH_TLS
1178 staticpro (&prompt);
1179 prompt = build_ascstring ("Password for ");
1180 Fprovide (intern ("tls"));
1181 #ifdef HAVE_NSS
1182 Fprovide (intern ("tls-nss"));
1183 #endif
1184 #ifdef HAVE_GNUTLS
1185 Fprovide (intern ("tls-gnutls"));
1186 #endif
1187 #ifdef HAVE_OPENSSL
1188 Fprovide (intern ("tls-openssl"));
1189 #endif
1190 #endif
1191 }