From 5c513060b17def062dcafdae13ff4fe05f49dbe2 Mon Sep 17 00:00:00 2001 From: "Richard W.M. Jones" Date: Mon, 18 Feb 2013 22:55:21 +0000 Subject: [PATCH] ocaml: Add binding for Guestfs.event_to_string and use it in events test. --- configure.ac | 8 ++++++++ generator/ocaml.ml | 6 ++++++ ocaml/examples/Makefile.am | 2 +- ocaml/guestfs-c.c | 29 +++++++++++++++++++++++++++++ ocaml/t/guestfs_400_events.ml | 14 +------------- 5 files changed, 45 insertions(+), 14 deletions(-) diff --git a/configure.ac b/configure.ac index 5129f4fa7..105b2e7e8 100644 --- a/configure.ac +++ b/configure.ac @@ -934,6 +934,14 @@ AM_CONDITIONAL([HAVE_OCAML], AM_CONDITIONAL([HAVE_OCAMLDOC], [test "x$OCAMLDOC" != "xno"]) +AS_IF([test "x$OCAMLC" != "xno"],[ + dnl Check for header. + old_CPPFLAGS="$CPPFLAGS" + CPPFLAGS="$CPPFLAGS -I`$OCAMLC -where`" + AC_CHECK_HEADERS([caml/unixsupport.h],[],[],[#include ]) + CPPFLAGS="$old_CPPFLAGS" +]) + OCAML_PKG_gettext=no AS_IF([test "x$OCAMLC" != "xno"],[ dnl Check for ocaml-gettext package to translate OCaml tools. diff --git a/generator/ocaml.ml b/generator/ocaml.ml index 315d33da9..c2e43ee34 100644 --- a/generator/ocaml.ml +++ b/generator/ocaml.ml @@ -112,6 +112,10 @@ val delete_event_callback : t -> event_handle -> unit (** [delete_event_callback g eh] removes a previously registered event callback. See {!set_event_callback}. *) +val event_to_string : event list -> string +(** [event_to_string events] returns the event(s) as a printable string + for debugging etc. *) + val last_errno : t -> int (** [last_errno g] returns the last errno that happened on the handle [g] (or [0] if there was no errno). Note that the returned integer is the @@ -249,6 +253,8 @@ external set_event_callback : t -> event_callback -> event list -> event_handle = \"ocaml_guestfs_set_event_callback\" external delete_event_callback : t -> event_handle -> unit = \"ocaml_guestfs_delete_event_callback\" +external event_to_string : event list -> string + = \"ocaml_guestfs_event_to_string\" external last_errno : t -> int = \"ocaml_guestfs_last_errno\" diff --git a/ocaml/examples/Makefile.am b/ocaml/examples/Makefile.am index 7860dc601..b906ea056 100644 --- a/ocaml/examples/Makefile.am +++ b/ocaml/examples/Makefile.am @@ -52,7 +52,7 @@ create_disk: create_disk.ml -warn-error A -I .. mlguestfs.cmxa $< -o $@ inspect_vm: inspect_vm.ml - $(OCAMLFIND) ocamlopt $(OCAMLFINDFLAGS) \ + $(OCAMLFIND) ocamlopt $(OCAMLFINDFLAGS) -package unix -linkpkg \ -warn-error A -I .. mlguestfs.cmxa $< -o $@ endif diff --git a/ocaml/guestfs-c.c b/ocaml/guestfs-c.c index 45437da31..75cbc39f3 100644 --- a/ocaml/guestfs-c.c +++ b/ocaml/guestfs-c.c @@ -20,6 +20,7 @@ #include #include #include +#include #include @@ -33,6 +34,13 @@ #include #include +#ifdef HAVE_CAML_UNIXSUPPORT_H +#include +#else +#define Nothing ((value) 0) +extern void unix_error (int errcode, char * cmdname, value arg) Noreturn; +#endif + #include "guestfs-c.h" static value **get_all_event_callbacks (guestfs_h *g, size_t *len_rtn); @@ -52,6 +60,7 @@ value ocaml_guestfs_create (value environmentv, value close_on_exitv, value unit value ocaml_guestfs_close (value gv); value ocaml_guestfs_set_event_callback (value gv, value closure, value events); value ocaml_guestfs_delete_event_callback (value gv, value eh); +value ocaml_guestfs_event_to_string (value events); value ocaml_guestfs_last_errno (value gv); value ocaml_guestfs_user_cancel (value gv); @@ -291,6 +300,26 @@ ocaml_guestfs_delete_event_callback (value gv, value ehv) CAMLreturn (Val_unit); } +/* Guestfs.event_to_string */ +value +ocaml_guestfs_event_to_string (value events) +{ + CAMLparam1 (events); + CAMLlocal1 (rv); + char *r; + uint64_t event_bitmask; + + event_bitmask = event_bitmask_of_event_list (events); + + r = guestfs_event_to_string (event_bitmask); + if (r == NULL) + unix_error (errno, (char *) "Guestfs.event_to_string", Nothing); + + rv = caml_copy_string (r); + free (r); + CAMLreturn (rv); +} + static value ** get_all_event_callbacks (guestfs_h *g, size_t *len_rtn) { diff --git a/ocaml/t/guestfs_400_events.ml b/ocaml/t/guestfs_400_events.ml index be406087f..baf834074 100644 --- a/ocaml/t/guestfs_400_events.ml +++ b/ocaml/t/guestfs_400_events.ml @@ -19,22 +19,10 @@ open Printf let log g ev eh buf array = - let ev = - match ev with - | Guestfs.EVENT_CLOSE -> "close" - | Guestfs.EVENT_SUBPROCESS_QUIT -> "subprocess_quit" - | Guestfs.EVENT_LAUNCH_DONE -> "launch_done" - | Guestfs.EVENT_PROGRESS -> "progress" - | Guestfs.EVENT_APPLIANCE -> "appliance" - | Guestfs.EVENT_LIBRARY -> "library" - | Guestfs.EVENT_TRACE -> "trace" - | Guestfs.EVENT_ENTER -> "enter" - | Guestfs.EVENT_LIBVIRT_AUTH -> "libvirt_auth" in - let eh : int = Obj.magic eh in printf "ocaml event logged: event=%s eh=%d buf=%S array=[%s]\n" - ev eh buf + (Guestfs.event_to_string [ev]) eh buf (String.concat ", " (List.map Int64.to_string (Array.to_list array))) let close_invoked = ref 0