bug#9036: [PATCH] gnutls: Add option to set minimum acceptable Diffie-Hellman key size

[Lawrence Mitchell]

* gnutls.c (Qgnutls_bootprop_min_prime_bits): New variable.
(Fgnutls_boot): Use it

* net/gnutls.el (gnutls-min-prime-bits): New variable.
(gnutls-negotiate): Use it.

The default acceptable key size used by gnutls in Diffie-Hellman key
exchange is larger than that advertised by many servers.  Introduce a
customization option to set the minimum acceptable value so that we
can still connect to such servers using TLS.
---
With the recent gnutls changes I could no longer send mail with
STARTTLS since the smtp server I connect to only advertises a D-H
key with 512bits.  This is smaller than the default value gnutls
allows and so the connection would be aborted.  This patch adds
the ability to set the minimum acceptable size of key, so that I
can send email again!

 lisp/ChangeLog     |    5 +++++
 lisp/net/gnutls.el |   22 ++++++++++++++++++++--
 src/ChangeLog      |    5 +++++
 src/gnutls.c       |   16 ++++++++++++++++
 4 files changed, 46 insertions(+), 2 deletions(-)

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index c3162c3..ca20415 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,8 @@
+2011-07-09  Lawrence Mitchell  <wence@gmx.li>
+
+       * net/gnutls.el (gnutls-min-prime-bits): New variable.
+       (gnutls-negotiate): Use it.
+
 2011-07-07  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
        * mail/smtpmail.el (smtpmail-stream-type): Note that `plain' can
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 67d7b2d..83726d0 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -47,6 +47,19 @@
   :type 'integer
   :group 'gnutls)
 
+;;;###autoload
+(defcustom gnutls-min-prime-bits nil
+  "The minimum number of bits to be used in Diffie-Hellman key exchange.
+
+This sets the minimum accepted size of the key to be used in a
+client-server handshake.  If the server sends a prime with fewer than
+the specified number of bits the handshake will fail.
+
+A value of nil says to use the default gnutls value."
+  :type '(choice (const :tag "Use default value" nil)
+                 (integer :tag "Number of bits" 512))
+  :group 'gnutls)
+
 (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.
@@ -90,8 +103,8 @@ trust and key files, and priority string."
 (defun* gnutls-negotiate
     (&rest spec
            &key process type hostname priority-string
-           trustfiles crlfiles keylist verify-flags
-           verify-error verify-hostname-error
+           trustfiles crlfiles keylist min-prime-bits
+           verify-flags verify-error verify-hostname-error
            &allow-other-keys)
   "Negotiate a SSL/TLS connection.  Returns proc. Signals gnutls-error.
 
@@ -104,6 +117,9 @@ PRIORITY-STRING is as per the GnuTLS docs, default is 
\"NORMAL\".
 TRUSTFILES is a list of CA bundles.
 CRLFILES is a list of CRL files.
 KEYLIST is an alist of (client key file, client cert file) pairs.
+MIN-PRIME-BITS is the minimum acceptable size of Diffie-Hellman keys
+\(see `gnutls-min-prime-bits' for more information).  Use nil for the
+default.
 
 When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised
 when the hostname does not match the presented certificate's host
@@ -146,9 +162,11 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
                                 "NORMAL:+ANON-DH:!ARCFOUR-128")
                                ((eq type 'gnutls-x509pki)
                                 "NORMAL"))))
