Richard W.M. Jones
2021-Dec-11 13:41 UTC
[Libguestfs] [PATCH libnbd 1/2] ocaml/examples: Fix extents example
Laszlo Ersek noted that the original example we had did not work properly if the size of the disk was larger than around 2G. The nbd_block_status API is really difficult to use correctly! In particular it is not guaranteed that the server will return extents covering the size requested. It's also not guaranteed that a bad server will return any base:allocation extents at all (although such a server would not be conforming - the protocol says that servers must always make forward progress). This commit attempts a fix, although it is not complete especially if the server is badly behaved. It also makes the output look a bit better by aligning the columns. Also we use nbdkit-sparse-random- plugin with a larger size to test the > 2G case. --- ocaml/examples/extents.ml | 53 ++++++++++++++++++++------------------- 1 file changed, 27 insertions(+), 26 deletions(-) diff --git a/ocaml/examples/extents.ml b/ocaml/examples/extents.ml index 6fa70e087..e4422b270 100644 --- a/ocaml/examples/extents.ml +++ b/ocaml/examples/extents.ml @@ -4,32 +4,33 @@ let () let nbd = NBD.create () in NBD.add_meta_context nbd "base:allocation"; NBD.connect_command nbd - ["nbdkit"; "-s"; "--exit-with-parent"; "memory"; "size=128K"]; - - (* Write some sectors. *) - let data_sector = Bytes.make 512 'a' in - let zero_sector = Bytes.make 512 '\000' in - NBD.pwrite nbd data_sector 0_L; - NBD.pwrite nbd zero_sector 32768_L; - NBD.pwrite nbd data_sector 65536_L; + ["nbdkit"; "-s"; "--exit-with-parent"; "-r"; + "sparse-random"; "8G"]; (* Read the extents and print them. *) let size = NBD.get_size nbd in - NBD.block_status nbd size 0_L ( - fun meta _ entries err -> - printf "err=%d\n" !err; - if meta = "base:allocation" then ( - printf "index\tlength\tflags\n"; - for i = 0 to Array.length entries / 2 - 1 do - let flags - match entries.(i*2+1) with - | 0_l -> "data" - | 1_l -> "hole" - | 2_l -> "zero" - | 3_l -> "hole+zero" - | i -> sprintf "unknown (%ld)" i in - printf "%d:\t%ld\t%s\n" i entries.(i*2) flags - done - ); - 0 - ) + 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 0x8000_0000_L in + NBD.block_status 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%-20s %-20s %s\n" "offset" "length" "flags"; + for i = 0 to Array.length entries / 2 - 1 do + let len = Int64.of_int32 entries.(i*2) + and flags + match entries.(i*2+1) with + | 0_l -> "data" + | 1_l -> "hole" + | 2_l -> "zero" + | 3_l -> "hole+zero" + | i -> sprintf "unknown (%ld)" i in + printf "%d:\t%-20Ld %-20Ld %s\n" i !fetch_offset len flags; + fetch_offset := Int64.add !fetch_offset len + done; + ); + 0 + ) (* NBD.block_status *) + done -- 2.32.0
Richard W.M. Jones
2021-Dec-11 13:41 UTC
[Libguestfs] [PATCH libnbd 2/2] ocaml: Add NBD.with_handle utility function
NBD.with_handle (fun nbd -> ...)
calls the inner function with a newly created handle, and ensures that
NBD.close is always called even if the inner function throws an
exception.
This is inspired by Laszlo Ersek's similar function added to virt-v2v
lib/utils.ml in the commit below. Unlike that, this does not abstract
the connection and does not call NBD.shutdown.
https://github.com/libguestfs/virt-v2v/commit/b4a8ccf00f1364d703c6d5cf1fd77850105fdd65
I adjusted one example and a few of the tests to use this function.
It is not really necessary to use it, so having a mix of both styles
seems reasonable.
---
generator/OCaml.ml | 15 +++++
ocaml/examples/extents.ml | 66 ++++++++++----------
ocaml/libnbd-ocaml.pod | 15 +++++
ocaml/tests/Makefile.am | 3 +
ocaml/tests/test_105_with_handle.ml | 37 ++++++++++++
ocaml/tests/test_110_defaults.ml | 28 +++++----
ocaml/tests/test_120_set_non_defaults.ml | 76 ++++++++++++------------
ocaml/tests/test_200_connect_command.ml | 9 ++-
ocaml/tests/test_400_pread.ml | 16 +++--
9 files changed, 174 insertions(+), 91 deletions(-)
diff --git a/generator/OCaml.ml b/generator/OCaml.ml
index 1349609bd..4e901648a 100644
--- a/generator/OCaml.ml
+++ b/generator/OCaml.ml
@@ -225,6 +225,17 @@ val close : t -> unit
immediately.
*)
+val with_handle : (t -> 'a) -> 'a
+(** Wrapper around {!create}. It calls the function parameter with a
+ newly created handle, and ensures that {!close} is always called
+ even if the function throws an exception.
+
+ Use this when it is essential that the handle is closed in order
+ to free up external resources in a timely manner; for example if
+ running the server as a subprocess and you want to ensure that the
+ subprocess is always killed; or if you need to disconnect from the
+ server before continuing with another operation. *)
+
";
List.iter (
@@ -315,6 +326,10 @@ type t
external create : unit -> t = \"nbd_internal_ocaml_nbd_create\"
external close : t -> unit = \"nbd_internal_ocaml_nbd_close\"
+let with_handle f + let nbd = create () in
+ try let r = f nbd in close nbd; r with exn -> close nbd; raise exn
+
";
List.iter (
diff --git a/ocaml/examples/extents.ml b/ocaml/examples/extents.ml
index e4422b270..58b4d56cb 100644
--- a/ocaml/examples/extents.ml
+++ b/ocaml/examples/extents.ml
@@ -1,36 +1,38 @@
open Printf
let () - let nbd = NBD.create () in
- NBD.add_meta_context nbd "base:allocation";
- NBD.connect_command nbd
- ["nbdkit"; "-s";
"--exit-with-parent"; "-r";
- "sparse-random"; "8G"];
+ 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 fetch_offset = ref 0_L in
- while !fetch_offset < size do
- let remaining = Int64.sub size !fetch_offset in
- let fetch_size = min remaining 0x8000_0000_L in
- NBD.block_status 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%-20s %-20s %s\n" "offset"
"length" "flags";
- for i = 0 to Array.length entries / 2 - 1 do
- let len = Int64.of_int32 entries.(i*2)
- and flags - match entries.(i*2+1) with
- | 0_l -> "data"
- | 1_l -> "hole"
- | 2_l -> "zero"
- | 3_l -> "hole+zero"
- | i -> sprintf "unknown (%ld)" i in
- printf "%d:\t%-20Ld %-20Ld %s\n" i !fetch_offset len
flags;
- fetch_offset := Int64.add !fetch_offset len
- done;
- );
- 0
- ) (* NBD.block_status *)
- done
+ (* Read the extents and print them. *)
+ let size = NBD.get_size nbd 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 0x8000_0000_L in
+ NBD.block_status 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%-20s %-20s %s\n" "offset"
"length" "flags";
+ for i = 0 to Array.length entries / 2 - 1 do
+ let len = Int64.of_int32 entries.(i*2)
+ and flags + match entries.(i*2+1) with
+ | 0_l -> "data"
+ | 1_l -> "hole"
+ | 2_l -> "zero"
+ | 3_l -> "hole+zero"
+ | i -> sprintf "unknown (%ld)" i in
+ printf "%d:\t%-20Ld %-20Ld %s\n" i !fetch_offset len
flags;
+ fetch_offset := Int64.add !fetch_offset len
+ done;
+ );
+ 0
+ ) (* NBD.block_status *)
+ done
+ )
diff --git a/ocaml/libnbd-ocaml.pod b/ocaml/libnbd-ocaml.pod
index 19825805b..ebcce37cf 100644
--- a/ocaml/libnbd-ocaml.pod
+++ b/ocaml/libnbd-ocaml.pod
@@ -7,6 +7,18 @@ libnbd-ocaml - how to use libnbd from OCaml
let nbd = NBD.create () in
NBD.connect_uri nbd "nbd://localhost";
let size = NBD.get_size nbd in
+ printf "%Ld\n" size;
+ NBD.close ()
+
+Alternate syntax which ensures that close is called even if an
+exception is thrown:
+
+ let size + NBD.with_handle (
+ fun nbd ->
+ NBD.connect_uri nbd "nbd://localhost";
+ NBD.get_size nbd
+ ) in
printf "%Ld\n" size
To compile:
@@ -36,6 +48,9 @@ it will be closed automatically when it is garbage collected.
If you
call any other method on a handle which you have explicitly closed
then the API will throw an C<NBD.Closed> exception.
+C<NBD.with_handle> can be used to make sure the handle is closed in a
+timely manner. See the example in the L</SYNOPSIS> above.
+
=head1 ERRORS
Libnbd errors are turned automatically into S<C<NBD.Error (str,
errno)>>
diff --git a/ocaml/tests/Makefile.am b/ocaml/tests/Makefile.am
index 6fac8b7c4..b89e807cc 100644
--- a/ocaml/tests/Makefile.am
+++ b/ocaml/tests/Makefile.am
@@ -22,6 +22,7 @@ CLEANFILES += *.annot *.cmi *.cmo *.cmx *.o *.a *.so *.bc
*.opt
EXTRA_DIST = \
test_010_import.ml \
test_100_handle.ml \
+ test_105_with_handle.ml \
test_110_defaults.ml \
test_120_set_non_defaults.ml \
test_130_private_data.ml \
@@ -49,6 +50,7 @@ if HAVE_NBDKIT
tests_bc = \
test_010_import.bc \
test_100_handle.bc \
+ test_105_with_handle.bc \
test_110_defaults.bc \
test_120_set_non_defaults.bc \
test_130_private_data.bc \
@@ -73,6 +75,7 @@ tests_bc = \
tests_opt = \
test_010_import.opt \
test_100_handle.opt \
+ test_105_with_handle.opt \
test_110_defaults.opt \
test_120_set_non_defaults.opt \
test_130_private_data.opt \
diff --git a/ocaml/tests/test_105_with_handle.ml
b/ocaml/tests/test_105_with_handle.ml
new file mode 100644
index 000000000..6957c0a71
--- /dev/null
+++ b/ocaml/tests/test_105_with_handle.ml
@@ -0,0 +1,37 @@
+(* hey emacs, this is OCaml code: -*- tuareg -*- *)
+(* libnbd OCaml test case
+ * Copyright (C) 2013-2021 Red Hat Inc.
+ *
+ * This library is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU Lesser General Public
+ * License as published by the Free Software Foundation; either
+ * version 2 of the License, or (at your option) any later version.
+ *
+ * This library is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
+ * Lesser General Public License for more details.
+ *
+ * You should have received a copy of the GNU Lesser General Public
+ * License along with this library; if not, write to the Free Software
+ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
+ *)
+
+exception Test
+
+let () + NBD.with_handle (fun nbd -> ());
+
+ (try
+ ignore (NBD.with_handle (fun nbd -> raise Test));
+ assert false
+ with Test -> () (* expected *)
+ | exn -> failwith (Printexc.to_string exn)
+ );
+
+ (* Were two handles created above?
+ * XXX How to test if close was called twice?
+ *)
+ assert (NBD.get_handle_name (NBD.create ()) = "nbd3")
+
+let () = Gc.compact ()
diff --git a/ocaml/tests/test_110_defaults.ml b/ocaml/tests/test_110_defaults.ml
index f5886fca3..b36949f0b 100644
--- a/ocaml/tests/test_110_defaults.ml
+++ b/ocaml/tests/test_110_defaults.ml
@@ -18,18 +18,20 @@
*)
let () - let nbd = NBD.create () in
- let name = NBD.get_export_name nbd in
- assert (name = "");
- let info = NBD.get_full_info nbd in
- assert (info = false);
- let tls = NBD.get_tls nbd in
- assert (tls = NBD.TLS.DISABLE);
- let sr = NBD.get_request_structured_replies nbd in
- assert (sr = true);
- let flags = NBD.get_handshake_flags nbd in
- assert (flags = NBD.HANDSHAKE_FLAG.mask);
- let opt = NBD.get_opt_mode nbd in
- assert (opt = false)
+ NBD.with_handle (
+ fun nbd ->
+ let name = NBD.get_export_name nbd in
+ assert (name = "");
+ let info = NBD.get_full_info nbd in
+ assert (info = false);
+ let tls = NBD.get_tls nbd in
+ assert (tls = NBD.TLS.DISABLE);
+ let sr = NBD.get_request_structured_replies nbd in
+ assert (sr = true);
+ let flags = NBD.get_handshake_flags nbd in
+ assert (flags = NBD.HANDSHAKE_FLAG.mask);
+ let opt = NBD.get_opt_mode nbd in
+ assert (opt = false)
+ )
let () = Gc.compact ()
diff --git a/ocaml/tests/test_120_set_non_defaults.ml
b/ocaml/tests/test_120_set_non_defaults.ml
index 421baaba4..67928bb58 100644
--- a/ocaml/tests/test_120_set_non_defaults.ml
+++ b/ocaml/tests/test_120_set_non_defaults.ml
@@ -18,42 +18,44 @@
*)
let () - let nbd = NBD.create () in
- NBD.set_export_name nbd "name";
- let name = NBD.get_export_name nbd in
- assert (name = "name");
- NBD.set_full_info nbd true;
- let info = NBD.get_full_info nbd in
- assert (info = true);
- (try
- NBD.set_tls nbd (NBD.TLS.UNKNOWN 3);
- assert (false)
- with
- NBD.Error _ -> ()
- );
- let tls = NBD.get_tls nbd in
- assert (tls = NBD.TLS.DISABLE);
- if NBD.supports_tls nbd then (
- NBD.set_tls nbd NBD.TLS.ALLOW;
- let tls = NBD.get_tls nbd in
- assert (tls = NBD.TLS.ALLOW);
- );
- NBD.set_request_structured_replies nbd false;
- let sr = NBD.get_request_structured_replies nbd in
- assert (sr = false);
- (try
- NBD.set_handshake_flags nbd [ NBD.HANDSHAKE_FLAG.UNKNOWN 2 ];
- assert false
- with
- NBD.Error _ -> ()
- );
- let flags = NBD.get_handshake_flags nbd in
- assert (flags = NBD.HANDSHAKE_FLAG.mask);
- NBD.set_handshake_flags nbd [];
- let flags = NBD.get_handshake_flags nbd in
- assert (flags = []);
- NBD.set_opt_mode nbd true;
- let opt = NBD.get_opt_mode nbd in
- assert (opt = true)
+ NBD.with_handle (
+ fun nbd ->
+ NBD.set_export_name nbd "name";
+ let name = NBD.get_export_name nbd in
+ assert (name = "name");
+ NBD.set_full_info nbd true;
+ let info = NBD.get_full_info nbd in
+ assert (info = true);
+ (try
+ NBD.set_tls nbd (NBD.TLS.UNKNOWN 3);
+ assert (false)
+ with
+ NBD.Error _ -> ()
+ );
+ let tls = NBD.get_tls nbd in
+ assert (tls = NBD.TLS.DISABLE);
+ if NBD.supports_tls nbd then (
+ NBD.set_tls nbd NBD.TLS.ALLOW;
+ let tls = NBD.get_tls nbd in
+ assert (tls = NBD.TLS.ALLOW);
+ );
+ NBD.set_request_structured_replies nbd false;
+ let sr = NBD.get_request_structured_replies nbd in
+ assert (sr = false);
+ (try
+ NBD.set_handshake_flags nbd [ NBD.HANDSHAKE_FLAG.UNKNOWN 2 ];
+ assert false
+ with
+ NBD.Error _ -> ()
+ );
+ let flags = NBD.get_handshake_flags nbd in
+ assert (flags = NBD.HANDSHAKE_FLAG.mask);
+ NBD.set_handshake_flags nbd [];
+ let flags = NBD.get_handshake_flags nbd in
+ assert (flags = []);
+ NBD.set_opt_mode nbd true;
+ let opt = NBD.get_opt_mode nbd in
+ assert (opt = true)
+ )
let () = Gc.compact ()
diff --git a/ocaml/tests/test_200_connect_command.ml
b/ocaml/tests/test_200_connect_command.ml
index dd64b09f4..17d1b50ef 100644
--- a/ocaml/tests/test_200_connect_command.ml
+++ b/ocaml/tests/test_200_connect_command.ml
@@ -18,8 +18,11 @@
*)
let () - let nbd = NBD.create () in
- NBD.connect_command nbd
- ["nbdkit"; "-s";
"--exit-with-parent"; "-v"; "null"]
+ NBD.with_handle (
+ fun nbd ->
+ NBD.connect_command nbd
+ ["nbdkit"; "-s";
"--exit-with-parent"; "-v";
+ "null"]
+ )
let () = Gc.compact ()
diff --git a/ocaml/tests/test_400_pread.ml b/ocaml/tests/test_400_pread.ml
index b798633f0..e6b550ac9 100644
--- a/ocaml/tests/test_400_pread.ml
+++ b/ocaml/tests/test_400_pread.ml
@@ -37,12 +37,16 @@ let expected b
let () - let nbd = NBD.create () in
- NBD.connect_command nbd
- ["nbdkit"; "-s";
"--exit-with-parent"; "-v";
- "pattern"; "size=512"];
- let buf = Bytes.create 512 in
- NBD.pread nbd buf 0_L;
+ let buf + NBD.with_handle (
+ fun nbd ->
+ NBD.connect_command nbd
+ ["nbdkit"; "-s";
"--exit-with-parent"; "-v";
+ "pattern"; "size=512"];
+ let buf = Bytes.create 512 in
+ NBD.pread nbd buf 0_L;
+ buf
+ ) in
printf "buf = %S\n" (Bytes.to_string buf);
printf "expected = %S\n" (Bytes.to_string expected);
--
2.32.0
Laszlo Ersek
2021-Dec-13 11:14 UTC
[Libguestfs] [PATCH libnbd 1/2] ocaml/examples: Fix extents example
On 12/11/21 14:41, Richard W.M. Jones wrote:> Laszlo Ersek noted that the original example we had did not work > properly if the size of the disk was larger than around 2G. > > The nbd_block_status API is really difficult to use correctly! In > particular it is not guaranteed that the server will return extents > covering the size requested. It's also not guaranteed that a bad > server will return any base:allocation extents at all (although such a > server would not be conforming - the protocol says that servers must > always make forward progress). > > This commit attempts a fix, although it is not complete especially if > the server is badly behaved. It also makes the output look a bit > better by aligning the columns. Also we use nbdkit-sparse-random- > plugin with a larger size to test the > 2G case. > --- > ocaml/examples/extents.ml | 53 ++++++++++++++++++++------------------- > 1 file changed, 27 insertions(+), 26 deletions(-) > > diff --git a/ocaml/examples/extents.ml b/ocaml/examples/extents.ml > index 6fa70e087..e4422b270 100644 > --- a/ocaml/examples/extents.ml > +++ b/ocaml/examples/extents.ml > @@ -4,32 +4,33 @@ let () > let nbd = NBD.create () in > NBD.add_meta_context nbd "base:allocation"; > NBD.connect_command nbd > - ["nbdkit"; "-s"; "--exit-with-parent"; "memory"; "size=128K"]; > - > - (* Write some sectors. *) > - let data_sector = Bytes.make 512 'a' in > - let zero_sector = Bytes.make 512 '\000' in > - NBD.pwrite nbd data_sector 0_L; > - NBD.pwrite nbd zero_sector 32768_L; > - NBD.pwrite nbd data_sector 65536_L; > + ["nbdkit"; "-s"; "--exit-with-parent"; "-r"; > + "sparse-random"; "8G"]; > > (* Read the extents and print them. *) > let size = NBD.get_size nbd in > - NBD.block_status nbd size 0_L ( > - fun meta _ entries err -> > - printf "err=%d\n" !err; > - if meta = "base:allocation" then ( > - printf "index\tlength\tflags\n"; > - for i = 0 to Array.length entries / 2 - 1 do > - let flags > - match entries.(i*2+1) with > - | 0_l -> "data" > - | 1_l -> "hole" > - | 2_l -> "zero" > - | 3_l -> "hole+zero" > - | i -> sprintf "unknown (%ld)" i in > - printf "%d:\t%ld\t%s\n" i entries.(i*2) flags > - done > - ); > - 0 > - ) > + 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 0x8000_0000_L in > + NBD.block_status 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%-20s %-20s %s\n" "offset" "length" "flags"; > + for i = 0 to Array.length entries / 2 - 1 do > + let len = Int64.of_int32 entries.(i*2) > + and flags > + match entries.(i*2+1) with > + | 0_l -> "data" > + | 1_l -> "hole" > + | 2_l -> "zero" > + | 3_l -> "hole+zero" > + | i -> sprintf "unknown (%ld)" i in > + printf "%d:\t%-20Ld %-20Ld %s\n" i !fetch_offset len flags;Should we use right-justification for the numbers? Reviewed-by: Laszlo Ersek <lersek at redhat.com> Thanks! Laszlo> + fetch_offset := Int64.add !fetch_offset len > + done; > + ); > + 0 > + ) (* NBD.block_status *) > + done >