[Emacs-diffs] /srv/bzr/emacs/trunk r101650: Add gnutls logging and clean up various gnutls bits.

[Lars Magne Ingebrigtsen]

------------------------------------------------------------
revno: 101650
committer: Lars Magne Ingebrigtsen <address@hidden>
branch nick: trunk
timestamp: Mon 2010-09-27 18:44:31 +0200
message:
  Add gnutls logging and clean up various gnutls bits.
  
  From: Teodor Zlatanov  <address@hidden>
modified:
  lisp/ChangeLog
  lisp/net/gnutls.el
  src/ChangeLog
  src/gnutls.c
  src/gnutls.h
  src/process.c
  src/process.h

=== modified file 'lisp/ChangeLog'
--- a/lisp/ChangeLog    2010-09-27 14:56:27 +0000
+++ b/lisp/ChangeLog    2010-09-27 16:44:31 +0000
@@ -1,3 +1,9 @@
+2010-09-27  Teodor Zlatanov  <address@hidden>
+
+       * net/gnutls.el (gnutls, gnutls-log-level): Add group and custom
+       variable.
+       (starttls-negotiate): Use it.
+
 2010-09-27  Lars Magne Ingebrigtsen  <address@hidden>
 
        * net/gnutls.el (starttls-negotiate): Stop looping when we get a t

=== modified file 'lisp/net/gnutls.el'
--- a/lisp/net/gnutls.el        2010-09-27 14:35:22 +0000
+++ b/lisp/net/gnutls.el        2010-09-27 16:44:31 +0000
@@ -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 @@
          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)

=== modified file 'src/ChangeLog'
--- a/src/ChangeLog     2010-09-27 16:27:37 +0000
+++ b/src/ChangeLog     2010-09-27 16:44:31 +0000
@@ -1,3 +1,18 @@
+2010-09-27  Teodor Zlatanov  <address@hidden>
+
+       * 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  <address@hidden>
 
        * w32.c (g_b_init_get_sid_identifier_authority)

=== modified file 'src/gnutls.c'
--- a/src/gnutls.c      2010-09-27 15:03:58 +0000
+++ b/src/gnutls.c      2010-09-27 16:44:31 +0000
@@ -220,11 +220,12 @@
   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 @@
 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 @@
 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 @@
 
   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 @@
   /* 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 @@
 
       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 @@
   {
       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 @@
 
       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 @@
 
   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 @@
 
   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 @@
   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 @@
 {
   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 @@
   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);

=== modified file 'src/gnutls.h'
--- a/src/gnutls.h      2010-09-26 06:06:28 +0000
+++ b/src/gnutls.h      2010-09-27 16:44:31 +0000
@@ -46,6 +46,8 @@
 
 #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);

=== modified file 'src/process.c'
--- a/src/process.c     2010-09-26 20:48:13 +0000
+++ b/src/process.c     2010-09-27 16:44:31 +0000
@@ -671,6 +671,7 @@
 
 #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.  */

=== modified file 'src/process.h'
--- a/src/process.h     2010-09-26 16:20:01 +0000
+++ b/src/process.h     2010-09-27 16:44:31 +0000
@@ -133,8 +133,9 @@
 #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
 };