[Emacs-diffs] /srv/bzr/emacs/trunk r101773: Rework the gnutls boot interface.

[Lars Magne Ingebrigtsen]

------------------------------------------------------------
revno: 101773
committer: Lars Magne Ingebrigtsen <address@hidden>
branch nick: trunk
timestamp: Mon 2010-10-04 00:37:37 +0200
message:
  Rework the gnutls boot interface.
  
  From Teodor Zlatanov.
modified:
  lisp/ChangeLog
  lisp/net/gnutls.el
  src/ChangeLog
  src/gnutls.c
  src/gnutls.h

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-10-03 21:23:13 +0000
+++ b/lisp/ChangeLog    2010-10-03 22:37:37 +0000
@@ -1,3 +1,10 @@
+2010-10-03  Teodor Zlatanov  <address@hidden>
+
+       * 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  Glenn Morris  <address@hidden>
 
        * subr.el (directory-sep-char): Remove obsolete variable.

=== modified file 'lisp/net/gnutls.el'
--- a/lisp/net/gnutls.el        2010-09-29 13:25:24 +0000
+++ b/lisp/net/gnutls.el        2010-10-03 22:37:37 +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))

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2010-10-03 21:27:04 +0000
+++ b/src/ChangeLog     2010-10-03 22:37:37 +0000
@@ -1,3 +1,15 @@
+2010-10-03  Teodor Zlatanov  <address@hidden>
+
+       * 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  Glenn Morris  <address@hidden>
 
        * fileio.c (Vdirectory_sep_char): Remove.

=== modified file 'src/gnutls.c'
--- a/src/gnutls.c      2010-10-03 12:52:04 +0000
+++ b/src/gnutls.c      2010-10-03 22:37:37 +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'
--- a/src/gnutls.h      2010-09-29 12:48:29 +0000
+++ b/src/gnutls.h      2010-10-03 22:37:37 +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);