[PATCH] GnuTLS: Support TOFU certificate checking.

[Toke Høiland-Jørgensen]

This implements Trust On First Use certificate checking in
gnutls.c. This is useful for protecting against MITM attacks when
connecting to servers using self-signed certificates, as well as to
guard against rogue or compromised CAs issuing illegitimate
certificates that would otherwise be accepted.

This adds two new possible symbols to gnutls-verify-error:
:gnutls-strict and :gnutls-auto. The former, if set, will cause a
certificate that is not found in the trust store to always be
rejected, while the latter will automatically add certificates that
have not been seen before, and reject only on certificate mismatch.

A new variable, gnutls-tofu-store, sets which file to use as the
certificate store. If nil, the global GnuTLS store is used.

Signed-off-by: Toke Høiland-Jørgensen <address@hidden>
---
 configure.ac       |   6 +++
 lisp/net/gnutls.el |  26 ++++++++++--
 src/gnutls.c       | 113 ++++++++++++++++++++++++++++++++++++++++++++++++++++-
 3 files changed, 140 insertions(+), 5 deletions(-)

diff --git a/configure.ac b/configure.ac
index 6d047a6..a6f8c4c 100644
--- a/configure.ac
+++ b/configure.ac
@@ -2586,6 +2586,7 @@ AC_SUBST(LIBSELINUX_LIBS)
 
 HAVE_GNUTLS=no
 HAVE_GNUTLS3=no
+HAVE_GNUTLS_TOFU=no
 if test "${with_gnutls}" = "yes" ; then
   EMACS_CHECK_MODULES([LIBGNUTLS], [gnutls >= 3.0.0],
     [HAVE_GNUTLS3=yes], [HAVE_GNUTLS3=no])
@@ -2600,6 +2601,11 @@ if test "${with_gnutls}" = "yes" ; then
     AC_DEFINE(HAVE_GNUTLS, 1, [Define if using GnuTLS.])
   fi
 
+  AC_CHECK_LIB(gnutls, gnutls_verify_stored_pubkey, HAVE_GNUTLS_TOFU=yes)
+  if test "${HAVE_GNUTLS_TOFU}" = "yes"; then
+    AC_DEFINE(HAVE_GNUTLS_TOFU, 1, [Define if using GnuTLS TOFU.])
+  fi
+
   # Windows loads GnuTLS dynamically
   if test "${opsys}" = "mingw32"; then
     LIBGNUTLS_LIBS=
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 0c650f3..3879ea1 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -63,7 +63,19 @@ set this variable to \"normal:-dhe-rsa\"."
                     (const ".*" :tag "Any hostname")
                     regexp)
             (set (const :trustfiles)
-                 (const :hostname))))))
+                 (const :hostname)
+                 (const :tofu-strict)
+                 (const :tofu-auto))))))
+
+(defcustom gnutls-tofu-store (locate-user-emacs-file "tofu-store")
+  "Place to store the Trust On First Use certificate store. If
+nil, use the default GnuTLS store located in the user's home
+directory."
+  :group 'gnutls
+  :version "24.4"
+  :type '(choice (const nil)
+                 string))
+
 
 (defcustom gnutls-trustfiles
   '(
@@ -123,7 +135,8 @@ GnuTLS connection, including specifying the credential type,
 trust and key files, and priority string."
   (gnutls-negotiate :process (open-network-stream name buffer host service)
                     :type 'gnutls-x509pki
-                    :hostname host))
+                    :hostname host
+                    :service service))
 
 (define-error 'gnutls-error "GnuTLS error")
 
@@ -133,8 +146,8 @@ trust and key files, and priority string."
 
 (cl-defun gnutls-negotiate
     (&rest spec
-           &key process type hostname priority-string
-           trustfiles crlfiles keylist min-prime-bits
+           &key process type hostname service priority-string
+           trustfiles crlfiles keylist min-prime-bits tofu-store
            verify-flags verify-error verify-hostname-error
            &allow-other-keys)
   "Negotiate a SSL/TLS connection.  Returns proc.  Signals gnutls-error.
@@ -144,6 +157,7 @@ Note arguments are passed CL style, :type TYPE instead of 
just TYPE.
 TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
 PROCESS is a process returned by `open-network-stream'.
 HOSTNAME is the remote hostname.  It must be a valid string.
+SERVICE is the remote service.  It will be formatted as a string.
 PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
 TRUSTFILES is a list of CA bundles.  It defaults to `gnutls-trustfiles'.
 CRLFILES is a list of CRL files.
@@ -219,6 +233,8 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
                             ;; else it's nil
                             (t nil))))
          (min-prime-bits (or min-prime-bits gnutls-min-prime-bits))
