Re: Emacs core TLS support

[Ted Zlatanov <tzz@lifelogs.com>]

[-- Attachment #1: Type: text/plain, Size: 476 bytes --]

On Sun, 03 Oct 2010 09:21:49 -0500 Ted Zlatanov <tzz@lifelogs.com> wrote: 

TZ> I pushed the last version of gnutls.{c,el} using the old API, but with
TZ> plists for gnutls-boot.  Please test and let me know if it works for
TZ> you.  It worked for me.

TZ> If there are no problems I'll rework gnutls.el to be a standalone
TZ> library and change the API as we discussed.

I had trouble committing so the patches are below.  I'll commit when I
can or Lars can push them.

Ted


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: tls-plist1.patch --]
[-- Type: text/x-diff, Size: 3252 bytes --]

=== modified file 'lisp/ChangeLog'
--- lisp/ChangeLog	2010-10-03 04:31:59 +0000
+++ lisp/ChangeLog	2010-10-03 14:19:04 +0000
@@ -1,3 +1,10 @@
+2010-10-03  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* net/gnutls.el (starttls-negotiate): Use the plist interface to
+	`gnutls-boot'.  Make TYPE the only required parameter.  Allow
+	TRUSTFILES and KEYFILES to be lists.
+	(open-ssl-stream): Use it.
+
 2010-10-03  Chong Yidong  <cyd@stupidchicken.com>
 
 	* emacs-lisp/bytecomp.el (byte-compile-from-buffer): Remove

=== modified file 'lisp/net/gnutls.el'
--- lisp/net/gnutls.el	2010-09-29 13:25:24 +0000
+++ lisp/net/gnutls.el	2010-10-03 14:19:04 +0000
@@ -57,34 +57,36 @@
 Fourth arg SERVICE is name of the service desired, or an integer
 specifying a port number to connect to."
   (let ((proc (open-network-stream name buffer host service)))
-    (starttls-negotiate proc nil 'gnutls-x509pki)))
+    (starttls-negotiate proc 'gnutls-x509pki)))
 
 ;; (open-ssl-stream "tls" "tls-buffer" "yourserver.com" "https")
-(defun starttls-negotiate (proc &optional priority-string
-                                credentials credentials-file)
+;; (open-ssl-stream "tls" "tls-buffer" "imap.gmail.com" "imaps")
+(defun starttls-negotiate (proc type &optional priority-string
+                                trustfiles keyfiles)
   "Negotiate a SSL or TLS connection.
-PROC is the process returned by `starttls-open-stream'.
-PRIORITY-STRING is as per the GnuTLS docs.
-CREDENTIALS is `gnutls-x509pki' or `gnutls-anon'.
-CREDENTIALS-FILE is a filename with meaning dependent on CREDENTIALS."
-  (let* ((credentials (or credentials 'gnutls-x509pki))
-         (credentials-file (or credentials-file
-                               "/etc/ssl/certs/ca-certificates.crt"
-                               ;"/etc/ssl/certs/ca.pem"
-                               ))
-
+TYPE is `gnutls-x509pki' (default) or `gnutls-anon'.  Use nil for the default.
+PROC is a process returned by `open-network-stream'.
+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."
+  (let* ((type (or type 'gnutls-x509pki))
+         (trusfiles (or trustfiles
+                        '("/etc/ssl/certs/ca-certificates.crt")))
          (priority-string (or priority-string
                               (cond
-                               ((eq credentials 'gnutls-anon)
+                               ((eq type 'gnutls-anon)
                                 "NORMAL:+ANON-DH:!ARCFOUR-128")
-                               ((eq credentials 'gnutls-x509pki)
+                               ((eq type 'gnutls-x509pki)
                                 "NORMAL"))))
+         (params `(:priority ,priority-string
+                             :loglevel ,gnutls-log-level
+                             :trustfiles ,trustfiles
+                             :keyfiles ,keyfiles
+                             :callbacks nil))
          ret)
 
     (gnutls-message-maybe
-     (setq ret (gnutls-boot proc priority-string
-                            credentials credentials-file
-                            nil nil gnutls-log-level))
+     (setq ret (gnutls-boot proc type params))
      "boot: %s")
 
     proc))


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #3: tls-plist2.patch --]
[-- Type: text/x-diff, Size: 9359 bytes --]

=== modified file 'src/ChangeLog'
--- src/ChangeLog	2010-10-03 12:36:19 +0000
+++ src/ChangeLog	2010-10-03 14:18:40 +0000
@@ -1,3 +1,15 @@
+2010-10-03  Teodor Zlatanov  <tzz@lifelogs.com>
+
+	* gnutls.h (GNUTLS_LOG2): Convenience macro.
+
+	* gnutls.c: Add property list symbol holders.
+	(emacs_gnutls_handshake): Clarify how sockets are passed to
+	GnuTLS.
+	(gnutls_log_function2): Convenience function using GNUTLS_LOG2.
+	(Fgnutls_boot): Get all parameters from a plist.  Require trustfiles
+	and keyfiles to be a list of file names.  Default to "NORMAL" for
+	the priority string.  Improve logging.
+
 2010-10-03  Juanma Barranquero  <lekktu@gmail.com>
 
 	* makefile.w32-in (TAGS, TAGS-LISP, TAGS-gmake): Add $(FONTOBJ).

