Mailing List Archive

[PATCH 15 of 15] libxl: ocaml: add bindings for libxl_domain_create_new
# HG changeset patch
# User Ian Campbell <ijc@hellion.org.uk>
# Date 1353432141 0
# Node ID 72376896ba08bb7035ad4b7ed5a91c2c1b45b905
# Parent 41f0137955f4a1a5a76ad34a5a6440e32d0090ef
libxl: ocaml: add bindings for libxl_domain_create_new

** NOT TO BE APPLIED **

Add a simple stub thing which should build a domain. Except it is
incomplete and doesn't actually build. Hence RFC.

It's a bit tedious to have to give empty values for everything. This
suggests that a better API would be for anything in the libxl API
which has the concept of a default type should be a FOO option in the
ocaml binding. Or is that tedious on the ocaml side?

Or is there some way to declare only a partially initialised struct
in ocaml (in a way which can be sensibly marshalled to C).

diff -r 41f0137955f4 -r 72376896ba08 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
@@ -72,4 +72,6 @@ external send_trigger : domid -> trigger
external send_sysrq : domid -> char -> unit = "stub_xl_send_sysrq"
external send_debug_keys : ctx -> string -> unit = "stub_xl_send_debug_keys"

+external domain_create_new : ctx -> Domain_config.t -> domid = "stub_xl_domain_create_new"
+
let _ = Callback.register_exception "Xenlight.Error" (Error(Fail, ""))
diff -r 41f0137955f4 -r 72376896ba08 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
@@ -54,3 +54,6 @@ external list_domain: ctx -> Dominfo.t l
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 : ctx -> string -> unit = "stub_xl_send_debug_keys"
+
+/* XXX: const libxl_asyncop_how *ao_how, const libxl_asyncprogress_how *aop_console_how */
+external domain_create_new :ctx -> Domain_config.t -> domid = "stub_xl_domain_create_new"
diff -r 41f0137955f4 -r 72376896ba08 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
@@ -518,6 +518,23 @@ value stub_xl_send_debug_keys(value ctx,
CAMLreturn(Val_unit);
}

+value stub_xl_domain_create_new(value ctx, value domain_config)
+{
+ CAMLparam2(ctx, domain_config);
+ int ret;
+ libxl_domain_config c_dconfig;
+ uint32_t c_domid;
+
+ ret = libxl_domain_create_new(CTX, &c_dconfig, &c_domid,
+ NULL, NULL);
+ if (ret != 0)
+ failwith_xl(ret, "domain_create_new");
+
+ libxl_domain_config_dispose(&c_dconfig);
+
+ CAMLreturn(Val_int(c_domid));
+}
+
/*
* Local variables:
* indent-tabs-mode: t
diff -r 41f0137955f4 -r 72376896ba08 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
@@ -6,9 +6,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 build_domain

-PROGRAMS = xtl send_debug_keys list_domains raise_exception
+PROGRAMS = xtl send_debug_keys list_domains raise_exception build_domain

xtl_LIBS = \
-ccopt -L -ccopt $(OCAML_TOPLEVEL)/libs/xentoollog $(OCAML_TOPLEVEL)/libs/xentoollog/xentoollog.cmxa
@@ -33,7 +33,13 @@ raise_exception_LIBS = \

raise_exception_OBJS = raise_exception

-OCAML_PROGRAM = xtl send_debug_keys list_domains raise_exception
+build_domain_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
+
+build_domain_OBJS = build_domain
+
+OCAML_PROGRAM = xtl send_debug_keys list_domains raise_exception build_domain

all: $(PROGRAMS)

diff -r 41f0137955f4 -r 72376896ba08 tools/ocaml/test/build_domain.ml
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/tools/ocaml/test/build_domain.ml Tue Nov 20 17:22:21 2012 +0000
@@ -0,0 +1,42 @@
+open Arg
+open Printf
+open Xentoollog
+open Xenlight
+
+let _ =
+ let logger = Xentoollog.create_stdio_logger ~level:Xentoollog.Debug () in
+ let ctx = Xenlight.ctx_alloc logger in
+ let c_info = {
+ Xenlight.Domain_create_info.hap = None;
+ Xenlight.Domain_create_info.oos = None;
+ Xenlight.Domain_create_info.name = "Test;
+ }
+ and b_info = {
+ Xenlight.Domain_build_info.max_vcpus = 1;
+ Xenlight.Domain_build_info.avail_vcpus = [| |];
+ Xenlight.Domain_build_info.cpumap = [| |];
+ Xenlight.Domain_build_info.numa_placement = None;
+ Xenlight.Domain_build_info.tsc_mode = Xenlight.TSC_MODE_DEFAULT;
+ Xenlight.Domain_build_info.max_memkb = 1024L;
+ Xenlight.Domain_build_info.target_memkb = 1024L;
+ Xenlight.Domain_build_info.video_memkb = 0L;
+ Xenlight.Domain_build_info.shadow_memkb = 0L;
+ Xenlight.Domain_build_info.rtc_timeoffset = 0L;
+ } in
+ let d_info = {
+ Xenlight.Domain_config.b_info = b_info;
+ Xenlight.Domain_config.c_info = c_info;
+ Xenlight.Domain_config.disks = [| |];
+ Xenlight.Domain_config.nics = [| |];
+ Xenlight.Domain_config.vfbs = [| |];
+ Xenlight.Domain_config.vkbs = [| |];
+ Xenlight.Domain_config.pcidevs = [| |];
+ (*Xenlight.Domain_config.on_poweroff = Xenlight.Action_on_shutdown.dESTROY;*)
+ } in
+ try
+ Xenlight.domain_create_new ctx d_info;
+ Xenlight.ctx_free ctx;
+ Xentoollog.destroy logger;
+ with Xenlight.Error(err, fn) -> begin
+ printf "Caught Exception: %s: %s\n" (Xenlight.string_of_error err) fn;
+ end

_______________________________________________
Xen-devel mailing list
Xen-devel@lists.xen.org
http://lists.xen.org/xen-devel