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

Rather than play with refcounts as in commits 796c796 and 43ed007, this commit adds a flag CHANNEL_FLAG_MANAGED_BY_GC that governs whether the 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.

1 files changed, 7 insertions, 2 deletions

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)