nnimap.el (nnimap-update-info): Refactor slightly.

[gnu-emacs] / src / gnutls.c

diff --git a/src/gnutls.c b/src/gnutls.c
index 4b8016aab37201f75b5ebefd88bf858a6915185e..3a461891e2e8c4975458329ae309b6603446758f 100644 (file)
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -1,5 +1,5 @@
 /* GnuTLS glue for GNU Emacs.
 /* GnuTLS glue for GNU Emacs.

-   Copyright (C) 2010  Free Software Foundation, Inc.
+   Copyright (C) 2010-2011  Free Software Foundation, Inc.

 
 This file is part of GNU Emacs.
 
 
 This file is part of GNU Emacs.
 


@@ -32,11 +32,60 @@ Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
   Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
 int global_initialized;
 
   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)
+{
+  gnutls_session_t state = proc->gnutls_state;
+  int ret;
+
+  if (proc->gnutls_initstage < GNUTLS_STAGE_HANDSHAKE_CANDO)
+    return;
+
+  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);
+
+      proc->gnutls_initstage = GNUTLS_STAGE_TRANSPORT_POINTERS_SET;
+    }
+
+  ret = gnutls_handshake (state);
+  proc->gnutls_initstage = GNUTLS_STAGE_HANDSHAKE_TRIED;
+
+  if (ret == GNUTLS_E_SUCCESS)
+    {
+      /* here we're finally done.  */
+      proc->gnutls_initstage = GNUTLS_STAGE_READY;
+    }
+}
+

 int
 int