+         (min-prime-bits (or min-prime-bits gnutls-min-prime-bits))
          (params `(:priority ,priority-string
                              :hostname ,hostname
                              :loglevel ,gnutls-log-level
+                             :min-prime-bits ,min-prime-bits
                              :trustfiles ,trustfiles
                              :crlfiles ,crlfiles
                              :keylist ,keylist
diff --git a/src/ChangeLog b/src/ChangeLog
index ac20a60..7ea45e7 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,8 @@
+2011-07-09  Lawrence Mitchell  <wence@gmx.li>
+
+       * gnutls.c (Qgnutls_bootprop_min_prime_bits): New variable.
+       (Fgnutls_boot): Use it.
+
 2011-07-07  Kenichi Handa  <handa@m17n.org>
 
        * character.h (unicode_category_t): New enum type.
diff --git a/src/gnutls.c b/src/gnutls.c
index 76cfa5d..26a88a7 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -50,6 +50,7 @@ static Lisp_Object Qgnutls_bootprop_crlfiles;
 static Lisp_Object Qgnutls_bootprop_callbacks;
 static Lisp_Object Qgnutls_bootprop_loglevel;
 static Lisp_Object Qgnutls_bootprop_hostname;
+static Lisp_Object Qgnutls_bootprop_min_prime_bits;
 static Lisp_Object Qgnutls_bootprop_verify_flags;
 static Lisp_Object Qgnutls_bootprop_verify_hostname_error;
 
@@ -105,6 +106,8 @@ DEF_GNUTLS_FN (int, gnutls_certificate_verify_peers2,
 DEF_GNUTLS_FN (int, gnutls_credentials_set,
                (gnutls_session_t, gnutls_credentials_type_t, void *));
 DEF_GNUTLS_FN (void, gnutls_deinit, (gnutls_session_t));
+DEF_GNUTLS_FN (void, gnutls_dh_set_prime_bits,
+               (gnutls_session_t, unsigned int));
 DEF_GNUTLS_FN (int, gnutls_error_is_fatal, (int));
 DEF_GNUTLS_FN (int, gnutls_global_init, (void));
 DEF_GNUTLS_FN (void, gnutls_global_set_log_function, (gnutls_log_func));
@@ -167,6 +170,7 @@ init_gnutls_functions (Lisp_Object libraries)
   LOAD_GNUTLS_FN (library, gnutls_certificate_verify_peers2);
   LOAD_GNUTLS_FN (library, gnutls_credentials_set);
   LOAD_GNUTLS_FN (library, gnutls_deinit);
+  LOAD_GNUTLS_FN (library, gnutls_dh_set_prime_bits);
   LOAD_GNUTLS_FN (library, gnutls_error_is_fatal);
   LOAD_GNUTLS_FN (library, gnutls_global_init);
   LOAD_GNUTLS_FN (library, gnutls_global_set_log_function);
@@ -213,6 +217,7 @@ init_gnutls_functions (Lisp_Object libraries)
 #define fn_gnutls_certificate_verify_peers2    gnutls_certificate_verify_peers2
 #define fn_gnutls_credentials_set              gnutls_credentials_set
 #define fn_gnutls_deinit                       gnutls_deinit
+#define fn_gnutls_dh_set_prime_bits            gnutls_dh_set_prime_bits
 #define fn_gnutls_error_is_fatal               gnutls_error_is_fatal
 #define fn_gnutls_global_init                  gnutls_global_init
 #define fn_gnutls_global_set_log_function      gnutls_global_set_log_function
@@ -641,6 +646,9 @@ gnutls_certificate_set_verify_flags.
 :verify-hostname-error, if non-nil, makes a hostname mismatch an
 error.  Otherwise it will be just a warning.
 
+:min-prime-bits is the minimum accepted number of bits the client will
+accept in Diffie-Hellman key exchange.
+
 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.
@@ -693,6 +701,7 @@ one trustfile (usually a CA bundle).  */)
   Lisp_Object verify_flags;
   /* Lisp_Object verify_error; */
   Lisp_Object verify_hostname_error;
+  Lisp_Object prime_bits;
 
   CHECK_PROCESS (proc);
   CHECK_SYMBOL (type);
@@ -714,6 +723,7 @@ one trustfile (usually a CA bundle).  */)
   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);
+  prime_bits            = Fplist_get (proplist, 
Qgnutls_bootprop_min_prime_bits);
 
   if (!STRINGP (hostname))
     error ("gnutls-boot: invalid :hostname parameter");
@@ -931,6 +941,11 @@ one trustfile (usually a CA bundle).  */)
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY;
 
+  if (!EQ (prime_bits, Qnil))
+    {
+      fn_gnutls_dh_set_prime_bits (state, XUINT (prime_bits));
+    }
+
   if (EQ (type, Qgnutls_x509pki))
     {
       ret = fn_gnutls_credentials_set (state, GNUTLS_CRD_CERTIFICATE, 
x509_cred);
@@ -1109,6 +1124,7 @@ syms_of_gnutls (void)
   DEFSYM (Qgnutls_bootprop_crlfiles, ":crlfiles");
   DEFSYM (Qgnutls_bootprop_callbacks, ":callbacks");
   DEFSYM (Qgnutls_bootprop_callbacks_verify, "verify");
+  DEFSYM (Qgnutls_bootprop_min_prime_bits, ":min-prime-bits");
   DEFSYM (Qgnutls_bootprop_loglevel, ":loglevel");
   DEFSYM (Qgnutls_bootprop_verify_flags, ":verify-flags");
   DEFSYM (Qgnutls_bootprop_verify_hostname_error, ":verify-hostname-error");
-- 
1.7.6.131.g99019