Re: [PATCH] GnuTLS support on Woe32

[Ted Zlatanov]

On Sun, 06 Mar 2011 16:16:34 +0100 address@hidden (Claudio Bley) wrote: 

CB> Please find attached a patch which makes building Emacs with GnuTLS
CB> support on Woe32 possible.

Claudio, thanks so much for looking at this.  My C is very rusty and I
appreciate all your help.  I also don't know GnuTLS very well so your
insight is very good.

I'll comment and at the end will show my own work on verification and
callbacks.  Whatever I don't comment, assume it's excellent :)  I hope
you can take what I've done, which is much less capable than your patch,
and bring it into yours to improve the GnuTLS support on all platforms.

CB> +2011-03-06  Claudio Bley  <address@hidden>
CB> +
CB> +   * net/gnutls.el (gnutls-negotiate): Check whether default
CB> +   trustfile exists before going to use it. Add missing argument to
CB> +   gnutls-message-maybe call. Return return value.
CB> +

Thanks for these fixes.  I had some of them but didn't notice the empty
%s and that we should return ret.  My patch incorporates your fixes.

CB> +2011-03-06  Claudio Bley  <address@hidden>
CB> +
CB> +   * starttls.el (starttls-negotiate-gnutls, starttls-open-stream-gnutls):
CB> +   Check for builtin GnuTLS support and use it if available.
CB> +

I think this should be optional.  GnuTLS locks up Emacs hard with
concurrent connections (see Lars' email about that from earlier this
week on emacs-devel).  Also I intentionally made gnutls.el a separate
file to avoid overriding starttls.el.  It shouldn't just take over the
starttls.el functionality.  There are too many parameters and no way to
tune them right now; starttls.el is not tunable at all.  

But it's good to have a way to just swap all the starttls.el
functionality for gnutls.el functionality, for testing and for brave
users, so I'm OK with making it optional.  I hope we can phase out
starttls.el out completely eventually.

CB> +2011-03-06  Claudio Bley  <address@hidden>
CB> +
CB> +   * configure.bat: New options --without-gnutls and --lib, new build
CB> +   variable USER_LIBS, automatically detect GnuTLS.
CB> +   * INSTALL: Add instructions for GnuTLS support.
CB> +   * gmake.defs: Prefix USER_LIB's with -l.
CB> +

I'm OK with whatever you and Eli decide here.  I don't know much about
the W32 platform.

CB> +2011-03-06  Claudio Bley  <address@hidden>
CB> +
CB> +   * process.c (wait_reading_process_output): Check if GnuTLS
CB> +   buffered some data internally if no FDs are set for TLS
CB> +   connections.

Thanks for catching this.

CB> +   * gnutls.c (emacs_gnutls_handle_error): New function.
CB> +   (wsaerror_to_errno): Likewise.
CB> +   (emacs_gnutls_pull): New function for GnuTLS on Woe32.
CB> +   (emacs_gnutls_push): Likewise.
CB> +   (emacs_gnutls_handshake): Add Woe32 support. Retry handshake
CB> +   unless a fatal error occured. Call gnutls_alert_send_appropriate
CB> +   on error. Return error code.
CB> +   (emacs_gnutls_write): Call emacs_gnutls_handle_error.
CB> +   (emacs_gnutls_read): Likewise.
CB> +   (Fgnutls_boot): Return handshake error code.

I'm OK with your approach here and it's much better done than what I
had.  See if you can use my work on verify_flags, but see below about
that.

CB> The [trustfiles] probably should be tri-state: use a default value,
CB> use the given trustfiles or use no trustfiles at all.

There is no default on every platform, that's the problem.  Let's leave
this nil if /etc/ssl/certs/ca-certificates.crt doesn't exist.  I'll work
on a more general way of collecting trust files for every platform.  I
think the default should be an Emacs ca-certificates.crt file and we
should add to the list whatever we find and whatever the user requests.

CB> According to GnuTLS documentation, one should retry calling
CB> gnutls_handshake until it returns 0 (and no fatal error occurred of
CB> course).

CB> For non-blocking sockets handshaking could fail with various non-fatal
CB> errors (e.g. EAGAIN).
...
CB> This is for alarm handling. If the TLS Server sends an alarm, the
CB> client should react appropriately.

Cool, thanks for thinking of these cases.  I appreciate your thoroughness.

OK, my patch:

- detects gnutls_certificate_set_verify_function() and sets
  HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY if it exists.

- sets a buffer-local variable `gnutls-hostname' on every connection
  that can be used to verify the certificate's hostname later

- adds a numeric `verify-flags' parameter to `gnutls-negotiate' and then
  gnutls_boot() uses it to gnutls_certificate_set_verify_flags()
  (I'm not sure I'm doing it correctly, though.)

