From ac5bb81af3cbf9149a722c1d48961108f3bd7cc0 Mon Sep 17 00:00:00 2001 From: Christian Lindig Date: Wed, 28 Feb 2024 09:29:13 +0000 Subject: [PATCH] Add patch for XSI-1457 to ocaml-vhd Signed-off-by: Christian Lindig --- ...-Limit-number-of-sectors-to-coalesce.patch | 99 +++++++++++++++++++ packages/upstream/vhd-format-lwt.0.12.0/opam | 3 + ...-Limit-number-of-sectors-to-coalesce.patch | 99 +++++++++++++++++++ packages/upstream/vhd-format.0.12.0/opam | 3 + 4 files changed, 204 insertions(+) create mode 100644 packages/upstream/vhd-format-lwt.0.12.0/files/0001-XSI-1457-Limit-number-of-sectors-to-coalesce.patch create mode 100644 packages/upstream/vhd-format.0.12.0/files/0001-XSI-1457-Limit-number-of-sectors-to-coalesce.patch diff --git a/packages/upstream/vhd-format-lwt.0.12.0/files/0001-XSI-1457-Limit-number-of-sectors-to-coalesce.patch b/packages/upstream/vhd-format-lwt.0.12.0/files/0001-XSI-1457-Limit-number-of-sectors-to-coalesce.patch new file mode 100644 index 000000000..d4eec20b4 --- /dev/null +++ b/packages/upstream/vhd-format-lwt.0.12.0/files/0001-XSI-1457-Limit-number-of-sectors-to-coalesce.patch @@ -0,0 +1,99 @@ +From e2de1b257ecad00173672411870695f7b362b2fe Mon Sep 17 00:00:00 2001 +From: Christian Lindig +Date: Tue, 27 Feb 2024 15:19:07 +0000 +Subject: [PATCH 1/1] XSI-1457: Limit number of sectors to coalesce + +We limit the number of sectors to coalesce when generating a list of +elements to be copied. The limit is currently set to 4 MiB. This allows +the progress bar to be displayed at a finer granularity rather than +going from 0 to 100 in one go due to one big sector being generated. + +Backport of xen-api.git db4d465f16745892b4d4ff37d44f8dbd72182314 + +Signed-off-by: Vincent Liu +Signed-off-by: Christian Lindig +--- + vhd_format/f.ml | 58 +++++++++++++++++++++++++++++++++++-------------- + 1 file changed, 42 insertions(+), 16 deletions(-) + +diff --git a/vhd_format/f.ml b/vhd_format/f.ml +index de1d521..e6f953f 100644 +--- a/vhd_format/f.ml ++++ b/vhd_format/f.ml +@@ -18,6 +18,14 @@ + let sector_size = 512 + let sector_shift = 9 + ++let mib n = ++ let ( ** ) = Int64.mul in ++ Int64.(1024L ** 1024L ** of_int n) ++ ++(** This is defined to be the same as sync_limit in channels.ml due to circular ++ dependencies. *) ++let sync_limit = mib 4 ++ + exception Cstruct_differ + + let cstruct_equal a b = +@@ -2000,24 +2008,42 @@ module From_file = functor(F: S.FILE) -> struct + | false, Some parent -> in_any_bat parent i + | false, None -> false + +- let rec coalesce_request acc s = ++ (* The coalesced_sectors variable accumulates the number of bytes that have ++ been coalesced so far. It is made optional because we only use it when we ++ continuously match with one pattern, i.e. the pattern where we coalesce ++ consecutive sectors, and default it to 1 when we are not coalescing. *) ++ let rec coalesce_request ?(coalesced_sectors = 1L) acc s = + let open Int64 in +- s >>= fun next -> match next, acc with ++ s >>= fun next -> ++ match (next, acc) with + | End, None -> return End +- | End, Some x -> return (Cons(x, fun () -> return End)) +- | Cons(`Sectors s, next), None -> return(Cons(`Sectors s, fun () -> coalesce_request None (next ()))) +- | Cons(`Sectors _, _next), Some x -> return(Cons(x, fun () -> coalesce_request None s)) +- | Cons(`Empty n, next), None -> coalesce_request (Some(`Empty n)) (next ()) +- | Cons(`Empty n, next), Some(`Empty m) -> coalesce_request (Some(`Empty (n ++ m))) (next ()) +- | Cons(`Empty _n, _next), Some x -> return (Cons(x, fun () -> coalesce_request None s)) +- | Cons(`Copy(h, ofs, len), next), None -> coalesce_request (Some (`Copy(h, ofs, len))) (next ()) +- | Cons(`Copy(h, ofs, len), next), Some(`Copy(h', ofs', len')) -> +- if ofs ++ len = ofs' && h == h' +- then coalesce_request (Some(`Copy(h, ofs, len ++ len'))) (next ()) +- else if ofs' ++ len' = ofs && h == h' +- then coalesce_request (Some(`Copy(h, ofs', len ++ len'))) (next ()) +- else return (Cons(`Copy(h', ofs', len'), fun () -> coalesce_request None s)) +- | Cons(`Copy(_h, _ofs, _len), _next), Some x -> return(Cons(x, fun () -> coalesce_request None s)) ++ | End, Some x -> return (Cons (x, fun () -> return End)) ++ | Cons (`Sectors s, next), None -> ++ return (Cons (`Sectors s, fun () -> coalesce_request None (next ()))) ++ | Cons (`Sectors _, _next), Some x -> ++ return (Cons (x, fun () -> coalesce_request None s)) ++ | Cons (`Empty n, next), None -> coalesce_request (Some (`Empty n)) (next ()) ++ | Cons (`Empty n, next), Some (`Empty m) -> ++ coalesce_request (Some (`Empty (n ++ m))) (next ()) ++ | Cons (`Empty _n, _next), Some x -> ++ return (Cons (x, fun () -> coalesce_request None s)) ++ | Cons (`Copy (h, ofs, len), next), None -> ++ coalesce_request (Some (`Copy (h, ofs, len))) (next ()) ++ | Cons (`Copy (h, ofs, len), next), Some (`Copy (h', ofs', len')) ++ when coalesced_sectors ** Int64.of_int sector_size <= sync_limit -> ++ if ofs ++ len = ofs' && h == h' then ++ coalesce_request ~coalesced_sectors:(coalesced_sectors ++ 1L) ++ (Some (`Copy (h, ofs, len ++ len'))) ++ (next ()) ++ else if ofs' ++ len' = ofs && h == h' then ++ coalesce_request ~coalesced_sectors:(coalesced_sectors ++ 1L) ++ (Some (`Copy (h, ofs', len ++ len'))) ++ (next ()) ++ else ++ return ++ (Cons (`Copy (h', ofs', len'), fun () -> coalesce_request None s)) ++ | Cons (`Copy (_h, _ofs, _len), _next), Some x -> ++ return (Cons (x, fun () -> coalesce_request None s)) + + let twomib_bytes = 2 * 1024 * 1024 + let twomib_sectors = twomib_bytes / 512 +-- +2.34.1 + diff --git a/packages/upstream/vhd-format-lwt.0.12.0/opam b/packages/upstream/vhd-format-lwt.0.12.0/opam index 074494b8a..ace1bed94 100644 --- a/packages/upstream/vhd-format-lwt.0.12.0/opam +++ b/packages/upstream/vhd-format-lwt.0.12.0/opam @@ -29,6 +29,9 @@ depends: [ "dune" {>= "1.0"} ] available: os = "linux" | os = "macos" +patches: [ + "0001-XSI-1457-Limit-number-of-sectors-to-coalesce.patch" +] build: [ ["dune" "build" "-p" name "-j" jobs] ["dune" "runtest" "-p" name "-j" jobs] {with-test} diff --git a/packages/upstream/vhd-format.0.12.0/files/0001-XSI-1457-Limit-number-of-sectors-to-coalesce.patch b/packages/upstream/vhd-format.0.12.0/files/0001-XSI-1457-Limit-number-of-sectors-to-coalesce.patch new file mode 100644 index 000000000..d4eec20b4 --- /dev/null +++ b/packages/upstream/vhd-format.0.12.0/files/0001-XSI-1457-Limit-number-of-sectors-to-coalesce.patch @@ -0,0 +1,99 @@ +From e2de1b257ecad00173672411870695f7b362b2fe Mon Sep 17 00:00:00 2001 +From: Christian Lindig +Date: Tue, 27 Feb 2024 15:19:07 +0000 +Subject: [PATCH 1/1] XSI-1457: Limit number of sectors to coalesce + +We limit the number of sectors to coalesce when generating a list of +elements to be copied. The limit is currently set to 4 MiB. This allows +the progress bar to be displayed at a finer granularity rather than +going from 0 to 100 in one go due to one big sector being generated. + +Backport of xen-api.git db4d465f16745892b4d4ff37d44f8dbd72182314 + +Signed-off-by: Vincent Liu +Signed-off-by: Christian Lindig +--- + vhd_format/f.ml | 58 +++++++++++++++++++++++++++++++++++-------------- + 1 file changed, 42 insertions(+), 16 deletions(-) + +diff --git a/vhd_format/f.ml b/vhd_format/f.ml +index de1d521..e6f953f 100644 +--- a/vhd_format/f.ml ++++ b/vhd_format/f.ml +@@ -18,6 +18,14 @@ + let sector_size = 512 + let sector_shift = 9 + ++let mib n = ++ let ( ** ) = Int64.mul in ++ Int64.(1024L ** 1024L ** of_int n) ++ ++(** This is defined to be the same as sync_limit in channels.ml due to circular ++ dependencies. *) ++let sync_limit = mib 4 ++ + exception Cstruct_differ + + let cstruct_equal a b = +@@ -2000,24 +2008,42 @@ module From_file = functor(F: S.FILE) -> struct + | false, Some parent -> in_any_bat parent i + | false, None -> false + +- let rec coalesce_request acc s = ++ (* The coalesced_sectors variable accumulates the number of bytes that have ++ been coalesced so far. It is made optional because we only use it when we ++ continuously match with one pattern, i.e. the pattern where we coalesce ++ consecutive sectors, and default it to 1 when we are not coalescing. *) ++ let rec coalesce_request ?(coalesced_sectors = 1L) acc s = + let open Int64 in +- s >>= fun next -> match next, acc with ++ s >>= fun next -> ++ match (next, acc) with + | End, None -> return End +- | End, Some x -> return (Cons(x, fun () -> return End)) +- | Cons(`Sectors s, next), None -> return(Cons(`Sectors s, fun () -> coalesce_request None (next ()))) +- | Cons(`Sectors _, _next), Some x -> return(Cons(x, fun () -> coalesce_request None s)) +- | Cons(`Empty n, next), None -> coalesce_request (Some(`Empty n)) (next ()) +- | Cons(`Empty n, next), Some(`Empty m) -> coalesce_request (Some(`Empty (n ++ m))) (next ()) +- | Cons(`Empty _n, _next), Some x -> return (Cons(x, fun () -> coalesce_request None s)) +- | Cons(`Copy(h, ofs, len), next), None -> coalesce_request (Some (`Copy(h, ofs, len))) (next ()) +- | Cons(`Copy(h, ofs, len), next), Some(`Copy(h', ofs', len')) -> +- if ofs ++ len = ofs' && h == h' +- then coalesce_request (Some(`Copy(h, ofs, len ++ len'))) (next ()) +- else if ofs' ++ len' = ofs && h == h' +- then coalesce_request (Some(`Copy(h, ofs', len ++ len'))) (next ()) +- else return (Cons(`Copy(h', ofs', len'), fun () -> coalesce_request None s)) +- | Cons(`Copy(_h, _ofs, _len), _next), Some x -> return(Cons(x, fun () -> coalesce_request None s)) ++ | End, Some x -> return (Cons (x, fun () -> return End)) ++ | Cons (`Sectors s, next), None -> ++ return (Cons (`Sectors s, fun () -> coalesce_request None (next ()))) ++ | Cons (`Sectors _, _next), Some x -> ++ return (Cons (x, fun () -> coalesce_request None s)) ++ | Cons (`Empty n, next), None -> coalesce_request (Some (`Empty n)) (next ()) ++ | Cons (`Empty n, next), Some (`Empty m) -> ++ coalesce_request (Some (`Empty (n ++ m))) (next ()) ++ | Cons (`Empty _n, _next), Some x -> ++ return (Cons (x, fun () -> coalesce_request None s)) ++ | Cons (`Copy (h, ofs, len), next), None -> ++ coalesce_request (Some (`Copy (h, ofs, len))) (next ()) ++ | Cons (`Copy (h, ofs, len), next), Some (`Copy (h', ofs', len')) ++ when coalesced_sectors ** Int64.of_int sector_size <= sync_limit -> ++ if ofs ++ len = ofs' && h == h' then ++ coalesce_request ~coalesced_sectors:(coalesced_sectors ++ 1L) ++ (Some (`Copy (h, ofs, len ++ len'))) ++ (next ()) ++ else if ofs' ++ len' = ofs && h == h' then ++ coalesce_request ~coalesced_sectors:(coalesced_sectors ++ 1L) ++ (Some (`Copy (h, ofs', len ++ len'))) ++ (next ()) ++ else ++ return ++ (Cons (`Copy (h', ofs', len'), fun () -> coalesce_request None s)) ++ | Cons (`Copy (_h, _ofs, _len), _next), Some x -> ++ return (Cons (x, fun () -> coalesce_request None s)) + + let twomib_bytes = 2 * 1024 * 1024 + let twomib_sectors = twomib_bytes / 512 +-- +2.34.1 + diff --git a/packages/upstream/vhd-format.0.12.0/opam b/packages/upstream/vhd-format.0.12.0/opam index 5bbb6a3e0..c50f23246 100644 --- a/packages/upstream/vhd-format.0.12.0/opam +++ b/packages/upstream/vhd-format.0.12.0/opam @@ -28,6 +28,9 @@ available: os = "linux" | os = "macos" build: ["dune" "build" "-p" name "-j" jobs] depexts: ["linux-headers"] {os-distribution = "alpine"} dev-repo: "git+https://github.com/mirage/ocaml-vhd.git" +patches: [ + "0001-XSI-1457-Limit-number-of-sectors-to-coalesce.patch" +] url { src: "https://github.com/mirage/ocaml-vhd/releases/download/v0.12.0/vhd-format-v0.12.0.tbz"