[Top][All Lists]
[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[Emacs-diffs] /srv/bzr/emacs/trunk r103998: Add GnuTLS support for W32 a
|
From: |
Ted Zlatanov |
|
Subject: |
[Emacs-diffs] /srv/bzr/emacs/trunk r103998: Add GnuTLS support for W32 and certificate and hostname verification in GnuTLS. |
|
Date: |
Sun, 24 Apr 2011 20:30:51 -0500 |
|
User-agent: |
Bazaar (2.3.1) |
------------------------------------------------------------
revno: 103998
committer: Ted Zlatanov <address@hidden>
branch nick: quickfixes
timestamp: Sun 2011-04-24 20:30:51 -0500
message:
Add GnuTLS support for W32 and certificate and hostname verification in
GnuTLS.
* src/gnutls.c: Renamed global_initialized to
gnutls_global_initialized. Added internals for the
:verify-hostname-error, :verify-error, and :verify-flags
parameters of `gnutls-boot' and documented those parameters in the
docstring. Start callback support.
(emacs_gnutls_handshake): Add Woe32 support. Retry handshake
unless a fatal error occured. Call gnutls_alert_send_appropriate
on error. Return error code.
(emacs_gnutls_write): Call emacs_gnutls_handle_error.
(emacs_gnutls_read): Likewise.
(Fgnutls_boot): Return handshake error code.
(emacs_gnutls_handle_error): New function.
(wsaerror_to_errno): Likewise.
* src/gnutls.h: Add GNUTLS_STAGE_CALLBACKS enum to denote we're in the
callbacks stage.
* src/w32.c (emacs_gnutls_pull): New function for GnuTLS on Woe32.
(emacs_gnutls_push): Likewise.
* src/w32.h (emacs_gnutls_pull): Add prototype.
(emacs_gnutls_push): Likewise.
modified:
src/ChangeLog
src/gnutls.c
src/gnutls.h
src/makefile.w32-in
src/process.c
src/w32.c
src/w32.h
=== modified file 'src/ChangeLog'
--- a/src/ChangeLog 2011-04-24 16:59:37 +0000
+++ b/src/ChangeLog 2011-04-25 01:30:51 +0000
@@ -1,3 +1,38 @@
+2011-04-24 Teodor Zlatanov <address@hidden>
+
+ * gnutls.h: Add GNUTLS_STAGE_CALLBACKS enum to denote we're in the
+ callbacks stage.
+
+ * gnutls.c: Renamed global_initialized to
+ gnutls_global_initialized. Added internals for the
+ :verify-hostname-error, :verify-error, and :verify-flags
+ parameters of `gnutls-boot' and documented those parameters in the
+ docstring. Start callback support.
+ (emacs_gnutls_handshake): Add Woe32 support. Retry handshake
+ unless a fatal error occured. Call gnutls_alert_send_appropriate
+ on error. Return error code.
+ (emacs_gnutls_write): Call emacs_gnutls_handle_error.
+ (emacs_gnutls_read): Likewise.
+ (Fgnutls_boot): Return handshake error code.
+ (emacs_gnutls_handle_error): New function.
+ (wsaerror_to_errno): Likewise.
+
+ * w32.h (emacs_gnutls_pull): Add prototype.
+ (emacs_gnutls_push): Likewise.
+
+ * w32.c (emacs_gnutls_pull): New function for GnuTLS on Woe32.
+ (emacs_gnutls_push): Likewise.
+
+2011-04-24 Claudio Bley <address@hidden> (tiny change)
+
+ * process.c (wait_reading_process_output): Check if GnuTLS
+ buffered some data internally if no FDs are set for TLS
+ connections.
+
+ * makefile.w32-in (OBJ2): Add gnutls.$(O).
+ (LIBS): Link to USER_LIBS.
+ ($(BLD)/gnutls.$(0)): New target.
+
2011-04-24 Eli Zaretskii <address@hidden>
* xdisp.c (handle_single_display_spec): Rename the
=== modified file 'src/gnutls.c'
--- a/src/gnutls.c 2011-04-16 19:16:40 +0000
+++ b/src/gnutls.c 2011-04-25 01:30:51 +0000
@@ -26,11 +26,20 @@
#ifdef HAVE_GNUTLS
#include <gnutls/gnutls.h>
+#ifdef WINDOWSNT
+#include <windows.h>
+#include "w32.h"
+#endif
+
+static int
+emacs_gnutls_handle_error (gnutls_session_t, int err);
+
+Lisp_Object Qgnutls_log_level;
Lisp_Object Qgnutls_code;
Lisp_Object Qgnutls_anon, Qgnutls_x509pki;
Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
-int global_initialized;
+int gnutls_global_initialized;
/* The following are for the property list of `gnutls-boot'. */
Lisp_Object Qgnutls_bootprop_priority;
@@ -38,8 +47,27 @@
Lisp_Object Qgnutls_bootprop_keyfiles;
Lisp_Object Qgnutls_bootprop_callbacks;
Lisp_Object Qgnutls_bootprop_loglevel;
-
-static void
+Lisp_Object Qgnutls_bootprop_hostname;
+Lisp_Object Qgnutls_bootprop_verify_flags;
+Lisp_Object Qgnutls_bootprop_verify_error;
+Lisp_Object Qgnutls_bootprop_verify_hostname_error;
+
+/* Callback keys for `gnutls-boot'. Unused currently. */
+Lisp_Object Qgnutls_bootprop_callbacks_verify;
+
+static void
+gnutls_log_function (int level, const char* string)
+{
+ message ("gnutls.c: [%d] %s", level, string);
+}
+
+static void
+gnutls_log_function2 (int level, const char* string, const char* extra)
+{
+ message ("gnutls.c: [%d] %s %s", level, string, extra);
+}
+
+static int
emacs_gnutls_handshake (struct Lisp_Process *proc)
{
gnutls_session_t state = proc->gnutls_state;
@@ -50,24 +78,55 @@
if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET)
{
+#ifdef WINDOWSNT
+ /* On W32 we cannot transfer socket handles between different runtime
+ libraries, so we tell GnuTLS to use our special push/pull
+ functions. */
+ gnutls_transport_set_ptr2 (state,
+ (gnutls_transport_ptr_t) proc,
+ (gnutls_transport_ptr_t) proc);
+ gnutls_transport_set_push_function (state, &emacs_gnutls_push);
+ gnutls_transport_set_pull_function (state, &emacs_gnutls_pull);
+
+ /* For non blocking sockets or other custom made pull/push
+ functions the gnutls_transport_set_lowat must be called, with
+ a zero low water mark value. (GnuTLS 2.10.4 documentation)
+
+ (Note: this is probably not strictly necessary as the lowat
+ value is only used when no custom pull/push functions are
+ set.) */
+ gnutls_transport_set_lowat (state, 0);
+#else
/* This is how GnuTLS takes sockets: as file descriptors passed
in. For an Emacs process socket, infd and outfd are the
same but we use this two-argument version for clarity. */
gnutls_transport_set_ptr2 (state,
- (gnutls_transport_ptr_t) (long) proc->infd,
- (gnutls_transport_ptr_t) (long) proc->outfd);
+ (gnutls_transport_ptr_t) proc->infd,
+ (gnutls_transport_ptr_t) proc->outfd);
+#endif
proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET;
}
- ret = gnutls_handshake (state);
+ do
+ {
+ ret = gnutls_handshake (state);
+ emacs_gnutls_handle_error (state, ret);
+ }
+ while (ret < 0 && gnutls_error_is_fatal (ret) == 0);
+
proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;
if (ret == GNUTLS_E_SUCCESS)
{
- /* here we're finally done. */
+ /* Here we're finally done. */
proc->gnutls_initstage = GNUTLS_STAGE_READY;
}
+ else
+ {
+ gnutls_alert_send_appropriate (state, ret);
+ }
+ return ret;
}
EMACS_INT
@@ -107,6 +166,7 @@
bytes_written += rtnval;
}
+ emacs_gnutls_handle_error (state, rtnval);
return (bytes_written);
}
@@ -122,19 +182,68 @@
emacs_gnutls_handshake (proc);
return -1;
}
-
rtnval = gnutls_read (state, buf, nbyte);
if (rtnval >= 0)
return rtnval;
+ else if (emacs_gnutls_handle_error (state, rtnval) == 0)
+ /* non-fatal error */
+ return -1;
else {
- if (rtnval == GNUTLS_E_AGAIN ||
- rtnval == GNUTLS_E_INTERRUPTED)
- return -1;
- else
- return 0;
+ /* a fatal error occured */
+ return 0;
}
}
+/* report a GnuTLS error to the user.
+ Returns zero if the error code was successfully handled. */
+static int
+emacs_gnutls_handle_error (gnutls_session_t session, int err)
+{
+ Lisp_Object gnutls_log_level = Fsymbol_value (Qgnutls_log_level);
+ int max_log_level = 0;
+
+ int alert, ret;
+ const char *str;
+
+ /* TODO: use a Lisp_Object generated by gnutls_make_error? */
+ if (err >= 0)
+ return 0;
+
+ if (NUMBERP (gnutls_log_level))
+ max_log_level = XINT (gnutls_log_level);
+
+ /* TODO: use gnutls-error-fatalp and gnutls-error-string. */
+
+ str = gnutls_strerror (err);
+ if (!str)
+ str = "unknown";
+
+ if (gnutls_error_is_fatal (err))
+ {
+ ret = err;
+ 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. */
+ }
+
+ if (err == GNUTLS_E_WARNING_ALERT_RECEIVED
+ || err == GNUTLS_E_FATAL_ALERT_RECEIVED)
+ {
+ int alert = gnutls_alert_get (session);
+ int level = (err == GNUTLS_E_FATAL_ALERT_RECEIVED) ? 0 : 1;
+ str = gnutls_alert_get_name (alert);
+ if (!str)
+ str = "unknown";
+
+ GNUTLS_LOG2 (level, max_log_level, "Received alert: ", str);
+ }
+ return ret;
+}
+
/* convert an integer error to a Lisp_Object; it will be either a
known symbol like `gnutls_e_interrupted' and `gnutls_e_again' or
simply the integer value of the error. GNUTLS_E_SUCCESS is mapped
@@ -262,14 +371,14 @@
Call `gnutls-global-deinit' when GnuTLS usage is no longer needed.
Returns zero on success. */
static Lisp_Object
-gnutls_emacs_global_init (void)
+emacs_gnutls_global_init (void)
{
int ret = GNUTLS_E_SUCCESS;
- if (!global_initialized)
+ if (!gnutls_global_initialized)
ret = gnutls_global_init ();
- global_initialized = 1;
+ gnutls_global_initialized = 1;
return gnutls_make_error (ret);
}
@@ -277,28 +386,16 @@
/* Deinitializes global GnuTLS state.
See also `gnutls-global-init'. */
static Lisp_Object
-gnutls_emacs_global_deinit (void)
+emacs_gnutls_global_deinit (void)
{
- if (global_initialized)
+ if (gnutls_global_initialized)
gnutls_global_deinit ();
- global_initialized = 0;
+ gnutls_global_initialized = 0;
return gnutls_make_error (GNUTLS_E_SUCCESS);
}
-static void
-gnutls_log_function (int level, const char* string)
-{
- message ("gnutls.c: [%d] %s", level, string);
-}
-
-static void
-gnutls_log_function2 (int level, const char* string, const char* extra)
-{
- message ("gnutls.c: [%d] %s %s", level, string, extra);
-}
-
DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0,
doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST.
Currently only client mode is supported. Returns a success/failure
@@ -307,12 +404,27 @@
TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'.
PROPLIST is a property list with the following keys:
+:hostname is a string naming the remote host.
+
:priority is a GnuTLS priority string, defaults to "NORMAL".
+
:trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
+
:keyfiles is a list of PEM-encoded key files for `gnutls-x509pki'.
-:callbacks is an alist of callback functions (TODO).
+
+:callbacks is an alist of callback functions, see below.
+
:loglevel is the debug level requested from GnuTLS, try 4.
+:verify-flags is a bitset as per GnuTLS'
+gnutls_certificate_set_verify_flags.
+
+:verify-error, if non-nil, makes failure of the certificate validation
+an error. Otherwise it will be just a series of warnings.
+
+:verify-hostname-error, if non-nil, makes a hostname mismatch an
+error. Otherwise it will be just a warning.
+
The debug level will be set for this process AND globally for GnuTLS.
So if you set it higher or lower at any point, it affects global
debugging.
@@ -325,6 +437,9 @@
functions are used. This function allocates resources which can only
be deallocated by calling `gnutls-deinit' or by calling it again.
+The callbacks alist can have a `verify' key, associated with a
+verification function (UNUSED).
+
Each authentication type may need additional information in order to
work. For X.509 PKI (`gnutls-x509pki'), you probably need at least
one trustfile (usually a CA bundle). */)
@@ -337,12 +452,19 @@
/* TODO: GNUTLS_X509_FMT_DER is also an option. */
int file_format = GNUTLS_X509_FMT_PEM;
+ unsigned int gnutls_verify_flags = GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT;
+ gnutls_x509_crt_t gnutls_verify_cert;
+ unsigned int gnutls_verify_cert_list_size;
+ const gnutls_datum_t *gnutls_verify_cert_list;
+
gnutls_session_t state;
gnutls_certificate_credentials_t x509_cred;
gnutls_anon_client_credentials_t anon_cred;
Lisp_Object global_init;
char* priority_string_ptr = "NORMAL"; /* default priority string. */
Lisp_Object tail;
+ int peer_verification;
+ char* c_hostname;
/* Placeholders for the property list elements. */
Lisp_Object priority_string;
@@ -350,16 +472,29 @@
Lisp_Object keyfiles;
Lisp_Object callbacks;
Lisp_Object loglevel;
+ Lisp_Object hostname;
+ Lisp_Object verify_flags;
+ Lisp_Object verify_error;
+ Lisp_Object verify_hostname_error;
CHECK_PROCESS (proc);
CHECK_SYMBOL (type);
CHECK_LIST (proplist);
- priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority);
- trustfiles = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
- keyfiles = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
- callbacks = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
- loglevel = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+ hostname = Fplist_get (proplist, Qgnutls_bootprop_hostname);
+ priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority);
+ trustfiles = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
+ keyfiles = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
+ callbacks = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
+ loglevel = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
+ verify_flags = Fplist_get (proplist, Qgnutls_bootprop_verify_flags);
+ verify_error = Fplist_get (proplist, Qgnutls_bootprop_verify_error);
+ verify_hostname_error = Fplist_get (proplist,
Qgnutls_bootprop_verify_hostname_error);
+
+ if (!STRINGP (hostname))
+ error ("gnutls-boot: invalid :hostname parameter");
+
+ c_hostname = SSDATA (hostname);
state = XPROCESS (proc)->gnutls_state;
XPROCESS (proc)->gnutls_p = 1;
@@ -373,7 +508,7 @@
}
/* always initialize globals. */
- global_init = gnutls_emacs_global_init ();
+ global_init = emacs_gnutls_global_init ();
if (! NILP (Fgnutls_errorp (global_init)))
return global_init;
@@ -417,6 +552,23 @@
x509_cred = XPROCESS (proc)->gnutls_x509_cred;
if (gnutls_certificate_allocate_credentials (&x509_cred) < 0)
memory_full ();
+
+ if (NUMBERP (verify_flags))
+ {
+ gnutls_verify_flags = XINT (verify_flags);
+ GNUTLS_LOG (2, max_log_level, "setting verification flags");
+ }
+ else if (NILP (verify_flags))
+ {
+ /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT. */
+ GNUTLS_LOG (2, max_log_level, "using default verification flags");
+ }
+ else
+ {
+ /* The default is already GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT. */
+ GNUTLS_LOG (2, max_log_level, "ignoring invalid verify-flags");
+ }
+ gnutls_certificate_set_verify_flags (x509_cred, gnutls_verify_flags);
}
else if (EQ (type, Qgnutls_anon))
{
@@ -485,6 +637,14 @@
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
+ GNUTLS_LOG (1, max_log_level, "gnutls callbacks");
+
+ GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CALLBACKS;
+
+#ifdef HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY
+#else
+#endif
+
GNUTLS_LOG (1, max_log_level, "gnutls_init");
ret = gnutls_init (&state, GNUTLS_CLIENT);
@@ -542,9 +702,113 @@
GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
- emacs_gnutls_handshake (XPROCESS (proc));
-
- return gnutls_make_error (GNUTLS_E_SUCCESS);
+ ret = emacs_gnutls_handshake (XPROCESS (proc));
+
+ if (ret < GNUTLS_E_SUCCESS)
+ return gnutls_make_error (ret);
+
+ /* Now verify the peer, following
+
http://www.gnu.org/software/gnutls/manual/html_node/Verifying-peer_0027s-certificate.html.
+ The peer should present at least one certificate in the chain; do a
+ check of the certificate's hostname with
+ gnutls_x509_crt_check_hostname() against :hostname. */
+
+ ret = gnutls_certificate_verify_peers2 (state, &peer_verification);
+
+ if (ret < GNUTLS_E_SUCCESS)
+ return gnutls_make_error (ret);
+
+ if (XINT (loglevel) > 0 && peer_verification & GNUTLS_CERT_INVALID)
+ message ("%s certificate could not be verified.",
+ c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_REVOKED)
+ GNUTLS_LOG2 (1, max_log_level, "certificate was revoked (CRL):",
+ c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_SIGNER_NOT_FOUND)
+ GNUTLS_LOG2 (1, max_log_level, "certificate signer was not found:",
+ c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_SIGNER_NOT_CA)
+ GNUTLS_LOG2 (1, max_log_level, "certificate signer is not a CA:",
+ c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_INSECURE_ALGORITHM)
+ GNUTLS_LOG2 (1, max_log_level,
+ "certificate was signed with an insecure algorithm:",
+ c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_NOT_ACTIVATED)
+ GNUTLS_LOG2 (1, max_log_level, "certificate is not yet activated:",
+ c_hostname);
+
+ if (peer_verification & GNUTLS_CERT_EXPIRED)
+ GNUTLS_LOG2 (1, max_log_level, "certificate has expired:",
+ c_hostname);
+
+ if (peer_verification != 0)
+ {
+ if (NILP (verify_hostname_error))
+ {
+ GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",
+ c_hostname);
+ }
+ else
+ {
+ error ("Certificate validation failed %s, verification code %d",
+ c_hostname, peer_verification);
+ }
+ }
+
+ /* Up to here the process is the same for X.509 certificates and
+ OpenPGP keys. From now on X.509 certificates are assumed. This
+ can be easily extended to work with openpgp keys as well. */
+ if (gnutls_certificate_type_get (state) == GNUTLS_CRT_X509)
+ {
+ ret = gnutls_x509_crt_init (&gnutls_verify_cert);
+
+ if (ret < GNUTLS_E_SUCCESS)
+ return gnutls_make_error (ret);
+
+ gnutls_verify_cert_list =
+ gnutls_certificate_get_peers (state, &gnutls_verify_cert_list_size);
+
+ if (NULL == gnutls_verify_cert_list)
+ {
+ error ("No x509 certificate was found!\n");
+ }
+
+ /* We only check the first certificate in the given chain. */
+ ret = gnutls_x509_crt_import (gnutls_verify_cert,
+ &gnutls_verify_cert_list[0],
+ GNUTLS_X509_FMT_DER);
+
+ if (ret < GNUTLS_E_SUCCESS)
+ {
+ gnutls_x509_crt_deinit (gnutls_verify_cert);
+ return gnutls_make_error (ret);
+ }
+
+ if (!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
+ {
+ gnutls_x509_crt_deinit (gnutls_verify_cert);
+ error ("The x509 certificate does not match \"%s\"",
+ c_hostname);
+ }
+ }
+
+ gnutls_x509_crt_deinit (gnutls_verify_cert);
+ }
+
+ return gnutls_make_error (ret);
}
DEFUN ("gnutls-bye", Fgnutls_bye,
@@ -579,7 +843,10 @@
void
syms_of_gnutls (void)
{
- global_initialized = 0;
+ gnutls_global_initialized = 0;
+
+ Qgnutls_log_level = intern_c_string ("gnutls-log-level");
+ staticpro (&Qgnutls_log_level);
Qgnutls_code = intern_c_string ("gnutls-code");
staticpro (&Qgnutls_code);
@@ -590,6 +857,9 @@
Qgnutls_x509pki = intern_c_string ("gnutls-x509pki");
staticpro (&Qgnutls_x509pki);
+ Qgnutls_bootprop_hostname = intern_c_string (":hostname");
+ staticpro (&Qgnutls_bootprop_hostname);
+
Qgnutls_bootprop_priority = intern_c_string (":priority");
staticpro (&Qgnutls_bootprop_priority);
@@ -602,9 +872,21 @@
Qgnutls_bootprop_callbacks = intern_c_string (":callbacks");
staticpro (&Qgnutls_bootprop_callbacks);
+ Qgnutls_bootprop_callbacks_verify = intern_c_string ("verify");
+ staticpro (&Qgnutls_bootprop_callbacks_verify);
+
Qgnutls_bootprop_loglevel = intern_c_string (":loglevel");
staticpro (&Qgnutls_bootprop_loglevel);
+ Qgnutls_bootprop_verify_flags = intern_c_string (":verify-flags");
+ staticpro (&Qgnutls_bootprop_verify_flags);
+
+ Qgnutls_bootprop_verify_hostname_error = intern_c_string (":verify-error");
+ staticpro (&Qgnutls_bootprop_verify_error);
+
+ Qgnutls_bootprop_verify_hostname_error = intern_c_string
(":verify-hostname-error");
+ staticpro (&Qgnutls_bootprop_verify_hostname_error);
+
Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted");
staticpro (&Qgnutls_e_interrupted);
Fput (Qgnutls_e_interrupted, Qgnutls_code,
=== modified file 'src/gnutls.h'
--- a/src/gnutls.h 2011-04-15 08:22:34 +0000
+++ b/src/gnutls.h 2011-04-25 01:30:51 +0000
@@ -21,6 +21,7 @@
#ifdef HAVE_GNUTLS
#include <gnutls/gnutls.h>
+#include <gnutls/x509.h>
typedef enum
{
@@ -28,6 +29,7 @@
GNUTLS_STAGE_EMPTY = 0,
GNUTLS_STAGE_CRED_ALLOC,
GNUTLS_STAGE_FILES,
+ GNUTLS_STAGE_CALLBACKS,
GNUTLS_STAGE_INIT,
GNUTLS_STAGE_PRIORITY,
GNUTLS_STAGE_CRED_SET,
=== modified file 'src/makefile.w32-in'
--- a/src/makefile.w32-in 2011-04-24 09:00:03 +0000
+++ b/src/makefile.w32-in 2011-04-25 01:30:51 +0000
@@ -105,6 +105,7 @@
$(BLD)/floatfns.$(O) \
$(BLD)/frame.$(O) \
$(BLD)/gmalloc.$(O) \
+ $(BLD)/gnutls.$(O) \
$(BLD)/intervals.$(O) \
$(BLD)/composite.$(O) \
$(BLD)/ralloc.$(O) \
@@ -150,6 +151,7 @@
$(OLE32) \
$(COMCTL32) \
$(UNISCRIBE) \
+ $(USER_LIBS) \
$(libc)
#
@@ -950,6 +952,14 @@
$(EMACS_ROOT)/nt/inc/unistd.h \
$(SRC)/getpagesize.h
+$(BLD)/gnutls.$(O) : \
+ $(SRC)/gnutls.h \
+ $(SRC)/gnutls.c \
+ $(CONFIG_H) \
+ $(EMACS_ROOT)/nt/inc/sys/socket.h \
+ $(SRC)/lisp.h \
+ $(SRC)/process.h
+
$(BLD)/image.$(O) : \
$(SRC)/image.c \
$(CONFIG_H) \
=== modified file 'src/process.c'
--- a/src/process.c 2011-04-16 22:04:41 +0000
+++ b/src/process.c 2011-04-25 01:30:51 +0000
@@ -4532,6 +4532,22 @@
&Available,
(check_write ? &Writeok : (SELECT_TYPE *)0),
(SELECT_TYPE *)0, &timeout);
+
+#ifdef HAVE_GNUTLS
+ /* GnuTLS buffers data internally. In lowat mode it leaves
+ some data in the TCP buffers so that select works, but
+ with custom pull/push functions we need to check if some
+ data is available in the buffers manually. */
+ if (nfds == 0 &&
+ wait_proc && wait_proc->gnutls_p /* Check for valid process. */
+ /* Do we have pending data? */
+ && gnutls_record_check_pending (wait_proc->gnutls_state) > 0)
+ {
+ nfds = 1;
+ /* Set to Available. */
+ FD_SET (wait_proc->infd, &Available);
+ }
+#endif
}
xerrno = errno;
=== modified file 'src/w32.c'
--- a/src/w32.c 2011-04-23 03:07:16 +0000
+++ b/src/w32.c 2011-04-25 01:30:51 +0000
@@ -6124,5 +6124,72 @@
p->childp = childp2;
}
+#ifdef HAVE_GNUTLS
+
+ssize_t
+emacs_gnutls_pull (gnutls_transport_ptr_t p, void* buf, size_t sz)
+{
+ int n, sc, err;
+ SELECT_TYPE fdset;
+ EMACS_TIME timeout;
+ struct Lisp_Process *process = (struct Lisp_Process *)p;
+ int fd = process->infd;
+
+ for (;;)
+ {
+ n = sys_read(fd, (char*)buf, sz);
+
+ if (n >= 0)
+ return n;
+
+ err = errno;
+
+ if (err == EWOULDBLOCK)
+ {
+ /* Set a small timeout. */
+ EMACS_SET_SECS_USECS(timeout, 1, 0);
+ FD_ZERO (&fdset);
+ FD_SET ((int)fd, &fdset);
+
+ /* Use select with the timeout to poll the selector. */
+ sc = select (fd + 1, &fdset, (SELECT_TYPE *)0, (SELECT_TYPE *)0,
+ &timeout);
+
+ if (sc > 0)
+ continue; /* Try again. */
+
+ /* Translate the WSAEWOULDBLOCK alias EWOULDBLOCK to EAGAIN.
+ Also accept select return 0 as an indicator to EAGAIN. */
+ if (sc == 0 || errno == EWOULDBLOCK)
+ err = EAGAIN;
+ else
+ err = errno; /* Other errors are just passed on. */
+ }
+
+ gnutls_transport_set_errno (process->gnutls_state, err);
+
+ return -1;
+ }
+}
+
+ssize_t
+emacs_gnutls_push (gnutls_transport_ptr_t p, const void* buf, size_t sz)
+{
+ struct Lisp_Process *process = (struct Lisp_Process *)p;
+ int fd = proc->outfd;
+ ssize_t n = sys_write(fd, buf, sz);
+
+ /* 0 or more bytes written means everything went fine. */
+ if (n >= 0)
+ return n;
+
+ /* Negative bytes written means we got an error in errno.
+ Translate the WSAEWOULDBLOCK alias EWOULDBLOCK to EAGAIN. */
+ gnutls_transport_set_errno (process->gnutls_state,
+ errno == EWOULDBLOCK ? EAGAIN : errno);
+
+ return -1;
+}
+#endif /* HAVE_GNUTLS */
+
/* end of w32.c */
-
=== modified file 'src/w32.h'
--- a/src/w32.h 2011-01-25 04:08:28 +0000
+++ b/src/w32.h 2011-04-25 01:30:51 +0000
@@ -143,5 +143,17 @@
extern int _sys_read_ahead (int fd);
extern int _sys_wait_accept (int fd);
+#ifdef HAVE_GNUTLS
+#include <gnutls/gnutls.h>
+
+/* GnuTLS pull (read from remote) interface. */
+extern ssize_t emacs_gnutls_pull (gnutls_transport_ptr_t p,
+ void* buf, size_t sz);
+
+/* GnuTLS push (write to remote) interface. */
+extern ssize_t emacs_gnutls_push (gnutls_transport_ptr_t p,
+ const void* buf, size_t sz);
+#endif /* HAVE_GNUTLS */
+
#endif /* EMACS_W32_H */
| [Prev in Thread] |
Current Thread |
[Next in Thread] |
- [Emacs-diffs] /srv/bzr/emacs/trunk r103998: Add GnuTLS support for W32 and certificate and hostname verification in GnuTLS.,
Ted Zlatanov <=