diff options
| -rw-r--r-- | generator/generator_ocaml.ml | 8 | ||||
| -rw-r--r-- | 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 aa1adec4..aafc6cb6 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 a1386ec7..45b8eaed 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; +} |