X-Git-Url: http://git.hcoop.net/bpt/emacs.git/blobdiff_plain/ac1a0ce1c6ba60a3faddc64463cb7a697b9d8fd2..6c596cb2ea3075afab8812f45803683be2949323:/src/gnutls.c
diff --git a/src/gnutls.c b/src/gnutls.c
index c5e21cc877..d9b417b46e 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -1,5 +1,5 @@
/* GnuTLS glue for GNU Emacs.
- Copyright (C) 2010-2012 Free Software Foundation, Inc.
+ Copyright (C) 2010-2014 Free Software Foundation, Inc.
This file is part of GNU Emacs.
@@ -18,10 +18,10 @@ along with GNU Emacs. If not, see . */
#include
#include
-#include
#include "lisp.h"
#include "process.h"
+#include "coding.h"
#ifdef HAVE_GNUTLS
#include
@@ -31,15 +31,14 @@ along with GNU Emacs. If not, see . */
#include "w32.h"
#endif
-static int
-emacs_gnutls_handle_error (gnutls_session_t, int err);
+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 int gnutls_global_initialized;
+static bool gnutls_global_initialized;
/* The following are for the property list of `gnutls-boot'. */
static Lisp_Object QCgnutls_bootprop_priority;
@@ -51,13 +50,16 @@ 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_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 WINDOWSNT
@@ -110,6 +112,9 @@ DEF_GNUTLS_FN (void, gnutls_dh_set_prime_bits,
DEF_GNUTLS_FN (int, gnutls_error_is_fatal, (int));
DEF_GNUTLS_FN (int, gnutls_global_init, (void));
DEF_GNUTLS_FN (void, gnutls_global_set_log_function, (gnutls_log_func));
+#ifdef HAVE_GNUTLS3
+DEF_GNUTLS_FN (void, gnutls_global_set_audit_log_function, (gnutls_audit_log_func));
+#endif
DEF_GNUTLS_FN (void, gnutls_global_set_log_level, (int));
DEF_GNUTLS_FN (void, gnutls_global_set_mem_functions,
(gnutls_alloc_function, gnutls_alloc_function,
@@ -142,13 +147,13 @@ DEF_GNUTLS_FN (int, gnutls_x509_crt_import,
gnutls_x509_crt_fmt_t));
DEF_GNUTLS_FN (int, gnutls_x509_crt_init, (gnutls_x509_crt_t *));
-static int
-init_gnutls_functions (Lisp_Object libraries)
+static bool
+init_gnutls_functions (void)
{
HMODULE library;
int max_log_level = 1;
- if (!(library = w32_delayed_load (libraries, Qgnutls_dll)))
+ if (!(library = w32_delayed_load (Qgnutls_dll)))
{
GNUTLS_LOG (1, max_log_level, "GnuTLS library not found");
return 0;
@@ -175,6 +180,9 @@ init_gnutls_functions (Lisp_Object libraries)
LOAD_GNUTLS_FN (library, gnutls_error_is_fatal);
LOAD_GNUTLS_FN (library, gnutls_global_init);
LOAD_GNUTLS_FN (library, gnutls_global_set_log_function);
+#ifdef HAVE_GNUTLS3
+ LOAD_GNUTLS_FN (library, gnutls_global_set_audit_log_function);
+#endif
LOAD_GNUTLS_FN (library, gnutls_global_set_log_level);
LOAD_GNUTLS_FN (library, gnutls_global_set_mem_functions);
LOAD_GNUTLS_FN (library, gnutls_handshake);
@@ -232,6 +240,9 @@ init_gnutls_functions (Lisp_Object libraries)
#define fn_gnutls_error_is_fatal gnutls_error_is_fatal
#define fn_gnutls_global_init gnutls_global_init
#define fn_gnutls_global_set_log_function gnutls_global_set_log_function
+#ifdef HAVE_GNUTLS3
+#define fn_gnutls_global_set_audit_log_function gnutls_global_set_audit_log_function
+#endif
#define fn_gnutls_global_set_log_level gnutls_global_set_log_level
#define fn_gnutls_global_set_mem_functions gnutls_global_set_mem_functions
#define fn_gnutls_handshake gnutls_handshake
@@ -241,7 +252,9 @@ init_gnutls_functions (Lisp_Object libraries)
#define fn_gnutls_record_recv gnutls_record_recv
#define fn_gnutls_record_send gnutls_record_send
#define fn_gnutls_strerror gnutls_strerror
+#ifdef WINDOWSNT
#define fn_gnutls_transport_set_errno gnutls_transport_set_errno
+#endif
#define fn_gnutls_transport_set_ptr2 gnutls_transport_set_ptr2
#define fn_gnutls_x509_crt_check_hostname gnutls_x509_crt_check_hostname
#define fn_gnutls_x509_crt_deinit gnutls_x509_crt_deinit
@@ -251,23 +264,35 @@ init_gnutls_functions (Lisp_Object libraries)
#endif /* !WINDOWSNT */
+#ifdef HAVE_GNUTLS3
+/* Function to log a simple audit message. */
+static void
+gnutls_audit_log_function (gnutls_session_t session, const char *string)
+{
+ if (global_gnutls_log_level >= 1)
+ {
+ message ("gnutls.c: [audit] %s", string);
+ }
+}
+#endif
+
/* 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);
}
@@ -322,6 +347,7 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
{
ret = fn_gnutls_handshake (state);
emacs_gnutls_handle_error (state, ret);
+ QUIT;
}
while (ret < 0 && fn_gnutls_error_is_fatal (ret) == 0);
@@ -339,17 +365,19 @@ emacs_gnutls_handshake (struct Lisp_Process *proc)
return ret;
}
-int
+ptrdiff_t
emacs_gnutls_record_check_pending (gnutls_session_t state)
{
return fn_gnutls_record_check_pending (state);
}
+#ifdef WINDOWSNT
void
emacs_gnutls_transport_set_errno (gnutls_session_t state, int err)
{
fn_gnutls_transport_set_errno (state, err);
}
+#endif
ptrdiff_t
emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte)
@@ -360,12 +388,7 @@ emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte)
if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
{
-#ifdef EWOULDBLOCK
- errno = EWOULDBLOCK;
-#endif
-#ifdef EAGAIN
errno = EAGAIN;
-#endif
return 0;
}
@@ -385,14 +408,7 @@ emacs_gnutls_write (struct Lisp_Process *proc, const char *buf, ptrdiff_t nbyte)
appropriately so that send_process retries the
correct way instead of erroring out. */
if (rtnval == GNUTLS_E_AGAIN)
- {
-#ifdef EWOULDBLOCK
- errno = EWOULDBLOCK;
-#endif
-#ifdef EAGAIN
- errno = EAGAIN;
-#endif
- }
+ errno = EAGAIN;
break;
}
}
@@ -438,7 +454,7 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte)
else if (rtnval == GNUTLS_E_UNEXPECTED_PACKET_LENGTH)
/* The peer closed the connection. */
return 0;
- else if (emacs_gnutls_handle_error (state, rtnval) == 0)
+ else if (emacs_gnutls_handle_error (state, rtnval))
/* non-fatal error */
return -1;
else {
@@ -447,19 +463,19 @@ emacs_gnutls_read (struct Lisp_Process *proc, char *buf, ptrdiff_t nbyte)
}
}
-/* report a GnuTLS error to the user.
- Returns zero if the error code was successfully handled. */
-static int
+/* Report a GnuTLS error to the user.
+ Return true if the error code was successfully handled. */
+static bool
emacs_gnutls_handle_error (gnutls_session_t session, int err)
{
int max_log_level = 0;
- int ret;
+ bool ret;
const char *str;
/* TODO: use a Lisp_Object generated by gnutls_make_error? */
if (err >= 0)
- return 0;
+ return 1;
max_log_level = global_gnutls_log_level;
@@ -471,14 +487,26 @@ emacs_gnutls_handle_error (gnutls_session_t session, int err)
if (fn_gnutls_error_is_fatal (err))
{
- ret = err;
+ ret = 0;
GNUTLS_LOG2 (0, max_log_level, "fatal error:", str);
}
else
{
- ret = 0;
- GNUTLS_LOG2 (1, max_log_level, "non-fatal error:", str);
- /* TODO: EAGAIN AKA Qgnutls_e_again should be level 2. */
+ ret = 1;
+
+ switch (err)
+ {
+ case GNUTLS_E_AGAIN:
+ GNUTLS_LOG2 (3,
+ max_log_level,
+ "retry:",
+ str);
+ default:
+ GNUTLS_LOG2 (1,
+ max_log_level,
+ "non-fatal error:",
+ str);
+ }
}
if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
@@ -656,7 +684,7 @@ DEFUN ("gnutls-available-p", Fgnutls_available_p, Sgnutls_available_p, 0, 0, 0,
else
{
Lisp_Object status;
- status = init_gnutls_functions (Vdynamic_library_alist) ? Qt : Qnil;
+ status = init_gnutls_functions () ? Qt : Qnil;
Vlibrary_cache = Fcons (Fcons (Qgnutls_dll, status), Vlibrary_cache);
return status;
}
@@ -726,8 +754,12 @@ certificates for `gnutls-x509pki'.
: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.
@@ -754,6 +786,7 @@ one trustfile (usually a CA bundle). */)
{
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;
@@ -761,7 +794,7 @@ one trustfile (usually a CA bundle). */)
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;
@@ -771,8 +804,7 @@ one trustfile (usually a CA bundle). */)
/* 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);
@@ -780,16 +812,10 @@ one trustfile (usually a CA bundle). */)
CHECK_LIST (proplist);
if (NILP (Fgnutls_available_p ()))
- {
- error ("GnuTLS not available");
- return gnutls_make_error (GNUTLS_EMACS_ERROR_NOT_LOADED);
- }
+ error ("GnuTLS not available");
if (!EQ (type, Qgnutls_x509pki) && !EQ (type, Qgnutls_anon))
- {
- error ("Invalid GnuTLS credential type");
- return gnutls_make_error (GNUTLS_EMACS_ERROR_INVALID_TYPE);
- }
+ error ("Invalid GnuTLS credential type");
hostname = Fplist_get (proplist, QCgnutls_bootprop_hostname);
priority_string = Fplist_get (proplist, QCgnutls_bootprop_priority);
@@ -797,19 +823,30 @@ one trustfile (usually a CA bundle). */)
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;
- XPROCESS (proc)->gnutls_p = 1;
if (TYPE_RANGED_INTEGERP (int, loglevel))
{
fn_gnutls_global_set_log_function (gnutls_log_function);
+#ifdef HAVE_GNUTLS3
+ fn_gnutls_global_set_audit_log_function (gnutls_audit_log_function);
+#endif
fn_gnutls_global_set_log_level (XINT (loglevel));
max_log_level = XINT (loglevel);
XPROCESS (proc)->gnutls_log_level = max_log_level;
@@ -825,11 +862,10 @@ one trustfile (usually a CA bundle). */)
emacs_gnutls_deinit (proc);
/* Mark PROC as a GnuTLS process. */
- XPROCESS (proc)->gnutls_p = 1;
XPROCESS (proc)->gnutls_state = NULL;
XPROCESS (proc)->gnutls_x509_cred = NULL;
XPROCESS (proc)->gnutls_anon_cred = NULL;
- XPROCESS (proc)->gnutls_cred_type = type;
+ pset_gnutls_cred_type (XPROCESS (proc), type);
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY;
GNUTLS_LOG (1, max_log_level, "allocating credentials");
@@ -870,13 +906,20 @@ one trustfile (usually a CA bundle). */)
int file_format = GNUTLS_X509_FMT_PEM;
Lisp_Object tail;
- for (tail = trustfiles; !NILP (tail); tail = Fcdr (tail))
+ for (tail = trustfiles; CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object trustfile = Fcar (tail);
+ Lisp_Object trustfile = XCAR (tail);
if (STRINGP (trustfile))
{
GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
SSDATA (trustfile));
+ trustfile = ENCODE_FILE (trustfile);
+#ifdef WINDOWSNT
+ /* Since GnuTLS doesn't support UTF-8 or UTF-16 encoded
+ file names on Windows, we need to re-encode the file
+ name using the current ANSI codepage. */
+ trustfile = ansi_encode_filename (trustfile);
+#endif
ret = fn_gnutls_certificate_set_x509_trust_file
(x509_cred,
SSDATA (trustfile),
@@ -892,13 +935,17 @@ one trustfile (usually a CA bundle). */)
}
}
- for (tail = crlfiles; !NILP (tail); tail = Fcdr (tail))
+ for (tail = crlfiles; CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object crlfile = Fcar (tail);
+ Lisp_Object crlfile = XCAR (tail);
if (STRINGP (crlfile))
{
GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
SSDATA (crlfile));
+ crlfile = ENCODE_FILE (crlfile);
+#ifdef WINDOWSNT
+ crlfile = ansi_encode_filename (crlfile);
+#endif
ret = fn_gnutls_certificate_set_x509_crl_file
(x509_cred, SSDATA (crlfile), file_format);
@@ -912,16 +959,22 @@ one trustfile (usually a CA bundle). */)
}
}
- for (tail = keylist; !NILP (tail); tail = Fcdr (tail))
+ for (tail = keylist; CONSP (tail); tail = XCDR (tail))
{
- Lisp_Object keyfile = Fcar (Fcar (tail));
- Lisp_Object certfile = Fcar (Fcdr (tail));
+ Lisp_Object keyfile = Fcar (XCAR (tail));
+ Lisp_Object certfile = Fcar (Fcdr (XCAR (tail)));
if (STRINGP (keyfile) && STRINGP (certfile))
{
GNUTLS_LOG2 (1, max_log_level, "setting the client key file: ",
SSDATA (keyfile));
GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ",
SSDATA (certfile));
+ keyfile = ENCODE_FILE (keyfile);
+ certfile = ENCODE_FILE (certfile);
+#ifdef WINDOWSNT
+ keyfile = ansi_encode_filename (keyfile);
+ certfile = ansi_encode_filename (certfile);
+#endif
ret = fn_gnutls_certificate_set_x509_key_file
(x509_cred, SSDATA (certfile), SSDATA (keyfile), file_format);
@@ -1025,14 +1078,17 @@ one trustfile (usually a CA bundle). */)
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);
}
}
@@ -1072,19 +1128,25 @@ one trustfile (usually a CA bundle). */)
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);
}
+ /* Set this flag only if the whole initialization succeeded. */
+ XPROCESS (proc)->gnutls_p = 1;
+
return gnutls_make_error (ret);
}
@@ -1136,7 +1198,7 @@ syms_of_gnutls (void)
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,