vhd_format: Switch to sparse interval format for blocks_json

Now that qcow-stream-tool output intervals of allocated clusters, do the same
for vhd-tool. This greatly decreases the filesize and memory usage in vhd-tool.

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

Author: last-genius

ocaml/libs/vhd/vhd_format/f.ml

@@ -2911,16 +2911,35 @@ functor
 
         let include_block = include_block None t in
 
-        let blocks =
+        let blocks, last_block =
           Seq.init max_table_entries Fun.id
-          |> Seq.filter_map (fun i ->
-              if include_block i then
-                Some (`Int i)
-              else
-                None
-          )
-          |> List.of_seq
+          |> Seq.fold_left
+               (fun (acc, left_block) i ->
+                 if include_block i then
+                   match left_block with
+                   | Some _ ->
+                       (acc, left_block)
+                   | None ->
+                       (acc, Some i)
+                 else
+                   match left_block with
+                   | Some x ->
+                       (`List [`Int x; `Int (i - 1)] :: acc, None)
+                   | None ->
+                       (acc, None)
+               )
+               ([], None)
         in
+        (* Close off the interval we were tracking we ran off the end of the seq *)
+        let blocks =
+          match last_block with
+          | Some x ->
+              `List [`Int x; `Int (max_table_entries - 1)] :: blocks
+          | None ->
+              blocks
+        in
+        let blocks = List.rev blocks in
+
         let json =
           `Assoc
             [

ocaml/vhd-tool/cli/main.ml

@@ -387,8 +387,8 @@ let stream_cmd =
 
 let read_headers_cmd =
   let doc =
-    {|Parse VHD headers and output allocated blocks information in JSON format \
-     like: {"virtual_size": X, "cluster_bits": X, "data_clusters": [1,2,3]}|}
+    {|Parse VHD headers and output allocated blocks intervals information in JSON format \
+     like: {"virtual_size": X, "cluster_bits": X, "data_clusters": [[1,13],[17,17],[19,272]]}|}
   in
   let source =
     let doc = Printf.sprintf "Path to the VHD file" in