guile: Loop or poll upon GNUTLS_E_AGAIN and GNUTLS_E_INTERRUPTED.

* guile/src/core.c (do_fill_port) [USING_GUILE_BEFORE_2_2]: Loop while
'gnutls_record_recv' returns GNUTLS_E_AGAIN or GNUTLS_E_INTERRUPTED.
(read_from_session_record_port) [!USING_GUILE_BEFORE_2_2]: Likewise, and
return -1 if SCM_GNUTLS_SESSION_TRANSPORT_IS_FD and we got GNUTLS_E_AGAIN.
(session_record_port_fd) [!USING_GUILE_BEFORE_2_2]: New function.
(scm_init_gnutls_session_record_port_type) [!USING_GUILE_BEFORE_2_2]:
Call 'scm_set_port_read_wait_fd'.

Signed-off-by: Ludovic Courtès <ludo@gnu.org>

1 files changed, 50 insertions, 5 deletions

diff --git a/guile/src/core.c b/guile/src/core.c
index 7cb0c32bf1..a3b3e9f740 100644
--- a/guile/src/core.c
+++ b/guile/src/core.c
@@ -29,6 +29,7 @@
 #include <libguile.h>
 
 #include <alloca.h>
+#include <assert.h>
 
 #include "enums.h"
 #include "smobs.h"
@@ -881,8 +882,15 @@ do_fill_port (void *data)
   const fill_port_data_t *args = (fill_port_data_t *) data;
 
   c_port = args->c_port;
-  result = gnutls_record_recv (args->c_session,
-                               c_port->read_buf, c_port->read_buf_size);
+
+  /* We can get GNUTLS_E_AGAIN due to a "short read", which does _not_
+     correspond to an actual EAGAIN from read(2) since the underlying file
+     descriptor is blocking.  Thus, we can safely loop right away.  */
+  do
+    result = gnutls_record_recv (args->c_session,
+				 c_port->read_buf, c_port->read_buf_size);
+  while (result == GNUTLS_E_AGAIN || result == GNUTLS_E_INTERRUPTED);
+
   if (EXPECT_TRUE (result > 0))
     {
       c_port->read_pos = c_port->read_buf;
@@ -1008,9 +1016,25 @@ read_from_session_record_port (SCM port, SCM dst, size_t start, size_t count)
 
   read_buf = (char *) SCM_BYTEVECTOR_CONTENTS (dst) + start;
 
-  /* XXX: Leave guile mode when SCM_GNUTLS_SESSION_TRANSPORT_IS_FD is
-     true?  */
-  result = gnutls_record_recv (c_session, read_buf, count);
+  /* We can get GNUTLS_E_AGAIN due to a "short read", which does _not_
+     correspond to an actual EAGAIN from read(2) if the underlying file
+     descriptor is blocking--e.g., from 'get_last_packet', returning
+     GNUTLS_E_REQUESTED_DATA_NOT_AVAILABLE.
+
+     If SESSION is backed by a file descriptor, return -1 to indicate that
+     we'd better poll; otherwise loop, which is good enough if the underlying
+     port is blocking.  */
+  do
+    result = gnutls_record_recv (c_session, read_buf, count);
+  while (result == GNUTLS_E_INTERRUPTED
+	 || (result == GNUTLS_E_AGAIN
+	     && !SCM_GNUTLS_SESSION_TRANSPORT_IS_FD (c_session)));
+
+  if (result == GNUTLS_E_AGAIN
+      && SCM_GNUTLS_SESSION_TRANSPORT_IS_FD (c_session))
+    /* Tell Guile that reading would block.  */
+    return (size_t) -1;
+
   if (EXPECT_FALSE (result < 0))
     /* FIXME: Silently swallowed! */
     scm_gnutls_error (result, FUNC_NAME);
@@ -1019,6 +1043,22 @@ read_from_session_record_port (SCM port, SCM dst, size_t start, size_t count)
 }
 #undef FUNC_NAME
 
+/* Return the file descriptor that backs PORT.  This function is called upon a
+   blocking read--i.e., 'read_from_session_record_port' returned -1.  */
+static int
+session_record_port_fd (SCM port)
+{
+  SCM session;
+  gnutls_session_t c_session;
+
+  session = SCM_GNUTLS_SESSION_RECORD_PORT_SESSION (port);
+  c_session = scm_to_gnutls_session (session, 1, __func__);
+
+  assert (SCM_GNUTLS_SESSION_TRANSPORT_IS_FD (c_session));
+
+  return gnutls_transport_get_int (c_session);
+}
+
 static size_t
 write_to_session_record_port (SCM port, SCM src, size_t start, size_t count)
 #define FUNC_NAME "write_to_session_record_port"
@@ -1092,6 +1132,11 @@ scm_init_gnutls_session_record_port_type (void)
 #endif
                         write_to_session_record_port);
 
+#if !USING_GUILE_BEFORE_2_2
+  scm_set_port_read_wait_fd (session_record_port_type,
+			     session_record_port_fd);
+#endif
+
   /* Guile >= 1.9.3 doesn't need a custom mark procedure, and doesn't need a
      finalizer (since memory associated with the port is automatically
      reclaimed.)  */