xapi: Wrap {vhd,qcow}-tool read_header invocation in a thread

This allows it to proceed in parallel with the parse side, not deadlocking on
the filled pipe.

Signed-off-by: Andrii Sultanov <andriy.sultanov@vates.tech>

Author: last-genius

ocaml/xapi/qcow_tool_wrapper.ml

@@ -27,12 +27,18 @@ let read_header qcow_path =
   let pipe_reader, pipe_writer = Unix.pipe ~cloexec:true () in
 
   let progress_cb _ = () in
-  Xapi_stdext_pervasives.Pervasiveext.finally
-    (fun () ->
-      Vhd_qcow_parsing.run_tool qcow_tool progress_cb args
-        ~output_fd:pipe_writer
-    )
-    (fun () -> Unix.close pipe_writer) ;
+  let (_ : Thread.t) =
+    Thread.create
+      (fun () ->
+        Xapi_stdext_pervasives.Pervasiveext.finally
+          (fun () ->
+            Vhd_qcow_parsing.run_tool qcow_tool progress_cb args
+              ~output_fd:pipe_writer
+          )
+          (fun () -> Unix.close pipe_writer)
+      )
+      ()
+  in
   pipe_reader
 
 let parse_header qcow_path =

ocaml/xapi/vhd_tool_wrapper.ml

@@ -122,11 +122,18 @@ let read_vhd_header path =
   let pipe_reader, pipe_writer = Unix.pipe ~cloexec:true () in
 
   let progress_cb _ = () in
-  Xapi_stdext_pervasives.Pervasiveext.finally
-    (fun () ->
-      Vhd_qcow_parsing.run_tool vhd_tool progress_cb args ~output_fd:pipe_writer
-    )
-    (fun () -> Unix.close pipe_writer) ;
+  let (_ : Thread.t) =
+    Thread.create
+      (fun () ->
+        Xapi_stdext_pervasives.Pervasiveext.finally
+          (fun () ->
+            Vhd_qcow_parsing.run_tool vhd_tool progress_cb args
+              ~output_fd:pipe_writer
+          )
+          (fun () -> Unix.close pipe_writer)
+      )
+      ()
+  in
   pipe_reader
 
 let parse_header vhd_path =