Re: client certs and CRL lists for GnuTLS

[Ted Zlatanov]

On Tue, 03 May 2011 17:25:44 +0200 Lars Magne Ingebrigtsen <address@hidden> 
wrote: 

LMI> Ted Zlatanov <address@hidden> writes:
>> The attached patch adds a :keylist parameter to `gnutls-boot' which is a
>> list of (client key file, client cert file) pairs.  It also renames the
>> :keyfiles parameter to :crlfiles since it's for CRL lists.  So now you
>> can specify any number of client certs.  If the key files require a
>> passphrase, the decoding won't work because we don't set a callback.

LMI> Right.  Hm...  if you specify a keyfile (that requires a password), does
LMI> starttls.el allow prompting for that password?  (I'm just wondering
LMI> whether the gnutls.c situation would be totally equivalent or not...)

I don't think so.  gnutls.c will eventually allow it if people need it.

>> (defun gnutls-negotiate (proc type hostname &optional priority-string
>> -                              trustfiles keyfiles verify-flags
>> +                              trustfiles crlfiles keylist verify-flags
>> verify-error verify-hostname-error)

LMI> Heh.  Yes, I think it would be better to change this to a plist.  :-)

Done, see attached (same patch with the plist change).

Ted

=== modified file 'lisp/net/gnutls.el'
--- lisp/net/gnutls.el  2011-04-25 13:47:23 +0000
+++ lisp/net/gnutls.el  2011-05-03 15:41:06 +0000
@@ -35,6 +35,8 @@
 
 ;;; Code:
 
+(eval-when-compile (require 'cl))
+
 (defgroup gnutls nil
   "Emacs interface to the GnuTLS library."
   :prefix "gnutls-"
@@ -72,9 +74,9 @@
 documentation for the specific parameters you can use to open a
 GnuTLS connection, including specifying the credential type,
 trust and key files, and priority string."
-  (gnutls-negotiate (open-network-stream name buffer host service)
-                    'gnutls-x509pki
-                    host))
+  (gnutls-negotiate :process (open-network-stream name buffer host service)
+                    :type 'gnutls-x509pki
+                    :hostname host))
 
 (put 'gnutls-error
      'error-conditions
@@ -85,16 +87,23 @@
 (declare-function gnutls-boot "gnutls.c" (proc type proplist))
 (declare-function gnutls-errorp "gnutls.c" (error))
 
-(defun gnutls-negotiate (proc type hostname &optional priority-string
-                              trustfiles keyfiles verify-flags
-                              verify-error verify-hostname-error)
+(defun* gnutls-negotiate
+    (&rest spec
+           &key process type hostname priority-string
+           trustfiles crlfiles keylist verify-flags
+           verify-error verify-hostname-error
+           &allow-other-keys)
   "Negotiate a SSL/TLS connection.  Returns proc. Signals gnutls-error.
+
+Note arguments are passed CL style, :type TYPE instead of just TYPE.
+
 TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
-PROC is a process returned by `open-network-stream'.
+PROCESS is a process returned by `open-network-stream'.
 HOSTNAME is the remote hostname.  It must be a valid string.
 PRIORITY-STRING is as per the GnuTLS docs, default is \"NORMAL\".
 TRUSTFILES is a list of CA bundles.
-KEYFILES is a list of client keys.
+CRLFILES is a list of CRL files.
+KEYLIST is an alist of (client key file, client cert file) pairs.
 
 When VERIFY-HOSTNAME-ERROR is not nil, an error will be raised
 when the hostname does not match the presented certificate's host
@@ -141,7 +150,8 @@
                              :hostname ,hostname
                              :loglevel ,gnutls-log-level
                              :trustfiles ,trustfiles
-                             :keyfiles ,keyfiles
+                             :crlfiles ,crlfiles
+                             :keylist ,keylist
                              :verify-flags ,verify-flags
                              :verify-error ,verify-error
                              :verify-hostname-error ,verify-hostname-error
@@ -149,14 +159,14 @@
          ret)
 
     (gnutls-message-maybe
-     (setq ret (gnutls-boot proc type params))
+     (setq ret (gnutls-boot process type params))
      "boot: %s" params)
 
     (when (gnutls-errorp ret)
       ;; This is a error from the underlying C code.
-      (signal 'gnutls-error (list proc ret)))
+      (signal 'gnutls-error (list process ret)))
 
-    proc))
+    process))
 
 (declare-function gnutls-error-string "gnutls.c" (error))
 

=== modified file 'lisp/net/network-stream.el'
--- lisp/net/network-stream.el  2011-05-01 15:39:10 +0000
+++ lisp/net/network-stream.el  2011-05-03 15:41:58 +0000
@@ -45,9 +45,7 @@
 (require 'tls)
 (require 'starttls)
 
-(declare-function gnutls-negotiate "gnutls"
-                  (proc type host &optional priority-string trustfiles keyfiles
-                        verify-flags verify-error verify-hostname-error))
+(declare-function gnutls-negotiate "gnutls" (&rest spec))
 
 ;;;###autoload
 (defun open-network-stream (name buffer host service &rest parameters)
@@ -203,7 +201,7 @@
                          (network-stream-command stream starttls-command eoc))
        ;; The server said it was OK to begin STARTTLS negotiations.
        (if (fboundp 'open-gnutls-stream)
-           (gnutls-negotiate stream nil host)
+           (gnutls-negotiate :process stream :hostname host)
          (unless (starttls-negotiate stream)
            (delete-process stream)))
        (if (memq (process-status stream) '(open run))

=== modified file 'src/gnutls.c'
--- src/gnutls.c        2011-05-02 02:49:06 +0000
+++ src/gnutls.c        2011-05-03 15:11:35 +0000
@@ -44,7 +44,8 @@
 /* The following are for the property list of `gnutls-boot'.  */
 static Lisp_Object Qgnutls_bootprop_priority;
 static Lisp_Object Qgnutls_bootprop_trustfiles;
