From: Ted Zlatanov <tzz@lifelogs.com>
Date: Tue, 19 Dec 2017 17:43:56 +0000 (-0500)
Subject: Collect GnuTLS extensions and use them to set %DUMBFW if supported
X-Git-Tag: emacs-26.0.91~111
X-Git-Url: http://git.eshelyaron.com/gitweb/?a=commitdiff_plain;h=21a212f9e256a05a0fc67260d338d612cba77266;p=emacs.git

Collect GnuTLS extensions and use them to set %DUMBFW if supported

* lisp/net/gnutls.el (gnutls-boot-parameters): Use it to set %DUMBFW
only when it's supported as "ClientHello Padding" (Bug#25061).

* src/gnutls.c (Fgnutls_available_p): Get extension names and
put them in the GnuTLS capabilities, using a hard-coded limit
of 100 since GnuTLS MAX_EXT_TYPES is not exported.
---

diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index a406b0b07fd..608b6cfe9e8 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -261,33 +261,37 @@ here's a recent version of the list.
 
 It must be omitted, a number, or nil; if omitted or nil it
 defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."
-  (let ((trustfiles (or trustfiles (gnutls-trustfiles)))
-        (priority-string (or priority-string
-                             (cond
-                              ((eq type 'gnutls-anon)
-                               "NORMAL:+ANON-DH:!ARCFOUR-128:%DUMBFW")
-                              ((eq type 'gnutls-x509pki)
-                               (if gnutls-algorithm-priority
-                                   (upcase gnutls-algorithm-priority)
-                                 "NORMAL:%DUMBFW")))))
-        (verify-error (or verify-error
-                          ;; this uses the value of `gnutls-verify-error'
-                          (cond
-                           ;; if t, pass it on
-                           ((eq gnutls-verify-error t)
-                            t)
-                           ;; if a list, look for hostname matches
-                           ((listp gnutls-verify-error)
-                            (apply 'append
-                                   (mapcar
-                                    (lambda (check)
-                                      (when (string-match (nth 0 check)
-                                                          hostname)
-                                        (nth 1 check)))
-                                    gnutls-verify-error)))
-                           ;; else it's nil
-                           (t nil))))
-        (min-prime-bits (or min-prime-bits gnutls-min-prime-bits)))
+  (let* ((trustfiles (or trustfiles (gnutls-trustfiles)))
+         (maybe-dumbfw (if (memq 'ClientHello\ Padding (gnutls-available-p))
+                           ":%DUMBFW"
+                         ""))
+         (priority-string (or priority-string
+                              (cond
+                               ((eq type 'gnutls-anon)
+                                (concat "NORMAL:+ANON-DH:!ARCFOUR-128"
+                                        maybe-dumbfw))
+                               ((eq type 'gnutls-x509pki)
+                                (if gnutls-algorithm-priority
+                                    (upcase gnutls-algorithm-priority)
+                                  (concat "NORMAL" maybe-dumbfw))))))
+         (verify-error (or verify-error
+                           ;; this uses the value of `gnutls-verify-error'
+                           (cond
+                            ;; if t, pass it on
+                            ((eq gnutls-verify-error t)
+                             t)
+                            ;; if a list, look for hostname matches
+                            ((listp gnutls-verify-error)
+                             (apply 'append
+                                    (mapcar
+                                     (lambda (check)
+                                       (when (string-match (nth 0 check)
+                                                           hostname)
+                                         (nth 1 check)))
+                                     gnutls-verify-error)))
+                            ;; else it's nil
+                            (t nil))))
+         (min-prime-bits (or min-prime-bits gnutls-min-prime-bits)))
 
     (when verify-hostname-error
       (push :hostname verify-error))
diff --git a/src/gnutls.c b/src/gnutls.c
index 4622011bc10..8db201ae834 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -2415,7 +2415,10 @@ GnuTLS 3 or higher      : the list will contain `gnutls3'.
 GnuTLS MACs             : the list will contain `macs'.
 GnuTLS digests          : the list will contain `digests'.
 GnuTLS symmetric ciphers: the list will contain `ciphers'.
-GnuTLS AEAD ciphers     : the list will contain `AEAD-ciphers'.  */)
+GnuTLS AEAD ciphers     : the list will contain `AEAD-ciphers'.
+%DUMBFW                 : the list will contain `ClientHello\ Padding'.
+Any GnuTLS extension with ID up to 100
+                        : the list will contain its name.  */)
   (void)
 {
   Lisp_Object capabilities = Qnil;
@@ -2436,6 +2439,15 @@ GnuTLS AEAD ciphers     : the list will contain `AEAD-ciphers'.  */)
   capabilities = Fcons (intern("macs"), capabilities);
 # endif	  /* HAVE_GNUTLS3 */
 
+  for (unsigned int ext=0; ext < 100; ext++)
+    {
+      const char* name = gnutls_ext_get_name(ext);
+      if (name != NULL)
+        {
+          capabilities = Fcons (intern(name), capabilities);
+        }
+    }
+
 # ifdef WINDOWSNT
   Lisp_Object found = Fassq (Qgnutls, Vlibrary_cache);
   if (CONSP (found))