-emacs_gnutls_write (int fildes, gnutls_session_t state, char *buf,
+emacs_gnutls_write (int fildes, struct Lisp_Process *proc, char *buf,

                     unsigned int nbyte)
 {
   register int rtnval, bytes_written;
                     unsigned int nbyte)
 {
   register int rtnval, bytes_written;

+  gnutls_session_t state = proc->gnutls_state;
+
+  if (proc->gnutls_initstage != GNUTLS_STAGE_READY) {
+#ifdef EWOULDBLOCK
+    errno = EWOULDBLOCK;
+#endif
+#ifdef EAGAIN
+    errno = EAGAIN;
+#endif
+    return -1;
+  }

 
   bytes_written = 0;
 
 
   bytes_written = 0;
 


@@ -44,9 +93,9 @@ emacs_gnutls_write (int fildes, gnutls_session_t state, char *buf,
     {
       rtnval = gnutls_write (state, buf, nbyte);
 
     {
       rtnval = gnutls_write (state, buf, nbyte);
 

-      if (rtnval == -1)
+      if (rtnval < 0)

         {
         {

-          if (errno == EINTR)
+          if (rtnval == GNUTLS_E_AGAIN || rtnval == GNUTLS_E_INTERRUPTED)

             continue;
           else
             return (bytes_written ? bytes_written : -1);
             continue;
           else
             return (bytes_written ? bytes_written : -1);


@@ -56,49 +105,61 @@ emacs_gnutls_write (int fildes, gnutls_session_t state, char *buf,
       nbyte -= rtnval;
       bytes_written += rtnval;
     }
       nbyte -= rtnval;
       bytes_written += rtnval;
     }

-  fsync (STDOUT_FILENO);

 
   return (bytes_written);
 }
 
 int
 
   return (bytes_written);
 }
 
 int

-emacs_gnutls_read (int fildes, gnutls_session_t state, char *buf,
+emacs_gnutls_read (int fildes, struct Lisp_Process *proc, char *buf,

                    unsigned int nbyte)
 {
   register int rtnval;
                    unsigned int nbyte)
 {
   register int rtnval;

+  gnutls_session_t state = proc->gnutls_state;
+
+  if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
+    {
+      emacs_gnutls_handshake (proc);
+      return -1;
+    }

 
   rtnval = gnutls_read (state, buf, nbyte);
   if (rtnval >= 0)
     return rtnval;
 
   rtnval = gnutls_read (state, buf, nbyte);
   if (rtnval >= 0)
     return rtnval;

-  else
-    return -1;
+  else {
+    if (rtnval == GNUTLS_E_AGAIN ||
+       rtnval == GNUTLS_E_INTERRUPTED)
+      return -1;
+    else
+      return 0;
+  }

 }
 
 /* convert an integer error to a Lisp_Object; it will be either a
    known symbol like `gnutls_e_interrupted' and `gnutls_e_again' or
    simply the integer value of the error.  GNUTLS_E_SUCCESS is mapped
    to Qt.  */
 }
 
 /* convert an integer error to a Lisp_Object; it will be either a
    known symbol like `gnutls_e_interrupted' and `gnutls_e_again' or
    simply the integer value of the error.  GNUTLS_E_SUCCESS is mapped
    to Qt.  */

-Lisp_Object gnutls_make_error (int error)
+static Lisp_Object
+gnutls_make_error (int error)

 {
   switch (error)
 {
   switch (error)

-  {
-  case GNUTLS_E_SUCCESS:
-    return Qt;
-  case GNUTLS_E_AGAIN:
-    return Qgnutls_e_again;
-  case GNUTLS_E_INTERRUPTED:
-    return Qgnutls_e_interrupted;
-  case GNUTLS_E_INVALID_SESSION:
-    return Qgnutls_e_invalid_session;
-  }
+    {
+    case GNUTLS_E_SUCCESS:
+      return Qt;
+    case GNUTLS_E_AGAIN:
+      return Qgnutls_e_again;
+    case GNUTLS_E_INTERRUPTED:
+      return Qgnutls_e_interrupted;
+    case GNUTLS_E_INVALID_SESSION:
+      return Qgnutls_e_invalid_session;
+    }

 
   return make_number (error);
 }
 
 DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0,
 
   return make_number (error);
 }
 
 DEFUN ("gnutls-get-initstage", Fgnutls_get_initstage, Sgnutls_get_initstage, 1, 1, 0,

-       doc: /* Return the GnuTLS init stage of PROCESS.
+       doc: /* Return the GnuTLS init stage of process PROC.

 See also `gnutls-boot'.  */)
 See also `gnutls-boot'.  */)

-    (Lisp_Object proc)
+  (Lisp_Object proc)

 {
   CHECK_PROCESS (proc);
 
 {
   CHECK_PROCESS (proc);
 


@@ -106,36 +167,38 @@ See also `gnutls-boot'.  */)
 }
 
 DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0,
 }
 
 DEFUN ("gnutls-errorp", Fgnutls_errorp, Sgnutls_errorp, 1, 1, 0,

-       doc: /* Returns t if ERROR (as generated by gnutls_make_error)
-indicates a GnuTLS problem.  */)
-    (Lisp_Object error)
+       doc: /* Return t if ERROR indicates a GnuTLS problem.
+ERROR is an integer or a symbol with an integer `gnutls-code' property.
+usage: (gnutls-errorp ERROR)  */)
+  (Lisp_Object err)

 {
 {

-  if (EQ (error, Qt)) return Qnil;
+  if (EQ (err, Qt)) return Qnil;

 
   return Qt;
 }
 
 DEFUN ("gnutls-error-fatalp", Fgnutls_error_fatalp, Sgnutls_error_fatalp, 1, 1, 0,
 
   return Qt;
 }
 
 DEFUN ("gnutls-error-fatalp", Fgnutls_error_fatalp, Sgnutls_error_fatalp, 1, 1, 0,

-       doc: /* Checks if ERROR is fatal.
-ERROR is an integer or a symbol with an integer `gnutls-code' property.  */)
-    (Lisp_Object err)
+       doc: /* Check if ERROR is fatal.
+ERROR is an integer or a symbol with an integer `gnutls-code' property.
+usage: (gnutls-error-fatalp ERROR)  */)
+  (Lisp_Object err)

 {
   Lisp_Object code;
 
   if (EQ (err, Qt)) return Qnil;
 
   if (SYMBOLP (err))
 {
   Lisp_Object code;
 
   if (EQ (err, Qt)) return Qnil;
 
   if (SYMBOLP (err))

-  {
-    code = Fget (err, Qgnutls_code);
-    if (NUMBERP (code))
-    {
-      err = code;
-    }
-    else

     {
     {

-      error ("Symbol has no numeric gnutls-code property");
+      code = Fget (err, Qgnutls_code);
+      if (NUMBERP (code))
+       {
+         err = code;
+       }
+      else
+       {
+         error ("Symbol has no numeric gnutls-code property");
+       }

     }
     }

-  }

 
   if (!NUMBERP (err))
     error ("Not an error symbol or code");
 
   if (!NUMBERP (err))
     error ("Not an error symbol or code");


@@ -147,26 +210,27 @@ ERROR is an integer or a symbol with an integer `gnutls-code' property.  */)
 }
 
 DEFUN ("gnutls-error-string", Fgnutls_error_string, Sgnutls_error_string, 1, 1, 0,
 }
 
 DEFUN ("gnutls-error-string", Fgnutls_error_string, Sgnutls_error_string, 1, 1, 0,

-       doc: /* Returns a description of ERROR.
-ERROR is an integer or a symbol with an integer `gnutls-code' property.  */)
-    (Lisp_Object err)
+       doc: /* Return a description of ERROR.
+ERROR is an integer or a symbol with an integer `gnutls-code' property.
+usage: (gnutls-error-string ERROR)  */)
+  (Lisp_Object err)

 {
   Lisp_Object code;
 
   if (EQ (err, Qt)) return build_string ("Not an error");
 
   if (SYMBOLP (err))
 {
   Lisp_Object code;
 
   if (EQ (err, Qt)) return build_string ("Not an error");
 
   if (SYMBOLP (err))

-  {
-    code = Fget (err, Qgnutls_code);
-    if (NUMBERP (code))
-    {
-      err = code;
-    }
-    else

     {
     {

-      return build_string ("Symbol has no numeric gnutls-code property");
+      code = Fget (err, Qgnutls_code);
+      if (NUMBERP (code))
+       {
+         err = code;
+       }
+      else
+       {
+         return build_string ("Symbol has no numeric gnutls-code property");
+       }

     }
     }

-  }

 
   if (!NUMBERP (err))
     return build_string ("Not an error symbol or code");
 
   if (!NUMBERP (err))
     return build_string ("Not an error symbol or code");


@@ -175,9 +239,9 @@ ERROR is an integer or a symbol with an integer `gnutls-code' property.  */)
 }
 
 DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,
 }
 
 DEFUN ("gnutls-deinit", Fgnutls_deinit, Sgnutls_deinit, 1, 1, 0,

-       doc: /* Deallocate GNU TLS resources associated with PROCESS.
+       doc: /* Deallocate GnuTLS resources associated with process PROC.

 See also `gnutls-init'.  */)
 See also `gnutls-init'.  */)

-    (Lisp_Object proc)
+  (Lisp_Object proc)

 {
   gnutls_session_t state;
 
 {
   gnutls_session_t state;
 


@@ -185,18 +249,19 @@ See also `gnutls-init'.  */)
   state = XPROCESS (proc)->gnutls_state;
 
   if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
   state = XPROCESS (proc)->gnutls_state;
 
   if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)

-  {
+    {

       gnutls_deinit (state);
       GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;
       gnutls_deinit (state);
       GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT - 1;

-  }
+    }

 
   return Qt;
 }
 
 
   return Qt;
 }
 

-/* Initializes global GNU TLS state to defaults.
-Call `gnutls-global-deinit' when GNU TLS usage is no longer needed.
+/* Initializes global GnuTLS state to defaults.
+Call `gnutls-global-deinit' when GnuTLS usage is no longer needed.

 Returns zero on success.  */
 Returns zero on success.  */

-Lisp_Object gnutls_emacs_global_init (void)
+static Lisp_Object
+gnutls_emacs_global_init (void)

 {
   int ret = GNUTLS_E_SUCCESS;
 
 {
   int ret = GNUTLS_E_SUCCESS;
 


@@ -208,9 +273,10 @@ Lisp_Object gnutls_emacs_global_init (void)
   return gnutls_make_error (ret);
 }
 
   return gnutls_make_error (ret);
 }
 

-/* Deinitializes global GNU TLS state.
+/* Deinitializes global GnuTLS state.

 See also `gnutls-global-init'.  */
 See also `gnutls-global-init'.  */

-Lisp_Object gnutls_emacs_global_deinit (void)
+static Lisp_Object
+gnutls_emacs_global_deinit (void)

 {
   if (global_initialized)
     gnutls_global_deinit ();
 {
   if (global_initialized)
     gnutls_global_deinit ();


@@ -220,40 +286,48 @@ Lisp_Object gnutls_emacs_global_deinit (void)
   return gnutls_make_error (GNUTLS_E_SUCCESS);
 }
 
   return gnutls_make_error (GNUTLS_E_SUCCESS);
 }
 

-static void gnutls_log_function (int level, const char* string)
+static void
+gnutls_log_function (int level, const char* string)

 {
 {

-  message("gnutls.c: [%d] %s", level, string);
+  message ("gnutls.c: [%d] %s", level, string);

 }
 
 }
 

-DEFUN ("gnutls-boot", Fgnutls_boot, Sgnutls_boot, 3, 7, 0,
-       doc: /* Initializes 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'.
 
 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.
+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.

 
 

-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.
+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
 specified.
 
 
 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
 specified.
 

-Processes must be initialized with this function before other GNU TLS
+Processes must be initialized with this function before other GnuTLS

 functions are used.  This function allocates resources which can only
 be deallocated by calling `gnutls-deinit' or by calling it again.
 
 Each authentication type may need additional information in order to
 functions are used.  This function allocates resources which can only
 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;
 
 {
   int ret = GNUTLS_E_SUCCESS;
 


@@ -266,22 +340,37 @@ KEYFILE and optionally CALLBACK.  */)
   gnutls_certificate_credentials_t x509_cred;
   gnutls_anon_client_credentials_t anon_cred;
   Lisp_Object global_init;
   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_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;
 
   state = XPROCESS (proc)->gnutls_state;

+  XPROCESS (proc)->gnutls_p = 1;

 
   if (NUMBERP (loglevel))
     {
 
   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;
     }
       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 ();
   if (! NILP (Fgnutls_errorp (global_init)))
   /* always initialize globals.  */
   global_init = gnutls_emacs_global_init ();
   if (! NILP (Fgnutls_errorp (global_init)))


@@ -289,89 +378,109 @@ KEYFILE and optionally CALLBACK.  */)
 
   /* deinit and free resources.  */
   if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_CRED_ALLOC)
 
   /* 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))
       GNUTLS_LOG (1, max_log_level, "deallocating credentials");
 
       if (EQ (type, Qgnutls_x509pki))

-      {
+       {

           GNUTLS_LOG (2, max_log_level, "deallocating x509 credentials");
           x509_cred = XPROCESS (proc)->gnutls_x509_cred;
           gnutls_certificate_free_credentials (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))
       else if (EQ (type, Qgnutls_anon))

-      {
+       {

           GNUTLS_LOG (2, max_log_level, "deallocating anon credentials");
           anon_cred = XPROCESS (proc)->gnutls_anon_cred;
           gnutls_anon_free_client_credentials (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
       else

-      {
+       {

           error ("unknown credential type");
           ret = GNUTLS_EMACS_ERROR_INVALID_TYPE;
           error ("unknown credential type");
           ret = GNUTLS_EMACS_ERROR_INVALID_TYPE;

-      }
+       }

 
       if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)
 
       if (GNUTLS_INITSTAGE (proc) >= GNUTLS_STAGE_INIT)

-      {
+       {

           GNUTLS_LOG (1, max_log_level, "deallocating x509 credentials");
           Fgnutls_deinit (proc);
           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))
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_EMPTY;
 
   GNUTLS_LOG (1, max_log_level, "allocating credentials");
 
   if (EQ (type, Qgnutls_x509pki))

-  {
+    {

       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 ();
       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))
   else if (EQ (type, Qgnutls_anon))

-  {
+    {

       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 ();
       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 ();

-  }
+    }

   else
   else

-  {
+    {

       error ("unknown credential type");
       ret = GNUTLS_EMACS_ERROR_INVALID_TYPE;
       error ("unknown credential type");
       ret = GNUTLS_EMACS_ERROR_INVALID_TYPE;

-  }
+    }

 
   if (ret < GNUTLS_E_SUCCESS)
 
   if (ret < GNUTLS_E_SUCCESS)

-      return gnutls_make_error (ret);
+    return gnutls_make_error (ret);

 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_ALLOC;
 
   if (EQ (type, Qgnutls_x509pki))
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_ALLOC;
 
   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;
 
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_FILES;
 


@@ -380,45 +489,51 @@ KEYFILE and optionally CALLBACK.  */)
   ret = gnutls_init (&state, GNUTLS_CLIENT);
 
   if (ret < GNUTLS_E_SUCCESS)
   ret = gnutls_init (&state, GNUTLS_CLIENT);
 
   if (ret < GNUTLS_E_SUCCESS)

