Re: [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/b4a8ccf00f1364d703c6d5cf1fd... 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);