[PATCH RFC] GnuTLS: Support TOFU certificate checking.

[Toke Høiland-Jørgensen]

This implements rudimentary 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.

To test:

(require 'gnutls)
(setq gnutls-verify-error '((".*" :tofu))
(open-gnutls-stream "test" nil "google.com" 443) ; this should fail

To add the certificate to the trust store, execute (in a shell)
`gnutls-cli --tofu -p 443 google.com` and answer yes when it asks
whether to trust the certificate. Doing so should cause the open to
success the next time around.

As noted above, this is quite rudimentary as it is right now, and will
probably need to be expanded. However, I wanted to solicit some feedback
first, and so here's a few questions:

1. Would this be viable to include at all? And if so, is this the right
   way to go about it?

2. There's currently no way to add a certificate to the store when it's
   first seen. What's the best way to go about this? I'm not sure how to
   actually communicate with the user from within gnutls-boot.

3. Currently this uses the global (well, per-user) GnuTLS certificate
   store. My thought was this makes the most sense (it's still per-port,
   so the same hostname can have different certificates for different
   services). But is it?

4. Setting gnutls-verify-error to t does not activate TOFU checking. The
   reasoning behind this is that TOFU works somewhat differently than
   the other trust models (CA and hostname matching), and so is a
   feature that is probably best left for people to explicitly ask for.
   Is this reasonable?

5. Any other comments. For instance, I have only tested this on Linux,
   so not sure if I fudged up all the library loading magic for W32...

Thanks in advance for looking this over.

As an aside, while testing this I found that using customize to set
gnutls-verify-error, a doubly-nested list of symbols would end up
getting passed to gnutls-boot, which would then subsequently fail all
the membership tests on it. This seems to stem from the fact that
customize produces list entries of the form '((".*" (:tofu))) while
gnutls-negotiate passes the cdr of each matched entry to cl-mapcan. Not
sure which should be fixed, so I just set it manually while testing, but
thought I'd point it out :)

Cheers,
-Toke
---
 lisp/net/gnutls.el | 10 +++++++---
 src/gnutls.c       | 43 ++++++++++++++++++++++++++++++++++++++++++-
 2 files changed, 49 insertions(+), 4 deletions(-)

diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 0c650f3..9809b0f 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -63,7 +63,8 @@ set this variable to \"normal:-dhe-rsa\"."
                     (const ".*" :tag "Any hostname")
                     regexp)
             (set (const :trustfiles)
-                 (const :hostname))))))
+                 (const :hostname)
+                 (const :tofu))))))
 
 (defcustom gnutls-trustfiles
   '(
@@ -123,7 +124,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,7 +135,7 @@ trust and key files, and priority string."
 
 (cl-defun gnutls-negotiate
     (&rest spec
-           &key process type hostname priority-string
+           &key process type hostname service priority-string
            trustfiles crlfiles keylist min-prime-bits
            verify-flags verify-error verify-hostname-error
            &allow-other-keys)
@@ -144,6 +146,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.
@@ -226,6 +229,7 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
 
     (setq params `(:priority ,priority-string
                              :hostname ,hostname
+                             :service ,(format "%s" service)
                              :loglevel ,gnutls-log-level
                              :min-prime-bits ,min-prime-bits
                              :trustfiles ,trustfiles
diff --git a/src/gnutls.c b/src/gnutls.c
index 5d48f78..a08ec8e 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -43,11 +43,13 @@ 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;
 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 +143,9 @@ 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 *));
+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 (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 +207,7 @@ 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);
+  LOAD_GNUTLS_FN (library, gnutls_verify_stored_pubkey);
   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 +263,7 @@ 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
+#define fn_gnutls_verify_stored_pubkey         gnutls_verify_stored_pubkey
 #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 +745,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 +768,8 @@ 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' to turn on Trust On First Use mode.
 
 :min-prime-bits is the minimum accepted number of bits the client will
 accept in Diffie-Hellman key exchange.
@@ -795,6 +805,7 @@ 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;
 
   /* Placeholders for the property list elements.  */
   Lisp_Object priority_string;
@@ -804,6 +815,7 @@ one trustfile (usually a CA bundle).  */)
   /* Lisp_Object callbacks; */
   Lisp_Object loglevel;
   Lisp_Object hostname;
+  Lisp_Object service;
   Lisp_Object verify_error;
   Lisp_Object prime_bits;
 
@@ -818,6 +830,7 @@ 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);
   priority_string       = Fplist_get (proplist, QCgnutls_bootprop_priority);
   trustfiles            = Fplist_get (proplist, QCgnutls_bootprop_trustfiles);
   keylist               = Fplist_get (proplist, QCgnutls_bootprop_keylist);
@@ -839,6 +852,10 @@ one trustfile (usually a CA bundle).  */)
     error ("gnutls-boot: invalid :hostname parameter (not a string)");
   c_hostname = SSDATA (hostname);
 
+  if (!STRINGP (service))
+    error ("gnutls-boot: invalid :service parameter (not a string)");
+  c_service = SSDATA (service);
+
   state = XPROCESS (proc)->gnutls_state;
 
   if (TYPE_RANGED_INTEGERP (int, loglevel))
@@ -1141,6 +1158,28 @@ one trustfile (usually a CA bundle).  */)
                            c_hostname);
            }
        }
+
+      if (!NILP (Fmember (QCgnutls_bootprop_tofu, verify_error)))
+       {
+         ret = fn_gnutls_verify_stored_pubkey(NULL, NULL, c_hostname, 
c_service, GNUTLS_CRT_X509, gnutls_verify_cert_list, 0);
+         if (ret == GNUTLS_E_NO_CERTIFICATE_FOUND)
+           {
+             fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
+             emacs_gnutls_deinit (proc);
+             error ("No TOFU trust entry found for hostname \"%s\" and service 
\"%s\"", c_hostname, c_service);
+           }
+         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\" and service 
\"%s\"", c_hostname, c_service);
+           }
+         else if (ret < GNUTLS_E_SUCCESS)
+           {
+             fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
+             return gnutls_make_error (ret);
+           }
+       }
       fn_gnutls_x509_crt_deinit (gnutls_verify_cert);
     }
 
@@ -1189,8 +1228,10 @@ 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, ":tofu");
   DEFSYM (QCgnutls_bootprop_keylist, ":keylist");
   DEFSYM (QCgnutls_bootprop_crlfiles, ":crlfiles");
   DEFSYM (QCgnutls_bootprop_callbacks, ":callbacks");
-- 
2.1.2