From 59fd52bfdd7e4a763b5d950ee2213b3bb1e69916 Mon Sep 17 00:00:00 2001

From: Jan Synacek <jsynacek@redhat.com>

Date: Tue, 11 Sep 2018 13:03:56 +0200

Subject: [PATCH 1/2] New verify-error GnuTLS interface for certificate

 validation

* net/gnutls.el (gnutls-verify-error): New defcustom to control

the behavior when a certificate fails validation.  Defaults to

old behavior: never abort, just warn.

(gnutls-negotiate): Use it.

* gnutls.c: Replace `:verify_hostname_error' with `:verify_error',

now a list of certificate validation checks that will abort a

connection with an error.

(Fgnutls_boot): Document it and use it.

(cherry-picked from commit 31b4827ea9ba8d22deb17c0593f0f555a33e1fa4)

jsynacek: gnutls-verify-error defaults to t in RHEL-7.

Resolves: #1403643

---

 lisp/net/gnutls.el  |  67 ++++++++++++++++++++++++++++++++++++++++------------

 src/bootstrap-emacs | Bin 25556936 -> 0 bytes

 src/emacs           | Bin 25556936 -> 0 bytes

 src/fns.c           |  22 ++++++++++++++++-

 src/gnutls.c        |  48 +++++++++++++++++++++++--------------

 src/temacs          | Bin 15992560 -> 0 bytes

 6 files changed, 103 insertions(+), 34 deletions(-)

 delete mode 100755 src/bootstrap-emacs

 delete mode 100755 src/emacs

 delete mode 100755 src/temacs

diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el

index 243c64e..2585f48 100644

--- a/lisp/net/gnutls.el

+++ b/lisp/net/gnutls.el

@@ -51,6 +51,19 @@ set this variable to \"normal:-dhe-rsa\"."

   :type '(choice (const nil)

                  string))

+(defcustom gnutls-verify-error t

+  "If non-nil, this should be a list of checks per hostname regex or t."

+  :group 'gnutls

+  :type '(choice

+          (const t)

+          (repeat :tag "List of hostname regexps with flags for each"

+           (list

+            (choice :tag "Hostname"

+                    (const ".*" :tag "Any hostname")

+                    regexp)

+            (set (const :trustfiles)

+                 (const :hostname))))))

