Add gnutls logging and clean up various gnutls bits.

From: Teodor Zlatanov  <tzz@lifelogs.com>

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 3d66ee0984cac7b8b1b0ef2c925048132e128b00..a19c80c0d1bd20d5fbe7f8e9b320989809ff14cb 100644 (file)
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,3 +1,9 @@
+2010-09-27  Teodor Zlatanov  <tzz@lifelogs.com>
+
+       * net/gnutls.el (gnutls, gnutls-log-level): Add group and custom
+       variable.
+       (starttls-negotiate): Use it.
+
 2010-09-27  Lars Magne Ingebrigtsen  <larsi@gnus.org>
 
        * net/gnutls.el (starttls-negotiate): Stop looping when we get a t

diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index b393d237d9027bf384f8dea9b29da09de27f058c..6a2d5aff68fe487af67234ff1f3a3f86bc6ae1cf 100644 (file)
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -32,6 +32,16 @@
 
 ;;; Code:
 
+(defgroup gnutls nil
+  "Emacs interface to the GnuTLS library."
+  :prefix "gnutls-"
+  :group 'net-utils)
+
+(defcustom gnutls-log-level 2
+  "Logging level to be used by `starttls-negotiate' and GnuTLS."
+  :type 'integer
+  :group 'gnutls)
+
 (defun open-ssl-stream (name buffer host service)
   "Open a SSL connection for a service to a host.
 Returns a subprocess-object to represent the connection.
@@ -72,7 +82,9 @@ CREDENTIALS-FILE is a filename with meaning dependent on CREDENTIALS."
          ret)
 
     (gnutls-message-maybe
-     (setq ret (gnutls-boot proc priority-string credentials credentials-file))     
+     (setq ret (gnutls-boot proc priority-string
+                            credentials credentials-file
+                            nil nil gnutls-log-level))
      "boot: %s")
 
     (when (gnutls-errorp ret)

diff --git a/src/ChangeLog b/src/ChangeLog
index ca9bc2599a03a90819f339b11f6a17a51cd2c46a..18f71f31ddec7ce4e152571429b647a7779977df 100644 (file)
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,3 +1,18 @@
+2010-09-27  Teodor Zlatanov  <tzz@lifelogs.com>
+
+       * gnutls.c (gnutls_log_function): Show level and "gnutls.c"
+       prefix.
+       (Fgnutls_boot): Use changed process members.  Use log level with a
+       function parameter to set it.  Bring back Emacs-level debugging
+       messages at log level 1 and 2.
+
+       * process.c (make_process): Initialize gnutls_log_level.
+
+       * process.h: Add gnutls_log_level and rename x509_cred and
+       anon_cred to have the gnutls_ prefix for consistency.
+
+       * gnutls.h (GNUTLS_LOG): Add convenience macro.
+
 2010-09-27  Juanma Barranquero  <lekktu@gmail.com>
 
        * w32.c (g_b_init_get_sid_identifier_authority)

diff --git a/src/gnutls.c b/src/gnutls.c
index 5d8a946fa9a78be22613ed318c9ff8e43e7fcfe7..c2d664ff97e7cecd891edb257d40d14839a9a139 100644 (file)
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -220,11 +220,12 @@ Lisp_Object gnutls_emacs_global_deinit (void)
   return gnutls_make_error (GNUTLS_E_SUCCESS);
 }
 
-static void gnutls_log_function (int level, const char* string) {
-  message("debug: %s", string);
+static void gnutls_log_function (int level, const char* string)
+{
+  message("gnutls.c: [%d] %s", level, string);
 }
 
-DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 6, 0,
+DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 7, 0,
        doc: /* Initializes client-mode GnuTLS for process PROC.
 Currently only client mode is supported.  Returns a success/failure
 value you can check with `gnutls-errorp'.
@@ -234,6 +235,10 @@ 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.
 
 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
@@ -247,10 +252,13 @@ 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 trustfile, Lisp_Object keyfile, Lisp_Object callback,
+     Lisp_Object loglevel)
 {
   int ret = GNUTLS_E_SUCCESS;
 
+  int max_log_level = 0;
+
   /* TODO: GNUTLS_X509_FMT_DER is also an option.  */
   int file_format = GNUTLS_X509_FMT_PEM;
 
@@ -267,8 +275,14 @@ KEYFILE and optionally CALLBACK.  */)
 
   state = XPROCESS (proc)->gnutls_state;
 
-  //gnutls_global_set_log_level(4);
-  //gnutls_global_set_log_function(gnutls_log_function);
+  if (NUMBERP (loglevel))
+    {
+      message ("setting up log level %d", XINT (loglevel));
+      gnutls_global_set_log_function (gnutls_log_function);
+      gnutls_global_set_log_level (XINT (loglevel));
+      max_log_level = XINT (loglevel);
+      XPROCESS (proc)->gnutls_log_level = max_log_level;
+    }
   
   /* always initialize globals.  */
   global_init = gnutls_emacs_global_init ();
@@ -278,14 +292,18 @@ KEYFILE and optionally CALLBACK.  */)
   /* deinit and free resources.  */
   if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_CRED_ALLOC)
   {
+      GNUTLS_LOG (1, max_log_level, "deallocating credentials");
+
       if (EQ (type, Qgnutls_x509pki))
       {
-          x509_cred = XPROCESS (proc)->x509_cred;
+          GNUTLS_LOG (2, max_log_level, "deallocating x509 credentials");
+          x509_cred = XPROCESS (proc)->gnutls_x509_cred;
           gnutls_certificate_free_credentials (x509_cred);
       }
       else if (EQ (type, Qgnutls_anon))
       {
-          anon_cred = XPROCESS (proc)->anon_cred;
+          GNUTLS_LOG (2, max_log_level, "deallocating anon credentials");
+          anon_cred = XPROCESS (proc)->gnutls_anon_cred;
           gnutls_anon_free_client_credentials (anon_cred);
       }
       else
@@ -296,21 +314,26 @@ KEYFILE and optionally CALLBACK.  */)
 
       if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
       {
+          GNUTLS_LOG (1, max_log_level, "deallocating x509 credentials");
           Fgnutls_deinit (proc);
       }
   }
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY;
 
