X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=blobdiff_plain;f=ocaml%2Fguestfs_c.c;h=80dcf9954f1a0fc28516b728e33645ba2c921400;hp=600440c92966ef54c2999eb2c4bf652644e3a226;hb=c6b8db6493dd633bf48b13daf72cdc9c078b5f9a;hpb=13339826ea01f8dbd581b5d2544e7692171cf386 diff --git a/ocaml/guestfs_c.c b/ocaml/guestfs_c.c index 600440c..80dcf99 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,28 +76,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 +105,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 +124,33 @@ ocaml_guestfs_close (value gv) CAMLreturn (Val_unit); } + +/* 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 (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] = String_val (Field (sv, i)); + r[i] = NULL; + + CAMLreturnT (char **, r); +} + +/* Free array of strings. */ +void +ocaml_guestfs_free_strings (char **argv) +{ + /* Don't free the actual strings - they are String_vals on + * the OCaml heap. + */ + free (argv); +}