[Libguestfs] [PATCH libnbd 2/2] ocaml: Add NBD.with_handle utility function
Laszlo Ersek
lersek at redhat.com
Mon Dec 13 11:56:24 UTC 2021
On 12/11/21 14:41, Richard W.M. Jones wrote:
> 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?
I think we can just trust that :) Otherwise we'd have to add another
(optional) close-like callback to "with_handle", e.g. a function to
increment a mutable integer.
Reviewed-by: Laszlo Ersek <lersek at redhat.com>
Thanks
Laszlo
> + *)
> + 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);
>
More information about the Libguestfs
mailing list