Re: [PATCH v6 03/11] libxl: ocaml: event management

[David Scott <dave.scott@eu.citrix.com>]

This one looks fine to me

Acked-by: David Scott <dave.scott@eu.citrix.com>

On 09/12/13 15:17, Rob Hoes wrote:
> Having bindings to the low-level functions libxl_osevent_register_hooks and
> related, allows to run an event loop in OCaml; either one we write ourselves,
> or one that is available elsewhere.
>
> The Lwt cooperative threads library (http://ocsigen.org/lwt/), which is quite
> popular these days, has an event loop that can be easily extended to poll any
> additional fds that we get from libxl. Lwt provides a "lightweight" threading
> model, which does not let you run any other (POSIX) threads in your
> application, and therefore excludes an event loop implemented in the C
> bindings.
>
> Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
> CC: David Scott <dave.scott@eu.citrix.com>
> CC: Ian Jackson <ian.jackson@eu.citrix.com>
> CC: Ian Campbell <ian.campbell@citrix.com>
>
> ---
> v6: Register "user" values with the OCaml GC, before handing them over to
> libxl, and unregister when giving them back to OCaml (the latter applies only
> to the for_callback values that go into asynchronous libxl calls; the (os)event
> ones are registered once and kept forever).
>
> I removed the acks I had on this patch, because of the relatively significant
> changes.
> ---
>   tools/ocaml/libs/xl/xenlight.ml.in   |   37 ++++
>   tools/ocaml/libs/xl/xenlight.mli.in  |   38 ++++
>   tools/ocaml/libs/xl/xenlight_stubs.c |  350 ++++++++++++++++++++++++++++++++++
>   3 files changed, 425 insertions(+)
>
> diff --git a/tools/ocaml/libs/xl/xenlight.ml.in b/tools/ocaml/libs/xl/xenlight.ml.in
> index a281425..46106b5 100644
> --- a/tools/ocaml/libs/xl/xenlight.ml.in
> +++ b/tools/ocaml/libs/xl/xenlight.ml.in
> @@ -25,10 +25,47 @@ external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
>
>   external test_raise_exception: unit -> unit = "stub_raise_exception"
>
> +type event =
> +	| POLLIN (* There is data to read *)
> +	| POLLPRI (* There is urgent data to read *)
> +	| POLLOUT (* Writing now will not block *)
> +	| POLLERR (* Error condition (revents only) *)
> +	| POLLHUP (* Device has been disconnected (revents only) *)
> +	| POLLNVAL (* Invalid request: fd not open (revents only). *)
> +
>   external send_trigger : ctx -> domid -> trigger -> int -> unit = "stub_xl_send_trigger"
>   external send_sysrq : ctx -> domid -> char -> unit = "stub_xl_send_sysrq"
>   external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys"
>
> +module Async = struct
> +	type for_libxl
> +	type event_hooks
> +	type osevent_hooks
> +
> +	external osevent_register_hooks' : ctx -> 'a -> osevent_hooks = "stub_libxl_osevent_register_hooks"
> +	external osevent_occurred_fd : ctx -> for_libxl -> Unix.file_descr -> event list -> event list -> unit = "stub_libxl_osevent_occurred_fd"
> +	external osevent_occurred_timeout : ctx -> for_libxl -> unit = "stub_libxl_osevent_occurred_timeout"
> +
> +	let osevent_register_hooks ctx ~user ~fd_register ~fd_modify ~fd_deregister ~timeout_register ~timeout_modify =
> +		Callback.register "libxl_fd_register" fd_register;
> +		Callback.register "libxl_fd_modify" fd_modify;
> +		Callback.register "libxl_fd_deregister" fd_deregister;
> +		Callback.register "libxl_timeout_register" timeout_register;
> +		Callback.register "libxl_timeout_modify" timeout_modify;
> +		osevent_register_hooks' ctx user
> +
> +	let async_register_callback ~async_callback =
> +		Callback.register "libxl_async_callback" async_callback
> +
> +	external evenable_domain_death : ctx -> domid -> int -> unit = "stub_libxl_evenable_domain_death"
> +	external event_register_callbacks' : ctx -> 'a -> event_hooks = "stub_libxl_event_register_callbacks"
> +
> +	let event_register_callbacks ctx ~user ~event_occurs_callback ~event_disaster_callback =
> +		Callback.register "libxl_event_occurs_callback" event_occurs_callback;
> +		Callback.register "libxl_event_disaster_callback" event_disaster_callback;
> +		event_register_callbacks' ctx user
> +end
> +
>   let register_exceptions () =
>   	Callback.register_exception "Xenlight.Error" (Error(ERROR_FAIL, ""))
>
> diff --git a/tools/ocaml/libs/xl/xenlight.mli.in b/tools/ocaml/libs/xl/xenlight.mli.in
> index d663196..170e0e0 100644
> --- a/tools/ocaml/libs/xl/xenlight.mli.in
> +++ b/tools/ocaml/libs/xl/xenlight.mli.in
> @@ -27,7 +27,45 @@ external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc"
>
>   external test_raise_exception: unit -> unit = "stub_raise_exception"
>
> +type event =
> +	| POLLIN (* There is data to read *)
> +	| POLLPRI (* There is urgent data to read *)
> +	| POLLOUT (* Writing now will not block *)
> +	| POLLERR (* Error condition (revents only) *)
> +	| POLLHUP (* Device has been disconnected (revents only) *)
> +	| POLLNVAL (* Invalid request: fd not open (revents only). *)
> +
>   external send_trigger : ctx -> domid -> trigger -> int -> unit = "stub_xl_send_trigger"
>   external send_sysrq : ctx -> domid -> char -> unit = "stub_xl_send_sysrq"
>   external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys"
>
> +module Async : sig
> +	type for_libxl
> +	type event_hooks
> +	type osevent_hooks
> +
> +	val osevent_register_hooks : ctx ->
> +		user:'a ->
> +		fd_register:('a -> Unix.file_descr -> event list -> for_libxl -> unit) ->
> +		fd_modify:('a -> Unix.file_descr -> event list -> unit) ->
> +		fd_deregister:('a -> Unix.file_descr -> unit) ->
> +		timeout_register:('a -> int -> int -> for_libxl -> unit) ->
> +		timeout_modify:('a -> unit) ->
> +		osevent_hooks
> +
> +	external osevent_occurred_fd : ctx -> for_libxl -> Unix.file_descr -> event list -> event list -> unit = "stub_libxl_osevent_occurred_fd"
> +	external osevent_occurred_timeout : ctx -> for_libxl -> unit = "stub_libxl_osevent_occurred_timeout"
> +
> +	val async_register_callback :
> +		async_callback:(result:error option -> user:'a -> unit) ->
> +		unit
> +
> +	external evenable_domain_death : ctx -> domid -> int -> unit = "stub_libxl_evenable_domain_death"
> +
> +	val event_register_callbacks : ctx ->
> +		user:'a ->
> +		event_occurs_callback:('a -> Event.t -> unit) ->
> +		event_disaster_callback:('a -> event_type -> string -> int -> unit) ->
> +		event_hooks
> +end
> +
> diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
> index 80a5986..660dd09 100644
> --- a/tools/ocaml/libs/xl/xenlight_stubs.c
> +++ b/tools/ocaml/libs/xl/xenlight_stubs.c
> @@ -30,6 +30,8 @@
>   #include <libxl.h>
>   #include <libxl_utils.h>
>
> +#include <unistd.h>
> +
>   #include "caml_xentoollog.h"
>
>   #define Ctx_val(x)(*((libxl_ctx **) Data_custom_val(x)))
> @@ -370,6 +372,31 @@ static char *String_option_val(value v)
>
>   #include "_libxl_types.inc"
>
> +void async_callback(libxl_ctx *ctx, int rc, void *for_callback)
> +{
> +	CAMLparam0();
> +	CAMLlocal2(error, tmp);
> +	static value *func = NULL;
> +	value *p = (value *) for_callback;
> +
> +	if (func == NULL) {
> +		/* First time around, lookup by name */
> +		func = caml_named_value("libxl_async_callback");
> +	}
> +
> +	if (rc == 0)
> +		error = Val_none;
> +	else {
> +		tmp = Val_error(rc);
> +		error = Val_some(tmp);
> +	}
> +
> +	caml_callback2(*func, error, *p);
> +
> +	caml_remove_global_root(p);
> +	free(p);
> +}
> +
>   #define _STRINGIFY(x) #x
>   #define STRINGIFY(x) _STRINGIFY(x)
>
> @@ -703,6 +730,329 @@ value stub_xl_send_debug_keys(value ctx, value keys)
>   	CAMLreturn(Val_unit);
>   }
>
> +
> +/* Event handling */
> +
> +short Poll_val(value event)
> +{
> +	CAMLparam1(event);
> +	short res = -1;
> +
> +	switch (Int_val(event)) {
> +		case 0: res = POLLIN; break;
> +		case 1: res = POLLPRI; break;
> +		case 2: res = POLLOUT; break;
> +		case 3: res = POLLERR; break;
> +		case 4: res = POLLHUP; break;
> +		case 5: res = POLLNVAL; break;
> +	}
> +
> +	CAMLreturn(res);
> +}
> +
> +short Poll_events_val(value event_list)
> +{
> +	CAMLparam1(event_list);
> +	short events = 0;
> +
> +	while (event_list != Val_emptylist) {
> +		events |= Poll_val(Field(event_list, 0));
> +		event_list = Field(event_list, 1);
> +	}
> +
> +	CAMLreturn(events);
> +}
> +
> +value Val_poll(short event)
> +{
> +	CAMLparam0();
> +	CAMLlocal1(res);
> +
> +	switch (event) {
> +		case POLLIN: res = Val_int(0); break;
> +		case POLLPRI: res = Val_int(1); break;
> +		case POLLOUT: res = Val_int(2); break;
> +		case POLLERR: res = Val_int(3); break;
> +		case POLLHUP: res = Val_int(4); break;
> +		case POLLNVAL: res = Val_int(5); break;
> +		default: failwith_xl(ERROR_FAIL, "cannot convert poll event value"); break;
> +	}
> +
> +	CAMLreturn(res);
> +}
> +
> +value add_event(value event_list, short event)
> +{
> +	CAMLparam1(event_list);
> +	CAMLlocal1(new_list);
> +
> +	new_list = caml_alloc(2, 0);
> +	Store_field(new_list, 0, Val_poll(event));
> +	Store_field(new_list, 1, event_list);
> +
> +	CAMLreturn(new_list);
> +}
> +
> +value Val_poll_events(short events)
> +{
> +	CAMLparam0();
> +	CAMLlocal1(event_list);
> +
> +	event_list = Val_emptylist;
> +	if (events & POLLIN)
> +		event_list = add_event(event_list, POLLIN);
> +	if (events & POLLPRI)
> +		event_list = add_event(event_list, POLLPRI);
> +	if (events & POLLOUT)
> +		event_list = add_event(event_list, POLLOUT);
> +	if (events & POLLERR)
> +		event_list = add_event(event_list, POLLERR);
> +	if (events & POLLHUP)
> +		event_list = add_event(event_list, POLLHUP);
> +	if (events & POLLNVAL)
> +		event_list = add_event(event_list, POLLNVAL);
> +
> +	CAMLreturn(event_list);
> +}
> +
> +int fd_register(void *user, int fd, void **for_app_registration_out,
> +                     short events, void *for_libxl)
> +{
> +	CAMLparam0();
> +	CAMLlocalN(args, 4);
> +	static value *func = NULL;
> +	value *p = (value *) user;
> +
> +	if (func == NULL) {
> +		/* First time around, lookup by name */
> +		func = caml_named_value("libxl_fd_register");
> +	}
> +
> +	args[0] = *p;
> +	args[1] = Val_int(fd);
> +	args[2] = Val_poll_events(events);
> +	args[3] = (value) for_libxl;
> +
> +	caml_callbackN(*func, 4, args);
> +	CAMLreturn(0);
> +}
> +
> +int fd_modify(void *user, int fd, void **for_app_registration_update,
> +                   short events)
> +{
> +	CAMLparam0();
> +	CAMLlocalN(args, 3);
> +	static value *func = NULL;
> +	value *p = (value *) user;
> +
> +	if (func == NULL) {
> +		/* First time around, lookup by name */
> +		func = caml_named_value("libxl_fd_modify");
> +	}
> +
> +	args[0] = *p;
> +	args[1] = Val_int(fd);
> +	args[2] = Val_poll_events(events);
> +
> +	caml_callbackN(*func, 3, args);
> +	CAMLreturn(0);
> +}
> +
> +void fd_deregister(void *user, int fd, void *for_app_registration)
> +{
> +	CAMLparam0();
> +	CAMLlocalN(args, 2);
> +	static value *func = NULL;
> +	value *p = (value *) user;
> +
> +	if (func == NULL) {
> +		/* First time around, lookup by name */
> +		func = caml_named_value("libxl_fd_deregister");
> +	}
> +
> +	args[0] = *p;
> +	args[1] = Val_int(fd);
> +
> +	caml_callbackN(*func, 2, args);
> +	CAMLreturn0;
> +}
> +
> +int timeout_register(void *user, void **for_app_registration_out,
> +                          struct timeval abs, void *for_libxl)
> +{
> +	CAMLparam0();
> +	CAMLlocalN(args, 4);
> +	static value *func = NULL;
> +	value *p = (value *) user;
> +
> +	if (func == NULL) {
> +		/* First time around, lookup by name */
> +		func = caml_named_value("libxl_timeout_register");
> +	}
> +
> +	args[0] = *p;
> +	args[1] = Val_int(abs.tv_sec);
> +	args[2] = Val_int(abs.tv_usec);
> +	args[3] = (value) for_libxl;
> +
> +	caml_callbackN(*func, 4, args);
> +	CAMLreturn(0);
> +}
> +
> +int timeout_modify(void *user, void **for_app_registration_update,
> +                         struct timeval abs)
> +{
> +	CAMLparam0();
> +	static value *func = NULL;
> +	value *p = (value *) user;
> +
> +	if (func == NULL) {
> +		/* First time around, lookup by name */
> +		func = caml_named_value("libxl_timeout_modify");
> +	}
> +
> +	caml_callback(*func, *p);
> +	CAMLreturn(0);
> +}
> +
> +void timeout_deregister(void *user, void *for_app_registration)
> +{
> +	failwith_xl(ERROR_FAIL, "timeout_deregister not yet implemented");
> +	return;
> +}
> +
> +value stub_libxl_osevent_register_hooks(value ctx, value user)
> +{
> +	CAMLparam2(ctx, user);
> +	CAMLlocal1(result);
> +	libxl_osevent_hooks *hooks;
> +	value *p;
> +
> +	hooks = malloc(sizeof(*hooks));
> +	if (!hooks)
> +		failwith_xl(ERROR_NOMEM, "cannot allocate osevent hooks");
> +	hooks->fd_register = fd_register;
> +	hooks->fd_modify = fd_modify;
> +	hooks->fd_deregister = fd_deregister;
> +	hooks->timeout_register = timeout_register;
> +	hooks->timeout_modify = timeout_modify;
> +	hooks->timeout_deregister = timeout_deregister;
> +
> +	p = malloc(sizeof(value));
> +	if (!p)
> +		failwith_xl(ERROR_NOMEM, "cannot allocate value");
> +	*p = user;
> +	caml_register_global_root(p);
> +
> +	libxl_osevent_register_hooks(CTX, hooks, (void *) p);
> +
> +	result = caml_alloc(1, Abstract_tag);
> +	*((libxl_osevent_hooks **) result) = hooks;
> +
> +	CAMLreturn(result);
> +}
> +
> +value stub_libxl_osevent_occurred_fd(value ctx, value for_libxl, value fd,
> +	value events, value revents)
> +{
> +	CAMLparam5(ctx, for_libxl, fd, events, revents);
> +	libxl_osevent_occurred_fd(CTX, (void *) for_libxl, Int_val(fd),
> +		Poll_events_val(events), Poll_events_val(revents));
> +	CAMLreturn(Val_unit);
> +}
> +
> +value stub_libxl_osevent_occurred_timeout(value ctx, value for_libxl)
> +{
> +	CAMLparam2(ctx, for_libxl);
> +	libxl_osevent_occurred_timeout(CTX, (void *) for_libxl);
> +	CAMLreturn(Val_unit);
> +}
> +
> +struct user_with_ctx {
> +	libxl_ctx *ctx;
> +	value user;
> +};
> +
> +void event_occurs(void *user, libxl_event *event)
> +{
> +	CAMLparam0();
> +	CAMLlocalN(args, 2);
> +	struct user_with_ctx *c_user = (struct user_with_ctx *) user;
> +	static value *func = NULL;
> +
> +	if (func == NULL) {
> +		/* First time around, lookup by name */
> +		func = caml_named_value("libxl_event_occurs_callback");
> +	}
> +
> +	args[0] = c_user->user;
> +	args[1] = Val_event(event);
> +	libxl_event_free(c_user->ctx, event);
> +
> +	caml_callbackN(*func, 2, args);
> +	CAMLreturn0;
> +}
> +
> +void disaster(void *user, libxl_event_type type,
> +                     const char *msg, int errnoval)
> +{
> +	CAMLparam0();
> +	CAMLlocalN(args, 4);
> +	struct user_with_ctx *c_user = (struct user_with_ctx *) user;
> +	static value *func = NULL;
> +
> +	if (func == NULL) {
> +		/* First time around, lookup by name */
> +		func = caml_named_value("libxl_event_disaster_callback");
> +	}
> +
> +	args[0] = c_user->user;
> +	args[1] = Val_event_type(type);
> +	args[2] = caml_copy_string(msg);
> +	args[3] = Val_int(errnoval);
> +
> +	caml_callbackN(*func, 4, args);
> +	CAMLreturn0;
> +}
> +
> +value stub_libxl_event_register_callbacks(value ctx, value user)
> +{
> +	CAMLparam2(ctx, user);
> +	CAMLlocal1(result);
> +	struct user_with_ctx *c_user = NULL;
> +	libxl_event_hooks *hooks;
> +
> +	c_user = malloc(sizeof(*c_user));
> +	if (!c_user)
> +		failwith_xl(ERROR_NOMEM, "cannot allocate user value");
> +	c_user->user = user;
> +	c_user->ctx = CTX;
> +	caml_register_global_root(&c_user->user);
> +
> +	hooks = malloc(sizeof(*hooks));
> +	if (!hooks)
> +		failwith_xl(ERROR_NOMEM, "cannot allocate event hooks");
> +	hooks->event_occurs_mask = LIBXL_EVENTMASK_ALL;
> +	hooks->event_occurs = event_occurs;
> +	hooks->disaster = disaster;
> +
> +	libxl_event_register_callbacks(CTX, hooks, (void *) c_user);
> +	result = caml_alloc(1, Abstract_tag);
> +	*((libxl_event_hooks **) result) = hooks;
> +
> +	CAMLreturn(result);
> +}
> +
> +value stub_libxl_evenable_domain_death(value ctx, value domid, value user)
> +{
> +	CAMLparam3(ctx, domid, user);
> +	libxl_evgen_domain_death *evgen_out;
> +
> +	libxl_evenable_domain_death(CTX, Int_val(domid), Int_val(user), &evgen_out);
> +
> +	CAMLreturn(Val_unit);
> +}
> +
>   /*
>    * Local variables:
>    *  indent-tabs-mode: t
>