Ian Campbell
2012-Nov-20 17:23 UTC
[PATCH 11 of 15] libxl: ocaml: allocate a long lived libxl context
# HG changeset patch
# User Ian Campbell <ijc@hellion.org.uk>
# Date 1353432141 0
# Node ID bdd9c3e423d7f505f93edf413a92ad7b47ed9e39
# Parent 2b433b1523e4295bb1ed74a7b71e2a20e00f1802
libxl: ocaml: allocate a long lived libxl context.
Rather than allocating a new context for every libxl call begin to
switch to a model where a context is allocated by the caller and may
then be used for multiple calls down into the library.
As a starting point convert list_domains and send_debug_keys and
implement simple tests which use them. These are just PoC of the
infrastructure, I don''t intend to add one for every function...
Signed-off-by: Ian Campbell <ian.campbell@citrix.com>
diff -r 2b433b1523e4 -r bdd9c3e423d7 .gitignore
--- a/.gitignore Tue Nov 20 17:22:21 2012 +0000
+++ b/.gitignore Tue Nov 20 17:22:21 2012 +0000
@@ -365,7 +365,8 @@ tools/ocaml/libs/xl/xenlight.ml
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/debugger/kdd/kdd
tools/firmware/etherboot/ipxe.tar.gz
tools/firmware/etherboot/ipxe/
diff -r 2b433b1523e4 -r bdd9c3e423d7 .hgignore
--- a/.hgignore Tue Nov 20 17:22:21 2012 +0000
+++ b/.hgignore Tue Nov 20 17:22:21 2012 +0000
@@ -306,6 +306,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 -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/libs/xl/Makefile
--- a/tools/ocaml/libs/xl/Makefile Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/Makefile Tue Nov 20 17:22:21 2012 +0000
@@ -10,6 +10,8 @@ OBJS = xenlight
INTF = xenlight.cmi
LIBS = xenlight.cma xenlight.cmxa
+OCAMLINCLUDE += -I ../xentoollog
+
LIBS_xenlight = $(LDLIBS_libxenlight)
xenlight_OBJS = $(OBJS)
diff -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/libs/xl/xenlight.ml.in
--- a/tools/ocaml/libs/xl/xenlight.ml.in Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/xenlight.ml.in Tue Nov 20 17:22:21 2012 +0000
@@ -13,6 +13,8 @@
* GNU Lesser General Public License for more details.
*)
+open Xentoollog
+
exception Error of string
type domid = int
@@ -24,8 +26,15 @@ end
(* @@LIBXL_TYPES@@ *)
+type ctx
+
+external ctx_alloc: Xentoollog.handle -> ctx =
"stub_libxl_ctx_alloc"
+external ctx_free: ctx -> unit = "stub_libxl_ctx_free"
+
+external list_domain: ctx -> Dominfo.t list =
"stub_libxl_list_domain"
+
external send_trigger : domid -> trigger -> int -> unit =
"stub_xl_send_trigger"
external send_sysrq : domid -> char -> unit =
"stub_xl_send_sysrq"
-external send_debug_keys : domid -> string -> unit =
"stub_xl_send_debug_keys"
+external send_debug_keys : ctx -> string -> unit =
"stub_xl_send_debug_keys"
let _ = Callback.register_exception "xl.error" (Error
"register_callback")
diff -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/libs/xl/xenlight.mli.in
--- a/tools/ocaml/libs/xl/xenlight.mli.in Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/xenlight.mli.in Tue Nov 20 17:22:21 2012 +0000
@@ -13,6 +13,8 @@
* GNU Lesser General Public License for more details.
*)
+open Xentoollog
+
exception Error of string
type domid = int
@@ -20,6 +22,13 @@ type devid = int
(* @@LIBXL_TYPES@@ *)
+type ctx
+
+external ctx_alloc: Xentoollog.handle -> ctx =
"stub_libxl_ctx_alloc"
+external ctx_free: ctx -> unit = "stub_libxl_ctx_free"
+
+external list_domain: ctx -> Dominfo.t list =
"stub_libxl_list_domain"
+
external send_trigger : domid -> trigger -> int -> unit =
"stub_xl_send_trigger"
external send_sysrq : domid -> char -> unit =
"stub_xl_send_sysrq"
-external send_debug_keys : domid -> string -> unit =
"stub_xl_send_debug_keys"
+external send_debug_keys : ctx -> string -> unit =
"stub_xl_send_debug_keys"
diff -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/libs/xl/xenlight_stubs.c
--- a/tools/ocaml/libs/xl/xenlight_stubs.c Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/libs/xl/xenlight_stubs.c Tue Nov 20 17:22:21 2012 +0000
@@ -29,6 +29,8 @@
#include <libxl.h>
#include <libxl_utils.h>
+#define CTX ((libxl_ctx *)ctx)
+
struct caml_logger {
struct xentoollog_logger logger;
int log_offset;
@@ -59,6 +61,8 @@ static void log_destroy(struct xentoollo
lg.logger.vmessage = log_vmessage; \
lg.logger.destroy = log_destroy; \
lg.logger.progress = NULL; \
+ lg.log_offset = 0; \
+ memset(&lg.log_buf,0,sizeof(lg.log_buf)); \
caml_enter_blocking_section(); \
ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (struct xentoollog_logger *)
&lg); \
if (ret != 0) \
@@ -77,7 +81,7 @@ static char * dup_String_val(caml_gc *gc
c = calloc(len + 1, sizeof(char));
if (!c)
caml_raise_out_of_memory();
- gc->ptrs[gc->offset++] = c;
+ if (gc) gc->ptrs[gc->offset++] = c;
memcpy(c, String_val(s), len);
return c;
}
@@ -94,9 +98,35 @@ static void failwith_xl(char *fname, str
{
char *s;
s = (lg) ? lg->log_buf : fname;
+ printf("Error: %s\n", fname);
caml_raise_with_string(*caml_named_value("xl.error"), s);
}
+CAMLprim value stub_libxl_ctx_alloc(value logger)
+{
+ CAMLparam1(logger);
+ libxl_ctx *ctx;
+ int ret;
+
+ caml_enter_blocking_section();
+ ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (struct xentoollog_logger *)
logger);
+ if (ret != 0) \
+ failwith_xl("cannot init context", NULL);
+ caml_leave_blocking_section();
+ CAMLreturn((value)ctx);
+}
+
+CAMLprim value stub_libxl_ctx_free(value ctx)
+{
+ CAMLparam1(ctx);
+
+ caml_enter_blocking_section();
+ libxl_ctx_free(CTX);
+ caml_leave_blocking_section();
+
+ CAMLreturn(Val_unit);
+}
+
static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size)
{
void *ptr;
@@ -311,6 +341,39 @@ static value Val_hwcap(libxl_hwcap *c_va
#include "_libxl_types.inc"
+value stub_libxl_list_domain(value ctx)
+{
+ CAMLparam1(ctx);
+ CAMLlocal2( cli, cons );
+ struct caml_gc gc;
+ libxl_dominfo *info;
+ int i, nr;
+
+ gc.offset = 0;
+ info = libxl_list_domain(CTX, &nr);
+ if (info == NULL)
+ failwith_xl("list_domain", NULL);
+
+ cli = Val_emptylist;
+
+ for (i = nr - 1; i >= 0; i--) {
+ cons = caml_alloc(2, 0);
+
+ /* Head */
+ Store_field(cons, 0, Val_dominfo(&gc, NULL, &info[i]));
+ /* Tail */
+ Store_field(cons, 1, cli);
+
+ cli = cons;
+ }
+
+ libxl_dominfo_list_free(info, nr);
+
+ gc_free(&gc);
+
+ CAMLreturn(cli);
+}
+
value stub_xl_device_disk_add(value info, value domid)
{
CAMLparam2(info, domid);
@@ -637,20 +700,20 @@ value stub_xl_send_sysrq(value domid, va
CAMLreturn(Val_unit);
}
-value stub_xl_send_debug_keys(value keys)
+value stub_xl_send_debug_keys(value ctx, value keys)
{
- CAMLparam1(keys);
+ CAMLparam2(ctx, keys);
int ret;
char *c_keys;
- INIT_STRUCT();
- c_keys = dup_String_val(&gc, keys);
+ c_keys = dup_String_val(NULL, keys);
- INIT_CTX();
- ret = libxl_send_debug_keys(ctx, c_keys);
+ ret = libxl_send_debug_keys(CTX, c_keys);
if (ret != 0)
- failwith_xl("send_debug_keys", &lg);
- FREE_CTX();
+ failwith_xl("send_debug_keys", NULL);
+
+ free(c_keys);
+
CAMLreturn(Val_unit);
}
diff -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/test/Makefile
--- a/tools/ocaml/test/Makefile Tue Nov 20 17:22:21 2012 +0000
+++ b/tools/ocaml/test/Makefile Tue Nov 20 17:22:21 2012 +0000
@@ -3,18 +3,31 @@ OCAML_TOPLEVEL = $(CURDIR)/..
include $(OCAML_TOPLEVEL)/common.make
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
-PROGRAMS = xtl
+PROGRAMS = xtl send_debug_keys list_domains
xtl_LIBS = \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog
$(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa
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 = 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 = list_domains
+
+OCAML_PROGRAM = xtl send_debug_keys list_domains
all: $(PROGRAMS)
diff -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/test/list_domains.ml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/test/list_domains.ml Tue Nov 20 17:22:21 2012 +0000
@@ -0,0 +1,26 @@
+open Arg
+open Printf
+open Xentoollog
+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 = Xentoollog.create_stdio_logger (*~level:Xentoollog.Debug*) () in
+ let ctx = Xenlight.ctx_alloc logger in
+ let domains = Xenlight.list_domain ctx in
+ List.iter (fun d -> print_dominfo d) domains;
+ Xenlight.ctx_free ctx;
+ Xentoollog.destroy logger;
+
diff -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/test/send_debug_keys.ml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/test/send_debug_keys.ml Tue Nov 20 17:22:21 2012 +0000
@@ -0,0 +1,17 @@
+open Arg
+open Printf
+open Xentoollog
+open Xenlight
+
+let send_keys ctx s =
+ printf "Sending debug key %s\n" s;
+ Xenlight.send_debug_keys ctx s;
+ ()
+
+let _ =
+ let logger = Xentoollog.create_stdio_logger () in
+ let ctx = Xenlight.ctx_alloc logger in
+ Arg.parse [
+ ] (fun s -> send_keys ctx s) "usage: send_debug_keys
<keys>";
+ Xenlight.ctx_free ctx;
+ Xentoollog.destroy logger
Rob Hoes
2012-Nov-30 10:55 UTC
Re: [PATCH 11 of 15] libxl: ocaml: allocate a long lived libxl context
> # HG changeset patch > # User Ian Campbell <ijc@hellion.org.uk> # Date 1353432141 0 # Node ID > bdd9c3e423d7f505f93edf413a92ad7b47ed9e39 > # Parent 2b433b1523e4295bb1ed74a7b71e2a20e00f1802 > libxl: ocaml: allocate a long lived libxl context. > > Rather than allocating a new context for every libxl call begin to switch to a > model where a context is allocated by the caller and may then be used for > multiple calls down into the library. > > As a starting point convert list_domains and send_debug_keys and > implement simple tests which use them. These are just PoC of the > infrastructure, I don''t intend to add one for every function... > > Signed-off-by: Ian Campbell <ian.campbell@citrix.com>Looks good to me. I just included a few minor comments below. Otherwise: Acked-by: Rob Hoes <rob.hoes@citrix.com> Cheers, Rob> diff -r 2b433b1523e4 -r bdd9c3e423d7 .gitignore > --- a/.gitignore Tue Nov 20 17:22:21 2012 +0000 > +++ b/.gitignore Tue Nov 20 17:22:21 2012 +0000 > @@ -365,7 +365,8 @@ tools/ocaml/libs/xl/xenlight.ml > 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/debugger/kdd/kdd > tools/firmware/etherboot/ipxe.tar.gz > tools/firmware/etherboot/ipxe/ > diff -r 2b433b1523e4 -r bdd9c3e423d7 .hgignore > --- a/.hgignore Tue Nov 20 17:22:21 2012 +0000 > +++ b/.hgignore Tue Nov 20 17:22:21 2012 +0000 > @@ -306,6 +306,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 -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/libs/xl/Makefile > --- a/tools/ocaml/libs/xl/Makefile Tue Nov 20 17:22:21 2012 +0000 > +++ b/tools/ocaml/libs/xl/Makefile Tue Nov 20 17:22:21 2012 +0000 > @@ -10,6 +10,8 @@ OBJS = xenlight > INTF = xenlight.cmi > LIBS = xenlight.cma xenlight.cmxa > > +OCAMLINCLUDE += -I ../xentoollog > + > LIBS_xenlight = $(LDLIBS_libxenlight) > > xenlight_OBJS = $(OBJS)I had to also add ''requires = "xentoollog"'' to tools/ocaml/libs/xl/META.in.> diff -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/libs/xl/xenlight.ml.in > --- a/tools/ocaml/libs/xl/xenlight.ml.in Tue Nov 20 17:22:21 2012 > +0000 > +++ b/tools/ocaml/libs/xl/xenlight.ml.in Tue Nov 20 17:22:21 2012 > +0000 > @@ -13,6 +13,8 @@ > * GNU Lesser General Public License for more details. > *) > > +open Xentoollog > + > exception Error of string > > type domid = int > @@ -24,8 +26,15 @@ end > > (* @@LIBXL_TYPES@@ *) > > +type ctx > + > +external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc" > +external ctx_free: ctx -> unit = "stub_libxl_ctx_free" > + > +external list_domain: ctx -> Dominfo.t list = "stub_libxl_list_domain"I wrote a similar function to this one, but instead used the IDL thing. I added "dominfo" to the list of functions in genwrap.py, with "list" and "get" functions, so in OCaml you can do something like ''Dominfo.list ctx''.> + > external send_trigger : domid -> trigger -> int -> unit > "stub_xl_send_trigger" > external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq" > -external send_debug_keys : domid -> string -> unit > "stub_xl_send_debug_keys" > +external send_debug_keys : ctx -> string -> unit > "stub_xl_send_debug_keys" > > let _ = Callback.register_exception "xl.error" (Error "register_callback") diff > -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/libs/xl/xenlight.mli.in > --- a/tools/ocaml/libs/xl/xenlight.mli.in Tue Nov 20 17:22:21 2012 > +0000 > +++ b/tools/ocaml/libs/xl/xenlight.mli.in Tue Nov 20 17:22:21 2012 > +0000 > @@ -13,6 +13,8 @@ > * GNU Lesser General Public License for more details. > *) > > +open Xentoollog > +You don''t really need to open this here if you are using the "Xentoollog." prefix as done below. I think is generally better to not use "open" too much, and just prefix values/functions and type with the module name, so it is easier to see where they come from, and you avoid namespace issues (open != #include). I''d only use "open" if there are lots of them. There are few more of these in other parts of the code.> exception Error of string > > type domid = int > @@ -20,6 +22,13 @@ type devid = int > > (* @@LIBXL_TYPES@@ *) > > +type ctx > + > +external ctx_alloc: Xentoollog.handle -> ctx = "stub_libxl_ctx_alloc" > +external ctx_free: ctx -> unit = "stub_libxl_ctx_free" > + > +external list_domain: ctx -> Dominfo.t list = "stub_libxl_list_domain" > + > external send_trigger : domid -> trigger -> int -> unit > "stub_xl_send_trigger" > external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq" > -external send_debug_keys : domid -> string -> unit > "stub_xl_send_debug_keys" > +external send_debug_keys : ctx -> string -> unit > "stub_xl_send_debug_keys" > diff -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/libs/xl/xenlight_stubs.c > --- a/tools/ocaml/libs/xl/xenlight_stubs.c Tue Nov 20 17:22:21 2012 > +0000 > +++ b/tools/ocaml/libs/xl/xenlight_stubs.c Tue Nov 20 17:22:21 2012 > +0000 > @@ -29,6 +29,8 @@ > #include <libxl.h> > #include <libxl_utils.h> > > +#define CTX ((libxl_ctx *)ctx) > + > struct caml_logger { > struct xentoollog_logger logger; > int log_offset; > @@ -59,6 +61,8 @@ static void log_destroy(struct xentoollo > lg.logger.vmessage = log_vmessage; \ > lg.logger.destroy = log_destroy; \ > lg.logger.progress = NULL; \ > + lg.log_offset = 0; \ > + memset(&lg.log_buf,0,sizeof(lg.log_buf)); \ > caml_enter_blocking_section(); \ > ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (struct > xentoollog_logger *) &lg); \ > if (ret != 0) \ > @@ -77,7 +81,7 @@ static char * dup_String_val(caml_gc *gc > c = calloc(len + 1, sizeof(char)); > if (!c) > caml_raise_out_of_memory(); > - gc->ptrs[gc->offset++] = c; > + if (gc) gc->ptrs[gc->offset++] = c; > memcpy(c, String_val(s), len); > return c; > } > @@ -94,9 +98,35 @@ static void failwith_xl(char *fname, str { > char *s; > s = (lg) ? lg->log_buf : fname; > + printf("Error: %s\n", fname); > caml_raise_with_string(*caml_named_value("xl.error"), s); } > > +CAMLprim value stub_libxl_ctx_alloc(value logger) { > + CAMLparam1(logger); > + libxl_ctx *ctx; > + int ret; > + > + caml_enter_blocking_section();I had to remove this to avoid segfaults, but that is probably due to the thing we discussed on the logger thread. If we are going completely async for all potentially blocking calls, we can remove this anyway.> + ret = libxl_ctx_alloc(&ctx, LIBXL_VERSION, 0, (struct > xentoollog_logger *) logger); > + if (ret != 0) \ > + failwith_xl("cannot init context", NULL); > + caml_leave_blocking_section(); > + CAMLreturn((value)ctx); > +} > + > +CAMLprim value stub_libxl_ctx_free(value ctx) { > + CAMLparam1(ctx); > + > + caml_enter_blocking_section(); > + libxl_ctx_free(CTX); > + caml_leave_blocking_section(); > + > + CAMLreturn(Val_unit); > +} > + > static void * gc_calloc(caml_gc *gc, size_t nmemb, size_t size) { > void *ptr; > @@ -311,6 +341,39 @@ static value Val_hwcap(libxl_hwcap *c_va > > #include "_libxl_types.inc" > > +value stub_libxl_list_domain(value ctx) { > + CAMLparam1(ctx); > + CAMLlocal2( cli, cons ); > + struct caml_gc gc; > + libxl_dominfo *info; > + int i, nr; > + > + gc.offset = 0; > + info = libxl_list_domain(CTX, &nr); > + if (info == NULL) > + failwith_xl("list_domain", NULL); > + > + cli = Val_emptylist; > + > + for (i = nr - 1; i >= 0; i--) { > + cons = caml_alloc(2, 0); > + > + /* Head */ > + Store_field(cons, 0, Val_dominfo(&gc, NULL, &info[i])); > + /* Tail */ > + Store_field(cons, 1, cli); > + > + cli = cons; > + } > + > + libxl_dominfo_list_free(info, nr); > + > + gc_free(&gc); > + > + CAMLreturn(cli); > +} > + > value stub_xl_device_disk_add(value info, value domid) { > CAMLparam2(info, domid); > @@ -637,20 +700,20 @@ value stub_xl_send_sysrq(value domid, va > CAMLreturn(Val_unit); > } > > -value stub_xl_send_debug_keys(value keys) > +value stub_xl_send_debug_keys(value ctx, value keys) > { > - CAMLparam1(keys); > + CAMLparam2(ctx, keys); > int ret; > char *c_keys; > - INIT_STRUCT(); > > - c_keys = dup_String_val(&gc, keys); > + c_keys = dup_String_val(NULL, keys); > > - INIT_CTX(); > - ret = libxl_send_debug_keys(ctx, c_keys); > + ret = libxl_send_debug_keys(CTX, c_keys); > if (ret != 0) > - failwith_xl("send_debug_keys", &lg); > - FREE_CTX(); > + failwith_xl("send_debug_keys", NULL); > + > + free(c_keys); > + > CAMLreturn(Val_unit); > } > > diff -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/test/Makefile > --- a/tools/ocaml/test/Makefile Tue Nov 20 17:22:21 2012 +0000 > +++ b/tools/ocaml/test/Makefile Tue Nov 20 17:22:21 2012 +0000 > @@ -3,18 +3,31 @@ OCAML_TOPLEVEL = $(CURDIR)/.. > include $(OCAML_TOPLEVEL)/common.make > > 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 > > -PROGRAMS = xtl > +PROGRAMS = xtl send_debug_keys list_domains > > xtl_LIBS = \ > -ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog > $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa > > 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 = 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 = list_domains > + > +OCAML_PROGRAM = xtl send_debug_keys list_domains > > all: $(PROGRAMS) > > diff -r 2b433b1523e4 -r bdd9c3e423d7 tools/ocaml/test/list_domains.ml > --- /dev/null Thu Jan 01 00:00:00 1970 +0000 > +++ b/tools/ocaml/test/list_domains.ml Tue Nov 20 17:22:21 2012 > +0000 > @@ -0,0 +1,26 @@ > +open Arg > +open Printf > +open Xentoollog > +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 = Xentoollog.create_stdio_logger > +(*~level:Xentoollog.Debug*) () in > + let ctx = Xenlight.ctx_alloc logger in > + let domains = Xenlight.list_domain ctx in > + List.iter (fun d -> print_dominfo d) domains; > + Xenlight.ctx_free ctx; > + Xentoollog.destroy logger; > + > diff -r 2b433b1523e4 -r bdd9c3e423d7 > tools/ocaml/test/send_debug_keys.ml > --- /dev/null Thu Jan 01 00:00:00 1970 +0000 > +++ b/tools/ocaml/test/send_debug_keys.ml Tue Nov 20 17:22:21 2012 > +0000 > @@ -0,0 +1,17 @@ > +open Arg > +open Printf > +open Xentoollog > +open Xenlight > + > +let send_keys ctx s > + printf "Sending debug key %s\n" s; > + Xenlight.send_debug_keys ctx s; > + () > + > +let _ > + let logger = Xentoollog.create_stdio_logger () in > + let ctx = Xenlight.ctx_alloc logger in > + Arg.parse [ > + ] (fun s -> send_keys ctx s) "usage: send_debug_keys <keys>"; > + Xenlight.ctx_free ctx; > + Xentoollog.destroy logger > > _______________________________________________ > Xen-devel mailing list > Xen-devel@lists.xen.org > http://lists.xen.org/xen-devel