/* GnuTLS glue for GNU Emacs.
- Copyright (C) 2010-2015 Free Software Foundation, Inc.
+ Copyright (C) 2010-2016 Free Software Foundation, Inc.
This file is part of GNU Emacs.
GNU Emacs is free software: you can redistribute it and/or modify
it under the terms of the GNU General Public License as published by
-the Free Software Foundation, either version 3 of the License, or
-(at your option) any later version.
+the Free Software Foundation, either version 3 of the License, or (at
+your option) any later version.
GNU Emacs is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
(gnutls_session_t, gnutls_push_func));
DEF_DLL_FN (int, gnutls_x509_crt_check_hostname,
(gnutls_x509_crt_t, const char *));
+DEF_DLL_FN (int, gnutls_x509_crt_check_issuer,
+ (gnutls_x509_crt_t, gnutls_x509_crt_t));
DEF_DLL_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t));
DEF_DLL_FN (int, gnutls_x509_crt_import,
(gnutls_x509_crt_t, const gnutls_datum_t *,
LOAD_DLL_FN (library, gnutls_transport_set_pull_function);
LOAD_DLL_FN (library, gnutls_transport_set_push_function);
LOAD_DLL_FN (library, gnutls_x509_crt_check_hostname);
+ LOAD_DLL_FN (library, gnutls_x509_crt_check_issuer);
LOAD_DLL_FN (library, gnutls_x509_crt_deinit);
LOAD_DLL_FN (library, gnutls_x509_crt_import);
LOAD_DLL_FN (library, gnutls_x509_crt_init);
# define gnutls_transport_set_pull_function fn_gnutls_transport_set_pull_function
# define gnutls_transport_set_push_function fn_gnutls_transport_set_push_function
# define gnutls_x509_crt_check_hostname fn_gnutls_x509_crt_check_hostname
+# define gnutls_x509_crt_check_issuer fn_gnutls_x509_crt_check_issuer
# define gnutls_x509_crt_deinit fn_gnutls_x509_crt_deinit
# define gnutls_x509_crt_get_activation_time fn_gnutls_x509_crt_get_activation_time
# define gnutls_x509_crt_get_dn fn_gnutls_x509_crt_get_dn
gnutls_hex_string (unsigned char *buf, ptrdiff_t buf_size, const char *prefix)
{
ptrdiff_t prefix_length = strlen (prefix);
- if ((STRING_BYTES_BOUND - prefix_length) / 3 < buf_size)
+ ptrdiff_t retlen;
+ if (INT_MULTIPLY_WRAPV (buf_size, 3, &retlen)
+ || INT_ADD_WRAPV (prefix_length - (buf_size != 0), retlen, &retlen))
string_overflow ();
- Lisp_Object ret = make_uninit_string (prefix_length + 3 * buf_size
- - (buf_size != 0));
+ Lisp_Object ret = make_uninit_string (retlen);
char *string = SSDATA (ret);
strcpy (string, prefix);
if (EQ (status_symbol, intern (":self-signed")))
return build_string ("certificate signer was not found (self-signed)");
+ if (EQ (status_symbol, intern (":unknown-ca")))
+ return build_string ("the certificate was signed by an unknown "
+ "and therefore untrusted authority");
+
if (EQ (status_symbol, intern (":not-ca")))
return build_string ("certificate signer is not a CA");
warnings = Fcons (intern (":revoked"), warnings);
if (verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
- warnings = Fcons (intern (":self-signed"), warnings);
+ warnings = Fcons (intern (":unknown-ca"), warnings);
if (verification & GNUTLS_CERT_SIGNER_NOT_CA)
warnings = Fcons (intern (":not-ca"), warnings);
CERTIFICATE_NOT_MATCHING)
warnings = Fcons (intern (":no-host-match"), warnings);
+ /* This could get called in the INIT stage, when the certificate is
+ not yet set. */
+ if (XPROCESS (proc)->gnutls_certificate != NULL &&
+ gnutls_x509_crt_check_issuer(XPROCESS (proc)->gnutls_certificate,
+ XPROCESS (proc)->gnutls_certificate))
+ warnings = Fcons (intern (":self-signed"), warnings);
+
if (!NILP (warnings))
result = list2 (intern (":warnings"), warnings);
/* Initialize global GnuTLS state to defaults.
Call `gnutls-global-deinit' when GnuTLS usage is no longer needed.
Return zero on success. */
-static Lisp_Object
+Lisp_Object
emacs_gnutls_global_init (void)
{
int ret = GNUTLS_E_SUCCESS;
if (!gnutls_global_initialized)
- ret = gnutls_global_init ();
-
- gnutls_global_initialized = 1;
+ {
+ ret = gnutls_global_init ();
+ if (ret == GNUTLS_E_SUCCESS)
+ gnutls_global_initialized = 1;
+ }
return gnutls_make_error (ret);
}
instead.
:verify-error is a list of symbols to express verification checks or
-`t' to do all checks. Currently it can contain `:trustfiles' and
+t to do all checks. Currently it can contain `:trustfiles' and
`:hostname' to verify the certificate or the hostname respectively.
:min-prime-bits is the minimum accepted number of bits the client will
|| !NILP (Fmember (QCgnutls_bootprop_trustfiles, verify_error)))
{
emacs_gnutls_deinit (proc);
- error ("Certificate validation failed %s, verification code %d",
+ error ("Certificate validation failed %s, verification code %x",
c_hostname, peer_verification);
}
else
#endif /* HAVE_GNUTLS */
DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
- doc: /* Return t if GnuTLS is available in this instance of Emacs. */
- attributes: const)
+ doc: /* Return t if GnuTLS is available in this instance of Emacs. */)
(void)
{
#ifdef HAVE_GNUTLS
void
syms_of_gnutls (void)
{
+ DEFSYM (Qlibgnutls_version, "libgnutls-version");
+ Fset (Qlibgnutls_version,
+#ifdef HAVE_GNUTLS
+ make_number (GNUTLS_VERSION_MAJOR * 10000
+ + GNUTLS_VERSION_MINOR * 100
+ + GNUTLS_VERSION_PATCH)
+#else
+ make_number (-1)
+#endif
+ );
#ifdef HAVE_GNUTLS
gnutls_global_initialized = 0;
- DEFSYM (Qgnutls_dll, "gnutls");
DEFSYM (Qgnutls_code, "gnutls-code");
DEFSYM (Qgnutls_anon, "gnutls-anon");
DEFSYM (Qgnutls_x509pki, "gnutls-x509pki");
DEFSYM (QCgnutls_bootprop_trustfiles, ":trustfiles");
DEFSYM (QCgnutls_bootprop_keylist, ":keylist");
DEFSYM (QCgnutls_bootprop_crlfiles, ":crlfiles");
- DEFSYM (QCgnutls_bootprop_callbacks, ":callbacks");
DEFSYM (QCgnutls_bootprop_min_prime_bits, ":min-prime-bits");
DEFSYM (QCgnutls_bootprop_loglevel, ":loglevel");
DEFSYM (QCgnutls_bootprop_verify_flags, ":verify-flags");