Richard W.M. Jones
2023-Jun-21 21:08 UTC
[Libguestfs] [PATCH nbdkit 0/6] Various fixed for OCaml 5
(Not for review, I've already pushed this upstream as commits 35db543e3..9d4b87e03) This series fixes nbdkit for OCaml 5 (thanks Jerry James for providing the Fedora packages necessary), and I tested it and it compiles and tests fine at least as far back as OCaml 4.05. It was quite complicated and subtle getting this right, not helped by the documentation which is unclear. Basically you have to follow the OCaml source code to work out what's really going on. Rich.
Richard W.M. Jones
2023-Jun-21 21:08 UTC
[Libguestfs] [PATCH nbdkit 1/6] configure: Recommend using -g with OCAMLOPTFLAGS
--- configure.ac | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/configure.ac b/configure.ac index c1d83a568..39b58b44e 100644 --- a/configure.ac +++ b/configure.ac @@ -935,8 +935,8 @@ AC_SUBST([PYTHON_LDFLAGS]) dnl For the OCaml plugin, you can set OCAMLOPTFLAGS before running dnl ./configure to specify any extra flags you want to pass to -dnl ocamlopt. For example to enable OCaml warnings: -dnl OCAMLOPTFLAGS="-warn-error +A-3" +dnl ocamlopt. For example to enable debug symbols & warnings: +dnl OCAMLOPTFLAGS="-g -warn-error +A-3" AC_SUBST([OCAMLOPTFLAGS]) dnl Check for OCaml, for embedding in the ocaml plugin. -- 2.41.0
Richard W.M. Jones
2023-Jun-21 21:08 UTC
[Libguestfs] [PATCH nbdkit 2/6] tests/test_ocaml_plugin.ml: Print a message when test plugin initializes
It's useful to have a message which is printed as the top level statements in the plugin module are being initialized, for debugging purposes. --- tests/test_ocaml_plugin.ml | 5 +++++ 1 file changed, 5 insertions(+) diff --git a/tests/test_ocaml_plugin.ml b/tests/test_ocaml_plugin.ml index 561a8690f..f8eed4f7f 100644 --- a/tests/test_ocaml_plugin.ml +++ b/tests/test_ocaml_plugin.ml @@ -30,6 +30,11 @@ * SUCH DAMAGE. *) +(* Print something during module initialization, useful for debugging + * obscure OCaml startup issues. + *) +let () = Printf.eprintf "test_ocaml_plugin.ml: module initializing\n%!" + let sector_size = 512 let nr_sectors = 2048 -- 2.41.0
Richard W.M. Jones
2023-Jun-21 21:08 UTC
[Libguestfs] [PATCH nbdkit 3/6] ocaml: Add -I +unix before using unix.cmxa
In OCaml 5.0 you will see this warning:
Alert ocaml_deprecated_auto_include:
OCaml's lib directory layout changed in 5.0. The unix subdirectory has
been
automatically added to the search path, but you should add -I +unix to the
command-line to silence this alert (e.g. by adding unix to the list of
libraries in your dune file, or adding use_unix to your _tags file for
ocamlbuild, or using -package unix for ocamlfind).
Using -I +unix doesn't hurt earlier versions, as the directory is just
ignored if it doesn't exist, and anyway findlib adds the directory if
you're using that.
---
plugins/cc/nbdkit-cc-plugin.pod | 4 ++--
plugins/ocaml/nbdkit-ocaml-plugin.pod | 2 +-
plugins/ocaml/Makefile.am | 2 +-
tests/Makefile.am | 4 ++--
tests/test-cc-ocaml.sh | 2 +-
tests/cc_shebang.ml | 2 +-
6 files changed, 8 insertions(+), 8 deletions(-)
diff --git a/plugins/cc/nbdkit-cc-plugin.pod b/plugins/cc/nbdkit-cc-plugin.pod
index 412233797..f55f74ab0 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 unix.cmxa NBDKit.cmx
-cclib -lnbdkitocaml" \
+ CFLAGS="-output-obj -runtime-variant _pic -I +unix 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 unix.cmxa NBDKit.cmx
-cclib -lnbdkitocaml" \
+ CFLAGS="-output-obj -runtime-variant _pic -I +unix 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 dc8260174..e4a8cf0b0 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 \
- unix.cmxa NBDKit.cmx myplugin.ml \
+ -I +unix 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 da1b1ec96..e7faae506 100644
--- a/plugins/ocaml/Makefile.am
+++ b/plugins/ocaml/Makefile.am
@@ -84,7 +84,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 $@ \
- unix.cmxa NBDKit.cmx $< \
+ -I +unix 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 f2912aa93..d8a640e1e 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -1185,7 +1185,7 @@ OCAML_PLUGIN_DEPS = \
test-ocaml-plugin.so: test_ocaml_plugin.cmx $(OCAML_PLUGIN_DEPS)
$(OCAMLOPT) $(OCAMLOPTFLAGS) -I ../plugins/ocaml \
-output-obj -runtime-variant _pic -o $@ \
- unix.cmxa NBDKit.cmx $< \
+ -I +unix unix.cmxa NBDKit.cmx $< \
-cclib -L../plugins/ocaml/.libs -cclib -lnbdkitocaml
test_ocaml_plugin.cmx: test_ocaml_plugin.ml $(OCAML_PLUGIN_DEPS)
$(OCAMLOPT) $(OCAMLOPTFLAGS) -I ../plugins/ocaml -c $< -o $@
@@ -1194,7 +1194,7 @@ test-ocaml-errorcodes-plugin.so: \
test_ocaml_errorcodes_plugin.cmx $(OCAML_PLUGIN_DEPS)
$(OCAMLOPT) $(OCAMLOPTFLAGS) -I ../plugins/ocaml \
-output-obj -runtime-variant _pic -o $@ \
- unix.cmxa NBDKit.cmx $< \
+ -I +unix unix.cmxa NBDKit.cmx $< \
-cclib -L../plugins/ocaml/.libs -cclib -lnbdkitocaml
test_ocaml_errorcodes_plugin.cmx: \
test_ocaml_errorcodes_plugin.ml $(OCAML_PLUGIN_DEPS)
diff --git a/tests/test-cc-ocaml.sh b/tests/test-cc-ocaml.sh
index 659fa195e..3b4f6a553 100755
--- a/tests/test-cc-ocaml.sh
+++ b/tests/test-cc-ocaml.sh
@@ -61,6 +61,6 @@ cleanup_fn rm -f $out
rm -f $out
nbdkit -U - cc $script a=1 b=2 c=3 d=4 \
- CC="$OCAMLOPT" CFLAGS="-output-obj -runtime-variant _pic
-I $SRCDIR/../plugins/ocaml unix.cmxa NBDKit.cmx -cclib -lnbdkitocaml" \
+ CC="$OCAMLOPT" CFLAGS="-output-obj -runtime-variant _pic
-I $SRCDIR/../plugins/ocaml -I +unix 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 d78d76618..619b08bb5 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 unix.cmxa NBDKit.cmx -cclib -lnbdkitocaml"
"$@"
+exec nbdkit cc "$0" CC=ocamlopt CFLAGS="-output-obj
-runtime-variant _pic -I +unix unix.cmxa NBDKit.cmx -cclib -lnbdkitocaml"
"$@"
*)
open Printf
--
2.41.0
Richard W.M. Jones
2023-Jun-21 21:08 UTC
[Libguestfs] [PATCH nbdkit 4/6] ocaml: Replace caml_leave_blocking_section with caml_acquire_runtime_system
Replace:
caml_leave_blocking_section
...
caml_enter_blocking_section
with the more sensibly named (and equivalent):
caml_acquire_runtime_system
...
caml_release_runtime_system
In addition we must release the runtime system just after caml_startup
and only acquire it around callbacks into OCaml code. (The reason for
this is only apparent in a later commit.)
OCaml 5 is more strict than earlier versions of OCaml and actually
implements the locks using pthread_mutex_t. So in OCaml 5 you will
see a deadlock error:
Fatal error: Fatal error during lock: Resource deadlock avoided
which was caused by attempting to double lock (ie. trying to acquire
the lock, when we already held it from caml_startup).
Also because of additional strictness we must acquire the lock even
before creating the stack frame with CAMLparam* functions.
---
plugins/ocaml/plugin.h | 16 ++++-----
plugins/ocaml/plugin.c | 75 +++++++++++++++++++++++-------------------
2 files changed, 49 insertions(+), 42 deletions(-)
diff --git a/plugins/ocaml/plugin.h b/plugins/ocaml/plugin.h
index 572c43c04..3d6d27db1 100644
--- a/plugins/ocaml/plugin.h
+++ b/plugins/ocaml/plugin.h
@@ -47,18 +47,18 @@ caml_alloc_initialized_string (mlsize_t len, const char *p)
#endif
/* For functions which call into OCaml code, call
- * caml_leave_blocking_section() to prevent other threads running,
- * then caml_enter_blocking_section() on return to C code. This macro
- * ensures that the calls are paired properly.
+ * caml_acquire_runtime_system ... caml_release_runtime_system around
+ * the code. This prevents other threads in the same domain running.
+ * The macro ensures that the calls are paired properly.
*/
-#define LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE() \
- __attribute__ ((unused, cleanup (cleanup_enter_blocking_section))) \
+#define ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE() \
+ __attribute__ ((unused, cleanup (cleanup_release_runtime_system))) \
int _unused; \
- caml_leave_blocking_section ()
+ caml_acquire_runtime_system ()
static inline void
-cleanup_enter_blocking_section (int *unused)
+cleanup_release_runtime_system (int *unused)
{
- caml_enter_blocking_section ();
+ caml_release_runtime_system ();
}
#endif /* NBDKIT_OCAML_PLUGIN_H */
diff --git a/plugins/ocaml/plugin.c b/plugins/ocaml/plugin.c
index 722b95e49..fe781f9af 100644
--- a/plugins/ocaml/plugin.c
+++ b/plugins/ocaml/plugin.c
@@ -64,6 +64,12 @@ constructor (void)
/* Initialize OCaml runtime. */
caml_startup (argv);
+
+ /* We need to release the runtime system here so other threads may
+ * use it. Before we call any OCaml callbacks we must acquire the
+ * runtime system again.
+ */
+ caml_release_runtime_system ();
}
/* Instead of using the NBDKIT_REGISTER_PLUGIN macro, we construct the
@@ -113,7 +119,7 @@ plugin_init (void)
static void
load_wrapper (void)
{
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
caml_callback (load_fn, Val_unit);
}
@@ -123,8 +129,9 @@ load_wrapper (void)
static void
unload_wrapper (void)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
+
if (unload_fn) {
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
caml_callback (unload_fn, Val_unit);
}
@@ -139,9 +146,9 @@ unload_wrapper (void)
static void
dump_plugin_wrapper (void)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (dump_plugin_fn, Val_unit);
if (Is_exception_result (rv))
@@ -152,9 +159,9 @@ dump_plugin_wrapper (void)
static int
config_wrapper (const char *key, const char *val)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal3 (keyv, valv, rv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
keyv = caml_copy_string (key);
valv = caml_copy_string (val);
@@ -171,9 +178,9 @@ config_wrapper (const char *key, const char *val)
static int
config_complete_wrapper (void)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (config_complete_fn, Val_unit);
if (Is_exception_result (rv)) {
@@ -187,9 +194,9 @@ config_complete_wrapper (void)
static int
thread_model_wrapper (void)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (thread_model_fn, Val_unit);
if (Is_exception_result (rv)) {
@@ -203,9 +210,9 @@ thread_model_wrapper (void)
static int
get_ready_wrapper (void)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (get_ready_fn, Val_unit);
if (Is_exception_result (rv)) {
@@ -219,9 +226,9 @@ get_ready_wrapper (void)
static int
after_fork_wrapper (void)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (after_fork_fn, Val_unit);
if (Is_exception_result (rv)) {
@@ -235,9 +242,9 @@ after_fork_wrapper (void)
static void
cleanup_wrapper (void)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (cleanup_fn, Val_unit);
if (Is_exception_result (rv)) {
@@ -251,9 +258,9 @@ cleanup_wrapper (void)
static int
preconnect_wrapper (int readonly)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (preconnect_fn, Val_bool (readonly));
if (Is_exception_result (rv)) {
@@ -267,9 +274,9 @@ preconnect_wrapper (int readonly)
static int
list_exports_wrapper (int readonly, int is_tls, struct nbdkit_exports *exports)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal2 (rv, v);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback2_exn (list_exports_fn, Val_bool (readonly),
Val_bool (is_tls));
@@ -299,10 +306,10 @@ list_exports_wrapper (int readonly, int is_tls, struct
nbdkit_exports *exports)
static const char *
default_export_wrapper (int readonly, int is_tls)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
const char *name;
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback2_exn (default_export_fn, Val_bool (readonly),
Val_bool (is_tls));
@@ -318,10 +325,10 @@ default_export_wrapper (int readonly, int is_tls)
static void *
open_wrapper (int readonly)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
value *ret;
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (open_fn, Val_bool (readonly));
if (Is_exception_result (rv)) {
@@ -341,9 +348,9 @@ open_wrapper (int readonly)
static void
close_wrapper (void *h)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (close_fn, *(value *) h);
if (Is_exception_result (rv)) {
@@ -360,10 +367,10 @@ close_wrapper (void *h)
static const char *
export_description_wrapper (void *h)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
const char *desc;
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (export_description_fn, *(value *) h);
if (Is_exception_result (rv)) {
@@ -378,10 +385,10 @@ export_description_wrapper (void *h)
static int64_t
get_size_wrapper (void *h)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
int64_t r;
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (get_size_fn, *(value *) h);
if (Is_exception_result (rv)) {
@@ -397,11 +404,11 @@ static int
block_size_wrapper (void *h,
uint32_t *minimum, uint32_t *preferred, uint32_t *maximum)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
int i;
int64_t i64;
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (block_size_fn, *(value *) h);
if (Is_exception_result (rv)) {
@@ -439,9 +446,9 @@ block_size_wrapper (void *h,
static int
can_write_wrapper (void *h)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (can_write_fn, *(value *) h);
if (Is_exception_result (rv)) {
@@ -455,9 +462,9 @@ can_write_wrapper (void *h)
static int
can_flush_wrapper (void *h)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (can_flush_fn, *(value *) h);
if (Is_exception_result (rv)) {
@@ -471,9 +478,9 @@ can_flush_wrapper (void *h)
static int
is_rotational_wrapper (void *h)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (is_rotational_fn, *(value *) h);
if (Is_exception_result (rv)) {
@@ -487,9 +494,9 @@ is_rotational_wrapper (void *h)
static int
can_trim_wrapper (void *h)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (can_trim_fn, *(value *) h);
if (Is_exception_result (rv)) {
@@ -503,9 +510,9 @@ can_trim_wrapper (void *h)
static int
can_zero_wrapper (void *h)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (can_zero_fn, *(value *) h);
if (Is_exception_result (rv)) {
@@ -519,9 +526,9 @@ can_zero_wrapper (void *h)
static int
can_fua_wrapper (void *h)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (can_fua_fn, *(value *) h);
if (Is_exception_result (rv)) {
@@ -535,9 +542,9 @@ can_fua_wrapper (void *h)
static int
can_fast_zero_wrapper (void *h)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (can_fast_zero_fn, *(value *) h);
if (Is_exception_result (rv)) {
@@ -551,9 +558,9 @@ can_fast_zero_wrapper (void *h)
static int
can_cache_wrapper (void *h)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (can_cache_fn, *(value *) h);
if (Is_exception_result (rv)) {
@@ -567,9 +574,9 @@ can_cache_wrapper (void *h)
static int
can_extents_wrapper (void *h)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (can_extents_fn, *(value *) h);
if (Is_exception_result (rv)) {
@@ -583,9 +590,9 @@ can_extents_wrapper (void *h)
static int
can_multi_conn_wrapper (void *h)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
rv = caml_callback_exn (can_multi_conn_fn, *(value *) h);
if (Is_exception_result (rv)) {
@@ -629,10 +636,10 @@ static int
pread_wrapper (void *h, void *buf, uint32_t count, uint64_t offset,
uint32_t flags)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal4 (rv, countv, offsetv, flagsv);
mlsize_t len;
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
countv = Val_int (count);
offsetv = caml_copy_int64 (offset);
@@ -659,9 +666,9 @@ static int
pwrite_wrapper (void *h, const void *buf, uint32_t count, uint64_t offset,
uint32_t flags)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal4 (rv, strv, offsetv, flagsv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
strv = caml_alloc_initialized_string (count, buf);
offsetv = caml_copy_int64 (offset);
@@ -680,9 +687,9 @@ pwrite_wrapper (void *h, const void *buf, uint32_t count,
uint64_t offset,
static int
flush_wrapper (void *h, uint32_t flags)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal2 (rv, flagsv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
flagsv = Val_flags (flags);
@@ -698,9 +705,9 @@ flush_wrapper (void *h, uint32_t flags)
static int
trim_wrapper (void *h, uint32_t count, uint64_t offset, uint32_t flags)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal4 (rv, countv, offsetv, flagsv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
countv = caml_copy_int64 (count);
offsetv = caml_copy_int64 (offset);
@@ -719,9 +726,9 @@ trim_wrapper (void *h, uint32_t count, uint64_t offset,
uint32_t flags)
static int
zero_wrapper (void *h, uint32_t count, uint64_t offset, uint32_t flags)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal4 (rv, countv, offsetv, flagsv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
countv = caml_copy_int64 (count);
offsetv = caml_copy_int64 (offset);
@@ -741,9 +748,9 @@ static int
extents_wrapper (void *h, uint32_t count, uint64_t offset, uint32_t flags,
struct nbdkit_extents *extents)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal5 (rv, countv, offsetv, flagsv, v);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
countv = caml_copy_int64 (count);
offsetv = caml_copy_int64 (offset);
@@ -781,9 +788,9 @@ extents_wrapper (void *h, uint32_t count, uint64_t offset,
uint32_t flags,
static int
cache_wrapper (void *h, uint32_t count, uint64_t offset, uint32_t flags)
{
+ ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal4 (rv, countv, offsetv, flagsv);
- LEAVE_BLOCKING_SECTION_FOR_CURRENT_SCOPE ();
countv = caml_copy_int64 (count);
offsetv = caml_copy_int64 (offset);
--
2.41.0
Richard W.M. Jones
2023-Jun-21 21:08 UTC
[Libguestfs] [PATCH nbdkit 5/6] ocaml: Always unregister the global root and free the handle
If the OCaml code did not provide a close method, we would never call
close_wrapper, and then we ended up leaking the global root and handle.
---
plugins/ocaml/plugin.c | 18 ++++++++++++++----
1 file changed, 14 insertions(+), 4 deletions(-)
diff --git a/plugins/ocaml/plugin.c b/plugins/ocaml/plugin.c
index fe781f9af..a4671d6ed 100644
--- a/plugins/ocaml/plugin.c
+++ b/plugins/ocaml/plugin.c
@@ -76,6 +76,7 @@ constructor (void)
* nbdkit_plugin struct and return it from our own plugin_init
* function.
*/
+static void close_wrapper (void *h);
static void unload_wrapper (void);
static void free_strings (void);
static void remove_roots (void);
@@ -92,6 +93,10 @@ static struct nbdkit_plugin plugin = {
*/
.name = NULL,
+ /* We always call these, even if the OCaml code does not provide a
+ * callback.
+ */
+ .close = close_wrapper,
.unload = unload_wrapper,
};
@@ -345,6 +350,9 @@ open_wrapper (int readonly)
CAMLreturnT (void *, ret);
}
+/* We always have a close function, since we need to unregister the
+ * global root and free the handle.
+ */
static void
close_wrapper (void *h)
{
@@ -352,10 +360,12 @@ close_wrapper (void *h)
CAMLparam0 ();
CAMLlocal1 (rv);
- rv = caml_callback_exn (close_fn, *(value *) h);
- if (Is_exception_result (rv)) {
- nbdkit_error ("%s", caml_format_exception (Extract_exception
(rv)));
- /*FALLTHROUGH*/
+ if (close_fn) {
+ rv = caml_callback_exn (close_fn, *(value *) h);
+ if (Is_exception_result (rv)) {
+ nbdkit_error ("%s", caml_format_exception (Extract_exception
(rv)));
+ /*FALLTHROUGH*/
+ }
}
caml_remove_generational_global_root (h);
--
2.41.0
Richard W.M. Jones
2023-Jun-21 21:08 UTC
[Libguestfs] [PATCH nbdkit 6/6] ocaml: Fix thread registration for OCaml 5
OCaml 5 is strict about registering threads before calling OCaml heap
functions, and will abort the program with this error if you don't do
this correctly:
Fatal error: no domain lock held
Fix this as explained in the comment.
Note (as it's not explained well in the documentation): Threads
created from C are placed in OCaml thread domain 0. In order to add
them to this domain, the main program must not hold on to the runtime
system lock (for domain 0, because that's what caml_startup gives
you). For this to work we must only hold this lock in the main
program briefly around calls to OCaml code, which means we must
release the runtime system after calling caml_startup as we did in an
earlier commit.
---
plugins/cc/nbdkit-cc-plugin.pod | 4 +--
plugins/ocaml/nbdkit-ocaml-plugin.pod | 3 +-
plugins/ocaml/Makefile.am | 2 +-
tests/Makefile.am | 4 +--
plugins/ocaml/plugin.c | 52 +++++++++++++++++++++++++--
tests/test-cc-ocaml.sh | 2 +-
tests/cc_shebang.ml | 2 +-
7 files changed, 59 insertions(+), 10 deletions(-)
diff --git a/plugins/cc/nbdkit-cc-plugin.pod b/plugins/cc/nbdkit-cc-plugin.pod
index f55f74ab0..e393457c4 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 -I +unix unix.cmxa
NBDKit.cmx -cclib -lnbdkitocaml" \
+ CFLAGS="-output-obj -runtime-variant _pic -I +unix unix.cmxa -I
+threads threads.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 -I +unix unix.cmxa
NBDKit.cmx -cclib -lnbdkitocaml" \
+ CFLAGS="-output-obj -runtime-variant _pic -I +unix unix.cmxa -I
+threads threads.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 e4a8cf0b0..f1e06d3e2 100644
--- a/plugins/ocaml/nbdkit-ocaml-plugin.pod
+++ b/plugins/ocaml/nbdkit-ocaml-plugin.pod
@@ -53,7 +53,8 @@ using this command:
ocamlopt.opt -output-obj -runtime-variant _pic \
-o nbdkit-myplugin-plugin.so \
- -I +unix unix.cmxa NBDKit.cmx myplugin.ml \
+ -I +unix unix.cmxa -I +threads threads.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 e7faae506..a61550cb9 100644
--- a/plugins/ocaml/Makefile.am
+++ b/plugins/ocaml/Makefile.am
@@ -84,7 +84,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 $@ \
- -I +unix unix.cmxa NBDKit.cmx $< \
+ -I +unix unix.cmxa -I +threads threads.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 d8a640e1e..32ebb7002 100644
--- a/tests/Makefile.am
+++ b/tests/Makefile.am
@@ -1185,7 +1185,7 @@ OCAML_PLUGIN_DEPS = \
test-ocaml-plugin.so: test_ocaml_plugin.cmx $(OCAML_PLUGIN_DEPS)
$(OCAMLOPT) $(OCAMLOPTFLAGS) -I ../plugins/ocaml \
-output-obj -runtime-variant _pic -o $@ \
- -I +unix unix.cmxa NBDKit.cmx $< \
+ -I +unix unix.cmxa -I +threads threads.cmxa NBDKit.cmx $< \
-cclib -L../plugins/ocaml/.libs -cclib -lnbdkitocaml
test_ocaml_plugin.cmx: test_ocaml_plugin.ml $(OCAML_PLUGIN_DEPS)
$(OCAMLOPT) $(OCAMLOPTFLAGS) -I ../plugins/ocaml -c $< -o $@
@@ -1194,7 +1194,7 @@ test-ocaml-errorcodes-plugin.so: \
test_ocaml_errorcodes_plugin.cmx $(OCAML_PLUGIN_DEPS)
$(OCAMLOPT) $(OCAMLOPTFLAGS) -I ../plugins/ocaml \
-output-obj -runtime-variant _pic -o $@ \
- -I +unix unix.cmxa NBDKit.cmx $< \
+ -I +unix unix.cmxa -I +threads threads.cmxa NBDKit.cmx $< \
-cclib -L../plugins/ocaml/.libs -cclib -lnbdkitocaml
test_ocaml_errorcodes_plugin.cmx: \
test_ocaml_errorcodes_plugin.ml $(OCAML_PLUGIN_DEPS)
diff --git a/plugins/ocaml/plugin.c b/plugins/ocaml/plugin.c
index a4671d6ed..eaa88a925 100644
--- a/plugins/ocaml/plugin.c
+++ b/plugins/ocaml/plugin.c
@@ -260,9 +260,31 @@ cleanup_wrapper (void)
CAMLreturn0;
}
+/* A note about nbdkit threads and OCaml:
+ *
+ * OCaml requires that all C threads are registered and unregistered.
+ *
+ * For the main thread callbacks like load, config, get_ready [above
+ * this comment] we don't need to do anything.
+ *
+ * For the connected callbacks [below this comment] nbdkit creates its
+ * own threads but does not provide a way to intercept thread creation
+ * or destruction. However we can register the current thread in
+ * every callback, and unregister the thread only call_wrapper.
+ *
+ * This is safe and cheap: Registering a thread is basically free if
+ * the thread is already registered (the OCaml code checks a
+ * thread-local variable to see if it needs to register). nbdkit will
+ * always call the .close method, which does not necessarily indicate
+ * that the thread is being destroyed, but if the thread is reused we
+ * will register the same thread again when .open or similar is called
+ * next time.
+ */
+
static int
preconnect_wrapper (int readonly)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -279,6 +301,7 @@ preconnect_wrapper (int readonly)
static int
list_exports_wrapper (int readonly, int is_tls, struct nbdkit_exports *exports)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal2 (rv, v);
@@ -311,6 +334,7 @@ list_exports_wrapper (int readonly, int is_tls, struct
nbdkit_exports *exports)
static const char *
default_export_wrapper (int readonly, int is_tls)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -330,6 +354,7 @@ default_export_wrapper (int readonly, int is_tls)
static void *
open_wrapper (int readonly)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -351,12 +376,13 @@ open_wrapper (int readonly)
}
/* We always have a close function, since we need to unregister the
- * global root and free the handle.
+ * global root, free the handle and unregister the thread.
*/
static void
close_wrapper (void *h)
{
- ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
+ caml_c_thread_register ();
+ caml_acquire_runtime_system ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -370,6 +396,8 @@ close_wrapper (void *h)
caml_remove_generational_global_root (h);
free (h);
+ caml_release_runtime_system ();
+ caml_c_thread_unregister ();
CAMLreturn0;
}
@@ -377,6 +405,7 @@ close_wrapper (void *h)
static const char *
export_description_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -395,6 +424,7 @@ export_description_wrapper (void *h)
static int64_t
get_size_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -414,6 +444,7 @@ static int
block_size_wrapper (void *h,
uint32_t *minimum, uint32_t *preferred, uint32_t *maximum)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -456,6 +487,7 @@ block_size_wrapper (void *h,
static int
can_write_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -472,6 +504,7 @@ can_write_wrapper (void *h)
static int
can_flush_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -488,6 +521,7 @@ can_flush_wrapper (void *h)
static int
is_rotational_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -504,6 +538,7 @@ is_rotational_wrapper (void *h)
static int
can_trim_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -520,6 +555,7 @@ can_trim_wrapper (void *h)
static int
can_zero_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -536,6 +572,7 @@ can_zero_wrapper (void *h)
static int
can_fua_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -552,6 +589,7 @@ can_fua_wrapper (void *h)
static int
can_fast_zero_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -568,6 +606,7 @@ can_fast_zero_wrapper (void *h)
static int
can_cache_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -584,6 +623,7 @@ can_cache_wrapper (void *h)
static int
can_extents_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -600,6 +640,7 @@ can_extents_wrapper (void *h)
static int
can_multi_conn_wrapper (void *h)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal1 (rv);
@@ -646,6 +687,7 @@ static int
pread_wrapper (void *h, void *buf, uint32_t count, uint64_t offset,
uint32_t flags)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal4 (rv, countv, offsetv, flagsv);
@@ -676,6 +718,7 @@ static int
pwrite_wrapper (void *h, const void *buf, uint32_t count, uint64_t offset,
uint32_t flags)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal4 (rv, strv, offsetv, flagsv);
@@ -697,6 +740,7 @@ pwrite_wrapper (void *h, const void *buf, uint32_t count,
uint64_t offset,
static int
flush_wrapper (void *h, uint32_t flags)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal2 (rv, flagsv);
@@ -715,6 +759,7 @@ flush_wrapper (void *h, uint32_t flags)
static int
trim_wrapper (void *h, uint32_t count, uint64_t offset, uint32_t flags)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal4 (rv, countv, offsetv, flagsv);
@@ -736,6 +781,7 @@ trim_wrapper (void *h, uint32_t count, uint64_t offset,
uint32_t flags)
static int
zero_wrapper (void *h, uint32_t count, uint64_t offset, uint32_t flags)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal4 (rv, countv, offsetv, flagsv);
@@ -758,6 +804,7 @@ static int
extents_wrapper (void *h, uint32_t count, uint64_t offset, uint32_t flags,
struct nbdkit_extents *extents)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal5 (rv, countv, offsetv, flagsv, v);
@@ -798,6 +845,7 @@ extents_wrapper (void *h, uint32_t count, uint64_t offset,
uint32_t flags,
static int
cache_wrapper (void *h, uint32_t count, uint64_t offset, uint32_t flags)
{
+ caml_c_thread_register ();
ACQUIRE_RUNTIME_FOR_CURRENT_SCOPE ();
CAMLparam0 ();
CAMLlocal4 (rv, countv, offsetv, flagsv);
diff --git a/tests/test-cc-ocaml.sh b/tests/test-cc-ocaml.sh
index 3b4f6a553..9458201a4 100755
--- a/tests/test-cc-ocaml.sh
+++ b/tests/test-cc-ocaml.sh
@@ -61,6 +61,6 @@ cleanup_fn rm -f $out
rm -f $out
nbdkit -U - cc $script a=1 b=2 c=3 d=4 \
- CC="$OCAMLOPT" CFLAGS="-output-obj -runtime-variant _pic
-I $SRCDIR/../plugins/ocaml -I +unix unix.cmxa NBDKit.cmx -cclib
-lnbdkitocaml" \
+ CC="$OCAMLOPT" CFLAGS="-output-obj -runtime-variant _pic
-I $SRCDIR/../plugins/ocaml -I +unix unix.cmxa -I +threads threads.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 619b08bb5..05ca77b64 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 -I +unix unix.cmxa NBDKit.cmx -cclib -lnbdkitocaml"
"$@"
+exec nbdkit cc "$0" CC=ocamlopt CFLAGS="-output-obj
-runtime-variant _pic -I +unix unix.cmxa -I +threads threads.cmxa NBDKit.cmx
-cclib -lnbdkitocaml" "$@"
*)
open Printf
--
2.41.0