[Emacs-diffs] /srv/bzr/emacs/trunk r105243: Allow controlling how many prime bits to use during TLS negotiation

[Lars Magne Ingebrigtsen]

------------------------------------------------------------
revno: 105243
author: Lawrence Mitchell  <address@hidden>
committer: Lars Magne Ingebrigtsen <address@hidden>
branch nick: trunk
timestamp: Fri 2011-07-15 19:41:24 +0200
message:
  Allow controlling how many prime bits to use during TLS negotiation
modified:
  lisp/ChangeLog
  lisp/net/gnutls.el
  src/ChangeLog
  src/gnutls.c

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2011-07-15 17:25:02 +0000
+++ b/lisp/ChangeLog    2011-07-15 17:41:24 +0000
@@ -1,3 +1,8 @@
+2011-07-09  Lawrence Mitchell  <address@hidden>
+
+       * net/gnutls.el (gnutls-min-prime-bits): New variable.
+       (gnutls-negotiate): Use it.
+
 2011-07-15  Lars Magne Ingebrigtsen  <address@hidden>
 
        * net/gnutls.el (gnutls-negotiate): Upcase

=== modified file 'lisp/net/gnutls.el'
--- a/lisp/net/gnutls.el        2011-07-15 17:25:02 +0000
+++ b/lisp/net/gnutls.el        2011-07-15 17:41:24 +0000
@@ -54,6 +54,19 @@
   :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 @@
 (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 @@
 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 @@
                                (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

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2011-07-15 15:31:36 +0000
+++ b/src/ChangeLog     2011-07-15 17:41:24 +0000
@@ -1,3 +1,8 @@
+2011-07-09  Lawrence Mitchell  <address@hidden>
+
+       * gnutls.c (Qgnutls_bootprop_min_prime_bits): New variable.
+       (Fgnutls_boot): Use it.
+
 2011-07-15  Andreas Schwab  <address@hidden>
 
        * doc.c (Fsubstitute_command_keys): Revert last change.

=== modified file 'src/gnutls.c'
--- a/src/gnutls.c      2011-07-13 20:33:44 +0000
+++ b/src/gnutls.c      2011-07-15 17:41:24 +0000
@@ -50,6 +50,7 @@
 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_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 @@
   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 @@
 #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 @@
 :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 @@
   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 @@
   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 @@
 
   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 @@
   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");