-      return gnutls_make_error (ret);
+    return gnutls_make_error (ret);

 
   XPROCESS (proc)->gnutls_state = state;
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT;
 
 
   XPROCESS (proc)->gnutls_state = state;
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_INIT;
 

+  if (STRINGP (priority_string))
+    {
+      priority_string_ptr = SSDATA (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");
 
   GNUTLS_LOG (1, max_log_level, "setting the priority string");
 

-  ret = gnutls_priority_set_direct(state,
-                                   (char*) SDATA (priority_string),
-                                   NULL);
+  ret = gnutls_priority_set_direct (state,
+                                   priority_string_ptr,
+                                   NULL);

 
   if (ret < GNUTLS_E_SUCCESS)
 
   if (ret < GNUTLS_E_SUCCESS)

-      return gnutls_make_error (ret);
+    return gnutls_make_error (ret);

 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY;
 
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_PRIORITY;
 

-  message ("gnutls: setting the credentials");
-

   if (EQ (type, Qgnutls_x509pki))
   if (EQ (type, Qgnutls_x509pki))

-  {
-      message ("gnutls: setting the x509 credentials");
-
+    {

       ret = gnutls_cred_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred);
       ret = gnutls_cred_set (state, GNUTLS_CRD_CERTIFICATE, x509_cred);

-  }
+    }

   else if (EQ (type, Qgnutls_anon))
   else if (EQ (type, Qgnutls_anon))

-  {
-      message ("gnutls: setting the anon credentials");
-
+    {

       ret = gnutls_cred_set (state, GNUTLS_CRD_ANON, anon_cred);
       ret = gnutls_cred_set (state, GNUTLS_CRD_ANON, anon_cred);

-  }
+    }

   else
   else

-  {
+    {

       error ("unknown credential type");
       ret = GNUTLS_EMACS_ERROR_INVALID_TYPE;
       error ("unknown credential type");
       ret = GNUTLS_EMACS_ERROR_INVALID_TYPE;

-  }
+    }

 
   if (ret < GNUTLS_E_SUCCESS)
 
   if (ret < GNUTLS_E_SUCCESS)

-      return gnutls_make_error (ret);
+    return gnutls_make_error (ret);

 
   XPROCESS (proc)->gnutls_anon_cred = anon_cred;
   XPROCESS (proc)->gnutls_x509_cred = x509_cred;
 
   XPROCESS (proc)->gnutls_anon_cred = anon_cred;
   XPROCESS (proc)->gnutls_x509_cred = x509_cred;


@@ -426,16 +541,18 @@ KEYFILE and optionally CALLBACK.  */)
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
 
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
 