+  GNUTLS_LOG (1, max_log_level, "allocating credentials");
+
   if (EQ (type, Qgnutls_x509pki))
   {
-      x509_cred = XPROCESS (proc)->x509_cred;
+      GNUTLS_LOG (2, max_log_level, "allocating x509 credentials");
+      x509_cred = XPROCESS (proc)->gnutls_x509_cred;
       if (gnutls_certificate_allocate_credentials (&x509_cred) < 0)
         memory_full ();
   }
   else if (EQ (type, Qgnutls_anon))
   {
-      anon_cred = XPROCESS (proc)->anon_cred;
+      GNUTLS_LOG (2, max_log_level, "allocating anon credentials");
+      anon_cred = XPROCESS (proc)->gnutls_anon_cred;
       if (gnutls_anon_allocate_client_credentials (&anon_cred) < 0)
         memory_full ();
   }
@@ -329,6 +352,7 @@ KEYFILE and optionally CALLBACK.  */)
   {
       if (STRINGP (trustfile))
       {
+          GNUTLS_LOG (1, max_log_level, "setting the trustfile");
           ret = gnutls_certificate_set_x509_trust_file
             (x509_cred,
              XSTRING (trustfile)->data,
@@ -340,6 +364,7 @@ KEYFILE and optionally CALLBACK.  */)
 
       if (STRINGP (keyfile))
       {
+          GNUTLS_LOG (1, max_log_level, "setting the keyfile");
           ret = gnutls_certificate_set_x509_crl_file
             (x509_cred,
              XSTRING (keyfile)->data,
@@ -352,6 +377,8 @@ KEYFILE and optionally CALLBACK.  */)
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
 
+  GNUTLS_LOG (1, max_log_level, "gnutls_init");
+
   ret = gnutls_init (&state, GNUTLS_CLIENT);
 
   if (ret < GNUTLS_E_SUCCESS)
@@ -361,6 +388,8 @@ KEYFILE and optionally CALLBACK.  */)
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT;
 
+  GNUTLS_LOG (1, max_log_level, "setting the priority string");
+
   ret = gnutls_priority_set_direct(state,
                                    (char*) SDATA (priority_string),
                                    NULL);
@@ -393,8 +422,8 @@ KEYFILE and optionally CALLBACK.  */)
   if (ret < GNUTLS_E_SUCCESS)
       return gnutls_make_error (ret);
 
-  XPROCESS (proc)->anon_cred = anon_cred;
-  XPROCESS (proc)->x509_cred = x509_cred;
+  XPROCESS (proc)->gnutls_anon_cred = anon_cred;
+  XPROCESS (proc)->gnutls_x509_cred = x509_cred;
   XPROCESS (proc)->gnutls_cred_type = type;
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
@@ -449,6 +478,7 @@ or `gnutls-e-interrupted'. In that case you may resume the handshake
 {
   gnutls_session_t state;
   int ret;
+  int max_log_level = XPROCESS (proc)->gnutls_log_level;
 
   CHECK_PROCESS (proc);
   state = XPROCESS (proc)->gnutls_state;
@@ -473,11 +503,10 @@ or `gnutls-e-interrupted'. In that case you may resume the handshake
   ret = gnutls_handshake (state);
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_HANDSHAKE_TRIED;
 
-  if (GNUTLS_E_SUCCESS == ret || ret == 0)
+  if (GNUTLS_E_SUCCESS == ret)
   {
     /* here we're finally done.  */
     GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_READY;
-    return Qt;
   }
 
   return gnutls_make_error (ret);

diff --git a/src/gnutls.h b/src/gnutls.h
index 3a9030ba454b8ba7e4abd91acaabe6ee6331b85f..d63555a8a940a28f296c93364a40e3982d021005 100644 (file)
--- a/src/gnutls.h
+++ b/src/gnutls.h
@@ -46,6 +46,8 @@ typedef enum
 
 #define GNUTLS_PROCESS_USABLE(proc) (GNUTLS_INITSTAGE(proc) >= GNUTLS_STAGE_READY)
 
+#define GNUTLS_LOG(level, max, string) if (level <= max) { gnutls_log_function (level, "(Emacs) " string); }
+
 int
 emacs_gnutls_write (int fildes, gnutls_session_t state, char *buf,
                     unsigned int nbyte);

diff --git a/src/process.c b/src/process.c
index 70cc8250addf3e691d6558dd87405885cc46d12b..cf16027b30a3f4bf186fba6086849892fd818c45 100644 (file)
--- a/src/process.c
+++ b/src/process.c
@@ -671,6 +671,7 @@ make_process (Lisp_Object name)
 
 #ifdef HAVE_GNUTLS
   p->gnutls_initstage = GNUTLS_STAGE_EMPTY;
+  p->gnutls_log_level = 0;
 #endif
 
   /* If name is already in use, modify it until it is unused.  */

diff --git a/src/process.h b/src/process.h
index d6e842cfbbc48f2b455ef0702b7aa20a7f16b76a..a28bf090ba9d41cec2a6b77040d7765abd9ba56c 100644 (file)
--- a/src/process.h
+++ b/src/process.h
@@ -133,8 +133,9 @@ struct Lisp_Process
 #ifdef HAVE_GNUTLS
     gnutls_initstage_t gnutls_initstage;
     gnutls_session_t gnutls_state;
-    gnutls_certificate_client_credentials x509_cred;
-    gnutls_anon_client_credentials_t anon_cred;
+    gnutls_certificate_client_credentials gnutls_x509_cred;
+    gnutls_anon_client_credentials_t gnutls_anon_cred;
+    int gnutls_log_level;
 #endif
 };