[PATCH v6 00/11] libxl: ocaml: improve the bindings

[PATCH v6 00/11] libxl: ocaml: improve the bindings

[Rob Hoes]

This series contains version 6 of the remaining patches to fix the OCaml
bindings to libxl.

The main change compared to version 5 is that we now properly register the
"user" values (OCaml values that are given to the libxl event system, and
returned to OCaml in callbacks) with the OCaml GC.

For convenience, the patches in this series may be pulled using:
git pull git://github.com/robhoes/xen.git hydrogen-upstream-v6

[PATCH v6 01/11] libxl: ocaml: add simple test case for xentoollog

[Rob Hoes]

Add a simple noddy test case (tools/ocaml/test) for the the Xentoollog OCaml
module.

Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>

---
v5: Add the test case that was omitted from a previous patch, and fixed the
Makefile.
---
 .gitignore                |    1 +
 .hgignore                 |    1 +
 tools/ocaml/Makefile      |    2 +-
 tools/ocaml/test/Makefile |   28 ++++++++++++++++++++++++++++
 tools/ocaml/test/xtl.ml   |   40 ++++++++++++++++++++++++++++++++++++++++
 5 files changed, 71 insertions(+), 1 deletion(-)
 create mode 100644 tools/ocaml/test/Makefile
 create mode 100644 tools/ocaml/test/xtl.ml

diff --git a/.gitignore b/.gitignore
index 93aae71..20f20ed 100644
--- a/.gitignore
+++ b/.gitignore
@@ -385,6 +385,7 @@ tools/ocaml/libs/xentoollog/_xtl_levels.*
 tools/ocaml/libs/xentoollog/xentoollog.ml
 tools/ocaml/libs/xentoollog/xentoollog.mli
 tools/ocaml/xenstored/oxenstored
+tools/ocaml/test/xtl
 
 tools/debugger/kdd/kdd
 tools/firmware/etherboot/ipxe.tar.gz
diff --git a/.hgignore b/.hgignore
index 05cb0de..bb1b67d 100644
--- a/.hgignore
+++ b/.hgignore
@@ -308,6 +308,7 @@
 ^tools/ocaml/libs/xl/xenlight\.ml$
 ^tools/ocaml/libs/xl/xenlight\.mli$
 ^tools/ocaml/xenstored/oxenstored$
+^tools/ocaml/test/xtl$
 ^tools/autom4te\.cache$
 ^tools/config\.h$
 ^tools/config\.log$
diff --git a/tools/ocaml/Makefile b/tools/ocaml/Makefile
index 6b22bbe..8e4ca36 100644
--- a/tools/ocaml/Makefile
+++ b/tools/ocaml/Makefile
@@ -1,7 +1,7 @@
 XEN_ROOT = $(CURDIR)/../..
 include $(XEN_ROOT)/tools/Rules.mk
 
-SUBDIRS_PROGRAMS = xenstored
+SUBDIRS_PROGRAMS = xenstored test
 
 SUBDIRS = libs $(SUBDIRS_PROGRAMS)
 
diff --git a/tools/ocaml/test/Makefile b/tools/ocaml/test/Makefile
new file mode 100644
index 0000000..3a35d04
--- /dev/null
+++ b/tools/ocaml/test/Makefile
@@ -0,0 +1,28 @@
+XEN_ROOT = $(CURDIR)/../../..
+OCAML_TOPLEVEL = $(CURDIR)/..
+include $(OCAML_TOPLEVEL)/common.make
+
+OCAMLINCLUDE += \
+	-I $(OCAML_TOPLEVEL)/libs/xentoollog
+
+OBJS = xtl
+
+PROGRAMS = xtl
+
+xtl_LIBS =  \
+	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
+	-cclib $(LDLIBS_libxenctrl)
+
+xtl_OBJS = xtl
+
+OCAML_PROGRAM = xtl
+
+all: $(PROGRAMS)
+
+bins: $(PROGRAMS)
+
+install: all
+	$(INSTALL_DIR) $(DESTDIR)$(BINDIR)
+	$(INSTALL_PROG) $(PROGRAMS) $(DESTDIR)$(BINDIR)
+
+include $(OCAML_TOPLEVEL)/Makefile.rules
diff --git a/tools/ocaml/test/xtl.ml b/tools/ocaml/test/xtl.ml
new file mode 100644
index 0000000..db30aae
--- /dev/null
+++ b/tools/ocaml/test/xtl.ml
@@ -0,0 +1,40 @@
+open Arg
+open Printf
+open Xentoollog
+
+let stdio_vmessage min_level level errno ctx msg =
+	let level_str = level_to_string level
+	and errno_str = match errno with None -> "" | Some s -> sprintf ": errno=%d" s
+	and ctx_str = match ctx with None -> "" | Some s -> sprintf ": %s" s in
+	if compare min_level level <= 0 then begin
+		printf "%s%s%s: %s\n" level_str ctx_str errno_str msg;
+		flush stdout;
+	end
+
+let stdio_progress ctx what percent dne total =
+	let nl = if dne = total then "\n" else "" in
+	printf "\rProgress %s %d%% (%Ld/%Ld)%s" what percent dne total nl;
+	flush stdout
+
+let create_stdio_logger ?(level=Info) () =
+	let cbs = {
+		vmessage = stdio_vmessage level;
+		progress = stdio_progress; } in
+	create "Xentoollog.stdio_logger" cbs
+
+let do_test level = 
+  let lgr = create_stdio_logger ~level:level () in
+  begin
+    test lgr;
+  end
+
+let () =
+  let debug_level = ref Info in
+  let speclist = [
+    ("-v", Arg.Unit (fun () -> debug_level := Debug), "Verbose");
+    ("-q", Arg.Unit (fun () -> debug_level := Critical), "Quiet");
+  ] in
+  let usage_msg = "usage: xtl [OPTIONS]" in
+  Arg.parse speclist (fun s -> ()) usage_msg;
+
+  do_test !debug_level
-- 
1.7.10.4

[PATCH v6 02/11] libxl: ocaml: implement some simple tests

[Rob Hoes]

Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: Ian Jackson <ian.jackson@eu.citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
---
 .gitignore                          |    3 ++-
 .hgignore                           |    2 ++
 tools/ocaml/test/Makefile           |   30 ++++++++++++++++++++++++++----
 tools/ocaml/test/list_domains.ml    |   28 ++++++++++++++++++++++++++++
 tools/ocaml/test/raise_exception.ml |   11 +++++++++++
 tools/ocaml/test/send_debug_keys.ml |   15 +++++++++++++++
 6 files changed, 84 insertions(+), 5 deletions(-)
 create mode 100644 tools/ocaml/test/list_domains.ml
 create mode 100644 tools/ocaml/test/raise_exception.ml
 create mode 100644 tools/ocaml/test/send_debug_keys.ml

diff --git a/.gitignore b/.gitignore
index 20f20ed..ce5fd39 100644
--- a/.gitignore
+++ b/.gitignore
@@ -386,7 +386,8 @@ tools/ocaml/libs/xentoollog/xentoollog.ml
 tools/ocaml/libs/xentoollog/xentoollog.mli
 tools/ocaml/xenstored/oxenstored
 tools/ocaml/test/xtl
-
+tools/ocaml/test/send_debug_keys
+tools/ocaml/test/list_domains
 tools/debugger/kdd/kdd
 tools/firmware/etherboot/ipxe.tar.gz
 tools/firmware/etherboot/ipxe/
diff --git a/.hgignore b/.hgignore
index bb1b67d..ee5c084 100644
--- a/.hgignore
+++ b/.hgignore
@@ -309,6 +309,8 @@
 ^tools/ocaml/libs/xl/xenlight\.mli$
 ^tools/ocaml/xenstored/oxenstored$
 ^tools/ocaml/test/xtl$
+^tools/ocaml/test/send_debug_keys$
+^tools/ocaml/test/list_domains$
 ^tools/autom4te\.cache$
 ^tools/config\.h$
 ^tools/config\.log$
diff --git a/tools/ocaml/test/Makefile b/tools/ocaml/test/Makefile
index 3a35d04..dfa6437 100644
--- a/tools/ocaml/test/Makefile
+++ b/tools/ocaml/test/Makefile
@@ -2,12 +2,16 @@ XEN_ROOT = $(CURDIR)/../../..
 OCAML_TOPLEVEL = $(CURDIR)/..
 include $(OCAML_TOPLEVEL)/common.make
 
+CFLAGS += $(CFLAGS_libxenlight)
+LIBS_xenlight = $(LDLIBS_libxenlight)
+
 OCAMLINCLUDE += \
-	-I $(OCAML_TOPLEVEL)/libs/xentoollog
+	-I $(OCAML_TOPLEVEL)/libs/xentoollog \
+	-I $(OCAML_TOPLEVEL)/libs/xl
 
-OBJS = xtl
+OBJS = xtl send_debug_keys list_domains raise_exception
 
-PROGRAMS = xtl
+PROGRAMS = xtl send_debug_keys list_domains raise_exception
 
 xtl_LIBS =  \
 	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
@@ -15,7 +19,25 @@ xtl_LIBS =  \
 
 xtl_OBJS = xtl
 
-OCAML_PROGRAM = xtl
+send_debug_keys_LIBS =  \
+	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
+	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xl $(OCAML_TOPLEVEL)/libs/xl/xenlight.cmxa
+
+send_debug_keys_OBJS = xtl send_debug_keys
+
+list_domains_LIBS =  \
+	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
+	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xl $(OCAML_TOPLEVEL)/libs/xl/xenlight.cmxa
+
+list_domains_OBJS = xtl list_domains
+
+raise_exception_LIBS =  \
+	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
+	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xl $(OCAML_TOPLEVEL)/libs/xl/xenlight.cmxa
+
+raise_exception_OBJS = raise_exception
+
+OCAML_PROGRAM = xtl send_debug_keys list_domains raise_exception
 
 all: $(PROGRAMS)
 
diff --git a/tools/ocaml/test/list_domains.ml b/tools/ocaml/test/list_domains.ml
new file mode 100644
index 0000000..c82d40d
--- /dev/null
+++ b/tools/ocaml/test/list_domains.ml
@@ -0,0 +1,28 @@
+open Arg
+open Printf
+open Xenlight
+
+let bool_as_char b c = if b then c else '-'
+
+let print_dominfo dominfo =
+  let id = dominfo.Xenlight.Dominfo.domid
+  and running = bool_as_char dominfo.Xenlight.Dominfo.running 'r'
+  and blocked = bool_as_char dominfo.Xenlight.Dominfo.blocked 'b'
+  and paused = bool_as_char dominfo.Xenlight.Dominfo.paused 'p'
+  and shutdown = bool_as_char dominfo.Xenlight.Dominfo.shutdown 's'
+  and dying = bool_as_char dominfo.Xenlight.Dominfo.dying 'd'
+  and memory = dominfo.Xenlight.Dominfo.current_memkb
+  in
+  printf "Dom %d: %c%c%c%c%c %LdKB\n" id running blocked paused shutdown dying memory
+
+let _ =
+  let logger = Xtl.create_stdio_logger (*~level:Xentoollog.Debug*) () in
+  let ctx = Xenlight.ctx_alloc logger in
+  try
+    let domains = Xenlight.Dominfo.list ctx in
+    List.iter (fun d -> print_dominfo d) domains
+  with Xenlight.Error(err, fn) -> begin
+    printf "Caught Exception: %s: %s\n" (Xenlight.string_of_error err) fn;
+  end
+
+
diff --git a/tools/ocaml/test/raise_exception.ml b/tools/ocaml/test/raise_exception.ml
new file mode 100644
index 0000000..d4371f5
--- /dev/null
+++ b/tools/ocaml/test/raise_exception.ml
@@ -0,0 +1,11 @@
+open Printf
+open Xentoollog
+open Xenlight
+
+let _ = 
+  try
+    Xenlight.test_raise_exception ()
+  with Xenlight.Error(err, fn) -> begin
+    printf "Caught Exception: %s: %s\n" (Xenlight.string_of_error err) fn;
+  end
+
diff --git a/tools/ocaml/test/send_debug_keys.ml b/tools/ocaml/test/send_debug_keys.ml
new file mode 100644
index 0000000..b9cd61e
--- /dev/null
+++ b/tools/ocaml/test/send_debug_keys.ml
@@ -0,0 +1,15 @@
+open Arg
+open Printf
+open Xenlight
+
+let send_keys ctx s = 
+  printf "Sending debug key %s\n" s;
+  Xenlight.send_debug_keys ctx s;
+  ()
+  
+let _ = 
+  let logger = Xtl.create_stdio_logger () in
+  let ctx = Xenlight.ctx_alloc logger in
+  Arg.parse [
+  ] (fun s -> send_keys ctx s) "usage: send_debug_keys <keys>"
+
-- 
1.7.10.4

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

[Rob Hoes]

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
-- 
1.7.10.4

[PATCH v6 04/11] libxl: ocaml: allow device operations to be called asynchronously

[Rob Hoes]

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 patch to register for_callback value with the GC.
---
 tools/ocaml/libs/xl/genwrap.py       |    6 +++---
 tools/ocaml/libs/xl/xenlight_stubs.c |   18 +++++++++++++++---
 2 files changed, 18 insertions(+), 6 deletions(-)

diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index f5d2224..dd43069 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -22,9 +22,9 @@ builtins = {
     "libxl_cpuid_policy_list": ("unit",                "%(c)s = 0",                         "Val_unit"),
     }
 
