Re: [PATCH v6 06/11] libxl: ocaml: add VM lifecycle operations

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

Also fine by me

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

On 09/12/13 15:17, Rob Hoes wrote:
> Also, reorganise toplevel OCaml functions into modules of Xenlight.
>
> Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
> CC: David Scott <dave.scott@eu.citrix.com>
> CC: Ian Campbell <ian.campbell@citrix.com>
>
> ---
> v6: Updated aohow_val to register for_callback with the OCaml GC.
> ---
>   tools/ocaml/libs/xl/xenlight.ml.in   |   21 ++++-
>   tools/ocaml/libs/xl/xenlight.mli.in  |   21 ++++-
>   tools/ocaml/libs/xl/xenlight_stubs.c |  167 ++++++++++++++++++++++++++++++++--
>   tools/ocaml/test/send_debug_keys.ml  |    2 +-
>   4 files changed, 194 insertions(+), 17 deletions(-)
>
> diff --git a/tools/ocaml/libs/xl/xenlight.ml.in b/tools/ocaml/libs/xl/xenlight.ml.in
> index 46106b5..fc05112 100644
> --- a/tools/ocaml/libs/xl/xenlight.ml.in
> +++ b/tools/ocaml/libs/xl/xenlight.ml.in
> @@ -33,9 +33,24 @@ type event =
>   	| 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 Domain = struct
> +	external create_new : ctx -> Domain_config.t -> ?async:'a -> unit -> domid = "stub_libxl_domain_create_new"
> +	external create_restore : ctx -> Domain_config.t -> (Unix.file_descr * Domain_restore_params.t) ->
> +		?async:'a -> unit -> domid = "stub_libxl_domain_create_restore"
> +	external shutdown : ctx -> domid -> unit = "stub_libxl_domain_shutdown"
> +	external reboot : ctx -> domid -> unit = "stub_libxl_domain_reboot"
> +	external destroy : ctx -> domid -> ?async:'a -> unit -> unit = "stub_libxl_domain_destroy"
> +	external suspend : ctx -> domid -> Unix.file_descr -> ?async:'a -> unit -> unit = "stub_libxl_domain_suspend"
> +	external pause : ctx -> domid -> unit = "stub_libxl_domain_pause"
> +	external unpause : ctx -> domid -> unit = "stub_libxl_domain_unpause"
> +
> +	external send_trigger : ctx -> domid -> trigger -> int -> unit = "stub_xl_send_trigger"
> +	external send_sysrq : ctx -> domid -> char -> unit = "stub_xl_send_sysrq"
> +end
> +
> +module Host = struct
> +	external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys"
> +end
>
>   module Async = struct
>   	type for_libxl
> diff --git a/tools/ocaml/libs/xl/xenlight.mli.in b/tools/ocaml/libs/xl/xenlight.mli.in
> index 170e0e0..ee4efd8 100644
> --- a/tools/ocaml/libs/xl/xenlight.mli.in
> +++ b/tools/ocaml/libs/xl/xenlight.mli.in
> @@ -35,9 +35,24 @@ type event =
>   	| 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 Domain : sig
> +	external create_new : ctx -> Domain_config.t -> ?async:'a -> unit -> domid = "stub_libxl_domain_create_new"
> +	external create_restore : ctx -> Domain_config.t -> (Unix.file_descr * Domain_restore_params.t) ->
> +		?async:'a -> unit -> domid = "stub_libxl_domain_create_restore"
> +	external shutdown : ctx -> domid -> unit = "stub_libxl_domain_shutdown"
> +	external reboot : ctx -> domid -> unit = "stub_libxl_domain_reboot"
> +	external destroy : ctx -> domid -> ?async:'a -> unit -> unit = "stub_libxl_domain_destroy"
> +	external suspend : ctx -> domid -> Unix.file_descr -> ?async:'a -> unit -> unit = "stub_libxl_domain_suspend"
> +	external pause : ctx -> domid -> unit = "stub_libxl_domain_pause"
> +	external unpause : ctx -> domid -> unit = "stub_libxl_domain_unpause"
> +
> +	external send_trigger : ctx -> domid -> trigger -> int -> unit = "stub_xl_send_trigger"
> +	external send_sysrq : ctx -> domid -> char -> unit = "stub_xl_send_sysrq"
> +end
> +
> +module Host : sig
> +	external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys"
> +end
>
>   module Async : sig
>   	type for_libxl
> diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
> index 2195632..b03fd93 100644
> --- a/tools/ocaml/libs/xl/xenlight_stubs.c
> +++ b/tools/ocaml/libs/xl/xenlight_stubs.c
> @@ -397,6 +397,162 @@ void async_callback(libxl_ctx *ctx, int rc, void *for_callback)
>   	free(p);
>   }
>
> +static libxl_asyncop_how *aohow_val(value async, libxl_asyncop_how *ao_how)
> +{
> +	CAMLparam1(async);
> +	value *p;
> +
> +	if (async != Val_none) {
> +		p = malloc(sizeof(value));
> +		if (!p)
> +			failwith_xl(ERROR_NOMEM, "cannot allocate value");
> +		*p = Some_val(async);
> +		caml_register_global_root(p);
> +		ao_how->callback = async_callback;
> +		ao_how->u.for_callback = (void *) p;
> +		CAMLreturnT(libxl_asyncop_how *, ao_how);
> +	}
> +	else
> +		CAMLreturnT(libxl_asyncop_how *, NULL);
> +}
> +
> +value stub_libxl_domain_create_new(value ctx, value domain_config, value async, value unit)
> +{
> +	CAMLparam4(ctx, async, domain_config, unit);
> +	int ret;
> +	libxl_domain_config c_dconfig;
> +	uint32_t c_domid;
> +	libxl_asyncop_how ao_how;
> +
> +	libxl_domain_config_init(&c_dconfig);
> +	ret = domain_config_val(CTX, &c_dconfig, domain_config);
> +	if (ret != 0) {
> +		libxl_domain_config_dispose(&c_dconfig);
> +		failwith_xl(ret, "domain_create_new");
> +	}
> +
> +	ret = libxl_domain_create_new(CTX, &c_dconfig, &c_domid,
> +		aohow_val(async, &ao_how), NULL);
> +
> +	libxl_domain_config_dispose(&c_dconfig);
> +
> +	if (ret != 0)
> +		failwith_xl(ret, "domain_create_new");
> +
> +	CAMLreturn(Val_int(c_domid));
> +}
> +
> +value stub_libxl_domain_create_restore(value ctx, value domain_config, value params,
> +	value async, value unit)
> +{
> +	CAMLparam5(ctx, domain_config, params, async, unit);
> +	int ret;
> +	libxl_domain_config c_dconfig;
> +	libxl_domain_restore_params c_params;
> +	uint32_t c_domid;
> +	libxl_asyncop_how ao_how;
> +
> +	libxl_domain_config_init(&c_dconfig);
> +	ret = domain_config_val(CTX, &c_dconfig, domain_config);
> +	if (ret != 0) {
> +		libxl_domain_config_dispose(&c_dconfig);
> +		failwith_xl(ret, "domain_create_restore");
> +	}
> +
> +	libxl_domain_restore_params_init(&c_params);
> +	ret = domain_restore_params_val(CTX, &c_params, Field(params, 1));
> +	if (ret != 0) {
> +		libxl_domain_restore_params_dispose(&c_params);
> +		failwith_xl(ret, "domain_create_restore");
> +	}
> +
> +	ret = libxl_domain_create_restore(CTX, &c_dconfig, &c_domid, Int_val(Field(params, 0)),
> +		&c_params, aohow_val(async, &ao_how), NULL);
> +
> +	libxl_domain_config_dispose(&c_dconfig);
> +	libxl_domain_restore_params_dispose(&c_params);
> +
> +	if (ret != 0)
> +		failwith_xl(ret, "domain_create_restore");
> +
> +	CAMLreturn(Val_int(c_domid));
> +}
> +
> +value stub_libxl_domain_shutdown(value ctx, value domid)
> +{
> +	CAMLparam2(ctx, domid);
> +	int ret;
> +
> +	ret = libxl_domain_shutdown(CTX, Int_val(domid));
> +	if (ret != 0)
> +		failwith_xl(ret, "domain_shutdown");
> +
> +	CAMLreturn(Val_unit);
> +}
> +
> +value stub_libxl_domain_reboot(value ctx, value domid)
> +{
> +	CAMLparam2(ctx, domid);
> +	int ret;
> +
> +	ret = libxl_domain_reboot(CTX, Int_val(domid));
> +	if (ret != 0)
> +		failwith_xl(ret, "domain_reboot");
> +
> +	CAMLreturn(Val_unit);
> +}
> +
> +value stub_libxl_domain_destroy(value ctx, value domid, value async, value unit)
> +{
> +	CAMLparam4(ctx, domid, async, unit);
> +	int ret;
> +	libxl_asyncop_how ao_how;
> +
> +	ret = libxl_domain_destroy(CTX, Int_val(domid), aohow_val(async, &ao_how));
> +	if (ret != 0)
> +		failwith_xl(ret, "domain_destroy");
> +
> +	CAMLreturn(Val_unit);
> +}
> +
> +value stub_libxl_domain_suspend(value ctx, value domid, value fd, value async, value unit)
> +{
> +	CAMLparam5(ctx, domid, fd, async, unit);
> +	int ret;
> +	libxl_asyncop_how ao_how;
> +
> +	ret = libxl_domain_suspend(CTX, Int_val(domid), Int_val(fd), 0,
> +		aohow_val(async, &ao_how));
> +	if (ret != 0)
> +		failwith_xl(ret, "domain_suspend");
> +
> +	CAMLreturn(Val_unit);
> +}
> +
> +value stub_libxl_domain_pause(value ctx, value domid)
> +{
> +	CAMLparam2(ctx, domid);
> +	int ret;
> +
> +	ret = libxl_domain_pause(CTX, Int_val(domid));
> +	if (ret != 0)
> +		failwith_xl(ret, "domain_pause");
> +
> +	CAMLreturn(Val_unit);
> +}
> +
> +value stub_libxl_domain_unpause(value ctx, value domid)
> +{
> +	CAMLparam2(ctx, domid);
> +	int ret;
> +
> +	ret = libxl_domain_unpause(CTX, Int_val(domid));
> +	if (ret != 0)
> +		failwith_xl(ret, "domain_unpause");
> +
> +	CAMLreturn(Val_unit);
> +}
> +
>   #define _STRINGIFY(x) #x
>   #define STRINGIFY(x) _STRINGIFY(x)
>
> @@ -408,20 +564,11 @@ value stub_xl_device_##type##_##op(value ctx, value info, value domid,	\
>   	libxl_device_##type c_info;					\
>   	int ret, marker_var;						\
>   	libxl_asyncop_how ao_how;					\
> -	value *p;							\
>   									\
>   	device_##type##_val(CTX, &c_info, info);			\
>   									\
> -	if (async != Val_none) {					\
> -		p = malloc(sizeof(value));				\
> -		*p = Some_val(async);					\
> -		caml_register_global_root(p);				\
> -		ao_how.callback = async_callback;			\
> -		ao_how.u.for_callback = (void *) p;			\
> -	}								\
> -									\
>   	ret = libxl_##fn##_##op(CTX, Int_val(domid), &c_info,		\
> -		async != Val_none ? &ao_how : NULL);			\
> +		aohow_val(async, &ao_how));				\
>   									\
>   	libxl_device_##type##_dispose(&c_info);				\
>   									\
> diff --git a/tools/ocaml/test/send_debug_keys.ml b/tools/ocaml/test/send_debug_keys.ml
> index b9cd61e..2cca322 100644
> --- a/tools/ocaml/test/send_debug_keys.ml
> +++ b/tools/ocaml/test/send_debug_keys.ml
> @@ -4,7 +4,7 @@ open Xenlight
>
>   let send_keys ctx s =
>     printf "Sending debug key %s\n" s;
> -  Xenlight.send_debug_keys ctx s;
> +  Xenlight.Host.send_debug_keys ctx s;
>     ()
>
>   let _ =
>