+  emacs_gnutls_handshake (XPROCESS (proc));
+

   return gnutls_make_error (GNUTLS_E_SUCCESS);
 }
 
 DEFUN ("gnutls-bye", Fgnutls_bye,
        Sgnutls_bye, 2, 2, 0,
   return gnutls_make_error (GNUTLS_E_SUCCESS);
 }
 
 DEFUN ("gnutls-bye", Fgnutls_bye,
        Sgnutls_bye, 2, 2, 0,

-       doc: /* Terminate current GNU TLS connection for PROCESS.
+       doc: /* Terminate current GnuTLS connection for process PROC.

 The connection should have been initiated using `gnutls-handshake'.
 
 If CONT is not nil the TLS connection gets terminated and further
 The connection should have been initiated using `gnutls-handshake'.
 
 If CONT is not nil the TLS connection gets terminated and further

-receives and sends will be disallowed. If the return value is zero you
+receives and sends will be disallowed.  If the return value is zero you

 may continue using the connection.  If CONT is nil, GnuTLS actually
 sends an alert containing a close request and waits for the peer to
 reply with the same message.  In order to reuse the connection you
 may continue using the connection.  If CONT is nil, GnuTLS actually
 sends an alert containing a close request and waits for the peer to
 reply with the same message.  In order to reuse the connection you


@@ -458,59 +575,6 @@ This function may also return `gnutls-e-again', or
   return gnutls_make_error (ret);
 }
 
   return gnutls_make_error (ret);
 }
 

-DEFUN ("gnutls-handshake", Fgnutls_handshake,
-       Sgnutls_handshake, 1, 1, 0,
-       doc: /* Perform GNU TLS handshake for PROCESS.
-The identity of the peer is checked automatically.  This function will
-fail if any problem is encountered, and will return a negative error
-code. In case of a client, if it has been asked to resume a session,
-but the server didn't, then a full handshake will be performed.
-
-If the error `gnutls-e-not-ready-for-handshake' is returned, you
-didn't call `gnutls-boot' first.
-
-This function may also return the non-fatal errors `gnutls-e-again',
-or `gnutls-e-interrupted'. In that case you may resume the handshake
-(by calling this function again).  */)
-    (Lisp_Object proc)
-{
-  gnutls_session_t state;
-  int ret;
-
-  CHECK_PROCESS (proc);
-  state = XPROCESS (proc)->gnutls_state;
-
-  if (GNUTLS_INITSTAGE (proc) < GNUTLS_STAGE_HANDSHAKE_CANDO)
-    return Qgnutls_e_not_ready_for_handshake;
-
-  
-  if (GNUTLS_INITSTAGE (proc) < GNUTLS_STAGE_TRANSPORT_POINTERS_SET)
-  {
-    /* for a network process in Emacs infd and outfd are the same
-       but this shows our intent more clearly.  */
-    message ("gnutls: handshake: setting the transport pointers to %d/%d",
-             XPROCESS (proc)->infd, XPROCESS (proc)->outfd);
-
-    /* FIXME: This can't be right: infd and outfd are integers (file handles)
-       whereas the function expects args of type gnutls_transport_ptr_t.  */
-    gnutls_transport_set_ptr2 (state, XPROCESS (proc)->infd,
-                               XPROCESS (proc)->outfd);
-
-    GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_TRANSPORT_POINTERS_SET;
-  }
-
-  ret = gnutls_handshake (state);
-  GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_HANDSHAKE_TRIED;
-
-  if (GNUTLS_E_SUCCESS == ret)
-  {
-    /* here we're finally done.  */
-    GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_READY;
-  }
-
-  return gnutls_make_error (ret);
-}
-

 void
 syms_of_gnutls (void)
 {
 void
 syms_of_gnutls (void)
 {


@@ -525,6 +589,21 @@ syms_of_gnutls (void)
   Qgnutls_x509pki = intern_c_string ("gnutls-x509pki");
   staticpro (&Qgnutls_x509pki);
 
   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,
   Qgnutls_e_interrupted = intern_c_string ("gnutls-e-interrupted");
   staticpro (&Qgnutls_e_interrupted);
   Fput (Qgnutls_e_interrupted, Qgnutls_code,


@@ -552,7 +631,6 @@ syms_of_gnutls (void)
   defsubr (&Sgnutls_error_string);
   defsubr (&Sgnutls_boot);
   defsubr (&Sgnutls_deinit);
   defsubr (&Sgnutls_error_string);
   defsubr (&Sgnutls_boot);
   defsubr (&Sgnutls_deinit);

-  defsubr (&Sgnutls_handshake);

   defsubr (&Sgnutls_bye);
 }
 #endif
   defsubr (&Sgnutls_bye);
 }
 #endif