-DEVICE_FUNCTIONS = [ ("add",            ["ctx", "t", "domid", "unit"]),
-                     ("remove",         ["ctx", "t", "domid", "unit"]),
-                     ("destroy",        ["ctx", "t", "domid", "unit"]),
+DEVICE_FUNCTIONS = [ ("add",            ["ctx", "t", "domid", "?async:'a", "unit", "unit"]),
+                     ("remove",         ["ctx", "t", "domid", "?async:'a", "unit", "unit"]),
+                     ("destroy",        ["ctx", "t", "domid", "?async:'a", "unit", "unit"]),
                    ]
 
 functions = { # ( name , [type1,type2,....] )
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
index 660dd09..b6649a7 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -401,15 +401,27 @@ void async_callback(libxl_ctx *ctx, int rc, void *for_callback)
 #define STRINGIFY(x) _STRINGIFY(x)
 
 #define _DEVICE_ADDREMOVE(type,op)					\
-value stub_xl_device_##type##_##op(value ctx, value info, value domid)	\
+value stub_xl_device_##type##_##op(value ctx, value info, value domid,	\
+	value async, value unit)					\
 {									\
-	CAMLparam3(ctx, info, domid);					\
+	CAMLparam5(ctx, info, domid, async, unit);			\
 	libxl_device_##type c_info;					\
 	int ret, marker_var;						\
+	libxl_asyncop_how ao_how;					\
+	value *p;							\
 									\
 	device_##type##_val(CTX, &c_info, info);			\
 									\
-	ret = libxl_device_##type##_##op(CTX, Int_val(domid), &c_info, 0); \
+	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_device_##type##_##op(CTX, Int_val(domid), &c_info,	\
+		async != Val_none ? &ao_how : NULL);			\
 									\
 	libxl_device_##type##_dispose(&c_info);				\
 									\
-- 
1.7.10.4

[PATCH v6 05/11] libxl: ocaml: add disk and cdrom helper functions

[Rob Hoes]

Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
---
 tools/ocaml/libs/xl/genwrap.py       |   17 +++++++-----
 tools/ocaml/libs/xl/xenlight_stubs.c |   50 ++++++++++++++++++++++++++++++----
 2 files changed, 55 insertions(+), 12 deletions(-)

diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
index dd43069..5e43831 100644
--- a/tools/ocaml/libs/xl/genwrap.py
+++ b/tools/ocaml/libs/xl/genwrap.py
@@ -26,18 +26,21 @@ DEVICE_FUNCTIONS = [ ("add",            ["ctx", "t", "domid", "?async:'a", "unit
                      ("remove",         ["ctx", "t", "domid", "?async:'a", "unit", "unit"]),
                      ("destroy",        ["ctx", "t", "domid", "?async:'a", "unit", "unit"]),
                    ]
+DEVICE_LIST =      [ ("list",           ["ctx", "domid", "t list"]),
+                   ]
 
 functions = { # ( name , [type1,type2,....] )
     "device_vfb":     DEVICE_FUNCTIONS,
     "device_vkb":     DEVICE_FUNCTIONS,
-    "device_disk":    DEVICE_FUNCTIONS,
-    "device_nic":     DEVICE_FUNCTIONS +
-                      [ ("list",           ["ctx", "domid", "t list"]),
-                        ("of_devid",       ["ctx", "domid", "int", "t"]),
+    "device_disk":    DEVICE_FUNCTIONS + DEVICE_LIST +
+                      [ ("insert",         ["ctx", "t", "domid", "?async:'a", "unit", "unit"]),
+                        ("of_vdev",        ["ctx", "domid", "string", "t"]),
+                      ],
+    "device_nic":     DEVICE_FUNCTIONS + DEVICE_LIST +
+                      [ ("of_devid",       ["ctx", "domid", "int", "t"]),
                       ],
-    "device_pci":     DEVICE_FUNCTIONS +
-                      [ ("list",              ["ctx", "domid", "t list"]),
-                        ("assignable_add",    ["ctx", "t", "bool", "unit"]),
+    "device_pci":     DEVICE_FUNCTIONS + DEVICE_LIST +
+                      [ ("assignable_add",    ["ctx", "t", "bool", "unit"]),
                         ("assignable_remove", ["ctx", "t", "bool", "unit"]),
                         ("assignable_list",   ["ctx", "t list"]),
                       ],
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
index b6649a7..2195632 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -400,7 +400,7 @@ void async_callback(libxl_ctx *ctx, int rc, void *for_callback)
 #define _STRINGIFY(x) #x
 #define STRINGIFY(x) _STRINGIFY(x)
 
-#define _DEVICE_ADDREMOVE(type,op)					\
+#define _DEVICE_ADDREMOVE(type,fn,op)					\
 value stub_xl_device_##type##_##op(value ctx, value info, value domid,	\
 	value async, value unit)					\
 {									\
@@ -420,7 +420,7 @@ value stub_xl_device_##type##_##op(value ctx, value info, value domid,	\
 		ao_how.u.for_callback = (void *) p;			\
 	}								\
 									\
-	ret = libxl_device_##type##_##op(CTX, Int_val(domid), &c_info,	\
+	ret = libxl_##fn##_##op(CTX, Int_val(domid), &c_info,		\
 		async != Val_none ? &ao_how : NULL);			\
 									\
 	libxl_device_##type##_dispose(&c_info);				\
@@ -432,15 +432,16 @@ value stub_xl_device_##type##_##op(value ctx, value info, value domid,	\
 }
 
 #define DEVICE_ADDREMOVE(type) \
-	_DEVICE_ADDREMOVE(type, add) \
- 	_DEVICE_ADDREMOVE(type, remove) \
- 	_DEVICE_ADDREMOVE(type, destroy)
+	_DEVICE_ADDREMOVE(type, device_##type, add) \
+ 	_DEVICE_ADDREMOVE(type, device_##type, remove) \
+ 	_DEVICE_ADDREMOVE(type, device_##type, destroy)
 
 DEVICE_ADDREMOVE(disk)
 DEVICE_ADDREMOVE(nic)
 DEVICE_ADDREMOVE(vfb)
 DEVICE_ADDREMOVE(vkb)
 DEVICE_ADDREMOVE(pci)
+_DEVICE_ADDREMOVE(disk, cdrom, insert)
 
 value stub_xl_device_nic_of_devid(value ctx, value domid, value devid)
 {
@@ -481,6 +482,45 @@ value stub_xl_device_nic_list(value ctx, value domid)
 	CAMLreturn(list);
 }
 
+value stub_xl_device_disk_list(value ctx, value domid)
+{
+	CAMLparam2(ctx, domid);
+	CAMLlocal2(list, temp);
+	libxl_device_disk *c_list;
+	int i, nb;
+	uint32_t c_domid;
+
+	c_domid = Int_val(domid);
+
+	c_list = libxl_device_disk_list(CTX, c_domid, &nb);
+	if (!c_list)
+		failwith_xl(ERROR_FAIL, "disk_list");
+
+	list = temp = Val_emptylist;
+	for (i = 0; i < nb; i++) {
+		list = caml_alloc_small(2, Tag_cons);
+		Field(list, 0) = Val_int(0);
+		Field(list, 1) = temp;
+		temp = list;
+		Store_field(list, 0, Val_device_disk(&c_list[i]));
+		libxl_device_disk_dispose(&c_list[i]);
+	}
+	free(c_list);
+
+	CAMLreturn(list);
+}
+
+value stub_xl_device_disk_of_vdev(value ctx, value domid, value vdev)
+{
+	CAMLparam3(ctx, domid, vdev);
+	CAMLlocal1(disk);
+	libxl_device_disk c_disk;
+	libxl_vdev_to_device_disk(CTX, Int_val(domid), String_val(vdev), &c_disk);
+	disk = Val_device_disk(&c_disk);
+	libxl_device_disk_dispose(&c_disk);
+	CAMLreturn(disk);
+}
+
 value stub_xl_device_pci_list(value ctx, value domid)
 {
 	CAMLparam2(ctx, domid);
-- 
1.7.10.4

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

[Rob Hoes]

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 _ = 
-- 
1.7.10.4

[PATCH v6 07/11] libxl: ocaml: add console reader functions

[Rob Hoes]

Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
---
 tools/ocaml/libs/xl/xenlight.ml.in   |   10 ++++-
 tools/ocaml/libs/xl/xenlight.mli.in  |    7 ++++
 tools/ocaml/libs/xl/xenlight_stubs.c |   68 ++++++++++++++++++++++++++++++++++
 tools/ocaml/test/Makefile            |   12 ++++--
 tools/ocaml/test/dmesg.ml            |   18 +++++++++
 5 files changed, 111 insertions(+), 4 deletions(-)
 create mode 100644 tools/ocaml/test/dmesg.ml

diff --git a/tools/ocaml/libs/xl/xenlight.ml.in b/tools/ocaml/libs/xl/xenlight.ml.in
index fc05112..47f3487 100644
--- a/tools/ocaml/libs/xl/xenlight.ml.in
+++ b/tools/ocaml/libs/xl/xenlight.ml.in
@@ -49,6 +49,13 @@ module Domain = struct
 end
 
 module Host = struct
+	type console_reader
+	exception End_of_file
+
+	external xen_console_read_start : ctx -> int -> console_reader  = "stub_libxl_xen_console_read_start"
+	external xen_console_read_line : ctx -> console_reader -> string = "stub_libxl_xen_console_read_line"
+	external xen_console_read_finish : ctx -> console_reader -> unit = "stub_libxl_xen_console_read_finish"
+
 	external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys"
 end
 
@@ -82,5 +89,6 @@ module Async = struct
 end
 
 let register_exceptions () =
-	Callback.register_exception "Xenlight.Error" (Error(ERROR_FAIL, ""))
+	Callback.register_exception "Xenlight.Error" (Error(ERROR_FAIL, ""));
+	Callback.register_exception "Xenlight.Host.End_of_file" (Host.End_of_file)
 
diff --git a/tools/ocaml/libs/xl/xenlight.mli.in b/tools/ocaml/libs/xl/xenlight.mli.in
index ee4efd8..794dbf1 100644
--- a/tools/ocaml/libs/xl/xenlight.mli.in
+++ b/tools/ocaml/libs/xl/xenlight.mli.in
@@ -51,6 +51,13 @@ module Domain : sig
 end
 
 module Host : sig
+	type console_reader
+	exception End_of_file
+
+	external xen_console_read_start : ctx -> int -> console_reader  = "stub_libxl_xen_console_read_start"
+	external xen_console_read_line : ctx -> console_reader -> string = "stub_libxl_xen_console_read_line"
+	external xen_console_read_finish : ctx -> console_reader -> unit = "stub_libxl_xen_console_read_finish"
+
 	external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys"
 end
 
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
index b03fd93..d568393 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -929,6 +929,74 @@ value stub_xl_send_debug_keys(value ctx, value keys)
 	CAMLreturn(Val_unit);
 }
 
+static struct custom_operations libxl_console_reader_custom_operations = {
+	"libxl_console_reader_custom_operations",
+	custom_finalize_default,
+	custom_compare_default,
+	custom_hash_default,
+	custom_serialize_default,
+	custom_deserialize_default
+};
+
+#define Console_reader_val(x)(*((libxl_xen_console_reader **) Data_custom_val(x)))
+
+value stub_libxl_xen_console_read_start(value ctx, value clear)
+{
+	CAMLparam2(ctx, clear);
+	CAMLlocal1(handle);
+	libxl_xen_console_reader *cr;
+
+	cr = libxl_xen_console_read_start(CTX, Int_val(clear));
+
+	handle = caml_alloc_custom(&libxl_console_reader_custom_operations, sizeof(cr), 0, 1);
+	Console_reader_val(handle) = cr;
+
+	CAMLreturn(handle);
+}
+
+static void raise_eof(void)
+{
+	static value *exc = NULL;
+
+	/* First time around, lookup by name */
+	if (!exc)
+		exc = caml_named_value("Xenlight.Host.End_of_file");
+
+	if (!exc)
+		caml_invalid_argument("Exception Xenlight.Host.End_of_file not initialized, please link xenlight.cma");
+
+	caml_raise_constant(*exc);
+}
+
+value stub_libxl_xen_console_read_line(value ctx, value reader)
+{
+	CAMLparam2(ctx, reader);
+	CAMLlocal1(line);
+	int ret;
+	char *c_line;
+	libxl_xen_console_reader *cr = (libxl_xen_console_reader *) Console_reader_val(reader);
+
+	ret = libxl_xen_console_read_line(CTX, cr, &c_line);
+
+	if (ret < 0)
+		failwith_xl(ret, "xen_console_read_line");
+	if (ret == 0)
+		raise_eof();
+
+	line = caml_copy_string(c_line);
+
+	CAMLreturn(line);
+}
+
+value stub_libxl_xen_console_read_finish(value ctx, value reader)
+{
+	CAMLparam2(ctx, reader);
+	libxl_xen_console_reader *cr = (libxl_xen_console_reader *) Console_reader_val(reader);
+
+	libxl_xen_console_read_finish(CTX, cr);
+
+	CAMLreturn(Val_unit);
+}
 
 /* Event handling */
 
diff --git a/tools/ocaml/test/Makefile b/tools/ocaml/test/Makefile
index dfa6437..827bd7c 100644
--- a/tools/ocaml/test/Makefile
+++ b/tools/ocaml/test/Makefile
@@ -9,9 +9,9 @@ OCAMLINCLUDE += \
 	-I $(OCAML_TOPLEVEL)/libs/xentoollog \
 	-I $(OCAML_TOPLEVEL)/libs/xl
 
-OBJS = xtl send_debug_keys list_domains raise_exception
+OBJS = xtl send_debug_keys list_domains raise_exception dmesg
 
-PROGRAMS = xtl send_debug_keys list_domains raise_exception
+PROGRAMS = xtl send_debug_keys list_domains raise_exception dmesg
 
 xtl_LIBS =  \
 	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
@@ -37,7 +37,13 @@ raise_exception_LIBS =  \
 
 raise_exception_OBJS = raise_exception
 
-OCAML_PROGRAM = xtl send_debug_keys list_domains raise_exception
+dmesg_LIBS =  \
+	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa \
+	-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xl $(OCAML_TOPLEVEL)/libs/xl/xenlight.cmxa
+
+dmesg_OBJS = xtl dmesg
+
+OCAML_PROGRAM = xtl send_debug_keys list_domains raise_exception dmesg
 
 all: $(PROGRAMS)
 
diff --git a/tools/ocaml/test/dmesg.ml b/tools/ocaml/test/dmesg.ml
new file mode 100644
index 0000000..864fac4
--- /dev/null
+++ b/tools/ocaml/test/dmesg.ml
@@ -0,0 +1,18 @@
+open Printf
+
+let _ =
+	Xenlight.register_exceptions ();
+	let logger = Xtl.create_stdio_logger ~level:Xentoollog.Debug () in
+	let ctx = Xenlight.ctx_alloc logger in
+
+	let open Xenlight.Host in
+	let reader = xen_console_read_start ctx 0 in
+	(try
+		while true do
+			let line = xen_console_read_line ctx reader in
+			print_string line
+		done
+	with End_of_file -> ());
+	let _ = xen_console_read_finish ctx reader in
+	()
+
-- 
1.7.10.4

[PATCH v6 08/11] libxl: ocaml: drop the ocaml heap lock before calling into libxl

[Rob Hoes]

Ocaml has a heap lock which must be held whenever ocaml code is running. Ocaml
usually drops this lock when it enters a potentially blocking low-level
function, such as writing to a file. Libxl has its own lock, which it may
acquire when being called.

Things get interesting when libxl calls back into ocaml code. There is a risk
of ending up in a deadlock when a thread holds both locks at the same time,
then temporarily drop the ocaml lock, while another thread calls another libxl
function.

To avoid deadlocks, we drop the ocaml heap lock before entering libxl, and
reacquire it in callbacks to ocaml. This way, the ocaml heap lock is never held
together with the libxl lock, except in osevent registration callbacks, and
xentoollog callbacks. If we guarantee to not call any libxl functions inside
those callbacks, we can avoid deadlocks.

This patch handle the dropping and reacquiring of the ocaml heap lock by the
caml_enter_blocking_section and caml_leave_blocking_section functions, and
related macros. We are also careful to not call any functions that access the
ocaml heap while the ocaml heap lock is dropped. This often involves copying
ocaml values to C before dropping the ocaml lock.

Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
---
 tools/ocaml/libs/xentoollog/Makefile           |    3 +
 tools/ocaml/libs/xentoollog/xentoollog_stubs.c |   13 +-
 tools/ocaml/libs/xl/Makefile                   |    5 +-
 tools/ocaml/libs/xl/xenlight_stubs.c           |  265 +++++++++++++++++++-----
 4 files changed, 229 insertions(+), 57 deletions(-)

diff --git a/tools/ocaml/libs/xentoollog/Makefile b/tools/ocaml/libs/xentoollog/Makefile
index e535ba5..471b428 100644
--- a/tools/ocaml/libs/xentoollog/Makefile
+++ b/tools/ocaml/libs/xentoollog/Makefile
@@ -2,6 +2,9 @@ TOPLEVEL=$(CURDIR)/../..
 XEN_ROOT=$(TOPLEVEL)/../..
 include $(TOPLEVEL)/common.make
 
+# allow mixed declarations and code
+CFLAGS += -Wno-declaration-after-statement
+
 CFLAGS += $(CFLAGS_libxenctrl) $(CFLAGS_libxenguest)
 OCAMLINCLUDE +=
 
diff --git a/tools/ocaml/libs/xentoollog/xentoollog_stubs.c b/tools/ocaml/libs/xentoollog/xentoollog_stubs.c
index 3b2f91b..daf48fe 100644
--- a/tools/ocaml/libs/xentoollog/xentoollog_stubs.c
+++ b/tools/ocaml/libs/xentoollog/xentoollog_stubs.c
@@ -31,6 +31,11 @@
 
 #include "caml_xentoollog.h"
 
+/* The following is equal to the CAMLreturn macro, but without the return */
+#define CAMLdone do{ \
+caml_local_roots = caml__frame; \
+}while (0)
+
 #define XTL ((xentoollog_logger *) Xtl_val(handle))
 
 static char * dup_String_val(value s)
@@ -81,6 +86,7 @@ static void stub_xtl_ocaml_vmessage(struct xentoollog_logger *logger,
 	const char *format,
 	va_list al)
 {
+	caml_leave_blocking_section();
 	CAMLparam0();
 	CAMLlocalN(args, 4);
 	struct caml_xtl *xtl = (struct caml_xtl*)logger;
@@ -103,7 +109,8 @@ static void stub_xtl_ocaml_vmessage(struct xentoollog_logger *logger,
 	free(msg);
 
 	caml_callbackN(*func, 4, args);
-	CAMLreturn0;
+	CAMLdone;
+	caml_enter_blocking_section();
 }
 
 static void stub_xtl_ocaml_progress(struct xentoollog_logger *logger,
@@ -111,6 +118,7 @@ static void stub_xtl_ocaml_progress(struct xentoollog_logger *logger,
 	const char *doing_what /* no \r,\n */,
 	int percent, unsigned long done, unsigned long total)
 {
+	caml_leave_blocking_section();
 	CAMLparam0();
 	CAMLlocalN(args, 5);
 	struct caml_xtl *xtl = (struct caml_xtl*)logger;
@@ -129,7 +137,8 @@ static void stub_xtl_ocaml_progress(struct xentoollog_logger *logger,
 	args[4] = caml_copy_int64(total);
 
 	caml_callbackN(*func, 5, args);
-	CAMLreturn0;
+	CAMLdone;
+	caml_enter_blocking_section();
 }
 
 static void xtl_destroy(struct xentoollog_logger *logger)
diff --git a/tools/ocaml/libs/xl/Makefile b/tools/ocaml/libs/xl/Makefile
index 0408cc2..61eb44c 100644
--- a/tools/ocaml/libs/xl/Makefile
+++ b/tools/ocaml/libs/xl/Makefile
@@ -2,8 +2,9 @@ TOPLEVEL=$(CURDIR)/../..
 XEN_ROOT=$(TOPLEVEL)/../..
 include $(TOPLEVEL)/common.make
 
-# ignore unused generated functions
-CFLAGS += -Wno-unused
+# ignore unused generated functions and allow mixed declarations and code
+CFLAGS += -Wno-unused -Wno-declaration-after-statement
+
 CFLAGS += $(CFLAGS_libxenlight)
 CFLAGS += -I ../xentoollog
 
diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
index d568393..5d8f039 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -34,6 +34,11 @@
 
 #include "caml_xentoollog.h"
 
+/* The following is equal to the CAMLreturn macro, but without the return */
+#define CAMLdone do{ \
+caml_local_roots = caml__frame; \
+}while (0)
+
 #define Ctx_val(x)(*((libxl_ctx **) Data_custom_val(x)))
 #define CTX ((libxl_ctx *) Ctx_val(ctx))
 
@@ -374,6 +379,7 @@ static char *String_option_val(value v)
 
 void async_callback(libxl_ctx *ctx, int rc, void *for_callback)
 {
+	caml_leave_blocking_section();
 	CAMLparam0();
 	CAMLlocal2(error, tmp);
 	static value *func = NULL;
@@ -395,11 +401,15 @@ void async_callback(libxl_ctx *ctx, int rc, void *for_callback)
 
 	caml_remove_global_root(p);
 	free(p);
+
+	CAMLdone;
+	caml_enter_blocking_section();
 }
 
-static libxl_asyncop_how *aohow_val(value async, libxl_asyncop_how *ao_how)
+static libxl_asyncop_how *aohow_val(value async)
 {
 	CAMLparam1(async);
+	libxl_asyncop_how *ao_how = NULL;
 	value *p;
 
 	if (async != Val_none) {
@@ -408,12 +418,12 @@ static libxl_asyncop_how *aohow_val(value async, libxl_asyncop_how *ao_how)
 			failwith_xl(ERROR_NOMEM, "cannot allocate value");
 		*p = Some_val(async);
 		caml_register_global_root(p);
+		libxl_asyncop_how *ao_how = malloc(sizeof(*ao_how));
 		ao_how->callback = async_callback;
 		ao_how->u.for_callback = (void *) p;
-		CAMLreturnT(libxl_asyncop_how *, ao_how);
 	}
-	else
-		CAMLreturnT(libxl_asyncop_how *, NULL);
+
+	CAMLreturnT(libxl_asyncop_how *, ao_how);
 }
 
 value stub_libxl_domain_create_new(value ctx, value domain_config, value async, value unit)
@@ -422,7 +432,7 @@ value stub_libxl_domain_create_new(value ctx, value domain_config, value async,
 	int ret;
 	libxl_domain_config c_dconfig;
 	uint32_t c_domid;
-	libxl_asyncop_how ao_how;
+	libxl_asyncop_how *ao_how;
 
 	libxl_domain_config_init(&c_dconfig);
 	ret = domain_config_val(CTX, &c_dconfig, domain_config);
@@ -431,9 +441,14 @@ value stub_libxl_domain_create_new(value ctx, value domain_config, value async,
 		failwith_xl(ret, "domain_create_new");
 	}
 
-	ret = libxl_domain_create_new(CTX, &c_dconfig, &c_domid,
-		aohow_val(async, &ao_how), NULL);
+	ao_how = aohow_val(async);
+
+	caml_enter_blocking_section();
+	ret = libxl_domain_create_new(CTX, &c_dconfig, &c_domid, ao_how, NULL);
+	caml_leave_blocking_section();
 
+	if (ao_how)
+		free(ao_how);
 	libxl_domain_config_dispose(&c_dconfig);
 
 	if (ret != 0)
@@ -450,7 +465,8 @@ value stub_libxl_domain_create_restore(value ctx, value domain_config, value par
 	libxl_domain_config c_dconfig;
 	libxl_domain_restore_params c_params;
 	uint32_t c_domid;
-	libxl_asyncop_how ao_how;
+	libxl_asyncop_how *ao_how;
+	int restore_fd;
 
 	libxl_domain_config_init(&c_dconfig);
 	ret = domain_config_val(CTX, &c_dconfig, domain_config);
@@ -466,9 +482,16 @@ value stub_libxl_domain_create_restore(value ctx, value domain_config, value par
 		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);
+	ao_how = aohow_val(async);
+	restore_fd = Int_val(Field(params, 0));
+
+	caml_enter_blocking_section();
+	ret = libxl_domain_create_restore(CTX, &c_dconfig, &c_domid, restore_fd,
+		&c_params, ao_how, NULL);
+	caml_leave_blocking_section();
 
+	if (ao_how)
+		free(ao_how);
 	libxl_domain_config_dispose(&c_dconfig);
 	libxl_domain_restore_params_dispose(&c_params);
 
@@ -482,8 +505,12 @@ value stub_libxl_domain_shutdown(value ctx, value domid)
 {
 	CAMLparam2(ctx, domid);
 	int ret;
+	uint32_t c_domid = Int_val(domid);
+
+	caml_enter_blocking_section();
+	ret = libxl_domain_shutdown(CTX, c_domid);
+	caml_leave_blocking_section();
 
-	ret = libxl_domain_shutdown(CTX, Int_val(domid));
 	if (ret != 0)
 		failwith_xl(ret, "domain_shutdown");
 
@@ -494,8 +521,12 @@ value stub_libxl_domain_reboot(value ctx, value domid)
 {
 	CAMLparam2(ctx, domid);
 	int ret;
+	uint32_t c_domid = Int_val(domid);
+
+	caml_enter_blocking_section();
+	ret = libxl_domain_reboot(CTX, c_domid);
+	caml_leave_blocking_section();
 
-	ret = libxl_domain_reboot(CTX, Int_val(domid));
 	if (ret != 0)
 		failwith_xl(ret, "domain_reboot");
 
@@ -506,9 +537,16 @@ 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;
+	uint32_t c_domid = Int_val(domid);
+	libxl_asyncop_how *ao_how = aohow_val(async);
+
+	caml_enter_blocking_section();
+	ret = libxl_domain_destroy(CTX, c_domid, ao_how);
+	caml_leave_blocking_section();
+
+	if (ao_how)
+		free(ao_how);
 
-	ret = libxl_domain_destroy(CTX, Int_val(domid), aohow_val(async, &ao_how));
 	if (ret != 0)
 		failwith_xl(ret, "domain_destroy");
 
@@ -519,10 +557,17 @@ value stub_libxl_domain_suspend(value ctx, value domid, value fd, value async, v
 {
 	CAMLparam5(ctx, domid, fd, async, unit);
 	int ret;
-	libxl_asyncop_how ao_how;
+	uint32_t c_domid = Int_val(domid);
+	int c_fd = Int_val(fd);
+	libxl_asyncop_how *ao_how = aohow_val(async);
+
+	caml_enter_blocking_section();
+	ret = libxl_domain_suspend(CTX, c_domid, c_fd, 0, ao_how);
+	caml_leave_blocking_section();
+
+	if (ao_how)
+		free(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");
 
@@ -533,8 +578,12 @@ value stub_libxl_domain_pause(value ctx, value domid)
 {
 	CAMLparam2(ctx, domid);
 	int ret;
+	uint32_t c_domid = Int_val(domid);
+
+	caml_enter_blocking_section();
+	ret = libxl_domain_pause(CTX, c_domid);
+	caml_leave_blocking_section();
 
-	ret = libxl_domain_pause(CTX, Int_val(domid));
 	if (ret != 0)
 		failwith_xl(ret, "domain_pause");
 
@@ -545,8 +594,12 @@ value stub_libxl_domain_unpause(value ctx, value domid)
 {
 	CAMLparam2(ctx, domid);
 	int ret;
+	uint32_t c_domid = Int_val(domid);
+
+	caml_enter_blocking_section();
+	ret = libxl_domain_unpause(CTX, c_domid);
+	caml_leave_blocking_section();
 
-	ret = libxl_domain_unpause(CTX, Int_val(domid));
 	if (ret != 0)
 		failwith_xl(ret, "domain_unpause");
 
@@ -563,13 +616,17 @@ value stub_xl_device_##type##_##op(value ctx, value info, value domid,	\
 	CAMLparam5(ctx, info, domid, async, unit);			\
 	libxl_device_##type c_info;					\
 	int ret, marker_var;						\
-	libxl_asyncop_how ao_how;					\
+	uint32_t c_domid = Int_val(domid);				\
+	libxl_asyncop_how *ao_how = aohow_val(async);			\
 									\
 	device_##type##_val(CTX, &c_info, info);			\
 									\
-	ret = libxl_##fn##_##op(CTX, Int_val(domid), &c_info,		\
-		aohow_val(async, &ao_how));				\
+	caml_enter_blocking_section();					\
+	ret = libxl_##fn##_##op(CTX, c_domid, &c_info, ao_how);		\
+	caml_leave_blocking_section();					\
 									\
+	if (ao_how)							\
+		free(ao_how);						\
 	libxl_device_##type##_dispose(&c_info);				\
 									\
 	if (ret != 0)							\
@@ -595,9 +652,16 @@ value stub_xl_device_nic_of_devid(value ctx, value domid, value devid)
 	CAMLparam3(ctx, domid, devid);
 	CAMLlocal1(nic);
 	libxl_device_nic c_nic;
-	libxl_devid_to_device_nic(CTX, Int_val(domid), Int_val(devid), &c_nic);
+	uint32_t c_domid = Int_val(domid);
+	int c_devid = Int_val(devid);
+
+	caml_enter_blocking_section();
+	libxl_devid_to_device_nic(CTX, c_domid, c_devid, &c_nic);
+	caml_leave_blocking_section();
+
 	nic = Val_device_nic(&c_nic);
 	libxl_device_nic_dispose(&c_nic);
+
 	CAMLreturn(nic);
 }
 
@@ -607,11 +671,12 @@ value stub_xl_device_nic_list(value ctx, value domid)
 	CAMLlocal2(list, temp);
 	libxl_device_nic *c_list;
 	int i, nb;
-	uint32_t c_domid;
-
-	c_domid = Int_val(domid);
+	uint32_t c_domid = Int_val(domid);
 
+	caml_enter_blocking_section();
 	c_list = libxl_device_nic_list(CTX, c_domid, &nb);
+	caml_leave_blocking_section();
+
 	if (!c_list)
 		failwith_xl(ERROR_FAIL, "nic_list");
 
@@ -635,11 +700,12 @@ value stub_xl_device_disk_list(value ctx, value domid)
 	CAMLlocal2(list, temp);
 	libxl_device_disk *c_list;
 	int i, nb;
-	uint32_t c_domid;
-
-	c_domid = Int_val(domid);
+	uint32_t c_domid = Int_val(domid);
 
+	caml_enter_blocking_section();
 	c_list = libxl_device_disk_list(CTX, c_domid, &nb);
+	caml_leave_blocking_section();
+
 	if (!c_list)
 		failwith_xl(ERROR_FAIL, "disk_list");
 
@@ -662,9 +728,19 @@ value stub_xl_device_disk_of_vdev(value ctx, value domid, value vdev)
 	CAMLparam3(ctx, domid, vdev);
 	CAMLlocal1(disk);
 	libxl_device_disk c_disk;
-	libxl_vdev_to_device_disk(CTX, Int_val(domid), String_val(vdev), &c_disk);
+	char *c_vdev;
+	uint32_t c_domid = Int_val(domid);
+
+	c_vdev = strdup(String_val(vdev));
+
+	caml_enter_blocking_section();
+	libxl_vdev_to_device_disk(CTX, c_domid, c_vdev, &c_disk);
+	caml_leave_blocking_section();
+
 	disk = Val_device_disk(&c_disk);
 	libxl_device_disk_dispose(&c_disk);
+	free(c_vdev);
+
 	CAMLreturn(disk);
 }
 
@@ -674,11 +750,12 @@ value stub_xl_device_pci_list(value ctx, value domid)
 	CAMLlocal2(list, temp);
 	libxl_device_pci *c_list;
 	int i, nb;
-	uint32_t c_domid;
-
-	c_domid = Int_val(domid);
+	uint32_t c_domid = Int_val(domid);
 
+	caml_enter_blocking_section();
 	c_list = libxl_device_pci_list(CTX, c_domid, &nb);
+	caml_leave_blocking_section();
+
 	if (!c_list)
 		failwith_xl(ERROR_FAIL, "pci_list");
 
@@ -701,10 +778,13 @@ value stub_xl_device_pci_assignable_add(value ctx, value info, value rebind)
 	CAMLparam3(ctx, info, rebind);
 	libxl_device_pci c_info;
 	int ret, marker_var;
+	int c_rebind = (int) Bool_val(rebind);
 
 	device_pci_val(CTX, &c_info, info);
 
-	ret = libxl_device_pci_assignable_add(CTX, &c_info, (int) Bool_val(rebind));
+	caml_enter_blocking_section();
+	ret = libxl_device_pci_assignable_add(CTX, &c_info, c_rebind);
+	caml_leave_blocking_section();
 
 	libxl_device_pci_dispose(&c_info);
 
@@ -719,10 +799,13 @@ value stub_xl_device_pci_assignable_remove(value ctx, value info, value rebind)
 	CAMLparam3(ctx, info, rebind);
 	libxl_device_pci c_info;
 	int ret, marker_var;
+	int c_rebind = (int) Bool_val(rebind);
 
 	device_pci_val(CTX, &c_info, info);
 
-	ret = libxl_device_pci_assignable_remove(CTX, &c_info, (int) Bool_val(rebind));
+	caml_enter_blocking_section();
+	ret = libxl_device_pci_assignable_remove(CTX, &c_info, c_rebind);
+	caml_leave_blocking_section();
 
 	libxl_device_pci_dispose(&c_info);
 
@@ -740,7 +823,10 @@ value stub_xl_device_pci_assignable_list(value ctx)
 	int i, nb;
 	uint32_t c_domid;
 
+	caml_enter_blocking_section();
 	c_list = libxl_device_pci_assignable_list(CTX, &nb);
+	caml_leave_blocking_section();
+
 	if (!c_list)
 		failwith_xl(ERROR_FAIL, "pci_assignable_list");
 
@@ -765,7 +851,9 @@ value stub_xl_physinfo_get(value ctx)
 	libxl_physinfo c_physinfo;
 	int ret;
 
+	caml_enter_blocking_section();
 	ret = libxl_get_physinfo(CTX, &c_physinfo);
+	caml_leave_blocking_section();
 
 	if (ret != 0)
 		failwith_xl(ret, "get_physinfo");
@@ -784,7 +872,9 @@ value stub_xl_cputopology_get(value ctx)
 	libxl_cputopology *c_topology;
 	int i, nr;
 
+	caml_enter_blocking_section();
 	c_topology = libxl_get_cpu_topology(CTX, &nr);
+	caml_leave_blocking_section();
 
 	if (!c_topology)
 		failwith_xl(ERROR_FAIL, "get_cpu_topologyinfo");
@@ -812,7 +902,10 @@ value stub_xl_dominfo_list(value ctx)
 	libxl_dominfo *c_domlist;
 	int i, nb;
 
+	caml_enter_blocking_section();
 	c_domlist = libxl_list_domain(CTX, &nb);
+	caml_leave_blocking_section();
+
 	if (!c_domlist)
 		failwith_xl(ERROR_FAIL, "dominfo_list");
 
@@ -837,8 +930,12 @@ value stub_xl_dominfo_get(value ctx, value domid)
 	CAMLlocal1(dominfo);
 	libxl_dominfo c_dominfo;
 	int ret;
+	uint32_t c_domid = Int_val(domid);
+
+	caml_enter_blocking_section();
+	ret = libxl_domain_info(CTX, &c_dominfo, c_domid);
+	caml_leave_blocking_section();
 
-	ret = libxl_domain_info(CTX, &c_dominfo, Int_val(domid));
 	if (ret != 0)
 		failwith_xl(ERROR_FAIL, "domain_info");
 	dominfo = Val_dominfo(&c_dominfo);
@@ -852,8 +949,12 @@ value stub_xl_domain_sched_params_get(value ctx, value domid)
 	CAMLlocal1(scinfo);
 	libxl_domain_sched_params c_scinfo;
 	int ret;
+	uint32_t c_domid = Int_val(domid);
+
+	caml_enter_blocking_section();
+	ret = libxl_domain_sched_params_get(CTX, c_domid, &c_scinfo);
+	caml_leave_blocking_section();
 
-	ret = libxl_domain_sched_params_get(CTX, Int_val(domid), &c_scinfo);
 	if (ret != 0)
 		failwith_xl(ret, "domain_sched_params_get");
 
@@ -869,10 +970,13 @@ value stub_xl_domain_sched_params_set(value ctx, value domid, value scinfo)
 	CAMLparam3(ctx, domid, scinfo);
 	libxl_domain_sched_params c_scinfo;
 	int ret;
+	uint32_t c_domid = Int_val(domid);
 
 	domain_sched_params_val(CTX, &c_scinfo, scinfo);
 
-	ret = libxl_domain_sched_params_set(CTX, Int_val(domid), &c_scinfo);
+	caml_enter_blocking_section();
+	ret = libxl_domain_sched_params_set(CTX, c_domid, &c_scinfo);
+	caml_leave_blocking_section();
 
 	libxl_domain_sched_params_dispose(&c_scinfo);
 
@@ -886,12 +990,15 @@ value stub_xl_send_trigger(value ctx, value domid, value trigger, value vcpuid)
 {
 	CAMLparam4(ctx, domid, trigger, vcpuid);
 	int ret;
+	uint32_t c_domid = Int_val(domid);
 	libxl_trigger c_trigger = LIBXL_TRIGGER_UNKNOWN;
+	int c_vcpuid = Int_val(vcpuid);
 
 	trigger_val(CTX, &c_trigger, trigger);
 
-	ret = libxl_send_trigger(CTX, Int_val(domid),
-				 c_trigger, Int_val(vcpuid));
+	caml_enter_blocking_section();
+	ret = libxl_send_trigger(CTX, c_domid, c_trigger, c_vcpuid);
+	caml_leave_blocking_section();
 
 	if (ret != 0)
 		failwith_xl(ret, "send_trigger");
@@ -903,8 +1010,12 @@ value stub_xl_send_sysrq(value ctx, value domid, value sysrq)
 {
 	CAMLparam3(ctx, domid, sysrq);
 	int ret;
+	uint32_t c_domid = Int_val(domid);
+	int c_sysrq = Int_val(sysrq);
 
-	ret = libxl_send_sysrq(CTX, Int_val(domid), Int_val(sysrq));
+	caml_enter_blocking_section();
+	ret = libxl_send_sysrq(CTX, c_domid, c_sysrq);
+	caml_leave_blocking_section();
 
 	if (ret != 0)
 		failwith_xl(ret, "send_sysrq");
@@ -920,7 +1031,10 @@ value stub_xl_send_debug_keys(value ctx, value keys)
 
 	c_keys = dup_String_val(keys);
 
+	caml_enter_blocking_section();
 	ret = libxl_send_debug_keys(CTX, c_keys);
+	caml_leave_blocking_section();
+
 	free(c_keys);
 
 	if (ret != 0)
@@ -944,9 +1058,12 @@ value stub_libxl_xen_console_read_start(value ctx, value clear)
 {
 	CAMLparam2(ctx, clear);
 	CAMLlocal1(handle);
+	int c_clear = Int_val(clear);
 	libxl_xen_console_reader *cr;
 
-	cr = libxl_xen_console_read_start(CTX, Int_val(clear));
+	caml_enter_blocking_section();
+	cr = libxl_xen_console_read_start(CTX, c_clear);
+	caml_leave_blocking_section();
 
 	handle = caml_alloc_custom(&libxl_console_reader_custom_operations, sizeof(cr), 0, 1);
 	Console_reader_val(handle) = cr;
@@ -976,7 +1093,9 @@ value stub_libxl_xen_console_read_line(value ctx, value reader)
 	char *c_line;
 	libxl_xen_console_reader *cr = (libxl_xen_console_reader *) Console_reader_val(reader);
 
+	caml_enter_blocking_section();
 	ret = libxl_xen_console_read_line(CTX, cr, &c_line);
+	caml_leave_blocking_section();
 
 	if (ret < 0)
 		failwith_xl(ret, "xen_console_read_line");
@@ -993,7 +1112,9 @@ value stub_libxl_xen_console_read_finish(value ctx, value reader)
 	CAMLparam2(ctx, reader);
 	libxl_xen_console_reader *cr = (libxl_xen_console_reader *) Console_reader_val(reader);
 
+	caml_enter_blocking_section();
 	libxl_xen_console_read_finish(CTX, cr);
+	caml_leave_blocking_section();
 
 	CAMLreturn(Val_unit);
 }
@@ -1085,6 +1206,7 @@ value Val_poll_events(short events)
 int fd_register(void *user, int fd, void **for_app_registration_out,
                      short events, void *for_libxl)
 {
+	caml_leave_blocking_section();
 	CAMLparam0();
 	CAMLlocalN(args, 4);
 	static value *func = NULL;
@@ -1101,12 +1223,15 @@ int fd_register(void *user, int fd, void **for_app_registration_out,
 	args[3] = (value) for_libxl;
 
 	caml_callbackN(*func, 4, args);
-	CAMLreturn(0);
+	CAMLdone;
+	caml_enter_blocking_section();
+	return 0;
 }
 
 int fd_modify(void *user, int fd, void **for_app_registration_update,
                    short events)
 {
+	caml_leave_blocking_section();
 	CAMLparam0();
 	CAMLlocalN(args, 3);
 	static value *func = NULL;
@@ -1122,11 +1247,14 @@ int fd_modify(void *user, int fd, void **for_app_registration_update,
 	args[2] = Val_poll_events(events);
 
 	caml_callbackN(*func, 3, args);
-	CAMLreturn(0);
+	CAMLdone;
+	caml_enter_blocking_section();
+	return 0;
 }
 
 void fd_deregister(void *user, int fd, void *for_app_registration)
 {
+	caml_leave_blocking_section();
 	CAMLparam0();
 	CAMLlocalN(args, 2);
 	static value *func = NULL;
@@ -1141,12 +1269,14 @@ void fd_deregister(void *user, int fd, void *for_app_registration)
 	args[1] = Val_int(fd);
 
 	caml_callbackN(*func, 2, args);
-	CAMLreturn0;
+	CAMLdone;
+	caml_enter_blocking_section();
 }
 
 int timeout_register(void *user, void **for_app_registration_out,
                           struct timeval abs, void *for_libxl)
 {
+	caml_leave_blocking_section();
 	CAMLparam0();
 	CAMLlocalN(args, 4);
 	static value *func = NULL;
@@ -1163,12 +1293,15 @@ int timeout_register(void *user, void **for_app_registration_out,
 	args[3] = (value) for_libxl;
 
 	caml_callbackN(*func, 4, args);
-	CAMLreturn(0);
+	CAMLdone;
+	caml_enter_blocking_section();
+	return 0;
 }
 
 int timeout_modify(void *user, void **for_app_registration_update,
                          struct timeval abs)
 {
+	caml_leave_blocking_section();
 	CAMLparam0();
 	static value *func = NULL;
 	value *p = (value *) user;
@@ -1179,13 +1312,16 @@ int timeout_modify(void *user, void **for_app_registration_update,
 	}
 
 	caml_callback(*func, *p);
-	CAMLreturn(0);
+	CAMLdone;
+	caml_enter_blocking_section();
+	return 0;
 }
 
 void timeout_deregister(void *user, void *for_app_registration)
 {
+	caml_leave_blocking_section();
 	failwith_xl(ERROR_FAIL, "timeout_deregister not yet implemented");
-	return;
+	caml_enter_blocking_section();
 }
 
 value stub_libxl_osevent_register_hooks(value ctx, value user)
@@ -1211,7 +1347,9 @@ value stub_libxl_osevent_register_hooks(value ctx, value user)
 	*p = user;
 	caml_register_global_root(p);
 
+	caml_enter_blocking_section();
 	libxl_osevent_register_hooks(CTX, hooks, (void *) p);
+	caml_leave_blocking_section();
 
 	result = caml_alloc(1, Abstract_tag);
 	*((libxl_osevent_hooks **) result) = hooks;
@@ -1223,15 +1361,25 @@ 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));
+	int c_fd = Int_val(fd);
+	short c_events = Poll_events_val(events);
+	short c_revents = Poll_events_val(revents);
+
+	caml_enter_blocking_section();
+	libxl_osevent_occurred_fd(CTX, (void *) for_libxl, c_fd, c_events, c_revents);
+	caml_leave_blocking_section();
+
 	CAMLreturn(Val_unit);
 }
 
 value stub_libxl_osevent_occurred_timeout(value ctx, value for_libxl)
 {
 	CAMLparam2(ctx, for_libxl);
+
+	caml_enter_blocking_section();
 	libxl_osevent_occurred_timeout(CTX, (void *) for_libxl);
+	caml_leave_blocking_section();
+
 	CAMLreturn(Val_unit);
 }
 
@@ -1242,6 +1390,7 @@ struct user_with_ctx {
 
 void event_occurs(void *user, libxl_event *event)
 {
+	caml_leave_blocking_section();
 	CAMLparam0();
 	CAMLlocalN(args, 2);
 	struct user_with_ctx *c_user = (struct user_with_ctx *) user;
@@ -1257,12 +1406,14 @@ void event_occurs(void *user, libxl_event *event)
 	libxl_event_free(c_user->ctx, event);
 
 	caml_callbackN(*func, 2, args);
-	CAMLreturn0;
+	CAMLdone;
+	caml_enter_blocking_section();
 }
 
 void disaster(void *user, libxl_event_type type,
                      const char *msg, int errnoval)
 {
+	caml_leave_blocking_section();
 	CAMLparam0();
 	CAMLlocalN(args, 4);
 	struct user_with_ctx *c_user = (struct user_with_ctx *) user;
@@ -1279,7 +1430,8 @@ void disaster(void *user, libxl_event_type type,
 	args[3] = Val_int(errnoval);
 
 	caml_callbackN(*func, 4, args);
-	CAMLreturn0;
+	CAMLdone;
+	caml_enter_blocking_section();
 }
 
 value stub_libxl_event_register_callbacks(value ctx, value user)
@@ -1303,7 +1455,10 @@ value stub_libxl_event_register_callbacks(value ctx, value user)
 	hooks->event_occurs = event_occurs;
 	hooks->disaster = disaster;
 
+	caml_enter_blocking_section();
 	libxl_event_register_callbacks(CTX, hooks, (void *) c_user);
+	caml_leave_blocking_section();
+
 	result = caml_alloc(1, Abstract_tag);
 	*((libxl_event_hooks **) result) = hooks;
 
@@ -1313,9 +1468,13 @@ value stub_libxl_event_register_callbacks(value ctx, value user)
 value stub_libxl_evenable_domain_death(value ctx, value domid, value user)
 {
 	CAMLparam3(ctx, domid, user);
+	uint32_t c_domid = Int_val(domid);
+	int c_user = Int_val(user);
 	libxl_evgen_domain_death *evgen_out;
 
-	libxl_evenable_domain_death(CTX, Int_val(domid), Int_val(user), &evgen_out);
+	caml_enter_blocking_section();
+	libxl_evenable_domain_death(CTX, c_domid, c_user, &evgen_out);
+	caml_leave_blocking_section();
 
 	CAMLreturn(Val_unit);
 }
-- 
1.7.10.4

[PATCH v6 09/11] libxl: ocaml: add some missing CAML macros

[Rob Hoes]

Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
---
 tools/ocaml/libs/xl/xenlight_stubs.c |    7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
index 5d8f039..2c24ea2 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -59,6 +59,7 @@ static value Val_error (libxl_error error_c);
 
 static void failwith_xl(int error, char *fname)
 {
+	CAMLparam0();
 	CAMLlocal1(arg);
 	static value *exc = NULL;
 
@@ -75,6 +76,7 @@ static void failwith_xl(int error, char *fname)
 	Store_field(arg, 1, caml_copy_string(fname));
 
 	caml_raise_with_arg(*exc, arg);
+	CAMLreturn0;
 }
 
 CAMLprim value stub_raise_exception(value unit)
@@ -338,7 +340,7 @@ static libxl_defbool Defbool_val(value v)
 		bool b = Bool_val(Some_val(v));
 		libxl_defbool_set(&db, b);
 	}
-	return db;
+	CAMLreturnT(libxl_defbool, db);
 }
 
 static value Val_hwcap(libxl_hwcap *c_val)
@@ -369,10 +371,11 @@ static value Val_string_option(const char *c_val)
 
 static char *String_option_val(value v)
 {
+	CAMLparam1(v);
 	char *s = NULL;
 	if (v != Val_none)
 		s = dup_String_val(Some_val(v));
-	return s;
+	CAMLreturnT(char *, s);
 }
 
 #include "_libxl_types.inc"
-- 
1.7.10.4

[PATCH v6 10/11] libxl: ocaml: fix memory corruption when converting string and key/values lists

[Rob Hoes]

Found by Coverty. CIDs: 1128562 1128563 1128564 1128565.

Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Reviewed-by: Andrew Cooper <andrew.cooper3@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
---
 tools/ocaml/libs/xl/xenlight_stubs.c |    6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
index 2c24ea2..4fd5d07 100644
--- a/tools/ocaml/libs/xl/xenlight_stubs.c
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c
@@ -160,8 +160,8 @@ static value Val_key_value_list(libxl_key_value_list *c_val)
 
 	list = Val_emptylist;
 	for (i = libxl_string_list_length((libxl_string_list *) c_val) - 1; i >= 0; i -= 2) {
-		val = caml_copy_string((char *) c_val[i]);
-		key = caml_copy_string((char *) c_val[i - 1]);
+		val = caml_copy_string((*c_val)[i]);
+		key = caml_copy_string((*c_val)[i - 1]);
 		kv = caml_alloc_tuple(2);
 		Store_field(kv, 0, key);
 		Store_field(kv, 1, val);
@@ -202,7 +202,7 @@ static value Val_string_list(libxl_string_list *c_val)
 
 	list = Val_emptylist;
 	for (i = libxl_string_list_length(c_val) - 1; i >= 0; i--) {
-		string = caml_copy_string((char *) c_val[i]);
+		string = caml_copy_string((*c_val)[i]);
 		cons = caml_alloc(2, 0);
 		Store_field(cons, 0, string);   // head
 		Store_field(cons, 1, list);     // tail
-- 
1.7.10.4

[PATCH v6 11/11] libxl: ocaml: remove dead code in xentoollog bindings

[Rob Hoes]

Found by Coverty. CIDs: 1128567 1128568 1128576 1128577.

Signed-off-by: Rob Hoes <rob.hoes@citrix.com>
Reviewed-by: Andrew Cooper <andrew.cooper3@citrix.com>
Acked-by: David Scott <dave.scott@eu.citrix.com>
Acked-by: Ian Campbell <ian.campbell@citrix.com>
---
 tools/ocaml/libs/xentoollog/xentoollog_stubs.c |    4 ----
 1 file changed, 4 deletions(-)

diff --git a/tools/ocaml/libs/xentoollog/xentoollog_stubs.c b/tools/ocaml/libs/xentoollog/xentoollog_stubs.c
index daf48fe..aadc3d1 100644
--- a/tools/ocaml/libs/xentoollog/xentoollog_stubs.c
+++ b/tools/ocaml/libs/xentoollog/xentoollog_stubs.c
@@ -93,8 +93,6 @@ static void stub_xtl_ocaml_vmessage(struct xentoollog_logger *logger,
 	value *func = caml_named_value(xtl->vmessage_cb) ;
 	char *msg;
 
-	if (args == NULL)
-		caml_raise_out_of_memory();
 	if (func == NULL)
 		caml_raise_sys_error(caml_copy_string("Unable to find callback"));
 	if (vasprintf(&msg, format, al) < 0)
@@ -124,8 +122,6 @@ static void stub_xtl_ocaml_progress(struct xentoollog_logger *logger,
 	struct caml_xtl *xtl = (struct caml_xtl*)logger;
 	value *func = caml_named_value(xtl->progress_cb) ;
 
-	if (args == NULL)
-		caml_raise_out_of_memory();
 	if (func == NULL)
 		caml_raise_sys_error(caml_copy_string("Unable to find callback"));
 
-- 
1.7.10.4

Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings

[Rob Hoes]

> This series contains version 6 of the remaining patches to fix the OCaml
> bindings to libxl.
> 
> The main change compared to version 5 is that we now properly register the
> "user" values (OCaml values that are given to the libxl event system, and
> returned to OCaml in callbacks) with the OCaml GC.

It is worth noting that I tested this on xenopsd/XenServer by calling the Gc.compact function immediately after doing an asynchronous libxl call. This function causes OCaml to execute all phases of the GC, which includes moving all new and "live" values from the minor heap to the major heap. If there would still be any unregistered value, this should trigger an error almost immediately.

Cheers,
Rob

> For convenience, the patches in this series may be pulled using:
> git pull git://github.com/robhoes/xen.git hydrogen-upstream-v6
> 
> 
> _______________________________________________
> Xen-devel mailing list
> Xen-devel@lists.xen.org
> http://lists.xen.org/xen-devel

Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings

[Ian Campbell]

On Mon, 2013-12-09 at 15:17 +0000, Rob Hoes wrote:
> This series contains version 6 of the remaining patches to fix the OCaml
> bindings to libxl.
> 
> The main change compared to version 5 is that we now properly register the
> "user" values (OCaml values that are given to the libxl event system, and
> returned to OCaml in callbacks) with the OCaml GC.

So the release process has moved on sufficiently that I think we need to
consider whether the previous release-ack still stands:
http://thread.gmane.org/gmane.comp.emulators.xen.devel/180254/focus=180383

I think the arguments made there still stand, in short it would be
awesome if xapi could move to using libxl on top of 4.4 and the risks
are almost entirely contained within this use case, which cannot be
satisfied by the code as it stands today.

> 
> For convenience, the patches in this series may be pulled using:
> git pull git://github.com/robhoes/xen.git hydrogen-upstream-v6
> 

Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings

[Andrew Cooper]

On 10/12/13 13:20, Ian Campbell wrote:
> On Mon, 2013-12-09 at 15:17 +0000, Rob Hoes wrote:
>> This series contains version 6 of the remaining patches to fix the OCaml
>> bindings to libxl.
>>
>> The main change compared to version 5 is that we now properly register the
>> "user" values (OCaml values that are given to the libxl event system, and
>> returned to OCaml in callbacks) with the OCaml GC.
> So the release process has moved on sufficiently that I think we need to
> consider whether the previous release-ack still stands:
> http://thread.gmane.org/gmane.comp.emulators.xen.devel/180254/focus=180383
>
> I think the arguments made there still stand, in short it would be
> awesome if xapi could move to using libxl on top of 4.4 and the risks
> are almost entirely contained within this use case, which cannot be
> satisfied by the code as it stands today.

Irrespective of the (re)decision about the release ack (which I believe
should still stand),

Patches 10 and 11 are Coverity fixes from issues caused by the bits of
the series committed so far, so should be considered differently if the
release ack is rescinded.

~Andrew

Re: [PATCH v6 04/11] libxl: ocaml: allow device operations to be called asynchronously

[Ian Campbell]

On Mon, 2013-12-09 at 15:17 +0000, Rob Hoes wrote:
> 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 patch to register for_callback value with the GC.
> ---
>  tools/ocaml/libs/xl/genwrap.py       |    6 +++---
>  tools/ocaml/libs/xl/xenlight_stubs.c |   18 +++++++++++++++---
>  2 files changed, 18 insertions(+), 6 deletions(-)
> 
> diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
> index f5d2224..dd43069 100644
> --- a/tools/ocaml/libs/xl/genwrap.py
> +++ b/tools/ocaml/libs/xl/genwrap.py
> @@ -22,9 +22,9 @@ builtins = {
>      "libxl_cpuid_policy_list": ("unit",                "%(c)s = 0",                         "Val_unit"),
>      }
>  
> -DEVICE_FUNCTIONS = [ ("add",            ["ctx", "t", "domid", "unit"]),
> -                     ("remove",         ["ctx", "t", "domid", "unit"]),
> -                     ("destroy",        ["ctx", "t", "domid", "unit"]),
> +DEVICE_FUNCTIONS = [ ("add",            ["ctx", "t", "domid", "?async:'a", "unit", "unit"]),
> +                     ("remove",         ["ctx", "t", "domid", "?async:'a", "unit", "unit"]),
> +                     ("destroy",        ["ctx", "t", "domid", "?async:'a", "unit", "unit"]),
>                     ]
>  
>  functions = { # ( name , [type1,type2,....] )
> diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
> index 660dd09..b6649a7 100644
> --- a/tools/ocaml/libs/xl/xenlight_stubs.c
> +++ b/tools/ocaml/libs/xl/xenlight_stubs.c
> @@ -401,15 +401,27 @@ void async_callback(libxl_ctx *ctx, int rc, void *for_callback)
>  #define STRINGIFY(x) _STRINGIFY(x)
>  
>  #define _DEVICE_ADDREMOVE(type,op)					\
> -value stub_xl_device_##type##_##op(value ctx, value info, value domid)	\
> +value stub_xl_device_##type##_##op(value ctx, value info, value domid,	\
> +	value async, value unit)					\
>  {									\
> -	CAMLparam3(ctx, info, domid);					\
> +	CAMLparam5(ctx, info, domid, async, unit);			\
>  	libxl_device_##type c_info;					\
>  	int ret, marker_var;						\
> +	libxl_asyncop_how ao_how;					\
> +	value *p;							\
>  									\
>  	device_##type##_val(CTX, &c_info, info);			\
>  									\
> -	ret = libxl_device_##type##_##op(CTX, Int_val(domid), &c_info, 0); \
> +	if (async != Val_none) {					\
> +		p = malloc(sizeof(value));				\

This lacks error handling, or as Ian J suggested previously a wrapper to
fail in a graceful manner. I think that can be a future more global
cleanup though.

Acked-by: Ian Campbell <ian.campbell@citrix.com>

> +		*p = Some_val(async);					\
> +		caml_register_global_root(p);				\
> +		ao_how.callback = async_callback;			\
> +		ao_how.u.for_callback = (void *) p;			\
> +	}								\
> +									\
> +	ret = libxl_device_##type##_##op(CTX, Int_val(domid), &c_info,	\
> +		async != Val_none ? &ao_how : NULL);			\
>  									\
>  	libxl_device_##type##_dispose(&c_info);				\
>  									\

Re: [PATCH v6 04/11] libxl: ocaml: allow device operations to be called asynchronously

[Ian Campbell]

On Tue, 2013-12-10 at 13:25 +0000, Ian Campbell wrote:
> On Mon, 2013-12-09 at 15:17 +0000, Rob Hoes wrote:
> > 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 patch to register for_callback value with the GC.
> > ---
> >  tools/ocaml/libs/xl/genwrap.py       |    6 +++---
> >  tools/ocaml/libs/xl/xenlight_stubs.c |   18 +++++++++++++++---
> >  2 files changed, 18 insertions(+), 6 deletions(-)
> > 
> > diff --git a/tools/ocaml/libs/xl/genwrap.py b/tools/ocaml/libs/xl/genwrap.py
> > index f5d2224..dd43069 100644
> > --- a/tools/ocaml/libs/xl/genwrap.py
> > +++ b/tools/ocaml/libs/xl/genwrap.py
> > @@ -22,9 +22,9 @@ builtins = {
> >      "libxl_cpuid_policy_list": ("unit",                "%(c)s = 0",                         "Val_unit"),
> >      }
> >  
> > -DEVICE_FUNCTIONS = [ ("add",            ["ctx", "t", "domid", "unit"]),
> > -                     ("remove",         ["ctx", "t", "domid", "unit"]),
> > -                     ("destroy",        ["ctx", "t", "domid", "unit"]),
> > +DEVICE_FUNCTIONS = [ ("add",            ["ctx", "t", "domid", "?async:'a", "unit", "unit"]),
> > +                     ("remove",         ["ctx", "t", "domid", "?async:'a", "unit", "unit"]),
> > +                     ("destroy",        ["ctx", "t", "domid", "?async:'a", "unit", "unit"]),
> >                     ]
> >  
> >  functions = { # ( name , [type1,type2,....] )
> > diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c b/tools/ocaml/libs/xl/xenlight_stubs.c
> > index 660dd09..b6649a7 100644
> > --- a/tools/ocaml/libs/xl/xenlight_stubs.c
> > +++ b/tools/ocaml/libs/xl/xenlight_stubs.c
> > @@ -401,15 +401,27 @@ void async_callback(libxl_ctx *ctx, int rc, void *for_callback)
> >  #define STRINGIFY(x) _STRINGIFY(x)
> >  
> >  #define _DEVICE_ADDREMOVE(type,op)					\
> > -value stub_xl_device_##type##_##op(value ctx, value info, value domid)	\
> > +value stub_xl_device_##type##_##op(value ctx, value info, value domid,	\
> > +	value async, value unit)					\
> >  {									\
> > -	CAMLparam3(ctx, info, domid);					\
> > +	CAMLparam5(ctx, info, domid, async, unit);			\
> >  	libxl_device_##type c_info;					\
> >  	int ret, marker_var;						\
> > +	libxl_asyncop_how ao_how;					\
> > +	value *p;							\
> >  									\
> >  	device_##type##_val(CTX, &c_info, info);			\
> >  									\
> > -	ret = libxl_device_##type##_##op(CTX, Int_val(domid), &c_info, 0); \
> > +	if (async != Val_none) {					\
> > +		p = malloc(sizeof(value));				\
> 
> This lacks error handling, or as Ian J suggested previously a wrapper to
> fail in a graceful manner. I think that can be a future more global
> cleanup though.

I see in a subsequent patch some similar code gets:
+               if (!p)
+                       failwith_xl(ERROR_NOMEM, "cannot allocate value");

Would be worth having here too.

> 
> Acked-by: Ian Campbell <ian.campbell@citrix.com>
> 
> > +		*p = Some_val(async);					\
> > +		caml_register_global_root(p);				\
> > +		ao_how.callback = async_callback;			\
> > +		ao_how.u.for_callback = (void *) p;			\
> > +	}								\
> > +									\
> > +	ret = libxl_device_##type##_##op(CTX, Int_val(domid), &c_info,	\
> > +		async != Val_none ? &ao_how : NULL);			\
> >  									\
> >  	libxl_device_##type##_dispose(&c_info);				\
> >  									\
> 
> 
> 
> _______________________________________________
> Xen-devel mailing list
> Xen-devel@lists.xen.org
> http://lists.xen.org/xen-devel

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

[Ian Campbell]

On Mon, 2013-12-09 at 15:17 +0000, 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>

Acked-by: Ian Campbell <ian.campbell@citrix.com>

Re: [PATCH v6 08/11] libxl: ocaml: drop the ocaml heap lock before calling into libxl

[Ian Campbell]

On Mon, 2013-12-09 at 15:17 +0000, Rob Hoes wrote:
> }
>  
> -static libxl_asyncop_how *aohow_val(value async, libxl_asyncop_how *ao_how)
> +static libxl_asyncop_how *aohow_val(value async)
>  {
>  	CAMLparam1(async);
> +	libxl_asyncop_how *ao_how = NULL;
>  	value *p;
>  
>  	if (async != Val_none) {
> @@ -408,12 +418,12 @@ static libxl_asyncop_how *aohow_val(value async, libxl_asyncop_how *ao_how)
>  			failwith_xl(ERROR_NOMEM, "cannot allocate value");
>  		*p = Some_val(async);
>  		caml_register_global_root(p);
> +		libxl_asyncop_how *ao_how = malloc(sizeof(*ao_how));

This will shadow the definition at the top of the function, meaning this
function always returns NULL AFAICT. I think you meant just
		ao_how = malloc(...);

Can you remind me why this needs to be dynamically allocated please,
preferably by adding the explanation to the commit message.

>  		ao_how->callback = async_callback;
>  		ao_how->u.for_callback = (void *) p;
> -		CAMLreturnT(libxl_asyncop_how *, ao_how);
>  	}
> -	else
> -		CAMLreturnT(libxl_asyncop_how *, NULL);
> +
> +	CAMLreturnT(libxl_asyncop_how *, ao_how);
>  }
>  
>  value stub_libxl_domain_create_new(value ctx, value domain_config, value async, value unit)
> @@ -422,7 +432,7 @@ value stub_libxl_domain_create_new(value ctx, value domain_config, value async,
>  	int ret;
>  	libxl_domain_config c_dconfig;
>  	uint32_t c_domid;
> -	libxl_asyncop_how ao_how;
> +	libxl_asyncop_how *ao_how;
>  
>  	libxl_domain_config_init(&c_dconfig);
>  	ret = domain_config_val(CTX, &c_dconfig, domain_config);
> @@ -431,9 +441,14 @@ value stub_libxl_domain_create_new(value ctx, value domain_config, value async,
>  		failwith_xl(ret, "domain_create_new");
>  	}
>  
> -	ret = libxl_domain_create_new(CTX, &c_dconfig, &c_domid,
> -		aohow_val(async, &ao_how), NULL);
> +	ao_how = aohow_val(async);
> +
> +	caml_enter_blocking_section();
> +	ret = libxl_domain_create_new(CTX, &c_dconfig, &c_domid, ao_how, NULL);
> +	caml_leave_blocking_section();
>  
> +	if (ao_how)
> +		free(ao_how);

free(NULL) is fine, so you can avoid the if. (multiple times in this
patch)

Ian.

Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings

[Ian Campbell]

On Tue, 2013-12-10 at 13:25 +0000, Andrew Cooper wrote:
> Patches 10 and 11 are Coverity fixes from issues caused by the bits of
> the series committed so far, so should be considered differently if the
> release ack is rescinded.

I've just applied those two.

Ian.

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

[Ian Campbell]

On Mon, 2013-12-09 at 15:17 +0000, 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 think this could legitimately be part of the main commit message.
(Except the actual registrations are all in subsequent patches I think,
just the cleanup is here)

It is probably worth a comment somewhere explaining that the
for_callback must always be non-NULL and that it must be registered as a
global root.

> +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);

Why do we need to return this results thing which is a pointer to the
hooks pointer? Something to do with keeping it live in the gc? Doesn't
that rely on the caller assigning it to a long lived variable so that it
isn't gc'd?

> +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);

Same thing again...

Ian.

Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings

[George Dunlap]

On 12/10/2013 01:20 PM, Ian Campbell wrote:
> On Mon, 2013-12-09 at 15:17 +0000, Rob Hoes wrote:
>> This series contains version 6 of the remaining patches to fix the OCaml
>> bindings to libxl.
>>
>> The main change compared to version 5 is that we now properly register the
>> "user" values (OCaml values that are given to the libxl event system, and
>> returned to OCaml in callbacks) with the OCaml GC.
> So the release process has moved on sufficiently that I think we need to
> consider whether the previous release-ack still stands:
> http://thread.gmane.org/gmane.comp.emulators.xen.devel/180254/focus=180383
>
> I think the arguments made there still stand, in short it would be
> awesome if xapi could move to using libxl on top of 4.4 and the risks
> are almost entirely contained within this use case, which cannot be
> satisfied by the code as it stands today.

Except that that basically calls into question what a "code freeze" is 
at all.  At some point we just need to say, "No more, this is what we 
have; from now on we work on bug fixes."

We've decided that PVH dom0 and ARM "physical address space leak" fixes 
are blockers for strategic reasons.  Is there a good reason that we 
should consider updated OCaml bindings in the same light?

At this point, the fact that there is only one downstream user 
(XenServer) is an argument *against* its inclusion: there is very little 
benefit, as XS can simply carry the patches if they want to.

The timeframe in which we did this kind of "cost/benefits" analysis for 
new features was meant to have passed already -- the "grace period" has 
already been three weeks; the schedule for the code freeze has been 
published and hasn't changed in 6 weeks.

While I can certainly understand the feeling of "just having missed" 
when it might have been accepted, given the number of people working on 
Xen now, I think we are almost always going to be in that situation.  We 
can either keep slipping the window until we happen to get lucky enough 
not to have any "really nice" features to add in, or we can set a hard 
deadline and say, "Sorry, that will have to wait."  Feel free to make a 
case for the first, but at the moment the second seems like the only way 
to proceed to me.

  -George

Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings

[George Dunlap]

On Tue, Dec 10, 2013 at 2:10 PM, George Dunlap
<george.dunlap@eu.citrix.com> wrote:
> On 12/10/2013 01:20 PM, Ian Campbell wrote:
>>
>> On Mon, 2013-12-09 at 15:17 +0000, Rob Hoes wrote:
>>>
>>> This series contains version 6 of the remaining patches to fix the OCaml
>>> bindings to libxl.
>>>
>>> The main change compared to version 5 is that we now properly register
>>> the
>>> "user" values (OCaml values that are given to the libxl event system, and
>>> returned to OCaml in callbacks) with the OCaml GC.
>>
>> So the release process has moved on sufficiently that I think we need to
>> consider whether the previous release-ack still stands:
>> http://thread.gmane.org/gmane.comp.emulators.xen.devel/180254/focus=180383
>>
>> I think the arguments made there still stand, in short it would be
>> awesome if xapi could move to using libxl on top of 4.4 and the risks
>> are almost entirely contained within this use case, which cannot be
>> satisfied by the code as it stands today.
>
>
> Except that that basically calls into question what a "code freeze" is at
> all.  At some point we just need to say, "No more, this is what we have;
> from now on we work on bug fixes."
>
> We've decided that PVH dom0 and ARM "physical address space leak" fixes are
> blockers for strategic reasons.  Is there a good reason that we should
> consider updated OCaml bindings in the same light?
>
> At this point, the fact that there is only one downstream user (XenServer)
> is an argument *against* its inclusion: there is very little benefit, as XS
> can simply carry the patches if they want to.
>
> The timeframe in which we did this kind of "cost/benefits" analysis for new
> features was meant to have passed already -- the "grace period" has already
> been three weeks; the schedule for the code freeze has been published and
> hasn't changed in 6 weeks.
>
> While I can certainly understand the feeling of "just having missed" when it
> might have been accepted, given the number of people working on Xen now, I
> think we are almost always going to be in that situation.  We can either
> keep slipping the window until we happen to get lucky enough not to have any
> "really nice" features to add in, or we can set a hard deadline and say,
> "Sorry, that will have to wait."  Feel free to make a case for the first,
> but at the moment the second seems like the only way to proceed to me.

If anyone has a better "rubric" to use in situations like these, I'm
open to hearing it...

 -George

Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings

[David Scott]

On 10/12/13 14:10, George Dunlap wrote:
> On 12/10/2013 01:20 PM, Ian Campbell wrote:
>> On Mon, 2013-12-09 at 15:17 +0000, Rob Hoes wrote:
>>> This series contains version 6 of the remaining patches to fix the OCaml
>>> bindings to libxl.
>>>
>>> The main change compared to version 5 is that we now properly
>>> register the
>>> "user" values (OCaml values that are given to the libxl event system,
>>> and
>>> returned to OCaml in callbacks) with the OCaml GC.
>> So the release process has moved on sufficiently that I think we need to
>> consider whether the previous release-ack still stands:
>> http://thread.gmane.org/gmane.comp.emulators.xen.devel/180254/focus=180383
>>
>>
>> I think the arguments made there still stand, in short it would be
>> awesome if xapi could move to using libxl on top of 4.4 and the risks
>> are almost entirely contained within this use case, which cannot be
>> satisfied by the code as it stands today.
>
> Except that that basically calls into question what a "code freeze" is
> at all.  At some point we just need to say, "No more, this is what we
> have; from now on we work on bug fixes."
>
> We've decided that PVH dom0 and ARM "physical address space leak" fixes
> are blockers for strategic reasons.  Is there a good reason that we
> should consider updated OCaml bindings in the same light?
>
> At this point, the fact that there is only one downstream user
> (XenServer) is an argument *against* its inclusion: there is very little
> benefit, as XS can simply carry the patches if they want to.

A nit-pick: the downstream user is really 'xenopsd', part of the xapi 
project. The xapi/xenopsd code is in XenServer and, increasingly, 
available for other Linux distros (we're trying to do the right thing 
and make the code easy to package). XenServer could easily carry some 
patches, but the other distros probably won't. The only workarounds to 
keep xapi/xenopsd working on non-XenServer distros that I can think of 
are (i) not using libxl at all [a shame, obviously]; or (ii) depending 
on a fresh package, 'libxl-ocaml-bindings-fixed' which would be a fork 
of the in-tree code with the fixes applied and named 'xenlight2' [ugly, 
not totally sure if it's even possible]. It seems odd to me to decide to 
ship code which the only user can't actually use ;-)

Cheers,
Dave

>
> The timeframe in which we did this kind of "cost/benefits" analysis for
> new features was meant to have passed already -- the "grace period" has
> already been three weeks; the schedule for the code freeze has been
> published and hasn't changed in 6 weeks.
>
> While I can certainly understand the feeling of "just having missed"
> when it might have been accepted, given the number of people working on
> Xen now, I think we are almost always going to be in that situation.  We
> can either keep slipping the window until we happen to get lucky enough
> not to have any "really nice" features to add in, or we can set a hard
> deadline and say, "Sorry, that will have to wait."  Feel free to make a
> case for the first, but at the moment the second seems like the only way
> to proceed to me.
>
>   -George

Re: [PATCH v6 04/11] libxl: ocaml: allow device operations to be called asynchronously

[Rob Hoes]

Ian Campbell wrote:
> On Mon, 2013-12-09 at 15:17 +0000, Rob Hoes wrote:
> > 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 patch to register for_callback value with the GC.
> > ---
> >  tools/ocaml/libs/xl/genwrap.py       |    6 +++---
> >  tools/ocaml/libs/xl/xenlight_stubs.c |   18 +++++++++++++++---
> >  2 files changed, 18 insertions(+), 6 deletions(-)
> >
> > diff --git a/tools/ocaml/libs/xl/genwrap.py
> b/tools/ocaml/libs/xl/genwrap.py
> > index f5d2224..dd43069 100644
> > --- a/tools/ocaml/libs/xl/genwrap.py
> > +++ b/tools/ocaml/libs/xl/genwrap.py
> > @@ -22,9 +22,9 @@ builtins = {
> >      "libxl_cpuid_policy_list": ("unit",                "%(c)s = 0",
> "Val_unit"),
> >      }
> >
> > -DEVICE_FUNCTIONS = [ ("add",            ["ctx", "t", "domid", "unit"]),
> > -                     ("remove",         ["ctx", "t", "domid", "unit"]),
> > -                     ("destroy",        ["ctx", "t", "domid", "unit"]),
> > +DEVICE_FUNCTIONS = [ ("add",            ["ctx", "t", "domid",
> "?async:'a", "unit", "unit"]),
> > +                     ("remove",         ["ctx", "t", "domid",
> "?async:'a", "unit", "unit"]),
> > +                     ("destroy",        ["ctx", "t", "domid",
> "?async:'a", "unit", "unit"]),
> >                     ]
> >
> >  functions = { # ( name , [type1,type2,....] )
> > diff --git a/tools/ocaml/libs/xl/xenlight_stubs.c
> b/tools/ocaml/libs/xl/xenlight_stubs.c
> > index 660dd09..b6649a7 100644
> > --- a/tools/ocaml/libs/xl/xenlight_stubs.c
> > +++ b/tools/ocaml/libs/xl/xenlight_stubs.c
> > @@ -401,15 +401,27 @@ void async_callback(libxl_ctx *ctx, int rc, void
> *for_callback)
> >  #define STRINGIFY(x) _STRINGIFY(x)
> >
> >  #define _DEVICE_ADDREMOVE(type,op)					\
> > -value stub_xl_device_##type##_##op(value ctx, value info, value domid)
> 	\
> > +value stub_xl_device_##type##_##op(value ctx, value info, value domid,
> 	\
> > +	value async, value unit)					\
> >  {									\
> > -	CAMLparam3(ctx, info, domid);					\
> > +	CAMLparam5(ctx, info, domid, async, unit);			\
> >  	libxl_device_##type c_info;					\
> >  	int ret, marker_var;						\
> > +	libxl_asyncop_how ao_how;					\
> > +	value *p;							\
> >  									\
> >  	device_##type##_val(CTX, &c_info, info);			\
> >  									\
> > -	ret = libxl_device_##type##_##op(CTX, Int_val(domid), &c_info, 0); \
> > +	if (async != Val_none) {					\
> > +		p = malloc(sizeof(value));				\
> 
> This lacks error handling, or as Ian J suggested previously a wrapper to
> fail in a graceful manner. I think that can be a future more global
> cleanup though.

Yes, indeed... However, fortunately, this particular bit of code is actually factored out into the aohow_val function in a following patch, which does have the error handling.

> Acked-by: Ian Campbell <ian.campbell@citrix.com>

Thanks.

Rob

> > +		*p = Some_val(async);					\
> > +		caml_register_global_root(p);				\
> > +		ao_how.callback = async_callback;			\
> > +		ao_how.u.for_callback = (void *) p;			\
> > +	}								\
> > +									\
> > +	ret = libxl_device_##type##_##op(CTX, Int_val(domid), &c_info,	\
> > +		async != Val_none ? &ao_how : NULL);			\
> >  									\
> >  	libxl_device_##type##_dispose(&c_info);				\
> >  									\
> 

Re: [PATCH v6 08/11] libxl: ocaml: drop the ocaml heap lock before calling into libxl

[Rob Hoes]

Ian Campbell wrote:
> On Mon, 2013-12-09 at 15:17 +0000, Rob Hoes wrote:
> > }
> >
> > -static libxl_asyncop_how *aohow_val(value async, libxl_asyncop_how
> > *ao_how)
> > +static libxl_asyncop_how *aohow_val(value async)
> >  {
> >  	CAMLparam1(async);
> > +	libxl_asyncop_how *ao_how = NULL;
> >  	value *p;
> >
> >  	if (async != Val_none) {
> > @@ -408,12 +418,12 @@ static libxl_asyncop_how *aohow_val(value async,
> libxl_asyncop_how *ao_how)
> >  			failwith_xl(ERROR_NOMEM, "cannot allocate value");
> >  		*p = Some_val(async);
> >  		caml_register_global_root(p);
> > +		libxl_asyncop_how *ao_how = malloc(sizeof(*ao_how));
> 
> This will shadow the definition at the top of the function, meaning this
> function always returns NULL AFAICT. I think you meant just
> 		ao_how = malloc(...);

Right, that's a typo while reorganising my patches... I'll send an update shortly.

> Can you remind me why this needs to be dynamically allocated please,
> preferably by adding the explanation to the commit message.

It doesn't need to be. It just made the function a little nicer to use (to me). I appreciate that C-experts may have better ways of doing this :)

> >  		ao_how->callback = async_callback;
> >  		ao_how->u.for_callback = (void *) p;
> > -		CAMLreturnT(libxl_asyncop_how *, ao_how);
> >  	}
> > -	else
> > -		CAMLreturnT(libxl_asyncop_how *, NULL);
> > +
> > +	CAMLreturnT(libxl_asyncop_how *, ao_how);
> >  }
> >
> >  value stub_libxl_domain_create_new(value ctx, value domain_config,
> > value async, value unit) @@ -422,7 +432,7 @@ value
> stub_libxl_domain_create_new(value ctx, value domain_config, value async,
> >  	int ret;
> >  	libxl_domain_config c_dconfig;
> >  	uint32_t c_domid;
> > -	libxl_asyncop_how ao_how;
> > +	libxl_asyncop_how *ao_how;
> >
> >  	libxl_domain_config_init(&c_dconfig);
> >  	ret = domain_config_val(CTX, &c_dconfig, domain_config); @@ -431,9
> > +441,14 @@ value stub_libxl_domain_create_new(value ctx, value
> domain_config, value async,
> >  		failwith_xl(ret, "domain_create_new");
> >  	}
> >
> > -	ret = libxl_domain_create_new(CTX, &c_dconfig, &c_domid,
> > -		aohow_val(async, &ao_how), NULL);
> > +	ao_how = aohow_val(async);
> > +
> > +	caml_enter_blocking_section();
> > +	ret = libxl_domain_create_new(CTX, &c_dconfig, &c_domid, ao_how,
> NULL);
> > +	caml_leave_blocking_section();
> >
> > +	if (ao_how)
> > +		free(ao_how);
> 
> free(NULL) is fine, so you can avoid the if. (multiple times in this
> patch)

Ok, good. I'll update that together with the fix above.

Cheers,
Rob

Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings

[George Dunlap]

On Tue, Dec 10, 2013 at 2:34 PM, David Scott <dave.scott@eu.citrix.com> wrote:
> On 10/12/13 14:10, George Dunlap wrote:
>>
>> On 12/10/2013 01:20 PM, Ian Campbell wrote:
>>> I think the arguments made there still stand, in short it would be
>>> awesome if xapi could move to using libxl on top of 4.4 and the risks
>>> are almost entirely contained within this use case, which cannot be
>>> satisfied by the code as it stands today.
>>
>>
>> Except that that basically calls into question what a "code freeze" is
>> at all.  At some point we just need to say, "No more, this is what we
>> have; from now on we work on bug fixes."
>>
>> We've decided that PVH dom0 and ARM "physical address space leak" fixes
>> are blockers for strategic reasons.  Is there a good reason that we
>> should consider updated OCaml bindings in the same light?
>>
>> At this point, the fact that there is only one downstream user
>> (XenServer) is an argument *against* its inclusion: there is very little
>> benefit, as XS can simply carry the patches if they want to.
>
>
> A nit-pick:

Not exactly. ;-)

> the downstream user is really 'xenopsd', part of the xapi
> project. The xapi/xenopsd code is in XenServer and, increasingly, available
> for other Linux distros (we're trying to do the right thing and make the
> code easy to package). XenServer could easily carry some patches, but the
> other distros probably won't. The only workarounds to keep xapi/xenopsd
> working on non-XenServer distros that I can think of are (i) not using libxl
> at all [a shame, obviously]; or (ii) depending on a fresh package,
> 'libxl-ocaml-bindings-fixed' which would be a fork of the in-tree code with
> the fixes applied and named 'xenlight2' [ugly, not totally sure if it's even
> possible]. It seems odd to me to decide to ship code which the only user
> can't actually use ;-)

Right -- so you are arguing that there is in fact a strategic reason
to get this into 4.4: you want xapi to be able to be easy to package
and install into distros, and having broken ocaml bindings is a major
blocker for that.  xapi packages for distros are already in a pretty
dire state, and not having support until 4.5 could be disastrous.

Would you agree with that assessment?

 -George

Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings

[David Scott]

On 10/12/13 15:42, George Dunlap wrote:
> On Tue, Dec 10, 2013 at 2:34 PM, David Scott <dave.scott@eu.citrix.com> wrote:
>> On 10/12/13 14:10, George Dunlap wrote:
>>>
>>> On 12/10/2013 01:20 PM, Ian Campbell wrote:
>>>> I think the arguments made there still stand, in short it would be
>>>> awesome if xapi could move to using libxl on top of 4.4 and the risks
>>>> are almost entirely contained within this use case, which cannot be
>>>> satisfied by the code as it stands today.
>>>
>>>
>>> Except that that basically calls into question what a "code freeze" is
>>> at all.  At some point we just need to say, "No more, this is what we
>>> have; from now on we work on bug fixes."
>>>
>>> We've decided that PVH dom0 and ARM "physical address space leak" fixes
>>> are blockers for strategic reasons.  Is there a good reason that we
>>> should consider updated OCaml bindings in the same light?
>>>
>>> At this point, the fact that there is only one downstream user
>>> (XenServer) is an argument *against* its inclusion: there is very little
>>> benefit, as XS can simply carry the patches if they want to.
>>
>>
>> A nit-pick:
>
> Not exactly. ;-)
>
>> the downstream user is really 'xenopsd', part of the xapi
>> project. The xapi/xenopsd code is in XenServer and, increasingly, available
>> for other Linux distros (we're trying to do the right thing and make the
>> code easy to package). XenServer could easily carry some patches, but the
>> other distros probably won't. The only workarounds to keep xapi/xenopsd
>> working on non-XenServer distros that I can think of are (i) not using libxl
>> at all [a shame, obviously]; or (ii) depending on a fresh package,
>> 'libxl-ocaml-bindings-fixed' which would be a fork of the in-tree code with
>> the fixes applied and named 'xenlight2' [ugly, not totally sure if it's even
>> possible]. It seems odd to me to decide to ship code which the only user
>> can't actually use ;-)
>
> Right -- so you are arguing that there is in fact a strategic reason
> to get this into 4.4: you want xapi to be able to be easy to package
> and install into distros, and having broken ocaml bindings is a major
> blocker for that.  xapi packages for distros are already in a pretty
> dire state, and not having support until 4.5 could be disastrous.
>
> Would you agree with that assessment?

Yes, I think that's fair.

Thanks,
Dave

Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings

[Ian Campbell]

On Tue, 2013-12-10 at 14:10 +0000, George Dunlap wrote:
> On 12/10/2013 01:20 PM, Ian Campbell wrote:
> > On Mon, 2013-12-09 at 15:17 +0000, Rob Hoes wrote:
> >> This series contains version 6 of the remaining patches to fix the OCaml
> >> bindings to libxl.
> >>
> >> The main change compared to version 5 is that we now properly register the
> >> "user" values (OCaml values that are given to the libxl event system, and
> >> returned to OCaml in callbacks) with the OCaml GC.
> > So the release process has moved on sufficiently that I think we need to
> > consider whether the previous release-ack still stands:
> > http://thread.gmane.org/gmane.comp.emulators.xen.devel/180254/focus=180383
> >
> > I think the arguments made there still stand, in short it would be
> > awesome if xapi could move to using libxl on top of 4.4 and the risks
> > are almost entirely contained within this use case, which cannot be
> > satisfied by the code as it stands today.
> 
> Except that that basically calls into question what a "code freeze" is 
> at all.  At some point we just need to say, "No more, this is what we 
> have; from now on we work on bug fixes."
> 
> We've decided that PVH dom0 and ARM "physical address space leak" fixes 
> are blockers for strategic reasons.  Is there a good reason that we 
> should consider updated OCaml bindings in the same light?

I think strategic reasons is a good way to put it. Our strategy over the
last several releases has been to move toolstack consumers of Xen over
to the libxl APIs instead of libxc and locally coded stuff. We're doing
pretty well on that from with xl/xm and libvirt and xapi is the final
major consumer of the old interfaces.

> At this point, the fact that there is only one downstream user 
> (XenServer) is an argument *against* its inclusion: there is very little 
> benefit, as XS can simply carry the patches if they want to.

I think this argument could be made either way. At the moment we might
as well git rm tools/ocaml/libs/xl for 4.4 because it is of basically no
use as it stands.

As Dave says there are also users of xapi/xenopsd outside of XenServer. 

It's unfortunate that the ocaml namespacing rules don't allow you to
easily ship a library of functions which extend an existing interface in
a compatible way (like e.g. libnih or the BSD linux compat lib), such
that you can just cut in the real functionality once it hits. 

> The timeframe in which we did this kind of "cost/benefits" analysis for 
> new features was meant to have passed already -- the "grace period" has 
> already been three weeks; the schedule for the code freeze has been 
> published and hasn't changed in 6 weeks.
> 
> While I can certainly understand the feeling of "just having missed" 
> when it might have been accepted, given the number of people working on 
> Xen now, I think we are almost always going to be in that situation.  We 
> can either keep slipping the window until we happen to get lucky enough 
> not to have any "really nice" features to add in, or we can set a hard 
> deadline and say, "Sorry, that will have to wait."  Feel free to make a 
> case for the first, but at the moment the second seems like the only way 
> to proceed to me.

For this specific series I don't think we need to slip the window for
it, either it works, good, or it doesn't work, bad, but effectively no
worse than where we are today.

Ian.

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

[Rob Hoes]

Ian Campbell wrote:
> On Mon, 2013-12-09 at 15:17 +0000, 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 think this could legitimately be part of the main commit message.
> (Except the actual registrations are all in subsequent patches I think,
> just the cleanup is here)
> 
> It is probably worth a comment somewhere explaining that the for_callback
> must always be non-NULL and that it must be registered as a global root.

Ok, I'll add a comment in the source, on top of the async_callback function. The registration part is indeed added in a following patch.

> > +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);
> 
> Why do we need to return this results thing which is a pointer to the
> hooks pointer? Something to do with keeping it live in the gc? Doesn't
> that rely on the caller assigning it to a long lived variable so that it
> isn't gc'd?

I think I made it return a pointer to the hooks, to be able to use it as a handle that we can give to a cleanup function. However, no such cleanup function currently exists (yet), and we don't actually use the return value.

The pointer is wrapped in an ocaml heap block with an Abstract_tag, which means that the GC will ignore whatever is inside. The block itself may be GC'ed if it goes out of scope in the ocaml code (which implies the value is not actually used in ocaml), but this won't affect the actual struct on the (C) heap.

Cheers,
Rob

> > +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);
> 
> Same thing again...
> 
> Ian.

Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings

[Ian Jackson]

George Dunlap writes ("Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings"):
> Except that that basically calls into question what a "code freeze" is 
> at all.  At some point we just need to say, "No more, this is what we 
> have; from now on we work on bug fixes."

That's indeed what we have a policy for.

> The timeframe in which we did this kind of "cost/benefits" analysis for 
> new features was meant to have passed already -- the "grace period" has 
> already been three weeks; the schedule for the code freeze has been 
> published and hasn't changed in 6 weeks.

Right.

> While I can certainly understand the feeling of "just having missed" 
> when it might have been accepted, given the number of people working on 
> Xen now, I think we are almost always going to be in that situation.  We 
> can either keep slipping the window until we happen to get lucky enough 
> not to have any "really nice" features to add in, or we can set a hard 
> deadline and say, "Sorry, that will have to wait."  Feel free to make a 
> case for the first, but at the moment the second seems like the only way 
> to proceed to me.

I would like to suggest that it was a mistake to provide a releease
ack for something which wasn't ready for immediate commit.

Perhaps in future a release ack should be implicitly qualified with
"if committed within the next working day" or some such.

Ian.

Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings

[Ian Jackson]

Ian Campbell writes ("Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings"):
> On Tue, 2013-12-10 at 14:10 +0000, George Dunlap wrote:
> > We've decided that PVH dom0 and ARM "physical address space leak" fixes 
> > are blockers for strategic reasons.  Is there a good reason that we 
> > should consider updated OCaml bindings in the same light?
> 
> I think strategic reasons is a good way to put it. Our strategy over the
> last several releases has been to move toolstack consumers of Xen over
> to the libxl APIs instead of libxc and locally coded stuff. We're doing
> pretty well on that from with xl/xm and libvirt and xapi is the final
> major consumer of the old interfaces.

I agree with this.

> > At this point, the fact that there is only one downstream user 
> > (XenServer) is an argument *against* its inclusion: there is very little 
> > benefit, as XS can simply carry the patches if they want to.
> 
> I think this argument could be made either way. At the moment we might
> as well git rm tools/ocaml/libs/xl for 4.4 because it is of basically no
> use as it stands.

I think this is the clincher argument for me.  Granting a freeze
exception is a balancing exercise between risk and benefit.  If the
code is already probably too broken to use, and definitely not
suitable for use by its primary consumers, then the risk of breaking
it is small.

Ian.

Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings

[George Dunlap]

On Tue, Dec 10, 2013 at 3:50 PM, Ian Jackson <Ian.Jackson@eu.citrix.com> wrote:
> George Dunlap writes ("Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings"):
>> Except that that basically calls into question what a "code freeze" is
>> at all.  At some point we just need to say, "No more, this is what we
>> have; from now on we work on bug fixes."
>
> That's indeed what we have a policy for.
>
>> The timeframe in which we did this kind of "cost/benefits" analysis for
>> new features was meant to have passed already -- the "grace period" has
>> already been three weeks; the schedule for the code freeze has been
>> published and hasn't changed in 6 weeks.
>
> Right.
>
>> While I can certainly understand the feeling of "just having missed"
>> when it might have been accepted, given the number of people working on
>> Xen now, I think we are almost always going to be in that situation.  We
>> can either keep slipping the window until we happen to get lucky enough
>> not to have any "really nice" features to add in, or we can set a hard
>> deadline and say, "Sorry, that will have to wait."  Feel free to make a
>> case for the first, but at the moment the second seems like the only way
>> to proceed to me.
>
> I would like to suggest that it was a mistake to provide a releease
> ack for something which wasn't ready for immediate commit.
>
> Perhaps in future a release ack should be implicitly qualified with
> "if committed within the next working day" or some such.

I think the reason I was giving them was to help focus reviewer and
developer energies in particular.  If a series has a chance of getting
in, it's important for reviewers and developers to prioritize it.  If
it's not going to get in, then the review / resubmit cycle can be put
on the back burner until the next development window opens up.

Two weeks ago there was no need to go through the whole exercise of
determining how important this was; given the criteria at the time, it
was a clear "accept".

 -George

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

[Ian Campbell]

On Tue, 2013-12-10 at 15:48 +0000, Rob Hoes wrote:

> > > +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);
> > 
> > Why do we need to return this results thing which is a pointer to the
> > hooks pointer? Something to do with keeping it live in the gc? Doesn't
> > that rely on the caller assigning it to a long lived variable so that it
> > isn't gc'd?
> 
> I think I made it return a pointer to the hooks, to be able to use it
> as a handle that we can give to a cleanup function. However, no such
> cleanup function currently exists (yet), and we don't actually use the
> return value.

Is this because changing the ocaml API in the future is a bit tricky? In
which case I suppose it is fine.

Ian.

Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings

[George Dunlap]

On Tue, Dec 10, 2013 at 3:48 PM, Ian Campbell <Ian.Campbell@citrix.com> wrote:
> On Tue, 2013-12-10 at 14:10 +0000, George Dunlap wrote:
>> On 12/10/2013 01:20 PM, Ian Campbell wrote:
>> > On Mon, 2013-12-09 at 15:17 +0000, Rob Hoes wrote:
>> >> This series contains version 6 of the remaining patches to fix the OCaml
>> >> bindings to libxl.
>> >>
>> >> The main change compared to version 5 is that we now properly register the
>> >> "user" values (OCaml values that are given to the libxl event system, and
>> >> returned to OCaml in callbacks) with the OCaml GC.
>> > So the release process has moved on sufficiently that I think we need to
>> > consider whether the previous release-ack still stands:
>> > http://thread.gmane.org/gmane.comp.emulators.xen.devel/180254/focus=180383
>> >
>> > I think the arguments made there still stand, in short it would be
>> > awesome if xapi could move to using libxl on top of 4.4 and the risks
>> > are almost entirely contained within this use case, which cannot be
>> > satisfied by the code as it stands today.
>>
>> Except that that basically calls into question what a "code freeze" is
>> at all.  At some point we just need to say, "No more, this is what we
>> have; from now on we work on bug fixes."
>>
>> We've decided that PVH dom0 and ARM "physical address space leak" fixes
>> are blockers for strategic reasons.  Is there a good reason that we
>> should consider updated OCaml bindings in the same light?
>
> I think strategic reasons is a good way to put it. Our strategy over the
> last several releases has been to move toolstack consumers of Xen over
> to the libxl APIs instead of libxc and locally coded stuff. We're doing
> pretty well on that from with xl/xm and libvirt and xapi is the final
> major consumer of the old interfaces.

When I say "strategic" in this case, I mean something in the timing
(why have it in this release rather than 4.5) that will have an impact
on Xen's place in the open-source ecosystem as a whole.  xapi's place
in distros is certainly time-critical and important to the success of
an important contributor to Xen; and the potential for negative impact
is certainly small.

In any case, there seems to be a strong consensus, so:

Release-acked-by: George Dunlap <george.dunlap@eu.citrix.com>

Re: [PATCH v6 08/11] libxl: ocaml: drop the ocaml heap lock before calling into libxl

[Ian Campbell]

On Tue, 2013-12-10 at 14:51 +0000, Rob Hoes wrote:
> > Can you remind me why this needs to be dynamically allocated please,
> > preferably by adding the explanation to the commit message.
> 
> It doesn't need to be. It just made the function a little nicer to use
> (to me). I appreciate that C-experts may have better ways of doing
> this :)

OK, I suppose there is no need to respin for this then, perhaps just
mention in the commit message that the aohow is being changed to be
dynamically allocated because you think it is a better API. (unexplained
changes in patches tend to make people twitchy, and are confusing as
hell in 6 months time...)

Ian

Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings

[Ian Campbell]

On Tue, 2013-12-10 at 15:57 +0000, George Dunlap wrote:
> On Tue, Dec 10, 2013 at 3:50 PM, Ian Jackson <Ian.Jackson@eu.citrix.com> wrote:
> > George Dunlap writes ("Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings"):
> >> Except that that basically calls into question what a "code freeze" is
> >> at all.  At some point we just need to say, "No more, this is what we
> >> have; from now on we work on bug fixes."
> >
> > That's indeed what we have a policy for.
> >
> >> The timeframe in which we did this kind of "cost/benefits" analysis for
> >> new features was meant to have passed already -- the "grace period" has
> >> already been three weeks; the schedule for the code freeze has been
> >> published and hasn't changed in 6 weeks.
> >
> > Right.
> >
> >> While I can certainly understand the feeling of "just having missed"
> >> when it might have been accepted, given the number of people working on
> >> Xen now, I think we are almost always going to be in that situation.  We
> >> can either keep slipping the window until we happen to get lucky enough
> >> not to have any "really nice" features to add in, or we can set a hard
> >> deadline and say, "Sorry, that will have to wait."  Feel free to make a
> >> case for the first, but at the moment the second seems like the only way
> >> to proceed to me.
> >
> > I would like to suggest that it was a mistake to provide a releease
> > ack for something which wasn't ready for immediate commit.
> >
> > Perhaps in future a release ack should be implicitly qualified with
> > "if committed within the next working day" or some such.
> 
> I think the reason I was giving them was to help focus reviewer and
> developer energies in particular.  If a series has a chance of getting
> in, it's important for reviewers and developers to prioritize it.  If
> it's not going to get in, then the review / resubmit cycle can be put
> on the back burner until the next development window opens up.

FWIW I don't think "within the next working day" would be very useful in
practice, since you'd be continually re-considering stuff posted every
other day (which is not uncommon due to timezone differences.

But "before the next $MILESTONE" might be. e.g. "Acked if applied before
$EVENT, planned for $DAY". That would help focus peoples attention,
especially those who may not be reading the regular development updates.

Ian.

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

[David Scott]

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
>

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

[David Scott]

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 _ =
>

Re: [PATCH v6 08/11] libxl: ocaml: drop the ocaml heap lock before calling into libxl

[Rob Hoes]

Ian Campbell wrote:
> On Tue, 2013-12-10 at 14:51 +0000, Rob Hoes wrote:
> > > Can you remind me why this needs to be dynamically allocated please,
> > > preferably by adding the explanation to the commit message.
> >
> > It doesn't need to be. It just made the function a little nicer to use
> > (to me). I appreciate that C-experts may have better ways of doing
> > this :)
> 
> OK, I suppose there is no need to respin for this then, perhaps just
> mention in the commit message that the aohow is being changed to be
> dynamically allocated because you think it is a better API. (unexplained
> changes in patches tend to make people twitchy, and are confusing as hell
> in 6 months time...)

Ok, I'll update the commit message. I do need to fix the ao_how malloc line though.

Cheers,
Rob

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

[Rob Hoes]

Ian Campbell wrote:
> On Tue, 2013-12-10 at 15:48 +0000, Rob Hoes wrote:
> > > Why do we need to return this results thing which is a pointer to
> > > the hooks pointer? Something to do with keeping it live in the gc?
> > > Doesn't that rely on the caller assigning it to a long lived
> > > variable so that it isn't gc'd?
> >
> > I think I made it return a pointer to the hooks, to be able to use it
> > as a handle that we can give to a cleanup function. However, no such
> > cleanup function currently exists (yet), and we don't actually use the
> > return value.
> 
> Is this because changing the ocaml API in the future is a bit tricky? In
> which case I suppose it is fine.

Well, it just avoids a possible interface change later on, while not causing much trouble.

Cheers,
Rob

Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings

[George Dunlap]

On Tue, Dec 10, 2013 at 4:00 PM, George Dunlap
<George.Dunlap@eu.citrix.com> wrote:
> On Tue, Dec 10, 2013 at 3:48 PM, Ian Campbell <Ian.Campbell@citrix.com> wrote:
>> On Tue, 2013-12-10 at 14:10 +0000, George Dunlap wrote:
>>> On 12/10/2013 01:20 PM, Ian Campbell wrote:
>>> > On Mon, 2013-12-09 at 15:17 +0000, Rob Hoes wrote:
>>> >> This series contains version 6 of the remaining patches to fix the OCaml
>>> >> bindings to libxl.
>>> >>
>>> >> The main change compared to version 5 is that we now properly register the
>>> >> "user" values (OCaml values that are given to the libxl event system, and
>>> >> returned to OCaml in callbacks) with the OCaml GC.
>>> > So the release process has moved on sufficiently that I think we need to
>>> > consider whether the previous release-ack still stands:
>>> > http://thread.gmane.org/gmane.comp.emulators.xen.devel/180254/focus=180383
>>> >
>>> > I think the arguments made there still stand, in short it would be
>>> > awesome if xapi could move to using libxl on top of 4.4 and the risks
>>> > are almost entirely contained within this use case, which cannot be
>>> > satisfied by the code as it stands today.
>>>
>>> Except that that basically calls into question what a "code freeze" is
>>> at all.  At some point we just need to say, "No more, this is what we
>>> have; from now on we work on bug fixes."
>>>
>>> We've decided that PVH dom0 and ARM "physical address space leak" fixes
>>> are blockers for strategic reasons.  Is there a good reason that we
>>> should consider updated OCaml bindings in the same light?
>>
>> I think strategic reasons is a good way to put it. Our strategy over the
>> last several releases has been to move toolstack consumers of Xen over
>> to the libxl APIs instead of libxc and locally coded stuff. We're doing
>> pretty well on that from with xl/xm and libvirt and xapi is the final
>> major consumer of the old interfaces.
>
> When I say "strategic" in this case, I mean something in the timing
> (why have it in this release rather than 4.5) that will have an impact
> on Xen's place in the open-source ecosystem as a whole.  xapi's place
> in distros is certainly time-critical and important to the success of
> an important contributor to Xen; and the potential for negative impact
> is certainly small.
>
> In any case, there seems to be a strong consensus, so:
>
> Release-acked-by: George Dunlap <george.dunlap@eu.citrix.com>

But I should emphasize, time is of the essence here. I can't imagine
us taking this after Christmas; and it sounds like there may be yet a
few more iterations to go. So if you guys want this in, this needs to
be a priority.

 -George

Re: [PATCH v6 00/11] libxl: ocaml: improve the bindings

[Rob Hoes]

> On Tue, Dec 10, 2013 at 4:00 PM, George Dunlap
> <George.Dunlap@eu.citrix.com> wrote:
> > On Tue, Dec 10, 2013 at 3:48 PM, Ian Campbell <Ian.Campbell@citrix.com>
> wrote:
> >> On Tue, 2013-12-10 at 14:10 +0000, George Dunlap wrote:
> >>> On 12/10/2013 01:20 PM, Ian Campbell wrote:
> >>> > On Mon, 2013-12-09 at 15:17 +0000, Rob Hoes wrote:
> >>> >> This series contains version 6 of the remaining patches to fix
> >>> >> the OCaml bindings to libxl.
> >>> >>
> >>> >> The main change compared to version 5 is that we now properly
> >>> >> register the "user" values (OCaml values that are given to the
> >>> >> libxl event system, and returned to OCaml in callbacks) with the
> OCaml GC.
> >>> > So the release process has moved on sufficiently that I think we
> >>> > need to consider whether the previous release-ack still stands:
> >>> > http://thread.gmane.org/gmane.comp.emulators.xen.devel/180254/focu
> >>> > s=180383
> >>> >
> >>> > I think the arguments made there still stand, in short it would be
> >>> > awesome if xapi could move to using libxl on top of 4.4 and the
> >>> > risks are almost entirely contained within this use case, which
> >>> > cannot be satisfied by the code as it stands today.
> >>>
> >>> Except that that basically calls into question what a "code freeze"
> >>> is at all.  At some point we just need to say, "No more, this is
> >>> what we have; from now on we work on bug fixes."
> >>>
> >>> We've decided that PVH dom0 and ARM "physical address space leak"
> >>> fixes are blockers for strategic reasons.  Is there a good reason
> >>> that we should consider updated OCaml bindings in the same light?
> >>
> >> I think strategic reasons is a good way to put it. Our strategy over
> >> the last several releases has been to move toolstack consumers of Xen
> >> over to the libxl APIs instead of libxc and locally coded stuff.
> >> We're doing pretty well on that from with xl/xm and libvirt and xapi
> >> is the final major consumer of the old interfaces.
> >
> > When I say "strategic" in this case, I mean something in the timing
> > (why have it in this release rather than 4.5) that will have an impact
> > on Xen's place in the open-source ecosystem as a whole.  xapi's place
> > in distros is certainly time-critical and important to the success of
> > an important contributor to Xen; and the potential for negative impact
> > is certainly small.
> >
> > In any case, there seems to be a strong consensus, so:
> >
> > Release-acked-by: George Dunlap <george.dunlap@eu.citrix.com>
> 
> But I should emphasize, time is of the essence here. I can't imagine us
> taking this after Christmas; and it sounds like there may be yet a few
> more iterations to go. So if you guys want this in, this needs to be a
> priority.

Thanks for the ack, George. I think indeed it is important to get this into Xen 4.4, especially for the reasons related to distros that were mentioned.

I have just sent out an update containing some minor changes that were discussed today.

Cheers,
Rob