From 26d69e842845e6dd09198e265528c5ba56fb2b7d Mon Sep 17 00:00:00 2001
From: ArthurW <arthur@tarides.com>
Date: Mon, 13 Jan 2025 16:19:48 +0100
Subject: [PATCH] Fix fd leak: keep latest in_channel open for granular_marshal

---
 src/index-format/granular_marshal.ml | 24 ++++++++++++++++++++++--
 1 file changed, 22 insertions(+), 2 deletions(-)

diff --git a/src/index-format/granular_marshal.ml b/src/index-format/granular_marshal.ml
index b6645649b..6c79f9959 100644
--- a/src/index-format/granular_marshal.ml
+++ b/src/index-format/granular_marshal.ml
@@ -38,10 +38,30 @@ let read_loc store fd loc schema =
   schema iter v;
   v
 
-let fetch_loc store loc schema =
+let last_open_store = ref None
+
+let () =
+  at_exit (fun () ->
+      match !last_open_store with
+      | None -> ()
+      | Some (_, fd) -> close_in fd)
+
+let force_open_store store =
   let fd = open_in store in
+  last_open_store := Some (store, fd);
+  fd
+
+let open_store store =
+  match !last_open_store with
+  | Some (store', fd) when store = store' -> fd
+  | Some (_, fd) ->
+    close_in fd;
+    force_open_store store
+  | None -> force_open_store store
+
+let fetch_loc store loc schema =
+  let fd = open_store store in
   let v = read_loc store fd loc schema in
-  close_in fd;
   v
 
 let rec fetch lnk =