+         (service (when service (format "%s" service)))
+         (tofu-store (or tofu-store (expand-file-name gnutls-tofu-store)))
          params ret)
 
     (when verify-hostname-error
@@ -226,6 +242,7 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
 
     (setq params `(:priority ,priority-string
                              :hostname ,hostname
+                             :service ,service
                              :loglevel ,gnutls-log-level
                              :min-prime-bits ,min-prime-bits
                              :trustfiles ,trustfiles
@@ -233,6 +250,7 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
                              :keylist ,keylist
                              :verify-flags ,verify-flags
                              :verify-error ,verify-error
+                             :tofu-store ,tofu-store
                              :callbacks nil))
 
     (gnutls-message-maybe
diff --git a/src/gnutls.c b/src/gnutls.c
index 5d48f78..1b73566 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -43,11 +43,15 @@ static bool gnutls_global_initialized;
 /* The following are for the property list of `gnutls-boot'.  */
 static Lisp_Object QCgnutls_bootprop_priority;
 static Lisp_Object QCgnutls_bootprop_trustfiles;
+static Lisp_Object QCgnutls_bootprop_tofu_strict;
+static Lisp_Object QCgnutls_bootprop_tofu_auto;
+static Lisp_Object QCgnutls_bootprop_tofu_store;
 static Lisp_Object QCgnutls_bootprop_keylist;
 static Lisp_Object QCgnutls_bootprop_crlfiles;
 static Lisp_Object QCgnutls_bootprop_callbacks;
 static Lisp_Object QCgnutls_bootprop_loglevel;
 static Lisp_Object QCgnutls_bootprop_hostname;
+static Lisp_Object QCgnutls_bootprop_service;
 static Lisp_Object QCgnutls_bootprop_min_prime_bits;
 static Lisp_Object QCgnutls_bootprop_verify_flags;
 static Lisp_Object QCgnutls_bootprop_verify_error;
@@ -141,6 +145,14 @@ DEF_GNUTLS_FN (void, gnutls_transport_set_push_function,
               (gnutls_session_t, gnutls_push_func));
 DEF_GNUTLS_FN (int, gnutls_x509_crt_check_hostname,
               (gnutls_x509_crt_t, const char *));
+#ifdef HAVE_GNUTLS_TOFU
+DEF_GNUTLS_FN (int, gnutls_verify_stored_pubkey,
+              (const char *, gnutls_tdb_t, const char *,const char *,
+               gnutls_cerificate_type_t,const gnutls_datum_t *,unsigned int));
+DEF_GNUTLS_FN (int, gnutls_store_pubkey,
+              (const char *, gnutls_tdb_t, const char *,const char *,
+               gnutls_cerificate_type_t,const gnutls_datum_t *,time_t,unsigned 
int));
+#endif
 DEF_GNUTLS_FN (void, gnutls_x509_crt_deinit, (gnutls_x509_crt_t));
 DEF_GNUTLS_FN (int, gnutls_x509_crt_import,
               (gnutls_x509_crt_t, const gnutls_datum_t *,
@@ -202,6 +214,10 @@ init_gnutls_functions (void)
   LOAD_GNUTLS_FN (library, gnutls_transport_set_pull_function);
   LOAD_GNUTLS_FN (library, gnutls_transport_set_push_function);
   LOAD_GNUTLS_FN (library, gnutls_x509_crt_check_hostname);
+#ifdef HAVE_GNUTLS_TOFU
+  LOAD_GNUTLS_FN (library, gnutls_verify_stored_pubkey);
+  LOAD_GNUTLS_FN (library, gnutls_store_pubkey);
+#endif
   LOAD_GNUTLS_FN (library, gnutls_x509_crt_deinit);
   LOAD_GNUTLS_FN (library, gnutls_x509_crt_import);
   LOAD_GNUTLS_FN (library, gnutls_x509_crt_init);
@@ -257,6 +273,10 @@ init_gnutls_functions (void)
 #endif
 #define fn_gnutls_transport_set_ptr2           gnutls_transport_set_ptr2
 #define fn_gnutls_x509_crt_check_hostname      gnutls_x509_crt_check_hostname
+#ifdef HAVE_GNUTLS_TOFU
+#define fn_gnutls_verify_stored_pubkey         gnutls_verify_stored_pubkey
+#define fn_gnutls_store_pubkey                 gnutls_store_pubkey
+#endif
 #define fn_gnutls_x509_crt_deinit              gnutls_x509_crt_deinit
 #define fn_gnutls_x509_crt_import              gnutls_x509_crt_import
 #define fn_gnutls_x509_crt_init                        gnutls_x509_crt_init
@@ -738,6 +758,8 @@ PROPLIST is a property list with the following keys:
 
 :hostname is a string naming the remote host.
 
+:service is a port number naming the remote service.
+
 :priority is a GnuTLS priority string, defaults to "NORMAL".
 
 :trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
@@ -759,7 +781,11 @@ 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.
+`:hostname' to verify the certificate or the hostname respectively, as
+well as `:tofu-strict' or `:tofu-auto' to turn on Trust On First Use
+mode. Using `:tofu-strict' rejects certificates not in the trust
+store, while `:tofu-auto' automatically adds unknown certificates the
+first time they are seen (but rejects them on subsequent mismatch).
 
 :min-prime-bits is the minimum accepted number of bits the client will
 accept in Diffie-Hellman key exchange.
@@ -795,6 +821,8 @@ one trustfile (usually a CA bundle).  */)
   char const *priority_string_ptr = "NORMAL"; /* default priority string.  */
   unsigned int peer_verification;
   char *c_hostname;
+  char *c_service;
+  char *c_tofu_store;
 
   /* Placeholders for the property list elements.  */
   Lisp_Object priority_string;
@@ -804,6 +832,8 @@ one trustfile (usually a CA bundle).  */)
   /* Lisp_Object callbacks; */
   Lisp_Object loglevel;
   Lisp_Object hostname;
+  Lisp_Object service;
+  Lisp_Object tofu_store;
   Lisp_Object verify_error;
   Lisp_Object prime_bits;
 
@@ -818,6 +848,8 @@ one trustfile (usually a CA bundle).  */)
     error ("Invalid GnuTLS credential type");
 
   hostname              = Fplist_get (proplist, QCgnutls_bootprop_hostname);
+  service               = Fplist_get (proplist, QCgnutls_bootprop_service);
+  tofu_store            = Fplist_get (proplist, QCgnutls_bootprop_tofu_store);
   priority_string       = Fplist_get (proplist, QCgnutls_bootprop_priority);
   trustfiles            = Fplist_get (proplist, QCgnutls_bootprop_trustfiles);
   keylist               = Fplist_get (proplist, QCgnutls_bootprop_keylist);
@@ -839,6 +871,32 @@ one trustfile (usually a CA bundle).  */)
     error ("gnutls-boot: invalid :hostname parameter (not a string)");
   c_hostname = SSDATA (hostname);
 
