Allow controlling how many prime bits to use during TLS negotiation

4 files changed, 46 insertions, 2 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 87f5cc9d70d..6bfdb61330b 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-15  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
 	* net/gnutls.el (gnutls-negotiate): Upcase
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 14d4a2f28e6..edbf9a54afc 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -54,6 +54,19 @@ set this variable to \"normal:-dhe-rsa\"."
   :type '(choice (const nil)
 		 string))
 
+;;;###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.
@@ -97,8 +110,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.
 
@@ -111,6 +124,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
@@ -155,9 +171,11 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
 				(if gnutls-algorithm-priority
 				    (upcase gnutls-algorithm-priority)
 				  "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 8b9f2935347..56c7a148416 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-15  Andreas Schwab  <schwab@linux-m68k.org>
 
 	* doc.c (Fsubstitute_command_keys): Revert last change.
diff --git a/src/gnutls.c b/src/gnutls.c
index 3761951b866..fdc0c13a53b 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));
@@ -169,6 +172,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);
@@ -218,6 +222,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
@@ -646,6 +651,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.
@@ -698,6 +706,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);
@@ -719,6 +728,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");
@@ -936,6 +946,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);
@@ -1114,6 +1129,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");