[Emacs-diffs] trunk r115526: New verify-error GnuTLS interface for certificate validation

[Teodor Zlatanov]

------------------------------------------------------------
revno: 115526
revision-id: address@hidden
parent: address@hidden
committer: Ted Zlatanov <address@hidden>
branch nick: quickfixes
timestamp: Sat 2013-12-14 13:04:09 -0500
message:
  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.
modified:
  lisp/ChangeLog                 changelog-20091113204419-o5vbwnq5f7feedwu-1432
  lisp/net/gnutls.el             gnutls.el-20100926054902-dzayyj6wycit6kzn-5
  src/ChangeLog                  changelog-20091113204419-o5vbwnq5f7feedwu-1438
  src/gnutls.c                   gnutls.c-20100926054902-dzayyj6wycit6kzn-3

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2013-12-14 17:00:54 +0000
+++ b/lisp/ChangeLog    2013-12-14 18:04:09 +0000
@@ -1,3 +1,10 @@
+2013-12-14  Teodor Zlatanov  <address@hidden>
+
+       * 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.
+
 2013-12-14  Martin Rudalics  <address@hidden>
 
        * window.el (display-buffer-below-selected): Never split window

=== modified file 'lisp/net/gnutls.el'
--- a/lisp/net/gnutls.el        2013-09-18 04:50:54 +0000
+++ b/lisp/net/gnutls.el        2013-12-14 18:04:09 +0000
@@ -51,6 +51,19 @@
   :type '(choice (const nil)
                  string))
 
+(defcustom gnutls-verify-error nil
+  "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
@@ -138,19 +151,25 @@
 \(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.
-
-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.
+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 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;
@@ -183,8 +202,28 @@
                                 (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
@@ -193,9 +232,7 @@
                              :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))

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2013-12-14 11:06:00 +0000
+++ b/src/ChangeLog     2013-12-14 18:04:09 +0000
@@ -1,3 +1,10 @@
+2013-12-14  Teodor Zlatanov  <address@hidden>
+
+       * 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.
+
 2013-12-14  Martin Rudalics  <address@hidden>
 
        * w32term.c (w32_enable_frame_resize_hack): New variable.

=== modified file 'src/gnutls.c'
--- a/src/gnutls.c      2013-12-13 03:44:59 +0000
+++ b/src/gnutls.c      2013-12-14 18:04:09 +0000
@@ -50,7 +50,7 @@
 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;
@@ -754,8 +754,12 @@
 :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.
@@ -799,8 +803,7 @@
   /* 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);
@@ -819,11 +822,14 @@
   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;
@@ -1065,14 +1071,17 @@
 
   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);
        }
     }
 
@@ -1112,14 +1121,17 @@
 
       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);
@@ -1179,7 +1191,7 @@
   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,