From e061a11b5a59f02fac66184e991f01a433f6dc8d Mon Sep 17 00:00:00 2001 From: Ted Zlatanov Date: Sun, 24 Apr 2011 20:30:51 -0500 Subject: [PATCH] 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. --- src/ChangeLog | 35 +++++ src/gnutls.c | 360 +++++++++++++++++++++++++++++++++++++++----- src/gnutls.h | 2 + src/makefile.w32-in | 10 ++ src/process.c | 16 ++ src/w32.c | 69 ++++++++- src/w32.h | 12 ++ 7 files changed, 464 insertions(+), 40 deletions(-) diff --git a/src/ChangeLog b/src/ChangeLog index f1d195c454..410a3b15ff 100644 --- a/src/ChangeLog +++ b/src/ChangeLog @@ -1,3 +1,38 @@ +2011-04-24 Teodor Zlatanov + + * 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 (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 * xdisp.c (handle_single_display_spec): Rename the diff --git a/src/gnutls.c b/src/gnutls.c index f4f2b9bbd3..18ceb79193 100644 --- a/src/gnutls.c +++ b/src/gnutls.c @@ -26,11 +26,20 @@ along with GNU Emacs. If not, see . */ #ifdef HAVE_GNUTLS #include +#ifdef WINDOWSNT +#include +#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_trustfiles; Lisp_Object Qgnutls_bootprop_keyfiles; Lisp_Object Qgnutls_bootprop_callbacks; Lisp_Object Qgnutls_bootprop_loglevel; +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 @@ emacs_gnutls_handshake (struct Lisp_Process *proc) 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 @@ emacs_gnutls_write (int fildes, struct Lisp_Process *proc, const char *buf, bytes_written += rtnval; } + emacs_gnutls_handle_error (state, rtnval); return (bytes_written); } @@ -122,19 +182,68 @@ emacs_gnutls_read (int fildes, struct Lisp_Process *proc, char *buf, 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 @@ See also `gnutls-init'. */) 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 @@ gnutls_emacs_global_init (void) /* 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 @@ value you can check with `gnutls-errorp'. 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 @@ Processes must be initialized with this function before other GnuTLS 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 @@ one trustfile (usually a CA bundle). */) /* 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 @@ one trustfile (usually a CA bundle). */) 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 @@ one trustfile (usually a CA bundle). */) } /* 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 @@ one trustfile (usually a CA bundle). */) 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 @@ one trustfile (usually a CA bundle). */) 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 @@ one trustfile (usually a CA bundle). */) GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET; - emacs_gnutls_handshake (XPROCESS (proc)); + ret = emacs_gnutls_handshake (XPROCESS (proc)); - return gnutls_make_error (GNUTLS_E_SUCCESS); + 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 @@ This function may also return `gnutls-e-again', or 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 @@ syms_of_gnutls (void) 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 @@ syms_of_gnutls (void) 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, diff --git a/src/gnutls.h b/src/gnutls.h index 5240d94c2a..6c2e4c6952 100644 --- a/src/gnutls.h +++ b/src/gnutls.h @@ -21,6 +21,7 @@ along with GNU Emacs. If not, see . */ #ifdef HAVE_GNUTLS #include +#include typedef enum { @@ -28,6 +29,7 @@ typedef enum GNUTLS_STAGE_EMPTY = 0, GNUTLS_STAGE_CRED_ALLOC, GNUTLS_STAGE_FILES, + GNUTLS_STAGE_CALLBACKS, GNUTLS_STAGE_INIT, GNUTLS_STAGE_PRIORITY, GNUTLS_STAGE_CRED_SET, diff --git a/src/makefile.w32-in b/src/makefile.w32-in index 0dd06b7efc..4ba314318d 100644 --- a/src/makefile.w32-in +++ b/src/makefile.w32-in @@ -105,6 +105,7 @@ OBJ2 = $(BLD)/sysdep.$(O) \ $(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 @@ LIBS = $(TLIB0) \ $(OLE32) \ $(COMCTL32) \ $(UNISCRIBE) \ + $(USER_LIBS) \ $(libc) # @@ -950,6 +952,14 @@ $(BLD)/gmalloc.$(O) : \ $(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) \ diff --git a/src/process.c b/src/process.c index d8851c56cf..4253286196 100644 --- a/src/process.c +++ b/src/process.c @@ -4532,6 +4532,22 @@ wait_reading_process_output (int time_limit, int microsecs, int read_kbd, &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; diff --git a/src/w32.c b/src/w32.c index 85e4a2025b..065d730333 100644 --- a/src/w32.c +++ b/src/w32.c @@ -6124,5 +6124,72 @@ serial_configure (struct Lisp_Process *p, Lisp_Object contact) p->childp = childp2; } -/* end of w32.c */ +#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 */ diff --git a/src/w32.h b/src/w32.h index 9279ddbe57..4086c4190e 100644 --- a/src/w32.h +++ b/src/w32.h @@ -143,5 +143,17 @@ extern void syms_of_fontset (void); extern int _sys_read_ahead (int fd); extern int _sys_wait_accept (int fd); +#ifdef HAVE_GNUTLS +#include + +/* 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 */ -- 2.20.1