-static Lisp_Object Qgnutls_bootprop_keyfiles;
+static Lisp_Object Qgnutls_bootprop_keylist;
+static Lisp_Object Qgnutls_bootprop_crlfiles;
 static Lisp_Object Qgnutls_bootprop_callbacks;
 static Lisp_Object Qgnutls_bootprop_loglevel;
 static Lisp_Object Qgnutls_bootprop_hostname;
@@ -412,7 +413,10 @@
 
 :trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
 
-:keyfiles is a list of PEM-encoded key files for `gnutls-x509pki'.
+:crlfiles is a list of PEM-encoded CRL lists for `gnutls-x509pki'.
+
+:keylist is an alist of PEM-encoded key files and PEM-encoded
+certificates for `gnutls-x509pki'.
 
 :callbacks is an alist of callback functions, see below.
 
@@ -471,7 +475,8 @@
   /* Placeholders for the property list elements.  */
   Lisp_Object priority_string;
   Lisp_Object trustfiles;
-  Lisp_Object keyfiles;
+  Lisp_Object crlfiles;
+  Lisp_Object keylist;
   /* Lisp_Object callbacks; */
   Lisp_Object loglevel;
   Lisp_Object hostname;
@@ -486,7 +491,8 @@
   hostname              = Fplist_get (proplist, Qgnutls_bootprop_hostname);
   priority_string       = Fplist_get (proplist, Qgnutls_bootprop_priority);
   trustfiles            = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
-  keyfiles              = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
+  keylist               = Fplist_get (proplist, Qgnutls_bootprop_keylist);
+  crlfiles              = Fplist_get (proplist, Qgnutls_bootprop_crlfiles);
   /* callbacks          = Fplist_get (proplist, Qgnutls_bootprop_callbacks); */
   loglevel              = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
   verify_flags          = Fplist_get (proplist, Qgnutls_bootprop_verify_flags);
@@ -614,15 +620,41 @@
             }
         }
 
-      for (tail = keyfiles; !NILP (tail); tail = Fcdr (tail))
-       {
-         Lisp_Object keyfile = Fcar (tail);
-          if (STRINGP (keyfile))
-            {
-              GNUTLS_LOG2 (1, max_log_level, "setting the keyfile: ",
+      for (tail = crlfiles; !NILP (tail); tail = Fcdr (tail))
+       {
+         Lisp_Object crlfile = Fcar (tail);
+          if (STRINGP (crlfile))
+            {
+              GNUTLS_LOG2 (1, max_log_level, "setting the CRL file: ",
+                           SSDATA (crlfile));
+              ret = gnutls_certificate_set_x509_crl_file
+                (x509_cred,
+                 SSDATA (crlfile),
+                 file_format);
+
+              if (ret < GNUTLS_E_SUCCESS)
+                return gnutls_make_error (ret);
+            }
+          else
+            {
+              error ("Sorry, GnuTLS can't use non-string CRL file %s",
+                     SDATA (crlfile));
+            }
+        }
+
+      for (tail = keylist; !NILP (tail); tail = Fcdr (tail))
+       {
+         Lisp_Object keyfile = Fcar (Fcar (tail));
+         Lisp_Object certfile = Fcar (Fcdr (tail));
+          if (STRINGP (keyfile) && STRINGP (certfile))
+            {
+              GNUTLS_LOG2 (1, max_log_level, "setting the client key file: ",
                            SSDATA (keyfile));
-              ret = gnutls_certificate_set_x509_crl_file
+              GNUTLS_LOG2 (1, max_log_level, "setting the client cert file: ",
+                           SSDATA (certfile));
+              ret = gnutls_certificate_set_x509_key_file
                 (x509_cred,
+                 SSDATA (certfile),
                  SSDATA (keyfile),
                  file_format);
 
@@ -631,8 +663,12 @@
             }
           else
             {
-              error ("Sorry, GnuTLS can't use non-string keyfile %s",
-                     SDATA (keyfile));
+              if (STRINGP (keyfile))
+                error ("Sorry, GnuTLS can't use non-string client cert file 
%s",
+                       SDATA (certfile));
+              else
+                error ("Sorry, GnuTLS can't use non-string client key file %s",
+                       SDATA (keyfile));
             }
         }
     }
@@ -868,8 +904,11 @@
   Qgnutls_bootprop_trustfiles = intern_c_string (":trustfiles");
   staticpro (&Qgnutls_bootprop_trustfiles);
 
-  Qgnutls_bootprop_keyfiles = intern_c_string (":keyfiles");
-  staticpro (&Qgnutls_bootprop_keyfiles);
+  Qgnutls_bootprop_keylist = intern_c_string (":keylist");
+  staticpro (&Qgnutls_bootprop_keylist);
+
+  Qgnutls_bootprop_crlfiles = intern_c_string (":crlfiles");
+  staticpro (&Qgnutls_bootprop_crlfiles);
 
   Qgnutls_bootprop_callbacks = intern_c_string (":callbacks");
   staticpro (&Qgnutls_bootprop_callbacks);