MPR#7609: use-after-free with ocamldebug and Pervasives.flush_all (#1361)

MPR#7609: use-after-free with ocamldebug and Pervasives.flush_all

This commit makes sure that the "dbg_out" channel used to send data from the debugged program back to ocamldebug cannot be freed early by finalization.

The full scenario for the memory corruption:

- Debugged program starts, opens an out channel "dbg_out" to send data to ocamldebug via the debugging socket.
- Channel is created by caml_open_descriptor_in with refcount = 0 and is inserted in the doubly-linked list caml_all_opened_channels.
- Later, debugged program calls Pervasives.flush_all, which calls caml_ml_out_channels_list.
- caml_ml_out_channels_list wraps dbg_out in a Caml custom object of type "out_channel".  dbg_out->refcount is increased to 1.
- Later, a GC finalizes this Caml custom object.  dbg_out->refcount is decreased to 0 and the dbg_out structure is freed via caml_stat_free().
- Subsequent interactions with ocamldebug access the now-freed dbg_out structure.  Disaster ensues.

The fix:

- Introduce a flag CHANNEL_FLAG_MANAGED_BY_GC that governs whether a struct channel can be destroyed by GC finalization.
- Internal channels opened by the runtime system for its own purposes do not have this flag and will never be finalized, even if they end up in the Caml heap as a consequence of Pervasives.flush_all.

3 files changed, 13 insertions, 3 deletions

diff --git a/Changes b/Changes
index 26961aedee..41b91ccc7c 100644
--- a/Changes
+++ b/Changes
@@ -555,6 +555,10 @@ Release branch for 4.06:
 - MPR#7591, GPR#1257: on x86-64, frame table is not 8-aligned
   (Xavier Leroy, report by Mantis user "voglerr", review by Gabriel Scherer)
 
+- MPR#7609: use-after-free memory corruption if a program debugged
+  under ocamldebug calls Pervasives.flush_all
+  (Xavier Leroy, report by Paul Steckler, review by Gabriel Scherer)
+
 - GPR#1155: Fix a race condition with WAIT_NOHANG on Windows
   (Jérémie Dimino and David Allsopp)
 
diff --git a/byterun/caml/io.h b/byterun/caml/io.h
index f388bd9fb4..87de679e53 100644
--- a/byterun/caml/io.h
+++ b/byterun/caml/io.h
@@ -55,8 +55,9 @@ struct channel {
 enum {
   CHANNEL_FLAG_FROM_SOCKET = 1,  /* For Windows */
 #if defined(NATIVE_CODE) && defined(WITH_SPACETIME)
-  CHANNEL_FLAG_BLOCKING_WRITE = 2,
+  CHANNEL_FLAG_BLOCKING_WRITE = 2, /* Don't release master lock when writing */
 #endif
+  CHANNEL_FLAG_MANAGED_BY_GC = 4,  /* Free and close using GC finalization */
 };
 
 /* For an output channel:
diff --git a/byterun/io.c b/byterun/io.c
index 2cd6816516..3d9560198a 100644
--- a/byterun/io.c
+++ b/byterun/io.c
@@ -394,6 +394,7 @@ CAMLexport intnat caml_input_scan_line(struct channel *channel)
 CAMLexport void caml_finalize_channel(value vchan)
 {
   struct channel * chan = Channel(vchan);
+  if ((chan->flags & CHANNEL_FLAG_MANAGED_BY_GC) == 0) return;
   if (--chan->refcount > 0) return;
   if (caml_channel_mutex_free != NULL) (*caml_channel_mutex_free)(chan);
 
@@ -461,12 +462,16 @@ CAMLexport value caml_alloc_channel(struct channel *chan)
 
 CAMLprim value caml_ml_open_descriptor_in(value fd)
 {
-  return caml_alloc_channel(caml_open_descriptor_in(Int_val(fd)));
+  struct channel * chan = caml_open_descriptor_in(Int_val(fd));
+  chan->flags |= CHANNEL_FLAG_MANAGED_BY_GC;
+  return caml_alloc_channel(chan);
 }
 
 CAMLprim value caml_ml_open_descriptor_out(value fd)
 {
-  return caml_alloc_channel(caml_open_descriptor_out(Int_val(fd)));
+  struct channel * chan = caml_open_descriptor_out(Int_val(fd));
+  chan->flags |= CHANNEL_FLAG_MANAGED_BY_GC;
+  return caml_alloc_channel(chan);
 }
 
 CAMLprim value caml_ml_set_channel_name(value vchannel, value vname)