+

 (defcustom gnutls-trustfiles

   '(

     "/etc/ssl/certs/ca-certificates.crt" ; Debian, Ubuntu, Gentoo and Arch Linux

@@ -141,19 +154,25 @@ 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

-name.  The exact verification algorithm is a basic implementation

-of the matching described in RFC2818 (HTTPS), which takes into

-account wildcards, and the DNSName/IPAddress subject alternative

-name PKIX extension.  See GnuTLS' gnutls_x509_crt_check_hostname

-for details.  When VERIFY-HOSTNAME-ERROR is nil, only a warning

-will be issued.

+VERIFY-HOSTNAME-ERROR is a backwards compatibility option for

+putting `:hostname' in VERIFY-ERROR.

+

+When VERIFY-ERROR is t or a list containing `:trustfiles', an

+error will be raised when the peer certificate verification fails

+as per GnuTLS' gnutls_certificate_verify_peers2.  Otherwise, only

+warnings will be shown about the verification failure.

-When VERIFY-ERROR is not nil, an error will be raised when the

-peer certificate verification fails as per GnuTLS'

-gnutls_certificate_verify_peers2.  Otherwise, only warnings will

-be shown about the verification failure.

+When VERIFY-ERROR is t or a list containing `:hostname', an error

+will be raised when the hostname does not match the presented

+certificate's host name.  The exact verification algorithm is a

+basic implementation of the matching described in

+RFC2818 (HTTPS), which takes into account wildcards, and the

+DNSName/IPAddress subject alternative name PKIX extension.  See

+GnuTLS' gnutls_x509_crt_check_hostname for details.  Otherwise,

+only a warning will be issued.

+

+Note that the list in `gnutls-verify-error', matched against the

+HOSTNAME, is the default VERIFY-ERROR.

 VERIFY-FLAGS is a numeric OR of verification flags only for

 `gnutls-x509pki' connections.  See GnuTLS' x509.h for details;

@@ -186,8 +205,28 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."

                                 (if gnutls-algorithm-priority

                                     (upcase gnutls-algorithm-priority)

                                   "NORMAL")))))

+         (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)

+                             (mapcan

+                              (lambda (check)

+                                (when (string-match (car check) hostname)

+                                  (cdr check)))

+                              gnutls-verify-error))

+                            ;; else it's nil

+                            (t nil))))

          (min-prime-bits (or min-prime-bits gnutls-min-prime-bits))

-         (params `(:priority ,priority-string

+         params ret)

+

+    (when verify-hostname-error

+      (push :hostname verify-error))

+

+    (setq params `(:priority ,priority-string

                              :hostname ,hostname

                              :loglevel ,gnutls-log-level

                              :min-prime-bits ,min-prime-bits

@@ -196,9 +235,7 @@ defaults to GNUTLS_VERIFY_ALLOW_X509_V1_CA_CRT."

                              :keylist ,keylist

                              :verify-flags ,verify-flags

                              :verify-error ,verify-error

-                             :verify-hostname-error ,verify-hostname-error

                              :callbacks nil))

-         ret)

     (gnutls-message-maybe

      (setq ret (gnutls-boot process type params))

diff --git a/src/fns.c b/src/fns.c

index fbb3fb5..2a417ff 100644

--- a/src/fns.c

+++ b/src/fns.c

@@ -2252,7 +2252,7 @@ usage: (nconc &rest LISTS)  */)

  storing the results into elements of VALS, a C vector of Lisp_Objects.

  LENI is the length of VALS, which should also be the length of SEQ.  */

-static void

+static EMACS_INT

 mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)

 {

   register Lisp_Object tail;

@@ -2326,6 +2326,7 @@ mapcar1 (EMACS_INT leni, Lisp_Object *vals, Lisp_Object fn, Lisp_Object seq)

     }

   UNGCPRO;

+  return leni;

 }

 DEFUN ("mapconcat", Fmapconcat, Smapconcat, 3, 3, 0,

@@ -2411,6 +2412,24 @@ SEQUENCE may be a list, a vector, a bool-vector, or a string.  */)

   return sequence;

 }

+

+DEFUN ("mapcan", Fmapcan, Smapcan, 2, 2, 0,

+       doc: /* Apply FUNCTION to each element of SEQUENCE, and concatenate

+the results by altering them (using `nconc').

+SEQUENCE may be a list, a vector, a bool-vector, or a string. */)

+     (Lisp_Object function, Lisp_Object sequence)

+{

+  USE_SAFE_ALLOCA;

+  EMACS_INT leni = XFASTINT (Flength (sequence));

+  if (CHAR_TABLE_P (sequence))

+    wrong_type_argument (Qlistp, sequence);

+  Lisp_Object *args;

+  SAFE_ALLOCA_LISP (args, leni);

+  ptrdiff_t nmapped = mapcar1 (leni, args, function, sequence);

+  Lisp_Object ret = Fnconc (nmapped, args);

+  SAFE_FREE ();

+  return ret;

+}

 /* This is how C code calls `yes-or-no-p' and allows the user

    to redefined it.

@@ -4984,6 +5003,7 @@ this variable.  */);

   defsubr (&Snconc);

   defsubr (&Smapcar);

   defsubr (&Smapc);

+  defsubr (&Smapcan);

   defsubr (&Smapconcat);

   defsubr (&Syes_or_no_p);

   defsubr (&Sload_average);

diff --git a/src/gnutls.c b/src/gnutls.c

index 57d9e17..0c4d10b 100644

--- a/src/gnutls.c

+++ b/src/gnutls.c

@@ -49,7 +49,7 @@ static Lisp_Object QCgnutls_bootprop_loglevel;

 static Lisp_Object QCgnutls_bootprop_hostname;

 static Lisp_Object QCgnutls_bootprop_min_prime_bits;

 static Lisp_Object QCgnutls_bootprop_verify_flags;

-static Lisp_Object QCgnutls_bootprop_verify_hostname_error;

+static Lisp_Object QCgnutls_bootprop_verify_error;

 /* Callback keys for `gnutls-boot'.  Unused currently.  */

 static Lisp_Object QCgnutls_bootprop_callbacks_verify;