+  if (NILP (service))
+    {
+      c_service = NULL;
+    }
+  else if (!STRINGP (service))
+    {
+      error ("gnutls-boot: invalid :service parameter (not a string)");
+    }
+  else
+    {
+      c_service = SSDATA (service);
+    }
+
+  if (NILP (tofu_store))
+    {
+      c_tofu_store = NULL;
+    }
+  else if (!STRINGP (tofu_store))
+    {
+      error ("gnutls-boot: invalid :tofu-store parameter (not a string)");
+    }
+  else
+    {
+      c_tofu_store = SSDATA (tofu_store);
+    }
+
   state = XPROCESS (proc)->gnutls_state;
 
   if (TYPE_RANGED_INTEGERP (int, loglevel))
@@ -1141,6 +1199,55 @@ one trustfile (usually a CA bundle).  */)
                            c_hostname);
            }
        }
+
+#ifdef HAVE_GNUTLS_TOFU
+      if (!NILP (Fmember (QCgnutls_bootprop_tofu_strict, verify_error)) ||
+         !NILP (Fmember (QCgnutls_bootprop_tofu_auto, verify_error)))
+       {
+         ret = fn_gnutls_verify_stored_pubkey(c_tofu_store, NULL, c_hostname, 
c_service,
+                                              GNUTLS_CRT_X509, 
gnutls_verify_cert_list, 0);
+         if (ret == GNUTLS_E_NO_CERTIFICATE_FOUND)
+           {
+             if(NILP (Fmember (QCgnutls_bootprop_tofu_strict, verify_error))) 
/* strict takes precedence */
+               {
+                 ret = fn_gnutls_store_pubkey(c_tofu_store, NULL, c_hostname, 
c_service,
+                                              GNUTLS_CRT_X509, 
gnutls_verify_cert_list, 0, 0);
+                 if(ret < GNUTLS_E_SUCCESS)
+                   {
+                     GNUTLS_LOG2 (0, max_log_level,
+                                  "Failed to add certificate to trust store 
for hostname:",
+                                  c_hostname);
+                     ret = GNUTLS_E_SUCCESS; /* don't actually fail the 
connection */
+                   }
+                 else
+                   {
+                     GNUTLS_LOG2 (0, max_log_level,
+                                  "Added certificate to trust store for 
hostname:",
+                                  c_hostname);
+                   }
+               }
+             else
+               {
+                 fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
+                 emacs_gnutls_deinit (proc);
+                 error ("No TOFU trust entry found for hostname \"%s\". "
+                        "Turn off strict TOFU mode, or add certificate 
manually.", c_hostname);
+               }
+           }
+         else if (ret == GNUTLS_E_CERTIFICATE_KEY_MISMATCH)
+           {
+             fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
+             emacs_gnutls_deinit (proc);
+             error ("TOFU trust mismatch for hostname \"%s\". "
+                    "Remove offending certificate from trust store and try 
again.", c_hostname);
+           }
+         else if (ret < GNUTLS_E_SUCCESS)
+           {
+             fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
+             return gnutls_make_error (ret);
+           }
+       }
+#endif /* HAVE_GNUTLS_TOFU */
       fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
     }
 
@@ -1189,8 +1296,12 @@ syms_of_gnutls (void)
   DEFSYM (Qgnutls_anon, "gnutls-anon");
   DEFSYM (Qgnutls_x509pki, "gnutls-x509pki");
   DEFSYM (QCgnutls_bootprop_hostname, ":hostname");
+  DEFSYM (QCgnutls_bootprop_service, ":service");
   DEFSYM (QCgnutls_bootprop_priority, ":priority");
   DEFSYM (QCgnutls_bootprop_trustfiles, ":trustfiles");
+  DEFSYM (QCgnutls_bootprop_tofu_strict, ":tofu-strict");
+  DEFSYM (QCgnutls_bootprop_tofu_auto, ":tofu-auto");
+  DEFSYM (QCgnutls_bootprop_tofu_store, ":tofu-store");
   DEFSYM (QCgnutls_bootprop_keylist, ":keylist");
   DEFSYM (QCgnutls_bootprop_crlfiles, ":crlfiles");
   DEFSYM (QCgnutls_bootprop_callbacks, ":callbacks");
-- 
2.1.2