X-Git-Url: http://git.annexia.org/?a=blobdiff_plain;f=ocaml%2Fguestfs_c.c;h=86fa29390d631426e4f233ef207af71c13dd14e3;hb=8c60f5c681b5d7cf90bc798fcaf94cd4e242e27f;hp=291c43085a5ec4b10191f68c9cf5d4dfe7f843bb;hpb=b4d2a01828e5de85e5eee3631f7fe3925a0312ca;p=libguestfs.git diff --git a/ocaml/guestfs_c.c b/ocaml/guestfs_c.c index 291c430..86fa293 100644 --- a/ocaml/guestfs_c.c +++ b/ocaml/guestfs_c.c @@ -62,28 +62,19 @@ Val_guestfs (guestfs_h *g) CAMLreturn (rv); } -/* Handle errors. */ -/* XXX Like the current Perl bindings, this is unsafe in a multi- - * threaded environment. - */ -static char *last_error = NULL; - -static void -error_handler (guestfs_h *g, - void *data, - const char *msg) -{ - if (last_error != NULL) free (last_error); - last_error = strdup (msg); -} - void ocaml_guestfs_raise_error (guestfs_h *g, const char *func) { CAMLparam0 (); CAMLlocal1 (v); + const char *msg; - v = caml_copy_string (last_error); + msg = guestfs_last_error (g); + + if (msg) + v = caml_copy_string (msg); + else + v = caml_copy_string (func); caml_raise_with_arg (*caml_named_value ("ocaml_guestfs_error"), v); CAMLnoreturn; } @@ -100,7 +91,7 @@ ocaml_guestfs_create (void) if (g == NULL) caml_failwith ("failed to create guestfs handle"); - guestfs_set_error_handler (g, error_handler, NULL); + guestfs_set_error_handler (g, NULL, NULL); gv = Val_guestfs (g); CAMLreturn (gv); @@ -120,15 +111,19 @@ ocaml_guestfs_close (value gv) CAMLreturn (Val_unit); } -/* Copy string array value. */ +/* Copy string array value. + * The return value is only 'safe' provided we don't allocate anything + * further on the OCaml heap (ie. cannot trigger the OCaml GC) because + * that could move the strings around. + */ char ** -ocaml_guestfs_strings_val (value sv) +ocaml_guestfs_strings_val (guestfs_h *g, value sv) { CAMLparam1 (sv); char **r; int i; - r = malloc (sizeof (char *) * (Wosize_val (sv) + 1)); + r = guestfs_safe_malloc (g, sizeof (char *) * (Wosize_val (sv) + 1)); for (i = 0; i < Wosize_val (sv); ++i) r[i] = String_val (Field (sv, i)); r[i] = NULL;