[Libguestfs] [PATCH libnbd 2/2] ocaml: Add NBD.with_handle utility function

Laszlo Ersek
Mon, 13 Dec 2021 11:56:24 -0000

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);
>