Libguestfs - Jun 2023 - [libnbd PATCH v3 17/22] ocaml: Add example for 64-bit extents

Since our example program for 32-bit extents is inherently limited to
32-bit lengths, it is also worth demonstrating the 64-bit extent API,
including the difference in the array indexing being saner.

Signed-off-by: Eric Blake <eblake at redhat.com>
---
 ocaml/examples/Makefile.am  |  1 +
 ocaml/examples/extents64.ml | 42 +++++++++++++++++++++++++++++++++++++
 2 files changed, 43 insertions(+)
 create mode 100644 ocaml/examples/extents64.ml

diff --git a/ocaml/examples/Makefile.am b/ocaml/examples/Makefile.am
index 28b4ab94..a4eb47a5 100644
--- a/ocaml/examples/Makefile.am
+++ b/ocaml/examples/Makefile.am
@@ -20,6 +20,7 @@ include $(top_srcdir)/subdir-rules.mk
 ml_examples = \
 	asynch_copy.ml \
 	extents.ml \
+	extents64.ml \
 	get_size.ml \
 	open_qcow2.ml \
 	server_flags.ml \
diff --git a/ocaml/examples/extents64.ml b/ocaml/examples/extents64.ml
new file mode 100644
index 00000000..8ee7e218
--- /dev/null
+++ b/ocaml/examples/extents64.ml
@@ -0,0 +1,42 @@
+open Printf
+
+let () +  NBD.with_handle (
+    fun nbd ->
+      NBD.add_meta_context nbd "base:allocation";
+      NBD.connect_command nbd
+                          ["nbdkit"; "-s";
"--exit-with-parent"; "-r";
+                           "sparse-random"; "8G"];
+
+      (* Read the extents and print them. *)
+      let size = NBD.get_size nbd in
+      let cap +        match NBD.get_extended_headers_negotiated nbd with
+        | true -> size
+        | false -> 0x8000_0000_L in
+      let fetch_offset = ref 0_L in
+      while !fetch_offset < size do
+        let remaining = Int64.sub size !fetch_offset in
+        let fetch_size = min remaining cap in
+        NBD.block_status_64 nbd fetch_size !fetch_offset (
+          fun meta _ entries err ->
+            printf "nbd_block_status callback: meta=%s err=%d\n" meta
!err;
+            if meta = "base:allocation" then (
+              printf "index\t%16s %16s %s\n" "offset"
"length" "flags";
+              for i = 0 to Array.length entries - 1 do
+                let len = fst entries.(i)
+                and flags +                  match snd entries.(i) with
+                  | 0_L -> "data"
+                  | 1_L -> "hole"
+                  | 2_L -> "zero"
+                  | 3_L -> "hole+zero"
+                  | unknown -> sprintf "unknown (%Ld)" unknown in
+                printf "%d:\t%16Ld %16Ld %s\n" i !fetch_offset len
flags;
+                fetch_offset := Int64.add !fetch_offset len
+              done;
+            );
+            0
+        ) (* NBD.block_status *)
+      done
+  )
-- 
2.40.1

On Thu, May 25, 2023 at 08:01:03AM -0500, Eric Blake
wrote:
> Since our example program for 32-bit extents is inherently limited to
> 32-bit lengths, it is also worth demonstrating the 64-bit extent API,
> including the difference in the array indexing being saner.
> 
> Signed-off-by: Eric Blake <eblake at redhat.com>
> ---
>  ocaml/examples/Makefile.am  |  1 +
>  ocaml/examples/extents64.ml | 42 +++++++++++++++++++++++++++++++++++++
>  2 files changed, 43 insertions(+)
>  create mode 100644 ocaml/examples/extents64.ml
> 
> diff --git a/ocaml/examples/Makefile.am b/ocaml/examples/Makefile.am
> index 28b4ab94..a4eb47a5 100644
> --- a/ocaml/examples/Makefile.am
> +++ b/ocaml/examples/Makefile.am
> @@ -20,6 +20,7 @@ include $(top_srcdir)/subdir-rules.mk
>  ml_examples = \
>  	asynch_copy.ml \
>  	extents.ml \
> +	extents64.ml \
>  	get_size.ml \
>  	open_qcow2.ml \
>  	server_flags.ml \
> diff --git a/ocaml/examples/extents64.ml b/ocaml/examples/extents64.ml
> new file mode 100644
> index 00000000..8ee7e218
> --- /dev/null
> +++ b/ocaml/examples/extents64.ml
> @@ -0,0 +1,42 @@
> +open Printf
> +
> +let () > +  NBD.with_handle (
> +    fun nbd ->
> +      NBD.add_meta_context nbd "base:allocation";
> +      NBD.connect_command nbd
> +                          ["nbdkit"; "-s";
"--exit-with-parent"; "-r";
> +                           "sparse-random"; "8G"];
> +
> +      (* Read the extents and print them. *)
> +      let size = NBD.get_size nbd in
> +      let cap > +        match NBD.get_extended_headers_negotiated nbd
with
> +        | true -> size
> +        | false -> 0x8000_0000_L in
> +      let fetch_offset = ref 0_L in
> +      while !fetch_offset < size do
> +        let remaining = Int64.sub size !fetch_offset in
> +        let fetch_size = min remaining cap in
> +        NBD.block_status_64 nbd fetch_size !fetch_offset (
> +          fun meta _ entries err ->
> +            printf "nbd_block_status callback: meta=%s err=%d\n"
meta !err;
> +            if meta = "base:allocation" then (
> +              printf "index\t%16s %16s %s\n" "offset"
"length" "flags";
> +              for i = 0 to Array.length entries - 1 do
> +                let len = fst entries.(i)
> +                and flags > +                  match snd entries.(i)
with
> +                  | 0_L -> "data"
> +                  | 1_L -> "hole"
> +                  | 2_L -> "zero"
> +                  | 3_L -> "hole+zero"
> +                  | unknown -> sprintf "unknown (%Ld)"
unknown in
> +                printf "%d:\t%16Ld %16Ld %s\n" i !fetch_offset
len flags;
> +                fetch_offset := Int64.add !fetch_offset len
> +              done;
> +            );
> +            0
> +        ) (* NBD.block_status *)
> +      done
> +  )
Yes, the API is nicer now we return the subelements as a list instead
of having to iterate over the list in pairs.  I might change that to
an array or struct after these patches go upstream as that will be a
tiny bit more efficient.

Reviewed-by: Richard W.M. Jones <rjones at redhat.com>

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming and virtualization blog: http://rwmj.wordpress.com
virt-top is 'top' for virtual machines.  Tiny program with many
powerful monitoring features, net stats, disk stats, logging, etc.
http://people.redhat.com/~rjones/virt-top