/* GnuTLS glue for GNU Emacs.
- Copyright (C) 2010-2014 Free Software Foundation, Inc.
+ Copyright (C) 2010-2015 Free Software Foundation, Inc.
This file is part of GNU Emacs.
static bool emacs_gnutls_handle_error (gnutls_session_t, int);
-static Lisp_Object Qgnutls_dll;
-static Lisp_Object Qgnutls_code;
-static Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
-static Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
- Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
static bool gnutls_global_initialized;
-/* The following are for the property list of `gnutls-boot'. */
-static Lisp_Object QCgnutls_bootprop_priority;
-static Lisp_Object QCgnutls_bootprop_trustfiles;
-static Lisp_Object QCgnutls_bootprop_keylist;
-static Lisp_Object QCgnutls_bootprop_crlfiles;
-static Lisp_Object QCgnutls_bootprop_callbacks;
-static Lisp_Object QCgnutls_bootprop_loglevel;
-static Lisp_Object QCgnutls_bootprop_hostname;
-static Lisp_Object QCgnutls_bootprop_min_prime_bits;
-static Lisp_Object QCgnutls_bootprop_verify_flags;
-static Lisp_Object QCgnutls_bootprop_verify_error;
-
-/* Callback keys for `gnutls-boot'. Unused currently. */
-static Lisp_Object QCgnutls_bootprop_callbacks_verify;
-
static void gnutls_log_function (int, const char *);
static void gnutls_log_function2 (int, const char *, const char *);
#ifdef HAVE_GNUTLS3
(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
DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0,
doc: /* Return t if ERROR indicates a GnuTLS problem.
ERROR is an integer or a symbol with an integer `gnutls-code' property.
-usage: (gnutls-errorp ERROR) */)
+usage: (gnutls-errorp ERROR) */
+ attributes: const)
(Lisp_Object err)
{
if (EQ (err, Qt)) return Qnil;
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);
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
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");
+
+ /* The following are for the property list of 'gnutls-boot'. */
DEFSYM (QCgnutls_bootprop_hostname, ":hostname");
DEFSYM (QCgnutls_bootprop_priority, ":priority");
DEFSYM (QCgnutls_bootprop_trustfiles, ":trustfiles");
DEFSYM (QCgnutls_bootprop_keylist, ":keylist");
DEFSYM (QCgnutls_bootprop_crlfiles, ":crlfiles");
- DEFSYM (QCgnutls_bootprop_callbacks, ":callbacks");
- DEFSYM (QCgnutls_bootprop_callbacks_verify, "verify");
DEFSYM (QCgnutls_bootprop_min_prime_bits, ":min-prime-bits");
DEFSYM (QCgnutls_bootprop_loglevel, ":loglevel");
DEFSYM (QCgnutls_bootprop_verify_flags, ":verify-flags");