[Patch] Make tls.el support certificate verification

[Elias Oltmanns]

Hi all,

since there is a copy of tls.el in gnus but the emacs22 copy is moved to
lisp/net, I'm not quite sure as to who is ultimately maintaining it.
Hence, I'm sending this to both lists.

Please find attached a patch (to current gnus trunk) that adds all it
needs to facilitate the certificate verification features of gnutls-cli
and openssl.

Regards,

Elias

Index: lisp/tls.el
===================================================================
RCS file: /usr/local/cvsroot/gnus/lisp/tls.el,v
retrieving revision 7.14
diff -u -r7.14 tls.el
--- lisp/tls.el 9 Apr 2007 23:44:06 -0000       7.14
+++ lisp/tls.el 16 Sep 2007 15:40:39 -0000
@@ -82,6 +82,38 @@
   :type 'regexp
   :group 'tls)
 
+(defcustom tls-checktrust nil
+  "Indicate if certificates should be checked against trusted root certs.
+If this is `ask', the user can decide whether to accept an untrusted
+certificate. You may have to adapt `tls-program' in order to make this feature
+work properly, i.e., to ensure that the external program knows about the
+root certificates you consider trustworthy. An appropriate entry in .emacs
+might look like this:
+(setq tls-program
+      '(\"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h\"
+       \"gnutls-cli --x509cafile /etc/ssl/certs/ca-certificates.crt -p %p %h 
--protocols ssl3\"
+       \"openssl s_client -connect %h:%p -CAfile 
/etc/ssl/certs/ca-certificates.crt -no_ssl2\"))"
+  :type '(choice (const :tag "Always" t)
+                (const :tag "Never" nil)
+                (const :tag "Ask" ask))
+  :group 'tls)
+
+(defcustom tls-untrusted "- Peer's certificate is NOT trusted\\|Verify return 
code: \\([^0] \\|.[^ ]\\)"
+  "*Regular expression indicating failure of TLS certificate verification.
+The default is what GNUTLS's \"gnutls-cli\" or OpenSSL's
+\"openssl s_client\" return in the event of unsuccessful verification."
+  :type 'regexp
+  :group 'tls)
+
+(defcustom tls-hostmismatch "# The hostname in the certificate does NOT match"
+  "*Regular expression indicating a host name mismatch in certificate.
+When the host name specified in the certificate doesn't match the name of the
+host you are connecting to, gnutls-cli issues a warning to this effect. There
+is no such feature in openssl. Set this to nil if you want to ignore host name
+mismatches."
+  :type 'regexp
+  :group 'tls)
+
 (defcustom tls-certtool-program (executable-find "certtool")
   "Name of  GnuTLS certtool.
 Used by `tls-certificate-information'."
@@ -156,6 +188,25 @@
                 (if done "done" "failed"))
        (if done
            (setq done process)
+         (delete-process process))))
+    (when done
+      (save-excursion
+       (set-buffer buffer)
+       (when
+           (or
+            (and tls-untrusted
+                 (progn
+                   (goto-char (point-min))
+                   (re-search-forward tls-untrusted nil t))
+                 (not (yes-or-no-p
+                       (format "The certificate presented by `%s' is NOT 
trusted. Accept anyway? " host))))
+            (and tls-hostmismatch
+                 (progn
+                   (goto-char (point-min))
+                   (re-search-forward tls-hostmismatch nil t))
+                 (not (yes-or-no-p
+                       (format "Host name in certificate doesn't match `%s'. 
Connect anyway? " host)))))
+         (setq done nil)
          (delete-process process))))
     (message "Opening TLS connection to `%s'...%s"
             host (if done "done" "failed"))