Do the gnutls handshake from the reader loop, instead of looping over

the handshake from Emacs Lisp.

4 files changed, 40 insertions, 67 deletions

diff --git a/lisp/ChangeLog b/lisp/ChangeLog
index 44cb82b4c7..3ca07c33e1 100644
--- a/lisp/ChangeLog
+++ b/lisp/ChangeLog
@@ -1,6 +1,8 @@
 2010-09-29  Lars Magne Ingebrigtsen  <[email protected]>
 
 	* net/gnutls.el (starttls-negotiate): Loop a lot longer.
+	(starttls-negotiate): Just call boot, and let the handshake be
+	triggered from the read loop.
 
 2010-09-29  Glenn Morris  <[email protected]>
 
diff --git a/lisp/net/gnutls.el b/lisp/net/gnutls.el
index e1d093ebf7..27d44d32bd 100644
--- a/lisp/net/gnutls.el
+++ b/lisp/net/gnutls.el
@@ -87,17 +87,6 @@ CREDENTIALS-FILE is a filename with meaning dependent on CREDENTIALS."
                             nil nil gnutls-log-level))
      "boot: %s")
 
-    (when (gnutls-errorp ret)
-      (error "Could not boot GnuTLS for this process"));
-
-    (let ((ret 'gnutls-e-again)
-          (n 250000))
-      (while (and (not (eq ret t))
-		  (not (gnutls-error-fatalp ret))
-                  (> n 0))
-        (setq n (1- n))
-	(setq ret (gnutls-handshake proc)))
-      (message "Handshake complete %s." ret))
     proc))
 
 (defun starttls-open-stream (name buffer host service)
diff --git a/src/ChangeLog b/src/ChangeLog
index ee6e8f6ce9..9d9833f7e6 100644
--- a/src/ChangeLog
+++ b/src/ChangeLog
@@ -1,5 +1,9 @@
 2010-09-29  Lars Magne Ingebrigtsen  <[email protected]>
 
+	* gnutls.c (emacs_gnutls_handshake): Made into internal function.
+	(Fgnutls_boot): Start the handshake.
+	(emacs_gnutls_read): Perform the handshake from the reader loop.
+
 	* process.h (Lisp_Process): Add a gnutls_p field to Lisp_Process.
 
 	* process.c (make_process): Set the gnutls_p field to zero by
diff --git a/src/gnutls.c b/src/gnutls.c
index 2d1aa3247f..4be28016ea 100644
--- a/src/gnutls.c
+++ b/src/gnutls.c
@@ -32,6 +32,34 @@ Lisp_Object Qgnutls_e_interrupted, Qgnutls_e_again,
   Qgnutls_e_invalid_session, Qgnutls_e_not_ready_for_handshake;
 int global_initialized;
 
+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)
+  {
+    /* 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, proc->infd, 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
 emacs_gnutls_write (int fildes, struct Lisp_Process *proc, char *buf,
                     unsigned int nbyte)
@@ -72,8 +100,10 @@ emacs_gnutls_read (int fildes, struct Lisp_Process *proc, char *buf,
   register int rtnval;
   gnutls_session_t state = proc->gnutls_state;
 
-  if (proc->gnutls_initstage != GNUTLS_STAGE_READY)
-    return 0;
+  if (proc->gnutls_initstage != GNUTLS_STAGE_READY) {
+    emacs_gnutls_handshake (proc);
+    return -1;
+  }
 
   rtnval = gnutls_read (state, buf, nbyte);
   if (rtnval >= 0)
@@ -435,6 +465,8 @@ KEYFILE and optionally CALLBACK.  */)
 
   GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_CRED_SET;
 
+  emacs_gnutls_handshake (XPROCESS (proc));
+
   return gnutls_make_error (GNUTLS_E_SUCCESS);
 }
 
@@ -467,59 +499,6 @@ This function may also return `gnutls-e-again', or
   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 (ret == GNUTLS_E_SUCCESS)
-  {
-    /* here we're finally done.  */
-    GNUTLS_INITSTAGE (proc) = GNUTLS_STAGE_READY;
-  }
-
-  return gnutls_make_error (ret);
-}
-
 void
 syms_of_gnutls (void)
 {
@@ -561,7 +540,6 @@ syms_of_gnutls (void)
   defsubr (&Sgnutls_error_string);
   defsubr (&Sgnutls_boot);
   defsubr (&Sgnutls_deinit);
-  defsubr (&Sgnutls_handshake);
   defsubr (&Sgnutls_bye);
 }
 #endif