=== modified file 'src/gnutls.c'
--- src/gnutls.c	2010-10-03 04:12:15 +0000
+++ src/gnutls.c	2010-10-03 14:18:40 +0000
@@ -32,6 +32,13 @@
   Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
 int global_initialized;
 
+/* The following are for the property list of `gnutls-boot'.  */
+Lisp_Object Qgnutls_bootprop_priority;
+Lisp_Object Qgnutls_bootprop_trustfiles;
+Lisp_Object Qgnutls_bootprop_keyfiles;
+Lisp_Object Qgnutls_bootprop_callbacks;
+Lisp_Object Qgnutls_bootprop_loglevel;
+
 static void
 emacs_gnutls_handshake (struct Lisp_Process *proc)
 {
@@ -43,6 +50,9 @@
 
   if (proc->gnutls_initstage < GNUTLS_STAGE_TRANSPORT_POINTERS_SET)
     {
+      /* This is how GnuTLS takes sockets: as file descriptors passed
+         in.  For an Emacs process socket, infd and outfd are the
+         same but we use this two-argument version for clarity.  */
       gnutls_transport_set_ptr2 (state,
 				 (gnutls_transport_ptr_t) (long) proc->infd,
 				 (gnutls_transport_ptr_t) (long) proc->outfd);
@@ -271,20 +281,29 @@
   message ("gnutls.c: [%d] %s", level, string);
 }
 
-DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 7, 0,
-       doc: /* Initialize client-mode GnuTLS for process PROC.
+static void
+gnutls_log_function2 (int level, const char* string, const char* extra)
+{
+  message ("gnutls.c: [%d] %s %s", level, string, extra);
+}
+
+DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 3, 0,
+       doc: /* Initialize GnuTLS client for process PROC with TYPE+PROPLIST.
 Currently only client mode is supported.  Returns a success/failure
 value you can check with `gnutls-errorp'.
 
-PRIORITY-STRING is a string describing the priority.
-TYPE is either `gnutls-anon' or `gnutls-x509pki'.
-TRUSTFILE is a PEM encoded trust file for `gnutls-x509pki'.
-KEYFILE is ... for `gnutls-x509pki' (TODO).
-CALLBACK is ... for `gnutls-x509pki' (TODO).
-LOGLEVEL is the debug level requested from GnuTLS, try 4.
-
-LOGLEVEL will be set for this process AND globally for GnuTLS.  So if
-you set it higher or lower at any point, it affects global debugging.
+TYPE is a symbol, either `gnutls-anon' or `gnutls-x509pki'.
+PROPLIST is a property list with the following keys:
+
+:priority is a GnuTLS priority string, defaults to "NORMAL".
+:trustfiles is a list of PEM-encoded trust files for `gnutls-x509pki'.
+:keyfiles is a list of PEM-encoded key files for `gnutls-x509pki'.
+:callbacks is an alist of callback functions (TODO).
+:loglevel is the debug level requested from GnuTLS, try 4.
+
+The debug level will be set for this process AND globally for GnuTLS.
+So if you set it higher or lower at any point, it affects global
+debugging.
 
 Note that the priority is set on the client.  The server does not use
 the protocols's priority except for disabling protocols that were not
@@ -295,11 +314,9 @@
 be deallocated by calling `gnutls-deinit' or by calling it again.
 
 Each authentication type may need additional information in order to
-work.  For X.509 PKI (`gnutls-x509pki'), you need TRUSTFILE and
-KEYFILE and optionally CALLBACK.  */)
-  (Lisp_Object proc, Lisp_Object priority_string, Lisp_Object type,
-   Lisp_Object trustfile, Lisp_Object keyfile, Lisp_Object callback,
-   Lisp_Object loglevel)
+work.  For X.509 PKI (`gnutls-x509pki'), you probably need at least
+one trustfile (usually a CA bundle).  */)
+  (Lisp_Object proc, Lisp_Object type, Lisp_Object proplist)
 {
   int ret = GNUTLS_E_SUCCESS;
 
@@ -312,10 +329,25 @@
   gnutls_certificate_credentials_t x509_cred;
   gnutls_anon_client_credentials_t anon_cred;
   Lisp_Object global_init;
+  char* priority_string_ptr = "NORMAL"; /* default priority string.  */
+  Lisp_Object tail;
+
+  /* Placeholders for the property list elements.  */
+  Lisp_Object priority_string;
+  Lisp_Object trustfiles;
+  Lisp_Object keyfiles;
+  Lisp_Object callbacks;
+  Lisp_Object loglevel;
 
   CHECK_PROCESS (proc);
   CHECK_SYMBOL (type);
-  CHECK_STRING (priority_string);
+  CHECK_LIST (proplist);
+
+  priority_string = Fplist_get (proplist, Qgnutls_bootprop_priority);
+  trustfiles      = Fplist_get (proplist, Qgnutls_bootprop_trustfiles);
+  keyfiles        = Fplist_get (proplist, Qgnutls_bootprop_keyfiles);
+  callbacks       = Fplist_get (proplist, Qgnutls_bootprop_callbacks);
+  loglevel        = Fplist_get (proplist, Qgnutls_bootprop_loglevel);
 
   state = XPROCESS (proc)->gnutls_state;
   XPROCESS (proc)->gnutls_p = 1;
@@ -394,29 +426,49 @@
 
   if (EQ (type, Qgnutls_x509pki))
     {
-      if (STRINGP (trustfile))
-	{
-          GNUTLS_LOG (1, max_log_level, "setting the trustfile");
-          ret = gnutls_certificate_set_x509_trust_file
-            (x509_cred,
-             SDATA (trustfile),
-             file_format);
-
-          if (ret < GNUTLS_E_SUCCESS)
-            return gnutls_make_error (ret);
-	}
-
-      if (STRINGP (keyfile))
-	{
-          GNUTLS_LOG (1, max_log_level, "setting the keyfile");
-          ret = gnutls_certificate_set_x509_crl_file
-            (x509_cred,
-             SDATA (keyfile),
-             file_format);
-
-          if (ret < GNUTLS_E_SUCCESS)
-            return gnutls_make_error (ret);
-	}
+      for (tail = trustfiles; !NILP (tail); tail = Fcdr (tail))
+	{
+	  Lisp_Object trustfile = Fcar (tail);
+          if (STRINGP (trustfile))
+            {
+              GNUTLS_LOG2 (1, max_log_level, "setting the trustfile: ",
+                           SDATA (trustfile));
+              ret = gnutls_certificate_set_x509_trust_file
+                (x509_cred,
+                 SDATA (trustfile),
+                 file_format);
+              
+              if (ret < GNUTLS_E_SUCCESS)
+                return gnutls_make_error (ret);
+            }
+          else
+            {
+              error ("Sorry, GnuTLS can't use non-string trustfile %s",
+                     trustfile);
+            }
+        }
+
+      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: ",
+                           SDATA (keyfile));
+              ret = gnutls_certificate_set_x509_crl_file
+                (x509_cred,
+                 SDATA (keyfile),
+                 file_format);
+              
+              if (ret < GNUTLS_E_SUCCESS)
+                return gnutls_make_error (ret);
+            }
+          else
+            {
+              error ("Sorry, GnuTLS can't use non-string keyfile %s",
+                     keyfile);
+            }
+        }
     }
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
@@ -432,10 +484,22 @@
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT;
 
+  if (STRINGP (priority_string))
+    {
+      priority_string_ptr = (char*) SDATA (priority_string);
+      GNUTLS_LOG2 (1, max_log_level, "got non-default priority string:",
+                   priority_string_ptr);
+    }
+  else
+    {
+      GNUTLS_LOG2 (1, max_log_level, "using default priority string:",
+                   priority_string_ptr);
+    }
+  
   GNUTLS_LOG (1, max_log_level, "setting the priority string");
 
   ret = gnutls_priority_set_direct (state,
-				    (char*) SDATA (priority_string),
+				    priority_string_ptr,
 				    NULL);
 
   if (ret < GNUTLS_E_SUCCESS)
@@ -514,6 +578,21 @@
   Qgnutls_x509pki = intern_c_string ("gnutls-x509pki");
   staticpro (&Qgnutls_x509pki);
 
+  Qgnutls_bootprop_priority = intern_c_string ("priority");
+  staticpro (&Qgnutls_bootprop_priority);
+
+  Qgnutls_bootprop_trustfiles = intern_c_string ("trustfiles");
+  staticpro (&Qgnutls_bootprop_trustfiles);
+
+  Qgnutls_bootprop_keyfiles = intern_c_string ("keyfiles");
+  staticpro (&Qgnutls_bootprop_keyfiles);
+
+  Qgnutls_bootprop_callbacks = intern_c_string ("callbacks");
+  staticpro (&Qgnutls_bootprop_callbacks);
+
+  Qgnutls_bootprop_loglevel = intern_c_string ("loglevel");
+  staticpro (&Qgnutls_bootprop_loglevel);
+
   Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted");
   staticpro (&Qgnutls_e_interrupted);
   Fput (Qgnutls_e_interrupted, Qgnutls_code,

=== modified file 'src/gnutls.h'
--- src/gnutls.h	2010-09-29 12:48:29 +0000
+++ src/gnutls.h	2010-10-03 14:18:40 +0000
@@ -48,6 +48,8 @@
 
 #define GNUTLS_LOG(level, max, string) if (level <= max) { gnutls_log_function (level, "(Emacs) " string); }
 
+#define GNUTLS_LOG2(level, max, string, extra) if (level <= max) { gnutls_log_function2 (level, "(Emacs) " string, extra); }
+
 int
 emacs_gnutls_write (int fildes, struct Lisp_Process *proc, char *buf,
                     unsigned int nbyte);