[Libguestfs] [PATCH nbdkit v2 2/2] ocaml: Simplify NBDKit.set_error
Richard W.M. Jones
rjones at redhat.com
Wed Nov 17 17:58:53 UTC 2021
Using the function code_of_unix_error from <caml/unixsupport.h> we can
greatly simplify this function. code_of_unix_error was added in OCaml
4.01 which is ≤ 4.03 that we currently require.
See also: https://github.com/ocaml/ocaml/issues/4812
This does require a small change ot how OCaml plugins are linked -- we
now need to link them with the standard OCaml Unix library (unix.cmxa).
This commit also adds a comprehensive end-to-end test of error codes.
---
plugins/cc/nbdkit-cc-plugin.pod | 4 +-
plugins/ocaml/nbdkit-ocaml-plugin.pod | 2 +-
plugins/ocaml/Makefile.am | 2 +-
tests/Makefile.am | 20 +++++-
plugins/ocaml/NBDKit.ml | 25 +------
plugins/ocaml/bindings.c | 22 +------
tests/test-cc-ocaml.sh | 2 +-
tests/cc_shebang.ml | 2 +-
tests/test-ocaml-errorcodes.c | 95 +++++++++++++++++++++++++++
tests/test_ocaml_errorcodes_plugin.ml | 32 +++++++++
.gitignore | 1 +
11 files changed, 155 insertions(+), 52 deletions(-)
diff --git a/plugins/cc/nbdkit-cc-plugin.pod b/plugins/cc/nbdkit-cc-plugin.pod
index 0fe0d9ea..be4019f9 100644
--- a/plugins/cc/nbdkit-cc-plugin.pod
+++ b/plugins/cc/nbdkit-cc-plugin.pod
@@ -89,7 +89,7 @@ C<CC=g++> as a parameter to exec nbdkit.
=head2 Using this plugin with OCaml
nbdkit cc CC=ocamlopt \
- CFLAGS="-output-obj -runtime-variant _pic NBDKit.cmx -cclib -lnbdkitocaml" \
+ CFLAGS="-output-obj -runtime-variant _pic unix.cmxa NBDKit.cmx -cclib -lnbdkitocaml" \
source.ml
OCaml plugin scripts can be created using this trick:
@@ -97,7 +97,7 @@ OCaml plugin scripts can be created using this trick:
(*/.)>/dev/null 2>&1
exec nbdkit cc "$0" \
CC=ocamlopt \
- CFLAGS="-output-obj -runtime-variant _pic NBDKit.cmx -cclib -lnbdkitocaml" \
+ CFLAGS="-output-obj -runtime-variant _pic unix.cmxa NBDKit.cmx -cclib -lnbdkitocaml" \
"$@"
*)
(* followed by OCaml code for the plugin here *)
diff --git a/plugins/ocaml/nbdkit-ocaml-plugin.pod b/plugins/ocaml/nbdkit-ocaml-plugin.pod
index 293f8143..efeb2240 100644
--- a/plugins/ocaml/nbdkit-ocaml-plugin.pod
+++ b/plugins/ocaml/nbdkit-ocaml-plugin.pod
@@ -53,7 +53,7 @@ using this command:
ocamlopt.opt -output-obj -runtime-variant _pic \
-o nbdkit-myplugin-plugin.so \
- NBDKit.cmx myplugin.ml \
+ unix.cmxa NBDKit.cmx myplugin.ml \
-cclib -lnbdkitocaml
You can then use C<nbdkit-myplugin-plugin.so> as an nbdkit plugin (see
diff --git a/plugins/ocaml/Makefile.am b/plugins/ocaml/Makefile.am
index 1082fc0a..fcf3396d 100644
--- a/plugins/ocaml/Makefile.am
+++ b/plugins/ocaml/Makefile.am
@@ -81,7 +81,7 @@ noinst_SCRIPTS = nbdkit-ocamlexample-plugin.so
nbdkit-ocamlexample-plugin.so: example.cmx libnbdkitocaml.la NBDKit.cmi NBDKit.cmx
$(OCAMLOPT) $(OCAMLOPTFLAGS) \
-output-obj -runtime-variant _pic -o $@ \
- NBDKit.cmx $< \
+ unix.cmxa NBDKit.cmx $< \
-cclib -L.libs -cclib -lnbdkitocaml
example.cmx: example.ml NBDKit.cmi NBDKit.cmx
$(OCAMLOPT) $(OCAMLOPTFLAGS) -c $< -o $@
diff --git a/tests/Makefile.am b/tests/Makefile.am
index 07b09207..912e8b3f 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -1067,6 +1067,7 @@ EXTRA_DIST += test-zero.sh
if HAVE_OCAML
LIBGUESTFS_TESTS += test-ocaml
+LIBNBD_TESTS += test-ocaml-errorcodes
test_ocaml_SOURCES = test-ocaml.c test.h
test_ocaml_CFLAGS = \
@@ -1075,15 +1076,30 @@ test_ocaml_CFLAGS = \
$(NULL)
test_ocaml_LDADD = libtest.la $(LIBGUESTFS_LIBS)
-check_SCRIPTS += test-ocaml-plugin.so
+test_ocaml_errorcodes_SOURCES = test-ocaml-errorcodes.c
+test_ocaml_errorcodes_CFLAGS = $(WARNINGS_CFLAGS) $(LIBNBD_CFLAGS)
+test_ocaml_errorcodes_LDADD = $(LIBNBD_LIBS)
+
+check_SCRIPTS += \
+ test-ocaml-plugin.so \
+ test-ocaml-errorcodes-plugin.so
+
test-ocaml-plugin.so: test_ocaml_plugin.cmx ../plugins/ocaml/libnbdkitocaml.la ../plugins/ocaml/NBDKit.cmi ../plugins/ocaml/NBDKit.cmx
$(OCAMLOPT) $(OCAMLOPTFLAGS) -I ../plugins/ocaml \
-output-obj -runtime-variant _pic -o $@ \
- NBDKit.cmx $< \
+ unix.cmxa NBDKit.cmx $< \
-cclib -L../plugins/ocaml/.libs -cclib -lnbdkitocaml
test_ocaml_plugin.cmx: test_ocaml_plugin.ml ../plugins/ocaml/NBDKit.cmi ../plugins/ocaml/NBDKit.cmx
$(OCAMLOPT) $(OCAMLOPTFLAGS) -I ../plugins/ocaml -c $< -o $@
+test-ocaml-errorcodes-plugin.so: test_ocaml_errorcodes_plugin.cmx ../plugins/ocaml/libnbdkitocaml.la ../plugins/ocaml/NBDKit.cmi ../plugins/ocaml/NBDKit.cmx
+ $(OCAMLOPT) $(OCAMLOPTFLAGS) -I ../plugins/ocaml \
+ -output-obj -runtime-variant _pic -o $@ \
+ unix.cmxa NBDKit.cmx $< \
+ -cclib -L../plugins/ocaml/.libs -cclib -lnbdkitocaml
+test_ocaml_errorcodes_plugin.cmx: test_ocaml_errorcodes_plugin.ml ../plugins/ocaml/NBDKit.cmi ../plugins/ocaml/NBDKit.cmx
+ $(OCAMLOPT) $(OCAMLOPTFLAGS) -I ../plugins/ocaml -c $< -o $@
+
endif HAVE_OCAML
EXTRA_DIST += \
diff --git a/plugins/ocaml/NBDKit.ml b/plugins/ocaml/NBDKit.ml
index c9ce31b5..d28992c8 100644
--- a/plugins/ocaml/NBDKit.ml
+++ b/plugins/ocaml/NBDKit.ml
@@ -220,30 +220,7 @@ let register_plugin plugin =
(* Bindings to nbdkit server functions. *)
-external _set_error : int -> unit = "ocaml_nbdkit_set_error" [@@noalloc]
-
-let set_error unix_error =
- (* There's an awkward triple translation going on here, because
- * OCaml Unix.error codes, errno on the host system, and NBD_*
- * errnos are not all the same integer value. Plus we cannot
- * read the host system errno values from OCaml.
- *)
- let nbd_error =
- match unix_error with
- | Unix.EPERM -> 1
- | Unix.EIO -> 2
- | Unix.ENOMEM -> 3
- | Unix.EINVAL -> 4
- | Unix.ENOSPC -> 5
- | Unix.ESHUTDOWN -> 6
- | Unix.EOVERFLOW -> 7
- | Unix.EOPNOTSUPP -> 8
- | Unix.EROFS -> 9
- | Unix.EFBIG -> 10
- | _ -> 4 (* EINVAL *) in
-
- _set_error nbd_error
-
+external set_error : Unix.error -> unit = "ocaml_nbdkit_set_error" [@@noalloc]
external parse_size : string -> int64 = "ocaml_nbdkit_parse_size"
external parse_bool : string -> bool = "ocaml_nbdkit_parse_bool"
external read_password : string -> string = "ocaml_nbdkit_read_password"
diff --git a/plugins/ocaml/bindings.c b/plugins/ocaml/bindings.c
index a6d57084..ba95fb4a 100644
--- a/plugins/ocaml/bindings.c
+++ b/plugins/ocaml/bindings.c
@@ -42,6 +42,7 @@
#include <caml/memory.h>
#include <caml/mlvalues.h>
#include <caml/threads.h>
+#include <caml/unixsupport.h>
#define NBDKIT_API_VERSION 2
#include <nbdkit-plugin.h>
@@ -54,26 +55,7 @@
NBDKIT_DLL_PUBLIC value
ocaml_nbdkit_set_error (value nv)
{
- int err;
-
- switch (Int_val (nv)) {
- /* Host errno values that will map to NBD protocol values */
- case 1: err = EPERM; break;
- case 2: err = EIO; break;
- case 3: err = ENOMEM; break;
- case 4: err = EINVAL; break;
- case 5: err = ENOSPC; break;
- case 6: err = ESHUTDOWN; break;
- case 7: err = EOVERFLOW; break;
- case 8: err = EOPNOTSUPP; break;
- /* Other errno values that server/protocol.c treats specially */
- case 9: err = EROFS; break;
- case 10: err = EFBIG; break;
- default: abort ();
- }
-
- nbdkit_set_error (err);
-
+ nbdkit_set_error (code_of_unix_error (nv));
return Val_unit;
}
diff --git a/tests/test-cc-ocaml.sh b/tests/test-cc-ocaml.sh
index e47bf26f..9ba7ee98 100755
--- a/tests/test-cc-ocaml.sh
+++ b/tests/test-cc-ocaml.sh
@@ -58,6 +58,6 @@ cleanup_fn rm -f $out
rm -f $out
nbdkit -U - cc $script a=1 b=2 c=3 \
- CC="$OCAMLOPT" CFLAGS="-output-obj -runtime-variant _pic -I $SRCDIR/../plugins/ocaml NBDKit.cmx -cclib -lnbdkitocaml" \
+ CC="$OCAMLOPT" CFLAGS="-output-obj -runtime-variant _pic -I $SRCDIR/../plugins/ocaml unix.cmxa NBDKit.cmx -cclib -lnbdkitocaml" \
--run 'nbdinfo --size $uri' > $out
test "$(cat $out)" -eq $((512 * 2048))
diff --git a/tests/cc_shebang.ml b/tests/cc_shebang.ml
index 05036284..a6c79039 100755
--- a/tests/cc_shebang.ml
+++ b/tests/cc_shebang.ml
@@ -4,7 +4,7 @@
# shell as an impossible command which is ignored. The line below is
# run by the shell and ignored by OCaml.
-exec nbdkit cc "$0" CC=ocamlopt CFLAGS="-output-obj -runtime-variant _pic NBDKit.cmx -cclib -lnbdkitocaml" "$@"
+exec nbdkit cc "$0" CC=ocamlopt CFLAGS="-output-obj -runtime-variant _pic unix.cmxa NBDKit.cmx -cclib -lnbdkitocaml" "$@"
*)
open Printf
diff --git a/tests/test-ocaml-errorcodes.c b/tests/test-ocaml-errorcodes.c
new file mode 100644
index 00000000..a7a3f125
--- /dev/null
+++ b/tests/test-ocaml-errorcodes.c
@@ -0,0 +1,95 @@
+/* nbdkit
+ * Copyright (C) 2013-2021 Red Hat Inc.
+ *
+ * Redistribution and use in source and binary forms, with or without
+ * modification, are permitted provided that the following conditions are
+ * met:
+ *
+ * * Redistributions of source code must retain the above copyright
+ * notice, this list of conditions and the following disclaimer.
+ *
+ * * Redistributions in binary form must reproduce the above copyright
+ * notice, this list of conditions and the following disclaimer in the
+ * documentation and/or other materials provided with the distribution.
+ *
+ * * Neither the name of Red Hat nor the names of its contributors may be
+ * used to endorse or promote products derived from this software without
+ * specific prior written permission.
+ *
+ * THIS SOFTWARE IS PROVIDED BY RED HAT AND CONTRIBUTORS ''AS IS'' AND
+ * ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO,
+ * THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+ * PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL RED HAT OR
+ * CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
+ * SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
+ * LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF
+ * USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND
+ * ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
+ * OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT
+ * OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF
+ * SUCH DAMAGE.
+ */
+
+#include <config.h>
+
+#include <stdio.h>
+#include <stdlib.h>
+#include <errno.h>
+#include <assert.h>
+
+#include <libnbd.h>
+
+/* This test checks the conversion from OCaml Unix.error to errno (in
+ * the plugin) to NBD_E* (over the wire) and back to errno (in
+ * libnbd).
+ *
+ * Reading at various sector offsets in the associated plugin
+ * (test_ocaml_errorcodes_plugin.ml) produces predictable error codes.
+ */
+static struct { uint64_t offset; int expected_errno; } tests[] = {
+ { 1*512, EPERM },
+ { 2*512, EIO },
+ { 3*512, ENOMEM },
+ { 4*512, ESHUTDOWN },
+ { 5*512, EINVAL },
+ { 0 }
+};
+
+int
+main (int argc, char *argv[])
+{
+ struct nbd_handle *nbd;
+ char buf[512];
+ size_t i;
+ int actual_errno;
+
+ nbd = nbd_create ();
+ if (nbd == NULL) {
+ fprintf (stderr, "%s\n", nbd_get_error ());
+ exit (EXIT_FAILURE);
+ }
+
+ if (nbd_connect_command (nbd,
+ (char *[]) {
+ "nbdkit", "-s", "--exit-with-parent",
+ "./test-ocaml-errorcodes-plugin.so",
+ NULL }) == -1) {
+ fprintf (stderr, "%s\n", nbd_get_error ());
+ exit (EXIT_FAILURE);
+ }
+
+ assert (nbd_pread (nbd, buf, 512, 0, 0) == 0);
+
+ for (i = 0; tests[i].offset != 0; ++i) {
+ assert (nbd_pread (nbd, buf, 512, tests[i].offset, 0) == -1);
+ actual_errno = nbd_get_errno ();
+ if (actual_errno != tests[i].expected_errno) {
+ fprintf (stderr, "%s: FAIL: actual errno = %d expected errno = %d\n",
+ argv[0], actual_errno, tests[i].expected_errno);
+ exit (EXIT_FAILURE);
+ }
+ }
+
+ nbd_close (nbd);
+ exit (EXIT_SUCCESS);
+}
diff --git a/tests/test_ocaml_errorcodes_plugin.ml b/tests/test_ocaml_errorcodes_plugin.ml
new file mode 100644
index 00000000..4b128846
--- /dev/null
+++ b/tests/test_ocaml_errorcodes_plugin.ml
@@ -0,0 +1,32 @@
+open Unix
+
+let sector_size = 512
+
+let open_connection _ = ()
+
+let get_size () = Int64.of_int (6 * sector_size)
+
+let pread () count offset _ =
+ (* Depending on the sector requested (offset), return a different
+ * error code.
+ *)
+ match (Int64.to_int offset) / sector_size with
+ | 0 -> (* good, return data *) String.make (Int32.to_int count) '\000'
+ | 1 -> NBDKit.set_error EPERM; failwith "EPERM"
+ | 2 -> NBDKit.set_error EIO; failwith "EIO"
+ | 3 -> NBDKit.set_error ENOMEM; failwith "ENOMEM"
+ | 4 -> NBDKit.set_error ESHUTDOWN; failwith "ESHUTDOWN"
+ | 5 -> NBDKit.set_error EINVAL; failwith "EINVAL"
+ | _ -> assert false
+
+let plugin = {
+ NBDKit.default_callbacks with
+ NBDKit.name = "test-ocaml-errorcodes";
+ version = NBDKit.version ();
+
+ open_connection = Some open_connection;
+ get_size = Some get_size;
+ pread = Some pread;
+}
+
+let () = NBDKit.register_plugin plugin
diff --git a/.gitignore b/.gitignore
index 91cbc810..4e2ae75d 100644
--- a/.gitignore
+++ b/.gitignore
@@ -146,6 +146,7 @@ plugins/*/*.3
/tests/test-nbd
/tests/test-null
/tests/test-ocaml
+/tests/test-ocaml-errorcodes
/tests/test-offset
/tests/test-oldstyle
/tests/test-old-plugins-*.sh
--
2.32.0
More information about the Libguestfs
mailing list