better handling for exceptions in close-port and port finalizers

* libguile/fports.c (close_the_fd, fport_close): Arrange to always close
  the fd, even if the flush procedure throws an exception.  Perhaps the
  port machinery should do this for us, though.  Don't wrap the close
  call in SCM_SYSCALL, EINTR leaves the fd in an unspecified state.
  Don't bother freeing buffers, the collector will handle that; simply
  drop references via scm_port_non_buffer.

* libguile/ports.c (do_free, finalize_port): Catch exceptions caused by
  the free procedure.  Don't bother setting the stream to 0 at all.
  (scm_close_port): Ensure that exceptions thrown by the "close"
  procedure don't prevent the port from being marked as closed.

diff --git a/libguile/fports.c b/libguile/fports.c
index 97dadde..bb998e7 100644 (file)
--- a/libguile/fports.c
+++ b/libguile/fports.c
@@ -852,32 +852,38 @@ fport_end_input (SCM port, int offset)
   pt->rw_active = SCM_PORT_NEITHER;
 }
 
+static void
+close_the_fd (void *data)
+{
+  scm_t_fport *fp = data;
+
+  close (fp->fdes);
+  /* There's already one exception.  That's probably enough!  */
+  errno = 0;
+}
+
 static int
 fport_close (SCM port)
 {
   scm_t_fport *fp = SCM_FSTREAM (port);
-  scm_t_port *pt = SCM_PTAB_ENTRY (port);
   int rv;
 
+  scm_dynwind_begin (0);
+  scm_dynwind_unwind_handler (close_the_fd, fp, 0);
   fport_flush (port);
-  SCM_SYSCALL (rv = close (fp->fdes));
-  if (rv == -1 && errno != EBADF)
-    {
-      if (scm_gc_running_p)
-       /* silently ignore the error.  scm_error would abort if we
-          called it now.  */
-       ;
-      else
-       scm_syserror ("fport_close");
-    }
-  if (pt->read_buf == pt->putback_buf)
-    pt->read_buf = pt->saved_read_buf;
-  if (pt->read_buf != &pt->shortbuf)
-    scm_gc_free (pt->read_buf, pt->read_buf_size, "port buffer");
-  if (pt->write_buf != &pt->shortbuf)
-    scm_gc_free (pt->write_buf, pt->write_buf_size, "port buffer");
-  scm_gc_free (fp, sizeof (*fp), "file port");
-  return rv;
+  scm_dynwind_end ();
+
+  scm_port_non_buffer (SCM_PTAB_ENTRY (port));
+
+  rv = close (fp->fdes);
+  if (rv)
+    /* It's not useful to retry after EINTR, as the file descriptor is
+       in an undefined state.  See http://lwn.net/Articles/365294/.
+       Instead just throw an error if close fails, trusting that the fd
+       was cleaned up.  */
+    scm_syserror ("fport_close");
+
+  return 0;
 }
 
 static size_t

diff --git a/libguile/ports.c b/libguile/ports.c
index c1da25e..d3fc453 100644 (file)
--- a/libguile/ports.c
+++ b/libguile/ports.c
@@ -548,6 +548,24 @@ register_finalizer_for_port (SCM port)
                                  &prev_finalization_data);
 }
 
+struct do_free_data
+{
+  scm_t_ptob_descriptor *ptob;
+  SCM port;
+};
+
+static SCM
+do_free (void *body_data)
+{
+  struct do_free_data *data = body_data;
+
+  /* `close' is for explicit `close-port' by user.  `free' is for this
+     purpose: ports collected by the GC.  */
+  data->ptob->free (data->port);
+
+  return SCM_BOOL_T;
+}
+
 /* Finalize the object (a port) pointed to by PTR.  */
 static void
 finalize_port (GC_PTR ptr, GC_PTR data)
@@ -564,16 +582,16 @@ finalize_port (GC_PTR ptr, GC_PTR data)
        register_finalizer_for_port (port);
       else
        {
-          scm_t_ptob_descriptor *ptob = SCM_PORT_DESCRIPTOR (port);
+          struct do_free_data data;
 
-         if (ptob->free)
-           /* Yes, I really do mean `free' rather than `close'.  `close'
-              is for explicit `close-port' by user.  */
-           ptob->free (port);
-
-         SCM_SETSTREAM (port, 0);
          SCM_CLR_PORT_OPEN_FLAG (port);
 
+          data.ptob = SCM_PORT_DESCRIPTOR (port);
+          data.port = port;
+
+          scm_internal_catch (SCM_BOOL_T, do_free, &data,
+                              scm_handle_by_message_noexit, NULL);
+
          scm_gc_ports_collected++;
        }
     }
@@ -726,30 +744,28 @@ SCM_DEFINE (scm_close_port, "close-port", 1, 0, 0,
   SCM_VALIDATE_PORT (1, port);
   if (SCM_CLOSEDP (port))
     return SCM_BOOL_F;
-  if (SCM_PORT_DESCRIPTOR (port)->close)
-    rv = SCM_PORT_DESCRIPTOR (port)->close (port);
-  else
-    rv = 0;
 
   p = SCM_PTAB_ENTRY (port);
-
-  scm_port_non_buffer (p);
-  SCM_SETPTAB_ENTRY (port, 0);
+  SCM_CLR_PORT_OPEN_FLAG (port);
 
   if (SCM_PORT_DESCRIPTOR (port)->flags & SCM_PORT_TYPE_HAS_FLUSH)
     scm_weak_set_remove_x (scm_i_port_weak_set, port);
 
-  p->putback_buf = NULL;
-  p->putback_buf_size = 0;
+  if (SCM_PORT_DESCRIPTOR (port)->close)
+    /* Note!  This may throw an exception.  Anything after this point
+       should be resilient to non-local exits.  */
+    rv = SCM_PORT_DESCRIPTOR (port)->close (port);
+  else
+    rv = 0;
 
   if (p->iconv_descriptors)
     {
+      /* If we don't get here, the iconv_descriptors finalizer will
+         clean up. */
       close_iconv_descriptors (p->iconv_descriptors);
       p->iconv_descriptors = NULL;
     }
 
-  SCM_CLR_PORT_OPEN_FLAG (port);
-
   return scm_from_bool (rv >= 0);
 }
 #undef FUNC_NAME