- sets up the verify callback structure but it's not used right now
  because GnuTLS 2.8.x is still too popular.  I was hoping to get by
  with just the verify flags.  It also adds a new GNUTLS_STAGE_CALLBACKS
  stage that does nothing currently.

- it attempts to verify the peer certificate and hostname.  I'm pretty
  sure I'm doing this wrong because I get a NULL gnutls_verify_cert_list
  every time.

- renames global_initialized to gnutls_global_initialized

I hope you find something useful in it to merge with your patch.

Thanks
Ted

=== modified file 'configure.in'
--- configure.in        2011-03-06 01:42:13 +0000
+++ configure.in        2011-03-07 02:07:34 +0000
@@ -1972,12 +1972,22 @@
 AC_SUBST(LIBSELINUX_LIBS)
 
 HAVE_GNUTLS=no
+HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=no
 if test "${with_gnutls}" = "yes" ; then
   PKG_CHECK_MODULES([LIBGNUTLS], [gnutls >= 2.2.4], HAVE_GNUTLS=yes, 
HAVE_GNUTLS=no)
   if test "${HAVE_GNUTLS}" = "yes"; then
     AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.])
   fi
+
+  CFLAGS="$CFLAGS $LIBGNUTLS_CFLAGS"
+  LIBS="$LIBGNUTLS_LIBS $LIBS"
+  AC_CHECK_FUNCS(gnutls_certificate_set_verify_function, 
HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY=yes)
+
+  if test "${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}" = "yes"; then
+    AC_DEFINE(HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY, 1, [Define if using 
GnuTLS certificate verification callbacks.])
+  fi
 fi
+
 AC_SUBST(LIBGNUTLS_LIBS)
 AC_SUBST(LIBGNUTLS_CFLAGS)
 
@@ -3666,6 +3676,7 @@
 echo "  Does Emacs use -lgconf?                                 ${HAVE_GCONF}"
 echo "  Does Emacs use -lselinux?                               
${HAVE_LIBSELINUX}"
 echo "  Does Emacs use -lgnutls?                                ${HAVE_GNUTLS}"
+echo "  Does Emacs use -lgnutls certificate verify callbacks?   
${HAVE_GNUTLS_CALLBACK_CERTIFICATE_VERIFY}"
 echo "  Does Emacs use -lxml2?                                  
${HAVE_LIBXML2}"
 
 echo "  Does Emacs use -lfreetype?                              
${HAVE_FREETYPE}"

=== modified file 'lisp/net/gnutls.el'
--- lisp/net/gnutls.el  2011-01-25 04:08:28 +0000
+++ lisp/net/gnutls.el  2011-03-08 02:44:11 +0000
@@ -44,6 +44,10 @@
   :type 'integer
   :group 'gnutls)
 
