/* GnuTLS glue for GNU Emacs.
- Copyright (C) 2010-2013 Free Software Foundation, Inc.
+ Copyright (C) 2010-2014 Free Software Foundation, Inc.
This file is part of GNU Emacs.
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_hostname_error;
+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*);
+static void gnutls_log_function2 (int, const char *, const char *);
#ifdef HAVE_GNUTLS3
static void gnutls_audit_log_function (gnutls_session_t, const char *);
#endif
#ifdef HAVE_GNUTLS3
/* Function to log a simple audit message. */
static void
-gnutls_audit_log_function (gnutls_session_t session, const char* string)
+gnutls_audit_log_function (gnutls_session_t session, const char *string)
{
if (global_gnutls_log_level >= 1)
{
/* Function to log a simple message. */
static void
-gnutls_log_function (int level, const char* string)
+gnutls_log_function (int level, const char *string)
{
message ("gnutls.c: [%d] %s", level, string);
}
/* Function to log a message and a string. */
static void
-gnutls_log_function2 (int level, const char* string, const char* extra)
+gnutls_log_function2 (int level, const char *string, const char *extra)
{
message ("gnutls.c: [%d] %s %s", level, string, extra);
}
/* Function to log a message and an integer. */
static void
-gnutls_log_function2i (int level, const char* string, int extra)
+gnutls_log_function2i (int level, const char *string, int extra)
{
message ("gnutls.c: [%d] %s %d", level, string, extra);
}
return ret;
}
-int
+ptrdiff_t
emacs_gnutls_record_check_pending (gnutls_session_t state)
{
return fn_gnutls_record_check_pending (state);
:verify-flags is a bitset as per GnuTLS'
gnutls_certificate_set_verify_flags.
-:verify-hostname-error, if non-nil, makes a hostname mismatch an
-error. Otherwise it will be just a warning.
+:verify-hostname-error is ignored. Pass :hostname in :verify-error
+instead.
+
+:verify-error is a list of symbols to express verification checks or
+`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
accept in Diffie-Hellman key exchange.
{
int ret = GNUTLS_E_SUCCESS;
int max_log_level = 0;
+ bool verify_error_all = 0;
gnutls_session_t state;
gnutls_certificate_credentials_t x509_cred = NULL;
Lisp_Object global_init;
char const *priority_string_ptr = "NORMAL"; /* default priority string. */
unsigned int peer_verification;
- char* c_hostname;
+ char *c_hostname;
/* Placeholders for the property list elements. */
Lisp_Object priority_string;
/* Lisp_Object callbacks; */
Lisp_Object loglevel;
Lisp_Object hostname;
- /* Lisp_Object verify_error; */
- Lisp_Object verify_hostname_error;
+ Lisp_Object verify_error;
Lisp_Object prime_bits;
CHECK_PROCESS (proc);
keylist = Fplist_get (proplist, QCgnutls_bootprop_keylist);
crlfiles = Fplist_get (proplist, QCgnutls_bootprop_crlfiles);
loglevel = Fplist_get (proplist, QCgnutls_bootprop_loglevel);
- verify_hostname_error = Fplist_get (proplist, QCgnutls_bootprop_verify_hostname_error);
+ verify_error = Fplist_get (proplist, QCgnutls_bootprop_verify_error);
prime_bits = Fplist_get (proplist, QCgnutls_bootprop_min_prime_bits);
+ if (EQ (verify_error, Qt))
+ {
+ verify_error_all = 1;
+ }
+ else if (NILP (Flistp (verify_error)))
+ {
+ error ("gnutls-boot: invalid :verify_error parameter (not a list)");
+ }
+
if (!STRINGP (hostname))
- error ("gnutls-boot: invalid :hostname parameter");
+ error ("gnutls-boot: invalid :hostname parameter (not a string)");
c_hostname = SSDATA (hostname);
state = XPROCESS (proc)->gnutls_state;
if (peer_verification != 0)
{
- if (NILP (verify_hostname_error))
- GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
- c_hostname);
- else
- {
+ if (verify_error_all
+ || !NILP (Fmember (QCgnutls_bootprop_trustfiles, verify_error)))
+ {
emacs_gnutls_deinit (proc);
error ("Certificate validation failed %s, verification code %d",
c_hostname, peer_verification);
+ }
+ else
+ {
+ GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
+ c_hostname);
}
}
if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))
{
- if (NILP (verify_hostname_error))
- GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
- c_hostname);
- else
- {
+ if (verify_error_all
+ || !NILP (Fmember (QCgnutls_bootprop_hostname, verify_error)))
+ {
fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
emacs_gnutls_deinit (proc);
error ("The x509 certificate does not match \"%s\"", c_hostname);
+ }
+ else
+ {
+ GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",
+ c_hostname);
}
}
fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
void
syms_of_gnutls (void)
{
+#include "gnutls.x"
+
gnutls_global_initialized = 0;
DEFSYM (Qgnutls_dll, "gnutls");
DEFSYM (QCgnutls_bootprop_min_prime_bits, ":min-prime-bits");
DEFSYM (QCgnutls_bootprop_loglevel, ":loglevel");
DEFSYM (QCgnutls_bootprop_verify_flags, ":verify-flags");
- DEFSYM (QCgnutls_bootprop_verify_hostname_error, ":verify-hostname-error");
+ DEFSYM (QCgnutls_bootprop_verify_error, ":verify-error");
DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted");
Fput (Qgnutls_e_interrupted, Qgnutls_code,
Fput (Qgnutls_e_not_ready_for_handshake, Qgnutls_code,
make_number (GNUTLS_E_APPLICATION_ERROR_MIN));
- defsubr (&Sgnutls_get_initstage);
- defsubr (&Sgnutls_errorp);
- defsubr (&Sgnutls_error_fatalp);
- defsubr (&Sgnutls_error_string);
- defsubr (&Sgnutls_boot);
- defsubr (&Sgnutls_deinit);
- defsubr (&Sgnutls_bye);
- defsubr (&Sgnutls_available_p);
-
DEFVAR_INT ("gnutls-log-level", global_gnutls_log_level,
doc: /* Logging level used by the GnuTLS functions.
Set this larger than 0 to get debug output in the *Messages* buffer.
HCoop / bpt / emacs.git / blobdiff