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.

2 files changed, 59 insertions, 15 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index f1f1f45df91..246b7ae5b5f 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,10 @@
+2013-12-14  Teodor Zlatanov  <tzz@lifelogs.com>
+
+        * 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  <rudalics@gmx.at>
 
         * window.el (display-buffer-below-selected): Never split window
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index 923b108c708..5bf9adc2b53 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 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 @@ 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;
@@ -183,8 +202,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
@@ -193,9 +232,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))