[Libguestfs] [PATCH 6/8] ocaml: Add binding for guestfs_user_cancel.

[Richard W.M. Jones]

-- 
Richard Jones, Virtualization Group, Red Hat http://people.redhat.com/~rjones
Read my programming blog: http://rwmj.wordpress.com
Fedora now supports 80 OCaml packages (the OPEN alternative to F#)
http://cocan.org/getting_started_with_ocaml_on_red_hat_and_fedora
-------------- next part --------------
>From 60dd9494f0890dcc6c9a1cce311edc92cb992290 Mon Sep 17 00:00:00 2001
From: "Richard W.M. Jones" <rjones at redhat.com>
Date: Fri, 15 Jul 2011 14:33:29 +0100
Subject: [PATCH 6/8] ocaml: Add binding for guestfs_user_cancel.

---
 generator/generator_ocaml.ml |    8 ++++++++
 ocaml/guestfs_c.c            |   11 +++++++++++
 2 files changed, 19 insertions(+), 0 deletions(-)

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;
+}
-- 
1.7.5.2