@@ -729,8 +729,12 @@ certificates for `gnutls-x509pki'.

 :verify-flags is a bitset as per GnuTLS'

 gnutls_certificate_set_verify_flags.

-:verify-hostname-error, if non-nil, makes a hostname mismatch an

-error.  Otherwise it will be just a warning.

+:verify-hostname-error is ignored.  Pass :hostname in :verify-error

+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.

 :min-prime-bits is the minimum accepted number of bits the client will

 accept in Diffie-Hellman key exchange.

@@ -774,8 +778,7 @@ one trustfile (usually a CA bundle).  */)

   /* Lisp_Object callbacks; */

   Lisp_Object loglevel;

   Lisp_Object hostname;

-  /* Lisp_Object verify_error; */

-  Lisp_Object verify_hostname_error;

+  Lisp_Object verify_error;

   Lisp_Object prime_bits;

   CHECK_PROCESS (proc);

@@ -800,11 +803,14 @@ one trustfile (usually a CA bundle).  */)

   keylist               = Fplist_get (proplist, QCgnutls_bootprop_keylist);

   crlfiles              = Fplist_get (proplist, QCgnutls_bootprop_crlfiles);

   loglevel              = Fplist_get (proplist, QCgnutls_bootprop_loglevel);

-  verify_hostname_error = Fplist_get (proplist, QCgnutls_bootprop_verify_hostname_error);

+  verify_error          = Fplist_get (proplist, QCgnutls_bootprop_verify_error);

   prime_bits            = Fplist_get (proplist, QCgnutls_bootprop_min_prime_bits);

+  if (!Flistp (verify_error))

+    error ("gnutls-boot: invalid :verify_error parameter (not a list)");

+

   if (!STRINGP (hostname))

-    error ("gnutls-boot: invalid :hostname parameter");

+    error ("gnutls-boot: invalid :hostname parameter (not a string)");

   c_hostname = SSDATA (hostname);

   state = XPROCESS (proc)->gnutls_state;

@@ -1033,14 +1039,17 @@ one trustfile (usually a CA bundle).  */)

   if (peer_verification != 0)

     {

-      if (NILP (verify_hostname_error))

-	GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",

-		     c_hostname);

-      else

-	{

+      if (EQ (verify_error, Qt)

+          || !NILP (Fmember (QCgnutls_bootprop_trustfiles, verify_error)))

+        {

 	  emacs_gnutls_deinit (proc);

 	  error ("Certificate validation failed %s, verification code %d",

 		 c_hostname, peer_verification);

+        }

+      else

+	{

+          GNUTLS_LOG2 (1, max_log_level, "certificate validation failed:",

+                       c_hostname);

 	}

     }

@@ -1080,14 +1089,17 @@ one trustfile (usually a CA bundle).  */)

       if (!fn_gnutls_x509_crt_check_hostname (gnutls_verify_cert, c_hostname))

 	{

-	  if (NILP (verify_hostname_error))

-	    GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",

-			 c_hostname);

-	  else

-	    {

+          if (EQ (verify_error, Qt)

+              || !NILP (Fmember (QCgnutls_bootprop_hostname, verify_error)))

+            {

 	      fn_gnutls_x509_crt_deinit (gnutls_verify_cert);

 	      emacs_gnutls_deinit (proc);

 	      error ("The x509 certificate does not match \"%s\"", c_hostname);

+            }

+	  else

+	    {

+              GNUTLS_LOG2 (1, max_log_level, "x509 certificate does not match:",

+                           c_hostname);

 	    }

 	}

       fn_gnutls_x509_crt_deinit (gnutls_verify_cert);

@@ -1144,7 +1156,7 @@ syms_of_gnutls (void)

   DEFSYM (QCgnutls_bootprop_min_prime_bits, ":min-prime-bits");

   DEFSYM (QCgnutls_bootprop_loglevel, ":loglevel");

   DEFSYM (QCgnutls_bootprop_verify_flags, ":verify-flags");

-  DEFSYM (QCgnutls_bootprop_verify_hostname_error, ":verify-hostname-error");

+  DEFSYM (QCgnutls_bootprop_verify_error, ":verify-error");

   DEFSYM (Qgnutls_e_interrupted, "gnutls-e-interrupted");

   Fput (Qgnutls_e_interrupted, Qgnutls_code,