+(defvar gnutls-hostname nil
+  "Remote hostname.  Always buffer-local.")
+(make-variable-buffer-local 'gnutls-hostname)
+
 (defun open-gnutls-stream (name buffer host service)
   "Open a SSL/TLS connection for a service to a host.
 Returns a subprocess-object to represent the connection.
@@ -64,21 +68,44 @@
 GnuTLS connection, including specifying the credential type,
 trust and key files, and priority string."
   (let ((proc (open-network-stream name buffer host service)))
+    ;; remember the hostname associated with this buffer
+    (with-current-buffer buffer
+      (setq gnutls-hostname host))
     (gnutls-negotiate proc 'gnutls-x509pki)))
 
 (declare-function gnutls-boot "gnutls.c" (proc type proplist))
 
 (defun gnutls-negotiate (proc type &optional priority-string
-                              trustfiles keyfiles)
-  "Negotiate a SSL/TLS connection.
+                              trustfiles keyfiles verify-flags)
+  "Negotiate a SSL/TLS connection.  Returns t if successful.
+
 TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
 PROC is a process returned by `open-network-stream'.
 PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
 TRUSTFILES is a list of CA bundles.
-KEYFILES is a list of client keys."
+KEYFILES is a list of client keys.
+
+VERIFY-FLAGS is a numeric OR of verification flags only for
+`gnutls-x509pki' connections.  See GnuTLS' x509.h for details;
+here's a recent version of the list.
+
+    GNUTLS_VERIFY_DISABLE_CA_SIGN = 1,
+    GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT = 2,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_SAME = 4,
+    GNUTLS_VERIFY_ALLOW_ANY_X509_V1_CA_CRT = 8,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD2 = 16,
+    GNUTLS_VERIFY_ALLOW_SIGN_RSA_MD5 = 32,
+    GNUTLS_VERIFY_DISABLE_TIME_CHECKS = 64,
+    GNUTLS_VERIFY_DISABLE_TRUSTED_TIME_CHECKS = 128,
+    GNUTLS_VERIFY_DO_NOT_ALLOW_X509_V1_CA_CRT = 256
+
+It must be omitted, a number, or nil; if omitted or nil it
+defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
   (let* ((type (or type 'gnutls-x509pki))
+         (default-trustfile "/etc/ssl/certs/ca-certificates.crt")
          (trustfiles (or trustfiles
-                        '("/etc/ssl/certs/ca-certificates.crt")))
+                         (when (file-exists-p default-trustfile)
+                           (list default-trustfile))))
          (priority-string (or priority-string
                               (cond
                                ((eq type 'gnutls-anon)
@@ -89,14 +116,15 @@
                              :loglevel ,gnutls-log-level
                              :trustfiles ,trustfiles
                              :keyfiles ,keyfiles
+                             :verify-flags ,verify-flags
                              :callbacks nil))
          ret)
 
     (gnutls-message-maybe
      (setq ret (gnutls-boot proc type params))
-     "boot: %s")
+     "boot: %s" params)
 
-    proc))
+    ret))
 
 (declare-function gnutls-errorp "gnutls.c" (error))
 (declare-function gnutls-error-string "gnutls.c" (error))

=== modified file 'src/gnutls.c'
--- src/gnutls.c        2011-01-25 04:08:28 +0000
+++ src/gnutls.c        2011-03-08 03:21:34 +0000
@@ -30,7 +30,9 @@
 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;
+
+Lisp_Object Qgnutls_hostname;
 
 /* The following are for the property list of `gnutls-boot'.  */
 Lisp_Object Qgnutls_bootprop_priority;
@@ -38,6 +40,10 @@
 Lisp_Object Qgnutls_bootprop_keyfiles;
 Lisp_Object Qgnutls_bootprop_callbacks;
 Lisp_Object Qgnutls_bootprop_loglevel;
+Lisp_Object Qgnutls_bootprop_verify_flags;
+
+/* Callback keys for `gnutls-boot'.  Unused currently.  */
+Lisp_Object Qgnutls_bootprop_callbacks_verify;
 
 static void
 emacs_gnutls_handshake (struct Lisp_Process *proc)
@@ -265,10 +271,10 @@
 {
   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);
 }
@@ -278,10 +284,10 @@
 static Lisp_Object
 gnutls_emacs_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);
 }
@@ -309,7 +315,7 @@
 :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.
 
 The debug level will be set for this process AND globally for GnuTLS.
@@ -324,6 +330,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.
+
 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).  */)
@@ -336,6 +345,11 @@
   /* 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;
@@ -349,6 +363,7 @@
   Lisp_Object keyfiles;
   Lisp_Object callbacks;
   Lisp_Object loglevel;
+  Lisp_Object verify_flags;
 
   CHECK_PROCESS (proc);
   CHECK_SYMBOL (type);
@@ -359,6 +374,7 @@
   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);
 
   state = XPROCESS (proc)->gnutls_state;
   XPROCESS (proc)->gnutls_p = 1;
@@ -416,6 +432,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))
     {
@@ -484,6 +517,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);
@@ -543,6 +584,51 @@
 
   emacs_gnutls_handshake (XPROCESS (proc));
 
+
+  /* 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 gnutls-hostname (which is
+     buffer-local and set by `open-gnutls-stream'.  */
+
+  /* We should be calling gnutls_verify_peers2 around here I think?  */
+
+  /* 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 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, SSDATA 
(intern_c_string ("gnutls-hostname"))))
+        {
+          gnutls_x509_crt_deinit (gnutls_verify_cert);
+          error ("The certificate's hostname does not match gnutls-hostname");
+        }
+
+      gnutls_x509_crt_deinit (gnutls_verify_cert);
+    }
+
   return gnutls_make_error (GNUTLS_E_SUCCESS);
 }
 
@@ -578,7 +664,7 @@
 void
 syms_of_gnutls (void)
 {
-  global_initialized = 0;
+  gnutls_global_initialized = 0;
 
   Qgnutls_code = intern_c_string ("gnutls-code");
   staticpro (&Qgnutls_code);
@@ -589,6 +675,9 @@
   Qgnutls_x509pki = intern_c_string ("gnutls-x509pki");
   staticpro (&Qgnutls_x509pki);
 
+  Qgnutls_hostname = intern_c_string ("gnutls-hostname");
+  staticpro (&Qgnutls_hostname);
+
   Qgnutls_bootprop_priority = intern_c_string (":priority");
   staticpro (&Qgnutls_bootprop_priority);
 
@@ -601,9 +690,15 @@
   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_e_interrupted = intern_c_string ("gnutls-e-interrupted");
   staticpro (&Qgnutls_e_interrupted);
   Fput (Qgnutls_e_interrupted, Qgnutls_code,

=== modified file 'src/gnutls.h'
--- src/gnutls.h        2011-01-25 04:08:28 +0000
+++ src/gnutls.h        2011-03-07 02:10:15 +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,