Mercurial > hg > xemacs-beta

comparison src/tls.c @ 5923:61d7d7bcbe76 cygwin

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
merged heads after pull -u
author Henry Thompson <ht@markup.co.uk>
date Thu, 05 Feb 2015 17:19:05 +0000
parents 5d5aeb79edb4
children 6eca500211f4 574f0cded429
comparison
equal deleted inserted replaced
5921:68639fb08af8 5923:61d7d7bcbe76
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 = (tls_state_t *) 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 = (tls_state_t *) 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 gnutls_certificate_type_t type;
619
620 type = gnutls_certificate_type_get (gnutls->tls_session);
621 err =
622 gnutls_certificate_verification_status_print (status, type, &msg, 0);
623 #else
624 err = -1;
625 #endif /* HAVE_GNUTLS_CERTIFICATE_VERIFICATION_STATUS_PRINT */
626 xfree (gnutls);
627 if (err == 0)
628 {
629 warn_when_safe (Qtls_error, Qerror,
630 "GNUTLS: certificate validation failed: %s",
631 msg.data);
632 gnutls_free(msg.data);
633 errno = EACCES;
634 return NULL;
635 }
636 else
637 {
638 warn_when_safe (Qtls_error, Qerror,
639 "GNUTLS: certificate validation failed with code %u",
640 status);
641 errno = EACCES;
642 return NULL;
643 }
644 }
645
646 #ifndef HAVE_GNUTLS_CERTIFICATE_VERIFY_PEERS3
647 if (hostname != NULL)
648 {
649 /* Match the peer certificate against the host name */
650 err = gnutls_x509_crt_init (&cert);
651 if (err != GNUTLS_E_SUCCESS)
652 {
653 xfree (gnutls);
654 warn_when_safe (Qtls_error, Qerror,
655 "GNUTLS error in gnutls_x509_crt_init: %s",
656 gnutls_strerror (err));
657 errno = EACCES;
658 return NULL;
659 }
660
661 /* The peer certificate is the first certificate in the list */
662 err = gnutls_x509_crt_import (cert, certs, GNUTLS_X509_FMT_DER);
663 if (err != GNUTLS_E_SUCCESS)
664 {
665 xfree (gnutls);
666 warn_when_safe (Qtls_error, Qerror,
667 "GNUTLS error in gnutls_x509_crt_import: %s",
668 gnutls_strerror (err));
669 gnutls_x509_crt_deinit (cert);
670 errno = EACCES;
671 return NULL;
672 }
673
674 err = gnutls_x509_crt_check_hostname (cert, hostname);
675 if (err == 0)
676 {
677 xfree (gnutls);
678 warn_when_safe (Qtls_error, Qerror,
679 "GNUTLS: hostname does not match certificate: %s",
680 gnutls_strerror (err));
681 gnutls_x509_crt_deinit (cert);
682 errno = EACCES;
683 return NULL;
684 }
685 gnutls_x509_crt_deinit (cert);
686 }
687 #endif /* HAVE_GNUTLS_CERTIFICATE_VERIFY_PEERS3 */
688
689 return gnutls;
690 }
691
692 /* Set the key and certificate files to use */
693 static void
694 tls_set_x509_key_file (const Extbyte *certfile, const Extbyte *keyfile)
695 {
696 int err;
697
698 err = gnutls_certificate_set_x509_key_file (global_cred, certfile, keyfile,
699 GNUTLS_X509_FMT_PEM);
700 if (err < GNUTLS_E_SUCCESS)
701 signal_error (Qtls_error, "gnutls_certificate_set_x509_key_file",
702 GNUTLS_ERRSTR (err));
703 }
704
705 /* Function that gathers PKCS #11 passwords. */
706 static int
707 gnutls_pk11_password (void * UNUSED (userdata), int UNUSED (attempt),
708 const char *token_url, const char *token_label,
709 unsigned int UNUSED (flags), char *pin, size_t pin_max)
710 {
711 Lisp_Object lsp_password, args[5];
712 Extbyte *c_password;
713 size_t len;
714
715 /* Get the password from the user */
716 args[0] = prompt;
717 args[1] = build_extstring (token_label, Qnative);
718 args[2] = build_ascstring (" (");
719 args[3] = build_extstring (token_url, Qnative);
720 args[4] = build_ascstring (")");
721 lsp_password = call1 (Qread_password, Fconcat (5, args));
722 c_password = LISP_STRING_TO_EXTERNAL (lsp_password, Qnative);
723
724 /* Insert the password */
725 len = strlen (c_password);
726 if (len > pin_max)
727 len = pin_max;
728 memcpy (pin, c_password, len);
729 pin[len] = '\0';
730
731 /* Wipe out the password on the stack and in the Lisp string */
732 args[0] = lsp_password;
733 args[1] = make_char ('*');
734 Ffill (2, args);
735 memset (c_password, '*', strlen (c_password));
736 return GNUTLS_E_SUCCESS;
737 }
738
739 static void xfree_for_gnutls (void *ptr)
740 {
741 /* GnuTLS sometimes tries to free NULL */
742 if (ptr != NULL)
743 xfree (ptr);
744 }
745
746 void
747 init_tls (void)
748 {
749 int err = GNUTLS_E_SUCCESS;
750
751 /* Tell gnutls to use our memory allocation functions */
752 gnutls_global_set_mem_functions ((void * (*)(size_t)) xmalloc,
753 (void * (*)(size_t)) xmalloc,
754 NULL,
755 (void * (*)(void *, size_t)) xrealloc,
756 xfree_for_gnutls);
757
758 /* Initialize the library */
759 err = gnutls_global_init ();
760 if (err != GNUTLS_E_SUCCESS)
761 signal_error (Qtls_error, "gnutls_global_init", GNUTLS_ERRSTR (err));
762
763 /* Load the trusted CA certificates */
764 err = gnutls_certificate_allocate_credentials (&global_cred);
765 if (err != GNUTLS_E_SUCCESS)
766 signal_error (Qtls_error, "gnutls_certificate_allocate_credentials",
767 GNUTLS_ERRSTR (err));
768 err = gnutls_certificate_set_x509_system_trust (global_cred);
769 if (err == 0)
770 signal_error (Qtls_error, "gnutls: no system certificates found", Qnil);
771 if (err < 0)
772 signal_error (Qtls_error, "gnutls_certificate_set_x509_system_trust",
773 GNUTLS_ERRSTR (err));
774
775 /* Setup password gathering */
776 gnutls_pkcs11_set_pin_function (gnutls_pk11_password, NULL);
777 }
778 #endif /* HAVE_GNUTLS */
779
780 #ifdef HAVE_OPENSSL
781 #include <unistd.h>
782 #include <openssl/conf.h>
783 #include <openssl/err.h>
784
785 /* The context used to create connections */
786 static SSL_CTX *ssl_ctx;
787
788 static Lisp_Object
789 openssl_error_string (void)
790 {
791 Lisp_Object args[5];
792 unsigned long err = ERR_get_error ();
793
794 args[0] = build_ascstring (ERR_lib_error_string (err));
795 args[1] = build_ascstring (":");
796 args[2] = build_ascstring (ERR_func_error_string (err));
797 args[3] = build_ascstring (":");
798 args[4] = build_ascstring (ERR_reason_error_string (err));
799 return Fconcat (5, args);
800 }
801
802 static unsigned long
803 openssl_report_error_stack (const char *msg, const SSL *ssl)
804 {
805 unsigned long err = ERR_get_error ();
806 if (err > 0UL)
807 {
808 if (ERR_GET_LIB (err) == ERR_LIB_SSL &&
809 ERR_GET_REASON (err) == SSL_R_CERTIFICATE_VERIFY_FAILED)
810 {
811 long cert_err = SSL_get_verify_result (ssl);
812 warn_when_safe (Qtls_error, Qerror, "%s:%s", msg,
813 X509_verify_cert_error_string (cert_err));
814 }
815 else
816 {
817 const char *lib = ERR_lib_error_string (err);
818 const char *func = ERR_func_error_string (err);
819 const char *reason = ERR_reason_error_string (err);
820 warn_when_safe (Qtls_error, Qerror, "%s:%s:%s:%s", msg,
821 lib == NULL ? "<unknown>" : lib,
822 func == NULL ? "<unknown>" : func,
823 reason == NULL ? "<unknown>" : reason);
824 }
825 }
826 return err;
827 }
828
829 /* Return values:
830 * -1 = fatal error, caller should exit
831 * 0 = no error, caller should continue
832 * 1 = nonfatal error, caller should retry
833 */
834 static int
835 openssl_report_error_num (const char *msg, const SSL *ssl, int ret, int retry)
836 {
837 int errno_copy = errno;
838 int ssl_error = SSL_get_error (ssl, ret);
839 int err;
840
841 switch (ssl_error)
842 {
843 case SSL_ERROR_NONE:
844 case SSL_ERROR_ZERO_RETURN:
845 err = 0;
846 break;
847 case SSL_ERROR_WANT_READ:
848 case SSL_ERROR_WANT_WRITE:
849 err = retry;
850 break;
851 case SSL_ERROR_WANT_CONNECT:
852 case SSL_ERROR_WANT_ACCEPT:
853 case SSL_ERROR_WANT_X509_LOOKUP:
854 err = 1;
855 break;
856 case SSL_ERROR_SYSCALL:
857 if (openssl_report_error_stack (msg, ssl) == 0UL && ret < 0)
858 warn_when_safe (Qtls_error, Qerror, "%s: %s", msg,
859 strerror (errno_copy));
860 err = ret;
861 break;
862 case SSL_ERROR_SSL:
863 openssl_report_error_stack (msg, ssl);
864 err = -1;
865 break;
866 default:
867 warn_when_safe (Qtls_error, Qerror, "%s: error %d", msg, ssl_error);
868 err = -1;
869 break;
870 }
871 errno = errno_copy;
872 return err;
873 }
874
875 int
876 tls_get_fd (tls_state_t *state)
877 {
878 return SSL_get_fd (state->tls_connection);
879 }
880
881 Bytecount
882 tls_read (tls_state_t *state, unsigned char *data, Bytecount size,
883 unsigned int allow_quit)
884 {
885 int action, bytes;
886
887 if (SSL_get_shutdown (state->tls_connection))
888 return 0;
889
890 bytes = SSL_read (state->tls_connection, data, size);
891 action = (bytes > 0) ? 0
892 : openssl_report_error_num ("SSL_read", state->tls_connection, bytes, 0);
893 while (bytes <= 0 && action > 0)
894 {
895 if (allow_quit)
896 QUIT;
897 bytes = SSL_read (state->tls_connection, data, size);
898 action = (bytes > 0) ? 0
899 : openssl_report_error_num ("SSL_read", state->tls_connection,
900 bytes, 0);
901 }
902 return (Bytecount) bytes;
903 }
904
905 Bytecount
906 tls_write (tls_state_t *state, const unsigned char *data, Bytecount size,
907 unsigned int allow_quit)
908 {
909 int action, bytes;
910
911 if (SSL_get_shutdown (state->tls_connection))
912 return 0;
913
914 bytes = SSL_write (state->tls_connection, data, size);
915 action = (bytes > 0) ? 0
916 : openssl_report_error_num ("SSL_write", state->tls_connection, bytes, 0);
917 while (bytes <= 0 && action > 0)
918 {
919 if (allow_quit)
920 QUIT;
921 bytes = SSL_write (state->tls_connection, data, size);
922 action = (bytes > 0) ? 0
923 : openssl_report_error_num ("SSL_write", state->tls_connection,
924 bytes, 0);
925 }
926 return (Bytecount) bytes;
927 }
928
929 int
930 tls_close (tls_state_t *state)
931 {
932 if (--state->tls_refcount == 0)
933 {
934 int err, fd;
935
936 fd = SSL_get_fd (state->tls_connection);
937 if (SSL_get_shutdown (state->tls_connection) == 0)
938 {
939 err = SSL_shutdown (state->tls_connection);
940 if (err < 0 && errno == EBADF)
941 err = 0;
942 if (err < 0)
943 openssl_report_error_num ("SSL_shutdown failed",
944 state->tls_connection, err, 0);
945 }
946 else
947 {
948 err = 0;
949 }
950 close (fd);
951 SSL_free (state->tls_connection);
952 xfree (state);
953 return err > 0 ? 0 : err;
954 }
955 return 0;
956 }
957
958 tls_state_t *
959 tls_open (int s, const Extbyte *hostname)
960 {
961 tls_state_t *openssl;
962 X509 *peer_cert = NULL;
963 const int val = 1;
964 int err;
965 long cert_err;
966
967 /* Disable Nagle's algorithm */
968 setsockopt (s, IPPROTO_TCP, TCP_NODELAY, &val, sizeof(val));
969
970 /* Create the state object */
971 openssl = (tls_state_t *) xmalloc (sizeof (*openssl));
972 openssl->tls_refcount = 2;
973
974 /* Create the connection object */
975 openssl->tls_connection = SSL_new (ssl_ctx);
976 if (openssl->tls_connection == NULL)
977 {
978 openssl_report_error_stack ("SSL_new failed", NULL);
979 goto error;
980 }
981 if (SSL_set_fd (openssl->tls_connection, s) == 0)
982 {
983 openssl_report_error_stack ("SSL_set_fd", openssl->tls_connection);
984 goto error;
985 }
986
987 /* Enable the ServerNameIndication extension */
988 if (hostname != NULL &&
989 !SSL_set_tlsext_host_name (openssl->tls_connection, hostname))
990 {
991 openssl_report_error_stack ("SSL_set_tlsext_host_name failed",
992 openssl->tls_connection);
993 goto error;
994 }
995
996 /* Perform the handshake */
997 err = SSL_connect (openssl->tls_connection);
998 while (err != 1)
999 {
1000 int action = openssl_report_error_num ("SSL_connect failed",
1001 openssl->tls_connection, err, 1);
1002 if (action < 0)
1003 goto error;
1004 err = SSL_connect (openssl->tls_connection);
1005 }
1006
1007 /* Get the server certificate */
1008 peer_cert = SSL_get_peer_certificate (openssl->tls_connection);
1009 if (peer_cert == NULL)
1010 {
1011 warn_when_safe (Qtls_error, Qerror,
1012 "Peer did not present a certificate");
1013 goto error;
1014 }
1015
1016 cert_err = SSL_get_verify_result (openssl->tls_connection);
1017 if (cert_err != X509_V_OK)
1018 {
1019 warn_when_safe (Qtls_error, Qerror,
1020 "Peer certificate verification failure:%s",
1021 X509_verify_cert_error_string (cert_err));
1022 goto error;
1023 }
1024
1025 #ifdef HAVE_X509_CHECK_HOST
1026 err = X509_check_host (peer_cert, (const unsigned char *) hostname,
1027 strlen (hostname), 0);
1028 if (err < 0)
1029 {
1030 warn_when_safe (Qtls_error, Qerror,
1031 "Out of memory while checking certificate");
1032 goto error;
1033 }
1034 if (err == 0)
1035 {
1036 warn_when_safe (Qtls_error, Qerror,
1037 "Peer certificate verification failure");
1038 goto error;
1039 }
1040 #endif
1041 X509_free (peer_cert);
1042
1043 return openssl;
1044
1045 error:
1046 if (openssl->tls_connection != NULL)
1047 SSL_free (openssl->tls_connection);
1048 xfree (openssl);
1049 errno = EACCES;
1050 return NULL;
1051 }
1052
1053 /* Set the key and certificate files to use */
1054 static void
1055 tls_set_x509_key_file (const Extbyte *certfile, const Extbyte *keyfile)
1056 {
1057 int err;
1058
1059 err = SSL_CTX_use_PrivateKey_file (ssl_ctx, keyfile, SSL_FILETYPE_PEM);
1060 if (err <= 0)
1061 signal_error (Qtls_error, "SSL_CTX_use_PrivateKey_file",
1062 openssl_error_string ());
1063 err = SSL_CTX_use_certificate_file (ssl_ctx, certfile, SSL_FILETYPE_PEM);
1064 if (err <= 0)
1065 signal_error (Qtls_error, "SSL_CTX_use_certificate_file",
1066 openssl_error_string ());
1067 }
1068
1069 /* Function that gathers passwords for PKCS #11 tokens. */
1070 static int
1071 openssl_password (char *buf, int size, int UNUSED (rwflag),
1072 void *UNUSED (userdata))
1073 {
1074 Lisp_Object lsp_password, args[2];
1075 Extbyte *c_password;
1076
1077 lsp_password =
1078 call1 (Qread_password, concat2 (prompt, build_ascstring ("PEM")));
1079 c_password = LISP_STRING_TO_EXTERNAL (lsp_password, Qnative);
1080 strncpy (buf, c_password, size);
1081
1082 /* Wipe out the password on the stack and in the Lisp string */
1083 args[0] = lsp_password;
1084 args[1] = make_char ('*');
1085 Ffill (2, args);
1086 memset (c_password, '*', strlen (c_password));
1087 return (int) strlen (buf);
1088 }
1089
1090 void
1091 init_tls (void)
1092 {
1093 /* Load the default configuration */
1094 OPENSSL_config (NULL);
1095
1096 /* Tell openssl to use our memory allocation functions */
1097 CRYPTO_set_mem_functions ((void * (*)(size_t)) xmalloc,
1098 (void * (*)(void *, size_t)) xrealloc,
1099 xfree_1);
1100
1101 /* Load human-readable error messages */
1102 SSL_load_error_strings ();
1103
1104 /* Initialize the library */
1105 SSL_library_init ();
1106
1107 /* Configure a client connection context, and send a handshake for the
1108 * highest supported TLS version. */
1109 ssl_ctx = SSL_CTX_new (SSLv23_client_method ());
1110 if (ssl_ctx == NULL)
1111 signal_error (Qtls_error, "SSL_CTX_new failed", openssl_error_string ());
1112
1113 /* Disallow SSLv2 and disable compression. */
1114 SSL_CTX_set_options (ssl_ctx, SSL_OP_NO_SSLv2 | SSL_OP_NO_COMPRESSION);
1115
1116 /* Set various useful mode bits */
1117 SSL_CTX_set_mode (ssl_ctx, SSL_MODE_ENABLE_PARTIAL_WRITE |
1118 SSL_MODE_AUTO_RETRY | SSL_MODE_RELEASE_BUFFERS);
1119
1120 /* Let the system select the ciphers */
1121 if (SSL_CTX_set_cipher_list (ssl_ctx, "DEFAULT") != 1)
1122 signal_error (Qtls_error, "SSL_CTX_set_cipher_list failed",
1123 openssl_error_string ());
1124
1125 /* Load the set of trusted root certificates. */
1126 if (!SSL_CTX_set_default_verify_paths (ssl_ctx))
1127 signal_error (Qtls_error, "SSL_CTX_set_default_verify_paths failed",
1128 openssl_error_string ());
1129
1130 /* Setup password gathering */
1131 SSL_CTX_set_default_passwd_cb (ssl_ctx, openssl_password);
1132 }
1133 #endif /* HAVE_OPENSSL */
1134
1135 #ifdef WITH_TLS
1136 tls_state_t *
1137 tls_negotiate (int fd, const Extbyte *host, Lisp_Object keylist)
1138 {
1139 Lisp_Object tail;
1140
1141 for (tail = keylist; CONSP (tail); tail = XCDR (tail))
1142 {
1143 Lisp_Object keyfile = Fcar (XCAR (tail));
1144 Lisp_Object certfile = Fcar (Fcdr (XCAR (tail)));
1145 Extbyte *c_keyfile, *c_certfile;
1146
1147 if (!STRINGP (keyfile))
1148 invalid_argument ("Keyfile must be a filename", keyfile);
1149 if (!STRINGP (certfile))
1150 invalid_argument ("Certfile must be a filename", certfile);
1151
1152 c_keyfile = LISP_STRING_TO_EXTERNAL (keyfile, Qfile_name);
1153 c_certfile = LISP_STRING_TO_EXTERNAL (certfile, Qfile_name);
1154 tls_set_x509_key_file (c_certfile, c_keyfile);
1155 }
1156 return tls_open (fd, host);
1157 }
1158 #endif /* WITH_TLS */
1159
1160 #ifndef WITH_TLS
1161 void
1162 init_tls (void)
1163 {
1164 }
1165 #endif /* !WITH_TLS */
1166
1167 void
1168 syms_of_tls (void)
1169 {
1170 #ifdef WITH_TLS
1171 DEFSYMBOL (Qread_password);
1172 #endif
1173 DEFERROR (Qtls_error, "TLS error", Qerror);
1174 }
1175
1176 void
1177 vars_of_tls (void)
1178 {
1179 #ifdef WITH_TLS
1180 staticpro (&prompt);
1181 prompt = build_ascstring ("Password for ");
1182 Fprovide (intern ("tls"));
1183 #ifdef HAVE_NSS
1184 Fprovide (intern ("tls-nss"));
1185 #endif
1186 #ifdef HAVE_GNUTLS
1187 Fprovide (intern ("tls-gnutls"));
1188 #endif
1189 #ifdef HAVE_OPENSSL
1190 Fprovide (intern ("tls-openssl"));
1191 #endif
1192 #endif
1193 }