[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Xen-API] [PATCH 11 of 15] libxl: ocaml: allocate a long lived libxl context



# HG changeset patch
# User Ian Campbell <ijc@xxxxxxxxxxxxxx>
# 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@xxxxxxxxxx>

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

_______________________________________________
Xen-api mailing list
Xen-api@xxxxxxxxxxxxx
http://lists.xen.org/cgi-bin/mailman/listinfo/xen-api


 


Rackspace

Lists.xenproject.org is hosted with RackSpace, monitoring our
servers 24x7x365 and backed by RackSpace's Fanatical Support®.