From: Richard W.M. Jones <rjones@redhat.com>
Date: Fri, 15 Jul 2011 13:33:29 +0000 (+0100)
Subject: ocaml: Add binding for guestfs_user_cancel.
X-Git-Tag: 1.11.18~5
X-Git-Url: http://git.annexia.org/?p=libguestfs.git;a=commitdiff_plain;h=60dd9494f0890dcc6c9a1cce311edc92cb992290

ocaml: Add binding for guestfs_user_cancel.
---

diff --git a/generator/generator_ocaml.ml b/generator/generator_ocaml.ml
index aa1adec..aafc6cb 100644
--- a/generator/generator_ocaml.ml
+++ b/generator/generator_ocaml.ml
@@ -94,6 +94,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 user_cancel : t -> unit
+(** Cancel current transfer.  This is safe to call from OCaml signal
+    handlers and threads. *)
+
 ";
   generate_ocaml_structure_decls ();
 
@@ -129,6 +133,7 @@ class guestfs : unit -> object
   method close : unit -> unit
   method set_event_callback : event_callback -> event list -> event_handle
   method delete_event_callback : event_handle -> unit
+  method user_cancel : unit -> unit
   method ocaml_handle : t
 ";
 
@@ -188,6 +193,8 @@ external set_event_callback : t -> event_callback -> event list -> event_handle
 external delete_event_callback : t -> event_handle -> unit
   = \"ocaml_guestfs_delete_event_callback\"
 
+external user_cancel : t -> unit = \"ocaml_guestfs_user_cancel\" \"noalloc\"
+
 (* Give the exceptions names, so they can be raised from the C code. *)
 let () =
   Callback.register_exception \"ocaml_guestfs_error\" (Error \"\");
@@ -211,6 +218,7 @@ class guestfs () =
     method close () = close g
     method set_event_callback = set_event_callback g
     method delete_event_callback = delete_event_callback g
+    method user_cancel () = user_cancel g
     method ocaml_handle = g
 ";
 
diff --git a/ocaml/guestfs_c.c b/ocaml/guestfs_c.c
index a1386ec..45b8eae 100644
--- a/ocaml/guestfs_c.c
+++ b/ocaml/guestfs_c.c
@@ -52,6 +52,7 @@ CAMLprim value ocaml_guestfs_create (void);
 CAMLprim value ocaml_guestfs_close (value gv);
 CAMLprim value ocaml_guestfs_set_event_callback (value gv, value closure, value events);
 CAMLprim value ocaml_guestfs_delete_event_callback (value gv, value eh);
+value ocaml_guestfs_user_cancel (value gv);
 
 /* Allocate handles and deal with finalization. */
 static void
@@ -372,3 +373,13 @@ event_callback_wrapper (guestfs_h *g,
 
   CAMLreturn0;
 }
+
+/* NB: This is and must remain a "noalloc" function. */
+value
+ocaml_guestfs_user_cancel (value gv)
+{
+  guestfs_h *g = Guestfs_val (gv);
+  if (g)
+    guestfs_user_cancel (g);
+  return Val_unit;
+}