From f978789dc45e9339ef2c6a4248984d54714043a7 Mon Sep 17 00:00:00 2001 From: Jon Ludlam Date: Thu, 9 Aug 2018 12:51:52 +0100 Subject: [PATCH] XSI-19 locate VHD footer based on file size I order to locate the footer in a VHD file or stream, the total length of that file or stream must be known. This commit passes it when it is known. This depends on a corresponding change in the ocaml-vhd library. Signed-off-by: Christian Lindig --- cli/get_vhd_vsize.ml | 19 +++++++++++-------- src/impl.ml | 5 +++-- 2 files changed, 14 insertions(+), 10 deletions(-) diff --git a/cli/get_vhd_vsize.ml b/cli/get_vhd_vsize.ml index 66e1824..f515e6f 100644 --- a/cli/get_vhd_vsize.ml +++ b/cli/get_vhd_vsize.ml @@ -14,16 +14,19 @@ let get_vhd_vsize filename = | End -> return () | Cons (hd, tl) -> begin match hd with - | Fragment.Footer x -> - let size = x.Footer.current_size in - Printf.printf "%Ld\n" size; - exit 0 - | _ -> - () + | Fragment.Footer x -> + let size = x.Footer.current_size in + Printf.printf "%Ld\n" size; + exit 0 + | _ -> + () end; tl () >>= fun x -> - loop x in - openstream (Input.of_fd (Vhd_format_lwt.IO.to_file_descr fd)) >>= fun stream -> + loop x + in + Vhd_format_lwt.IO.get_file_size filename >>= fun file_size -> + openstream (Some file_size) + (Input.of_fd (Vhd_format_lwt.IO.to_file_descr fd)) >>= fun stream -> loop stream >>= fun () -> Vhd_format_lwt.IO.close fd let _ = diff --git a/src/impl.ml b/src/impl.ml index 981ccf6..56939f3 100644 --- a/src/impl.ml +++ b/src/impl.ml @@ -108,7 +108,8 @@ let contents common filename = end; tl () >>= fun x -> loop x in - openstream (Input.of_fd (Vhd_format_lwt.IO.to_file_descr fd)) >>= fun stream -> + Vhd_format_lwt.IO.get_file_size filename >>= fun size -> + openstream (Some size) (Input.of_fd (Vhd_format_lwt.IO.to_file_descr fd)) >>= fun stream -> loop stream in Lwt_main.run t; `Ok () @@ -481,7 +482,7 @@ let serve_vhd_to_raw total_size c dest prezeroed progress _ _ = (match !p with Some p -> p blocks_seen | None -> ()); tl () >>= loop block_size_sectors_shift this_block blocks_seen | Cons (_, tl) -> tl () >>= loop block_size_sectors_shift last_block blocks_seen in - openstream c >>= fun stream -> + openstream (Some total_size) c >>= fun stream -> loop 0 (-1L) 0L stream let serve_tar_to_raw total_size c dest prezeroed progress expected_prefix ignore_checksums =