X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=ocaml%2Fguestfs_c.c;h=71f416ab64c718054cf3d8730fcf3a728c941e48;hp=600440c92966ef54c2999eb2c4bf652644e3a226;hb=2e7da2a2f3bbc6d6db148d7dc2ce238bf56f34db;hpb=13339826ea01f8dbd581b5d2544e7692171cf386 diff --git a/ocaml/guestfs_c.c b/ocaml/guestfs_c.c index 600440c..71f416a 100644 --- a/ocaml/guestfs_c.c +++ b/ocaml/guestfs_c.c @@ -16,6 +16,7 @@ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA */ +#include #include #include #include @@ -32,6 +33,19 @@ #include "guestfs_c.h" +/* This macro was added in OCaml 3.10. Backport for earlier versions. */ +#ifndef CAMLreturnT +#define CAMLreturnT(type, result) do{ \ + type caml__temp_result = (result); \ + caml_local_roots = caml__frame; \ + return (caml__temp_result); \ +}while(0) +#endif + +/* These prototypes are solely to quiet gcc warning. */ +CAMLprim value ocaml_guestfs_create (void); +CAMLprim value ocaml_guestfs_close (value gv); + /* Allocate handles and deal with finalization. */ static void guestfs_finalize (value gv) @@ -41,7 +55,7 @@ guestfs_finalize (value gv) } static struct custom_operations guestfs_custom_operations = { - "guestfs_custom_operations", + (char *) "guestfs_custom_operations", guestfs_finalize, custom_compare_default, custom_hash_default, @@ -62,29 +76,31 @@ 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) +void +ocaml_guestfs_raise_error (guestfs_h *g, const char *func) { - if (last_error != NULL) free (last_error); - last_error = strdup (msg); + CAMLparam0 (); + CAMLlocal1 (v); + const char *msg; + + 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; } void -ocaml_guestfs_raise_error (guestfs_h *g, const char *func) +ocaml_guestfs_raise_closed (const char *func) { CAMLparam0 (); CAMLlocal1 (v); - v = caml_copy_string (last_error); - caml_raise_with_arg (*caml_named_value ("ocaml_guestfs_error"), v); + v = caml_copy_string (func); + caml_raise_with_arg (*caml_named_value ("ocaml_guestfs_closed"), v); CAMLnoreturn; } @@ -100,7 +116,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); @@ -119,3 +135,30 @@ ocaml_guestfs_close (value gv) CAMLreturn (Val_unit); } + +/* Copy string array value. */ +char ** +ocaml_guestfs_strings_val (guestfs_h *g, value sv) +{ + CAMLparam1 (sv); + char **r; + unsigned int i; + + r = guestfs_safe_malloc (g, sizeof (char *) * (Wosize_val (sv) + 1)); + for (i = 0; i < Wosize_val (sv); ++i) + r[i] = guestfs_safe_strdup (g, String_val (Field (sv, i))); + r[i] = NULL; + + CAMLreturnT (char **, r); +} + +/* Free array of strings. */ +void +ocaml_guestfs_free_strings (char **argv) +{ + unsigned int i; + + for (i = 0; argv[i] != NULL; ++i) + free (argv[i]); + free (argv); +}