[Libguestfs] [PATCH libnbd 2/2] ocaml: Add NBD.with_handle utility function
Richard W.M. Jones
rjones at redhat.com
Sat Dec 11 13:41:06 UTC 2021
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
More information about the Libguestfs
mailing list